From: Camm Maguire Date: Mon, 30 Dec 2019 15:46:22 +0000 (+0000) Subject: Import gcl_2.6.12-92.debian.tar.xz X-Git-Tag: archive/raspbian/2.6.12-92+rpi1^2~114^2 X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=b463437a230b4dad535125d6f208359b3e0dc19c;p=gcl.git Import gcl_2.6.12-92.debian.tar.xz [dgit import tarball gcl 2.6.12-92 gcl_2.6.12-92.debian.tar.xz] --- b463437a230b4dad535125d6f208359b3e0dc19c diff --git a/README.Debian b/README.Debian new file mode 100644 index 00000000..81749750 --- /dev/null +++ b/README.Debian @@ -0,0 +1,28 @@ +The Debian package gcl +---------------------- + +GCL is one of the oldest free common lisp systems still in use. Several +production systems have used it for over a decade. The common lisp +standard in effect when GCL was first released is known as "Common Lisp, +the Language" (CLtL1) after a book by Steele of the same name providing +this specification. Subsequently, a much expanded standard was adopted by +the American National Standards Institute (ANSI), which is still +considered the definitive common lisp language specification to this day. + +Debian GCL now installs both the small 'traditional' lisp image +designed to conform to a pre-ANSI Lisp standard, and an experimental +ANSI image. Please note that ANSI support in GCL is still +preliminary. On an ansi-test suite written by a GCL developer, GCL +fails on a little under 3 percent of the tests. Details can be found +in /usr/share/doc/gcl/test_results.gz. + +To toggle the use of the ANSI image, set the environment variable +GCL_ANSI to any non-empty string. + +New in 2.6.2 +------------ + +Please see the RELEASE-2.6.2.html file for release note information, +regression testing, and sample benchmarks. + + -- Camm Maguire , Wed Dec 14 18:55:19 2005 diff --git a/changelog b/changelog new file mode 100644 index 00000000..29f18157 --- /dev/null +++ b/changelog @@ -0,0 +1,3990 @@ +gcl (2.6.12-92) unstable; urgency=medium + + * Version_2_6_13pre89 + + -- Camm Maguire Mon, 30 Dec 2019 15:46:22 +0000 + +gcl (2.6.12-91) unstable; urgency=medium + + * Version_2_6_13pre88 + + -- Camm Maguire Wed, 18 Dec 2019 20:14:09 +0000 + +gcl (2.6.12-90) unstable; urgency=medium + + * Version_2_6_13pre87 + * latest standards + + -- Camm Maguire Sun, 08 Dec 2019 19:27:24 +0000 + +gcl (2.6.12-89) unstable; urgency=medium + + * Bug fix: "gcl - FTBFS on ppc64el - invalid relocation type 31", thanks + to thierry.fauck@fr.ibm.com; (Closes: #942312). + * Bug fix: "FTBFS on ppc64el", thanks to Ivo De Decker (Closes: + #944651). + + -- Camm Maguire Sat, 07 Dec 2019 23:27:53 +0000 + +gcl (2.6.12-88) unstable; urgency=medium + + * Source only upload + + -- Camm Maguire Fri, 11 Oct 2019 19:18:44 +0000 + +gcl (2.6.12-87) unstable; urgency=medium + + * Version_2_6_13pre84 + + -- Camm Maguire Sat, 06 Apr 2019 13:03:21 +0000 + +gcl (2.6.12-86) unstable; urgency=medium + + * Version_2_6_13pre83 + + -- Camm Maguire Tue, 02 Apr 2019 19:57:15 +0000 + +gcl (2.6.12-85) unstable; urgency=medium + + * Version_2_6_13pre82 + + -- Camm Maguire Thu, 28 Mar 2019 18:48:55 +0000 + +gcl (2.6.12-84) unstable; urgency=medium + + * Version_2_6_13pre80 + + -- Camm Maguire Thu, 21 Mar 2019 18:59:40 +0000 + +gcl (2.6.12-83) unstable; urgency=high + + * Version_2_6_13pre79 + * Fix acl2 arm builds (Closes: #919477). + + -- Camm Maguire Tue, 05 Feb 2019 21:54:42 +0000 + +gcl (2.6.12-82) unstable; urgency=high + + * Version_2_6_13pre74 + + -- Camm Maguire Sat, 02 Feb 2019 17:40:20 +0000 + +gcl (2.6.12-81) unstable; urgency=high + + * Version_2_6_13pre72 + * Fix to ppc64el for acl2 FTBFS bug + + -- Camm Maguire Mon, 21 Jan 2019 16:40:36 +0000 + +gcl (2.6.12-80) unstable; urgency=medium + + * Version_2_6_13pre71 + * Bug fix: "FTBFS on hppa - segmentation fault assembling gbc.s", thanks + to John David Anglin (Closes: #912071). + + -- Camm Maguire Tue, 30 Oct 2018 17:20:43 +0000 + +gcl (2.6.12-79) unstable; urgency=medium + + * Version_2_6_13pre70 + + -- Camm Maguire Mon, 29 Oct 2018 16:52:17 +0000 + +gcl (2.6.12-78) unstable; urgency=medium + + * rebuild against latest compilers and tools + * Version_2_6_13pre69 + + -- Camm Maguire Thu, 11 Oct 2018 16:40:48 +0000 + +gcl (2.6.12-77) unstable; urgency=medium + + * Version_2_6_13pre68 + * Bug fix: "GCL fails to load .o files it generates", thanks to Gong-Yi + Liao (Closes: #902475). Add support for R_X86_64_PLT32 relocs. + + -- Camm Maguire Tue, 24 Jul 2018 20:06:45 +0000 + +gcl (2.6.12-76) unstable; urgency=medium + + * Version_2_6_13pre67 + + -- Camm Maguire Fri, 23 Mar 2018 19:25:22 +0000 + +gcl (2.6.12-75) unstable; urgency=medium + + * Version_2_6_13pre65 + + -- Camm Maguire Wed, 21 Mar 2018 20:28:08 +0000 + +gcl (2.6.12-74) unstable; urgency=medium + + * Version_2_6_13pre63 + + -- Camm Maguire Sat, 17 Mar 2018 11:56:05 +0000 + +gcl (2.6.12-73) unstable; urgency=medium + + * Version_2_6_13pre62 + + -- Camm Maguire Wed, 14 Mar 2018 15:38:43 +0000 + +gcl (2.6.12-72) unstable; urgency=medium + + * Version_2_6_13pre61 + + -- Camm Maguire Tue, 13 Mar 2018 15:32:44 +0000 + +gcl (2.6.12-71) unstable; urgency=medium + + * Version_2_6_13pre60 + + -- Camm Maguire Mon, 12 Mar 2018 19:44:47 +0000 + +gcl (2.6.12-70) unstable; urgency=medium + + * Version_2_6_13pre59 + + -- Camm Maguire Mon, 12 Mar 2018 16:19:00 +0000 + +gcl (2.6.12-69) unstable; urgency=medium + + * Version_2_6_13pre58 + + -- Camm Maguire Fri, 09 Mar 2018 17:10:51 +0000 + +gcl (2.6.12-68) unstable; urgency=medium + + * Version_2_6_13pre57 + + -- Camm Maguire Sun, 04 Mar 2018 13:21:00 +0000 + +gcl (2.6.12-67) unstable; urgency=medium + + * Version_2_6_13pre55 + + -- Camm Maguire Sat, 03 Mar 2018 14:27:51 +0000 + +gcl (2.6.12-66) unstable; urgency=medium + + * Version_2_6_13pre54 + + -- Camm Maguire Fri, 02 Mar 2018 21:19:03 +0000 + +gcl (2.6.12-65) unstable; urgency=medium + + * Version_2_6_13pre52 + * Bug fix: "FTBFS on hurd-i386", thanks to svante.signell@gmail.com; + (Closes: #802593). + + -- Camm Maguire Fri, 23 Feb 2018 15:55:23 +0000 + +gcl (2.6.12-64) unstable; urgency=medium + + * list_order.24 + + -- Camm Maguire Sun, 04 Feb 2018 13:26:27 +0000 + +gcl (2.6.12-63) unstable; urgency=medium + + * list_order.23 + + -- Camm Maguire Thu, 01 Feb 2018 18:36:29 +0000 + +gcl (2.6.12-62) unstable; urgency=medium + + * list_order.22 + + -- Camm Maguire Thu, 01 Feb 2018 01:05:10 +0000 + +gcl (2.6.12-61) unstable; urgency=medium + + * list_order.21 + + -- Camm Maguire Tue, 30 Jan 2018 21:13:13 +0000 + +gcl (2.6.12-60) unstable; urgency=medium + + * list_order.19 + + -- Camm Maguire Tue, 23 Jan 2018 18:11:59 +0000 + +gcl (2.6.12-59) unstable; urgency=medium + + * list_order.16 + + -- Camm Maguire Fri, 12 Jan 2018 03:25:08 +0000 + +gcl (2.6.12-58) unstable; urgency=medium + + * list_order.14 + + -- Camm Maguire Mon, 18 Sep 2017 15:45:10 +0000 + +gcl (2.6.12-57) unstable; urgency=medium + + * list_order.13 + + -- Camm Maguire Fri, 25 Aug 2017 13:44:10 +0000 + +gcl (2.6.12-56) unstable; urgency=medium + + * list_order.12 + + -- Camm Maguire Thu, 24 Aug 2017 19:12:50 +0000 + +gcl (2.6.12-55) unstable; urgency=medium + + * disable gprof on aarch64 + * Bug fix: "gcl FTBFS on arm64: Unrecoverable error: Segmentation + violation..", thanks to Adrian Bunk (Closes: #873052). + + -- Camm Maguire Thu, 24 Aug 2017 16:37:07 +0000 + +gcl (2.6.12-54) unstable; urgency=medium + + * list_order.11 + + -- Camm Maguire Wed, 23 Aug 2017 22:19:14 +0000 + +gcl (2.6.12-53) unstable; urgency=medium + + * list_order.9 + + -- Camm Maguire Sun, 18 Jun 2017 18:32:30 +0000 + +gcl (2.6.12-52) unstable; urgency=medium + + * list_order.8 + + -- Camm Maguire Thu, 15 Jun 2017 18:04:41 +0000 + +gcl (2.6.12-51) unstable; urgency=medium + + * list_order.7 + + -- Camm Maguire Wed, 14 Jun 2017 18:30:46 +0000 + +gcl (2.6.12-50) unstable; urgency=medium + + * list_order.6 + + -- Camm Maguire Tue, 13 Jun 2017 22:38:52 +0000 + +gcl (2.6.12-49) unstable; urgency=medium + + * list_order.5 + + -- Camm Maguire Thu, 08 Jun 2017 17:21:01 +0000 + +gcl (2.6.12-48) unstable; urgency=medium + + * list_order.1 + + -- Camm Maguire Sun, 28 May 2017 01:42:29 +0000 + +gcl (2.6.12-47) unstable; urgency=high + + * pathnames1.13 + + -- Camm Maguire Tue, 22 Nov 2016 04:53:35 +0000 + +gcl (2.6.12-46) unstable; urgency=high + + * pathnames1.12 + * Bug fix: "maintainer script(s) do not start on #!", thanks to + treinen@debian.org; (Closes: #843303). + + -- Camm Maguire Fri, 18 Nov 2016 18:27:53 +0000 + +gcl (2.6.12-45) unstable; urgency=high + + * pathnames1.11 + + -- Camm Maguire Mon, 31 Oct 2016 22:57:27 +0000 + +gcl (2.6.12-44) unstable; urgency=high + + * pathnames1.9 + + -- Camm Maguire Fri, 28 Oct 2016 17:04:38 +0000 + +gcl (2.6.12-43) unstable; urgency=medium + + * pathnames1.7 + + -- Camm Maguire Thu, 27 Oct 2016 03:46:32 +0000 + +gcl (2.6.12-42) unstable; urgency=medium + + * pathnames1.6 + * Bug fix: "FTBFS with bindnow and PIE enabled", thanks to Balint Reczey + (Closes: #837481). + * Bug fix: "FTBFS with compilers that default to -fPIE (patch + attached)", thanks to Adam Conrad (Closes: #822820). + + -- Camm Maguire Wed, 26 Oct 2016 23:04:57 +0000 + +gcl (2.6.12-41) unstable; urgency=medium + + * pathnames1.4, kfreebsd fix + + -- Camm Maguire Fri, 14 Oct 2016 01:17:18 +0000 + +gcl (2.6.12-40) unstable; urgency=medium + + * pathnames1.2 + * Bug fix: "popen arguments not quoted causes trouble and security + issues", thanks to axel (Closes: #802203). + + -- Camm Maguire Wed, 12 Oct 2016 18:09:26 +0000 + +gcl (2.6.12-39) unstable; urgency=medium + + * pathnames1.1 + * ansi-test clean target + + -- Camm Maguire Wed, 12 Oct 2016 01:32:05 +0000 + +gcl (2.6.12-38) unstable; urgency=medium + + * Version_2_6_13pre50 + + -- Camm Maguire Tue, 04 Oct 2016 19:45:38 +0000 + +gcl (2.6.12-37) unstable; urgency=medium + + * Version_2_6_13pre49 + + -- Camm Maguire Mon, 03 Oct 2016 14:54:09 +0000 + +gcl (2.6.12-36) unstable; urgency=medium + + * Version_2_6_13pre48 + + -- Camm Maguire Sat, 01 Oct 2016 12:10:25 +0000 + +gcl (2.6.12-35) unstable; urgency=medium + + * Version_2_6_13pre47 + + -- Camm Maguire Fri, 30 Sep 2016 21:21:43 +0000 + +gcl (2.6.12-34) unstable; urgency=medium + + * Version_2_6_13pre45 + + -- Camm Maguire Fri, 23 Sep 2016 19:42:37 +0000 + +gcl (2.6.12-33) unstable; urgency=medium + + * Version_2_6_13pre43 + + -- Camm Maguire Tue, 03 May 2016 16:17:03 +0000 + +gcl (2.6.12-32) unstable; urgency=medium + + * Version_2_6_13pre40 + * Bug fix: "[INTL:pt_BR] Brazilian Portuguese debconf templates + translation", thanks to Adriano Rafael Gomes (Closes: #811523). + + -- Camm Maguire Wed, 20 Apr 2016 15:18:35 +0000 + +gcl (2.6.12-31) unstable; urgency=medium + + * Version_2_6_13pre39 + + -- Camm Maguire Mon, 11 Apr 2016 00:41:11 +0000 + +gcl (2.6.12-30) unstable; urgency=medium + + * Version_2_6_13pre38 + + -- Camm Maguire Wed, 06 Apr 2016 00:20:15 +0000 + +gcl (2.6.12-29) unstable; urgency=medium + + * Version_2_6_13pre35; support latest binutils + * Bug fix: "gcl ftbfs on amd64 and i386 with binutils from + experimental", thanks to Matthias Klose (Closes: #803214). + + -- Camm Maguire Thu, 29 Oct 2015 15:20:27 +0000 + +gcl (2.6.12-28) unstable; urgency=medium + + * Version_2_6_13pre35; restore hppa build + + -- Camm Maguire Tue, 27 Oct 2015 20:00:46 +0000 + +gcl (2.6.12-27) unstable; urgency=medium + + * Version_2_6_13pre34; mips64 relocs; stack saving tail-recursive equal. + + -- Camm Maguire Tue, 27 Oct 2015 16:35:06 +0000 + +gcl (2.6.12-26) unstable; urgency=medium + + * Version_2_6_13pre32 + + -- Camm Maguire Fri, 23 Oct 2015 00:03:34 +0000 + +gcl (2.6.12-25) unstable; urgency=medium + + * Version_2_6_13pre31, kfreebsd and mips64 FTBFS fix + + -- Camm Maguire Fri, 16 Oct 2015 15:03:03 +0000 + +gcl (2.6.12-24) unstable; urgency=medium + + * Version_2_6_13pre30 + + -- Camm Maguire Fri, 16 Oct 2015 02:44:23 +0000 + +gcl (2.6.12-23) unstable; urgency=medium + + * Version_2_6_13pre29 + + -- Camm Maguire Thu, 15 Oct 2015 18:09:59 +0000 + +gcl (2.6.12-22) unstable; urgency=medium + + * Version_2_6_13pre27 + + -- Camm Maguire Tue, 13 Oct 2015 14:38:53 +0000 + +gcl (2.6.12-21) unstable; urgency=medium + + * Version_2_6_13pre26 + + -- Camm Maguire Wed, 07 Oct 2015 15:14:27 +0000 + +gcl (2.6.12-20) unstable; urgency=medium + + * Version_2_6_13pre25 + + -- Camm Maguire Thu, 01 Oct 2015 15:16:14 +0000 + +gcl (2.6.12-19) unstable; urgency=medium + + * Use-dpkg-buidflags-opt-levels-in-debian-rules, -O3 has bug in 5.2.1 + * Version_2_6_13pre24 + + -- Camm Maguire Wed, 30 Sep 2015 15:45:20 +0000 + +gcl (2.6.12-18) unstable; urgency=medium + + * Version_2_6_13pre22 + + -- Camm Maguire Tue, 29 Sep 2015 16:51:03 +0000 + +gcl (2.6.12-17) unstable; urgency=medium + + * Version_2_6_13pre20 + + -- Camm Maguire Sat, 26 Sep 2015 10:34:23 -0400 + +gcl (2.6.12-16) unstable; urgency=medium + + * Version_2_6_13pre19 + + -- Camm Maguire Fri, 25 Sep 2015 18:39:52 -0400 + +gcl (2.6.12-15) unstable; urgency=medium + + * Version_2_6_13pre18 + + -- Camm Maguire Fri, 25 Sep 2015 15:08:50 +0000 + +gcl (2.6.12-14) unstable; urgency=medium + + * Version_2_6_13pre17 + + -- Camm Maguire Thu, 28 May 2015 03:37:47 +0000 + +gcl (2.6.12-13) unstable; urgency=medium + + * Version_2_6_13pre16 + + -- Camm Maguire Fri, 15 May 2015 18:09:38 +0000 + +gcl (2.6.12-12) unstable; urgency=medium + + * Version_2_6_13pre13 + + -- Camm Maguire Fri, 01 May 2015 11:08:46 -0400 + +gcl (2.6.12-11) unstable; urgency=medium + + * Version_2_6_13pre12 + + -- Camm Maguire Thu, 30 Apr 2015 12:49:16 -0400 + +gcl (2.6.12-10) unstable; urgency=medium + + * rebuild in clean sid environment + + -- Camm Maguire Mon, 27 Apr 2015 15:34:15 -0400 + +gcl (2.6.12-9) unstable; urgency=medium + + * Version_2_6_13pre8b + * Bug fix: "ftbfs with GCC-5", thanks to Matthias Klose (Closes: + #777866). + + -- Camm Maguire Mon, 27 Apr 2015 12:32:49 -0400 + +gcl (2.6.12-8) unstable; urgency=medium + + * Version_2_6_13pre7 + + -- Camm Maguire Fri, 24 Apr 2015 13:38:30 -0400 + +gcl (2.6.12-7) unstable; urgency=medium + + * Version_2_6_13pre6 + + -- Camm Maguire Thu, 23 Apr 2015 13:43:45 -0400 + +gcl (2.6.12-6) unstable; urgency=medium + + * Version_2_6_13pre5 + + -- Camm Maguire Wed, 22 Apr 2015 17:14:16 -0400 + +gcl (2.6.12-5) unstable; urgency=medium + + * Version_2_6_13pre4 + + -- Camm Maguire Wed, 22 Apr 2015 10:25:36 -0400 + +gcl (2.6.12-4) unstable; urgency=medium + + * Version_2_6_13pre3a + + -- Camm Maguire Mon, 20 Apr 2015 13:26:36 -0400 + +gcl (2.6.12-3) unstable; urgency=medium + + * Version_2_6_13pre2 + + -- Camm Maguire Fri, 17 Apr 2015 15:50:37 -0400 + +gcl (2.6.12-2) unstable; urgency=medium + + * Version_2_6_13pre1 + + -- Camm Maguire Wed, 26 Nov 2014 11:12:46 -0500 + +gcl (2.6.12-1) unstable; urgency=medium + + * New upstream release + + -- Camm Maguire Tue, 28 Oct 2014 09:56:15 -0400 + +gcl (2.6.11-6) unstable; urgency=medium + + * 2.6.12pre5 + + -- Camm Maguire Thu, 23 Oct 2014 17:33:22 -0400 + +gcl (2.6.11-5) unstable; urgency=medium + + * 2.6.12pre4 + + -- Camm Maguire Sat, 18 Oct 2014 09:46:34 -0400 + +gcl (2.6.11-4) unstable; urgency=medium + + * 2.6.12pre3 + + -- Camm Maguire Thu, 16 Oct 2014 11:56:15 -0400 + +gcl (2.6.11-3) unstable; urgency=medium + + * 2.6.12pre2 + + -- Camm Maguire Sun, 28 Sep 2014 20:56:18 -0400 + +gcl (2.6.11-2) unstable; urgency=medium + + * 2.6.12pre1 + + -- Camm Maguire Fri, 19 Sep 2014 14:49:25 -0400 + +gcl (2.6.11-1) unstable; urgency=medium + + * New upstream release + + -- Camm Maguire Sat, 06 Sep 2014 12:28:46 -0400 + +gcl (2.6.10-54) unstable; urgency=medium + + * remove-debug-message-from-BUGGY_MAXIMUM_SSCANF_LENGTH-code + + -- Camm Maguire Fri, 05 Sep 2014 10:35:46 -0400 + +gcl (2.6.10-53) unstable; urgency=medium + + * ppc64le-support-headers + + -- Camm Maguire Wed, 03 Sep 2014 15:02:12 -0400 + +gcl (2.6.10-52) unstable; urgency=medium + + * accept-TMP-paths-with-types-versions + + -- Camm Maguire Fri, 29 Aug 2014 17:51:04 -0400 + +gcl (2.6.10-51) unstable; urgency=medium + + * fix-match-function-proclaim-skew + + -- Camm Maguire Fri, 29 Aug 2014 16:40:30 +0000 + +gcl (2.6.10-50) unstable; urgency=medium + + * trial_selinux_support + + -- Camm Maguire Thu, 21 Aug 2014 17:29:50 +0000 + +gcl (2.6.10-49) unstable; urgency=medium + + * R_ARM_JUMP24 + + -- Camm Maguire Wed, 20 Aug 2014 17:08:23 +0000 + +gcl (2.6.10-48) unstable; urgency=medium + + * try-SGC-for-aarch64 + + -- Camm Maguire Tue, 19 Aug 2014 18:35:22 +0000 + +gcl (2.6.10-47) unstable; urgency=medium + + * set-stack_guard-after-alloc-setup + * Bug fix: "work around build failure on AArch64", thanks to Matthias + Klose (Closes: #758101). + + -- Camm Maguire Thu, 14 Aug 2014 19:36:48 +0000 + +gcl (2.6.10-46) unstable; urgency=medium + + * R_AARCH64_LDST128_ABS_LO12_NC + + -- Camm Maguire Wed, 13 Aug 2014 21:39:50 +0000 + +gcl (2.6.10-45) unstable; urgency=medium + + * fix sh4 CLEAR_CACHE + + -- Camm Maguire Sun, 10 Aug 2014 20:12:03 +0000 + +gcl (2.6.10-44) unstable; urgency=medium + + * clear_protect_memory on all elf machines + + -- Camm Maguire Sat, 09 Aug 2014 00:55:17 +0000 + +gcl (2.6.10-43) unstable; urgency=medium + + * mips uses builtin_clear_cache like mipsel + + -- Camm Maguire Fri, 08 Aug 2014 23:42:42 +0000 + +gcl (2.6.10-42) unstable; urgency=medium + + * backport travel_push_new from master + + -- Camm Maguire Wed, 06 Aug 2014 20:14:14 +0000 + +gcl (2.6.10-41) unstable; urgency=medium + + * protos and CFLAGS for axiom extensions + + -- Camm Maguire Wed, 06 Aug 2014 01:54:38 +0000 + +gcl (2.6.10-40) unstable; urgency=medium + + * better solaris unexec fix + + -- Camm Maguire Mon, 04 Aug 2014 22:00:54 +0000 + +gcl (2.6.10-39) unstable; urgency=medium + + * earlier prelink_init, phys_pages w/o malloc + + -- Camm Maguire Mon, 04 Aug 2014 16:52:09 +0000 + +gcl (2.6.10-38) unstable; urgency=medium + + * error on overflow of array dimensions + + -- Camm Maguire Fri, 01 Aug 2014 14:35:44 +0000 + +gcl (2.6.10-37) unstable; urgency=medium + + * FILE * casts for windows feof wrapper + + -- Camm Maguire Thu, 31 Jul 2014 02:17:11 +0000 + +gcl (2.6.10-36) unstable; urgency=medium + + * better casts for frs_jmpbuf + + -- Camm Maguire Wed, 30 Jul 2014 17:00:06 +0000 + +gcl (2.6.10-35) unstable; urgency=medium + + * find_sym_ptable typo fix + + -- Camm Maguire Tue, 29 Jul 2014 18:08:57 +0000 + +gcl (2.6.10-34) unstable; urgency=medium + + * --enable-prelink configure arg; stack_chk_guard for 68k + + -- Camm Maguire Fri, 25 Jul 2014 20:39:10 +0000 + +gcl (2.6.10-33) unstable; urgency=medium + + * hurd stack_guard, ppc64 C_GC_OFFSET + + -- Camm Maguire Thu, 24 Jul 2014 21:46:24 +0000 + +gcl (2.6.10-32) unstable; urgency=medium + + * __stack_chk_guard fix for arm/sh4 + + -- Camm Maguire Wed, 23 Jul 2014 18:12:56 +0000 + +gcl (2.6.10-31) unstable; urgency=medium + + * dpkg-buildflags trial + + -- Camm Maguire Tue, 22 Jul 2014 20:06:10 +0000 + +gcl (2.6.10-30) unstable; urgency=medium + + * fix offsets ppc + + -- Camm Maguire Tue, 22 Jul 2014 17:12:27 +0000 + +gcl (2.6.10-29) unstable; urgency=medium + + * fix unexec file offsets + + -- Camm Maguire Tue, 22 Jul 2014 15:36:45 +0000 + +gcl (2.6.10-28) unstable; urgency=high + + * enable prelink + + -- Camm Maguire Fri, 18 Jul 2014 19:24:38 +0000 + +gcl (2.6.10-27) unstable; urgency=high + + * protect closure calls from gc + + -- Camm Maguire Wed, 16 Jul 2014 16:15:33 +0000 + +gcl (2.6.10-26) unstable; urgency=high + + * Bug fix: "packages should not build-depend on binutils-dev", thanks to + Matthias Klose (Closes: #754840). Please note that gcl has long + depended on binutils-dev for good reason -- happily it is no longer + necessary + + -- Camm Maguire Tue, 15 Jul 2014 16:04:04 +0000 + +gcl (2.6.10-25) unstable; urgency=high + + * rebuild to get gcc fixes on i386 + + -- Camm Maguire Fri, 11 Jul 2014 03:14:45 +0000 + +gcl (2.6.10-24) unstable; urgency=high + + * try default gcc 4.9 + * access libopcodes without link dependency via dlopen + * Bug fix: "please switch to emacs24", thanks to Gabriele Giacone + (Closes: #754012). + + -- Camm Maguire Wed, 09 Jul 2014 17:34:21 +0000 + +gcl (2.6.10-23) unstable; urgency=high + + * rebuild latest binutils + + -- Camm Maguire Sat, 05 Jul 2014 23:19:27 +0000 + +gcl (2.6.10-22) unstable; urgency=high + + * gcc-4.8 on i386, 4.9 has bugs at present + + -- Camm Maguire Fri, 04 Jul 2014 01:36:06 +0000 + +gcl (2.6.10-21) unstable; urgency=high + + * 2.6.11pre test 20 + + -- Camm Maguire Mon, 30 Jun 2014 22:43:27 +0000 + +gcl (2.6.10-20) unstable; urgency=high + + * 2.6.11pre test 19 + + -- Camm Maguire Sun, 29 Jun 2014 17:59:59 +0000 + +gcl (2.6.10-19) unstable; urgency=high + + * 2.6.11pre test 18 + + -- Camm Maguire Sun, 29 Jun 2014 16:00:07 +0000 + +gcl (2.6.10-18) unstable; urgency=high + + * 2.6.11pre test 17 + + -- Camm Maguire Sat, 28 Jun 2014 16:57:54 +0000 + +gcl (2.6.10-17) unstable; urgency=high + + * 2.6.11pre test 16 + + -- Camm Maguire Thu, 26 Jun 2014 18:06:42 +0000 + +gcl (2.6.10-16) unstable; urgency=high + + * 2.6.11pre test 15 + + -- Camm Maguire Wed, 18 Jun 2014 17:37:36 +0000 + +gcl (2.6.10-15) unstable; urgency=high + + * 2.6.11pre test 14 + + -- Camm Maguire Tue, 17 Jun 2014 00:39:35 +0000 + +gcl (2.6.10-14) unstable; urgency=high + + * 2.6.11pre test 13 + + -- Camm Maguire Sat, 14 Jun 2014 13:43:57 +0000 + +gcl (2.6.10-13) unstable; urgency=high + + * 2.6.11pre test 12 + + -- Camm Maguire Tue, 20 May 2014 16:00:22 +0000 + +gcl (2.6.10-12) unstable; urgency=high + + * 2.6.11pre test 11 + + -- Camm Maguire Fri, 16 May 2014 17:41:33 +0000 + +gcl (2.6.10-11) unstable; urgency=high + + * 2.6.11pre test 10 + + -- Camm Maguire Fri, 16 May 2014 13:18:07 +0000 + +gcl (2.6.10-10) unstable; urgency=high + + * 2.6.11pre test 9 + + -- Camm Maguire Wed, 07 May 2014 17:10:30 +0000 + +gcl (2.6.10-9) unstable; urgency=high + + * 2.6.11pre test 8 + + -- Camm Maguire Fri, 25 Apr 2014 19:53:10 +0000 + +gcl (2.6.10-8) unstable; urgency=high + + * 2.6.11pre test 7 + + -- Camm Maguire Mon, 21 Apr 2014 14:09:37 +0000 + +gcl (2.6.10-7) unstable; urgency=high + + * 2.6.11pre test 6 + + -- Camm Maguire Sat, 19 Apr 2014 17:52:17 +0000 + +gcl (2.6.10-6) unstable; urgency=high + + * 2.6.11pre test 5 + + -- Camm Maguire Fri, 18 Apr 2014 15:06:09 +0000 + +gcl (2.6.10-5) unstable; urgency=high + + * 2.6.11pre test 4 + + -- Camm Maguire Tue, 15 Apr 2014 20:30:13 +0000 + +gcl (2.6.10-4) unstable; urgency=high + + * 2.6.11pre test 3 + * Bug fix: "debian/rules uses DEB_BUILD_* macros instead of DEB_HOST_* + macros", thanks to Matthias Klose (Closes: #743520). + + -- Camm Maguire Wed, 09 Apr 2014 13:15:32 +0000 + +gcl (2.6.10-3) unstable; urgency=high + + * 2.6.11pre test 2 + + -- Camm Maguire Thu, 03 Apr 2014 14:24:23 +0000 + +gcl (2.6.10-2) unstable; urgency=high + + * 2.6.11pre test 1 + * Bug fix: "FTBFS: gcl_readline.d:472:39: error: 'CPPFunction' + undeclared (first use in this function)", thanks to David Suárez + (Closes: #741819). + + -- Camm Maguire Mon, 24 Mar 2014 15:47:01 +0000 + +gcl (2.6.10-1) unstable; urgency=high + + * New upstream release + + -- Camm Maguire Wed, 13 Nov 2013 18:39:19 +0000 + +gcl (2.6.9-17) unstable; urgency=high + + * 2.6.10pre test 17 + + -- Camm Maguire Mon, 11 Nov 2013 19:41:45 +0000 + +gcl (2.6.9-16) unstable; urgency=high + + * 2.6.10pre test 16 + * Bug fix: "gcl 2.6.7+dfsga-20 needs 1 GB disk space on amd64", thanks + to Edi Meier (Closes: #714507). + * Bug fix: "[INTL:ja] New Japanese translation", thanks to victory + (Closes: #718925). + + -- Camm Maguire Sat, 09 Nov 2013 13:34:32 +0000 + +gcl (2.6.9-15) unstable; urgency=high + + * 2.6.10pre test 15 + + -- Camm Maguire Sat, 02 Nov 2013 22:21:16 +0000 + +gcl (2.6.9-14) unstable; urgency=high + + * 2.6.10pre test 14 + + -- Camm Maguire Wed, 23 Oct 2013 17:44:14 +0000 + +gcl (2.6.9-13) unstable; urgency=high + + * environment allocation unrandomize.h + + -- Camm Maguire Mon, 21 Oct 2013 00:20:16 +0000 + +gcl (2.6.9-12) unstable; urgency=high + + * 2.6.10pre test 13 + + -- Camm Maguire Fri, 18 Oct 2013 14:18:17 +0000 + +gcl (2.6.9-11) unstable; urgency=high + + * 2.6.10pre test 12, s390, mingw cleanup, make_bignum bug fix + + -- Camm Maguire Tue, 15 Oct 2013 23:32:09 +0000 + +gcl (2.6.9-10) unstable; urgency=high + + * fast-fixnums + + -- Camm Maguire Fri, 11 Oct 2013 15:05:58 +0000 + +gcl (2.6.9-9) unstable; urgency=high + + * 2.6.10pre test 10 and 11 + + -- Camm Maguire Wed, 02 Oct 2013 19:12:36 +0000 + +gcl (2.6.9-8) unstable; urgency=high + + * 2.6.10pre test 8 and 9 + + -- Camm Maguire Tue, 01 Oct 2013 21:00:19 +0000 + +gcl (2.6.9-7) unstable; urgency=high + + * 2.6.10pre test 6 and 7 + + -- Camm Maguire Mon, 30 Sep 2013 19:34:38 +0000 + +gcl (2.6.9-6) unstable; urgency=high + + * 2.6.10pre test 5 + + -- Camm Maguire Tue, 24 Sep 2013 17:03:24 +0000 + +gcl (2.6.9-5) unstable; urgency=high + + * 2.6.10pre test 4 + + -- Camm Maguire Mon, 23 Sep 2013 19:27:36 +0000 + +gcl (2.6.9-4) unstable; urgency=high + + * 2.6.10pre test 3 + + -- Camm Maguire Mon, 23 Sep 2013 16:30:09 +0000 + +gcl (2.6.9-3) unstable; urgency=high + + * 2.6.10pre test 2 + + -- Camm Maguire Sun, 22 Sep 2013 03:27:10 +0000 + +gcl (2.6.9-2) unstable; urgency=high + + * 2.6.10pre test + + -- Camm Maguire Sat, 21 Sep 2013 04:14:55 +0000 + +gcl (2.6.9-1) unstable; urgency=high + + * New upstream release + + -- Camm Maguire Wed, 28 Aug 2013 16:49:18 +0000 + +gcl (2.6.7+dfsga-40) unstable; urgency=high + + * fix allocate functions + + -- Camm Maguire Tue, 06 Aug 2013 22:36:37 +0000 + +gcl (2.6.7+dfsga-39) unstable; urgency=high + + * lower initial contiguous and relblock allocations, set *ihs-top* + properly on startup, protect memory->cfd.cfd_start initialization from + gc + + -- Camm Maguire Mon, 05 Aug 2013 17:38:22 +0000 + +gcl (2.6.7+dfsga-38) unstable; urgency=high + + * robustify near oom handling to fix axiom compile of EXPEXPAN on mips + + -- Camm Maguire Fri, 02 Aug 2013 16:25:16 +0000 + +gcl (2.6.7+dfsga-37) unstable; urgency=high + + * ppc64 gprof fix + + -- Camm Maguire Fri, 26 Jul 2013 23:40:14 +0000 + +gcl (2.6.7+dfsga-36) unstable; urgency=high + + * min_pagewidth=14 on mips + + -- Camm Maguire Fri, 26 Jul 2013 02:20:56 +0000 + +gcl (2.6.7+dfsga-35) unstable; urgency=high + + * latest gcc on all platforms, no gprof ppc64, -O1 ia64, -O0 alpha + + -- Camm Maguire Thu, 25 Jul 2013 14:42:48 +0000 + +gcl (2.6.7+dfsga-34) unstable; urgency=high + + * sgc link_array mark fix;rb_end across save fix;more stable gcc on older arches + + -- Camm Maguire Tue, 23 Jul 2013 17:11:23 +0000 + +gcl (2.6.7+dfsga-33) unstable; urgency=high + + * fix mark_link_array for marked sLAlink_arrayA->s.s_dbind + + -- Camm Maguire Mon, 22 Jul 2013 19:00:43 +0000 + +gcl (2.6.7+dfsga-32) unstable; urgency=high + + * protect mark_link_array in sgc + + -- Camm Maguire Sat, 20 Jul 2013 00:16:07 +0000 + +gcl (2.6.7+dfsga-31) unstable; urgency=high + + * properly clean link array on gc + + -- Camm Maguire Fri, 19 Jul 2013 20:34:34 +0000 + +gcl (2.6.7+dfsga-30) unstable; urgency=high + + * fix gcl.script compiler::link, darwin compile warnings + + -- Camm Maguire Mon, 15 Jul 2013 20:35:03 +0000 + +gcl (2.6.7+dfsga-29) unstable; urgency=high + + * fix compiler::link in presence of gcl.script + + -- Camm Maguire Mon, 15 Jul 2013 16:23:33 +0000 + +gcl (2.6.7+dfsga-28) unstable; urgency=high + + * install unixport/gcl.script + + -- Camm Maguire Sat, 13 Jul 2013 18:42:28 +0000 + +gcl (2.6.7+dfsga-27) unstable; urgency=high + + * workaround for ia64 and hurd brk issues + + -- Camm Maguire Fri, 12 Jul 2013 21:44:54 +0000 + +gcl (2.6.7+dfsga-26) unstable; urgency=high + + * -- command line support, map-shared in unexec + + -- Camm Maguire Fri, 12 Jul 2013 00:52:35 +0000 + +gcl (2.6.7+dfsga-25) unstable; urgency=high + + * alpha, mips, 68k + + -- Camm Maguire Wed, 10 Jul 2013 18:29:37 +0000 + +gcl (2.6.7+dfsga-24) unstable; urgency=high + + * sgc and reloc fixes + + -- Camm Maguire Mon, 08 Jul 2013 13:56:33 +0000 + +gcl (2.6.7+dfsga-23) unstable; urgency=high + + * fix for maxima on kfbsd and sparc + + -- Camm Maguire Wed, 03 Jul 2013 19:19:16 +0000 + +gcl (2.6.7+dfsga-22) unstable; urgency=high + + * fix stack definition issues on i386 + + -- Camm Maguire Tue, 02 Jul 2013 18:27:54 +0000 + +gcl (2.6.7+dfsga-21) unstable; urgency=high + + * near out of memory robustification + + -- Camm Maguire Tue, 02 Jul 2013 15:32:58 +0000 + +gcl (2.6.7+dfsga-20) unstable; urgency=high + + * fix 3GB workaround for gprof + + -- Camm Maguire Fri, 21 Jun 2013 11:09:01 -0400 + +gcl (2.6.7+dfsga-19) unstable; urgency=high + + * work around 3GB personality/alloca/malloc bug + + -- Camm Maguire Fri, 21 Jun 2013 02:46:49 +0000 + +gcl (2.6.7+dfsga-18) unstable; urgency=high + + * alpha NULL_OR_ON_C_STACK, attempt to get 32 immfix space with + ADDR_LIMIT_3GB|ADDR_COMPAT_LAYOUT personality, clean compile with no + immfix + + -- Camm Maguire Thu, 20 Jun 2013 20:24:29 +0000 + +gcl (2.6.7+dfsga-17) unstable; urgency=high + + * small optimizations, #= nil fix + + -- Camm Maguire Wed, 19 Jun 2013 16:23:27 +0000 + +gcl (2.6.7+dfsga-16) unstable; urgency=high + + * no linker script on hurd;fix OBJ_ALIGN + + -- Camm Maguire Thu, 13 Jun 2013 15:35:00 +0000 + +gcl (2.6.7+dfsga-15) unstable; urgency=high + + * ia64 fix + + -- Camm Maguire Thu, 13 Jun 2013 02:38:47 +0000 + +gcl (2.6.7+dfsga-14) unstable; urgency=high + + * eliminate maxpage/dbegin, restore windows and macosx builds + + -- Camm Maguire Wed, 12 Jun 2013 21:42:29 +0000 + +gcl (2.6.7+dfsga-13) unstable; urgency=low + + * ia64/hurd/s390 and SGC + + -- Camm Maguire Sun, 09 Jun 2013 00:23:51 +0000 + +gcl (2.6.7+dfsga-12) unstable; urgency=low + + * ia64/hurd/s390 + + -- Camm Maguire Sat, 08 Jun 2013 15:24:46 +0000 + +gcl (2.6.7+dfsga-11) unstable; urgency=high + + * 2.6.9 test + + -- Camm Maguire Fri, 07 Jun 2013 21:46:41 +0000 + +gcl (2.6.7+dfsga-10) unstable; urgency=high + + * output mips make bug text to stderr + + -- Camm Maguire Sat, 25 May 2013 12:24:35 +0000 + +gcl (2.6.7+dfsga-9) unstable; urgency=high + + * mips make bug workaround + + -- Camm Maguire Wed, 22 May 2013 14:23:43 +0000 + +gcl (2.6.7+dfsga-8) unstable; urgency=high + + * revert doubled default maxpage + * export *read-eval* + + -- Camm Maguire Tue, 21 May 2013 14:42:05 +0000 + +gcl (2.6.7+dfsga-7) unstable; urgency=high + + * export ansi symbols + + -- Camm Maguire Sat, 11 May 2013 21:36:56 +0000 + +gcl (2.6.7+dfsga-6) unstable; urgency=high + + * fast hash-equal in compiler + + -- Camm Maguire Sat, 11 May 2013 19:11:42 +0000 + +gcl (2.6.7+dfsga-5) unstable; urgency=high + + * Bug fix: "FTBFS: cp: cannot stat + 'debian/tmp/usr/share/info/gcl-si.info': No such file or + directory", thanks to Lucas Nussbaum (Closes: #707490). + + -- Camm Maguire Fri, 10 May 2013 18:09:14 +0000 + +gcl (2.6.7+dfsga-4) unstable; urgency=high + + * sgc-on fix with latest gcc + + -- Camm Maguire Tue, 23 Apr 2013 18:45:11 +0000 + +gcl (2.6.7+dfsga-3) unstable; urgency=high + + * hash depth bug fix + * new s390 reloc + + -- Camm Maguire Thu, 24 Jan 2013 19:46:30 +0000 + +gcl (2.6.7+dfsga-2) unstable; urgency=high + + * more arm relocs supported;check default timezone dynamically;follow + bash ~ semantics in user-homedir-pathname + + -- Camm Maguire Mon, 21 Jan 2013 18:41:06 +0000 + +gcl (2.6.7+dfsga-1) unstable; urgency=high + + * Acknowledge Non-maintainer upload. + (thanks David Prévot ) + * Remove unused and non DFSG-compliant gmp3/gmp.* from source. + (Closes: #695721) + * Show translated debconf templates, thanks to Denis Barbier for the + analysis and the proposed fixes. (Closes: #691946) + * trim excess digits from printed floats + + -- Camm Maguire Tue, 15 Jan 2013 20:46:25 +0000 + +gcl (2.6.7-108) unstable; urgency=high + + * Depend on emacs23 | emacsen to allow wheezy propagation + + -- Camm Maguire Mon, 08 Oct 2012 18:08:36 +0000 + +gcl (2.6.7-107) unstable; urgency=high + + * mode 644 on ucf newfile + + -- Camm Maguire Wed, 03 Oct 2012 20:38:43 +0000 + +gcl (2.6.7-106) unstable; urgency=high + + * Bug fix: "modifies conffiles (policy 10.7.3): /etc/default/gcl", + thanks to Andreas Beckmann (Closes: #688201). + + -- Camm Maguire Wed, 03 Oct 2012 16:52:10 +0000 + +gcl (2.6.7-105) unstable; urgency=high + + * restore #DEBHELPER# to postinst and postrm scripts + + -- Camm Maguire Mon, 01 Oct 2012 17:31:43 +0000 + +gcl (2.6.7-104) unstable; urgency=high + + * Bug fix: "modifies conffiles (policy 10.7.3): /etc/default/gcl", + thanks to Andreas Beckmann (Closes: #688201). + + -- Camm Maguire Mon, 01 Oct 2012 15:32:52 +0000 + +gcl (2.6.7-103) unstable; urgency=high + + * sfaslelf.c: FIX_HIDDEN_SYMBOLS + + -- Camm Maguire Wed, 22 Aug 2012 15:13:12 +0000 + +gcl (2.6.7-102) unstable; urgency=high + + * Fix hash key distribution bug, bitvector equal bug + * distinguish car position in equal-hash of lists + + -- Camm Maguire Mon, 20 Aug 2012 17:33:26 +0000 + +gcl (2.6.7-101) unstable; urgency=high + + * add alpha, ppc, ppc64, and ia64 to __builtin__clear_cache exception + list as per gcc maintainers + * lintian cleanups + + -- Camm Maguire Sat, 05 May 2012 23:18:56 +0000 + +gcl (2.6.7-100) unstable; urgency=high + + * nil case keylist support + * Bug fix: "[INTL:da] Danish translation of the debconf templates gcl", + thanks to Joe Dalton (Closes: #666528). + + -- Camm Maguire Fri, 20 Apr 2012 02:25:26 +0000 + +gcl (2.6.7-99) unstable; urgency=low + + * case default error checking + + -- Camm Maguire Fri, 23 Mar 2012 14:14:44 +0000 + +gcl (2.6.7-98) unstable; urgency=low + + * restore traditional make-sequence,make-array, and coerce, and + optimize replace, as 2.6.8 compiler is still too weak re: inlines + + -- Camm Maguire Fri, 20 Jan 2012 19:55:45 +0000 + +gcl (2.6.7-97) unstable; urgency=low + + * evade __builtin___clear_cache on hppa + * make-array;make-sequence;replace;coerce + + -- Camm Maguire Fri, 20 Jan 2012 05:13:22 +0000 + +gcl (2.6.7-96) unstable; urgency=low + + * better XDR detection; no __builtin_clear_cache on sh4 + + -- Camm Maguire Wed, 18 Jan 2012 01:32:43 +0000 + +gcl (2.6.7-95) unstable; urgency=low + + * clear_cache after mprotect + + -- Camm Maguire Tue, 17 Jan 2012 03:54:56 +0000 + +gcl (2.6.7-94) unstable; urgency=low + + * optimize unwind at O0 to workaround gcc bug; centralize on + __builtin__clear_cache when available;arm_thm_call reloc support + + -- Camm Maguire Mon, 16 Jan 2012 20:10:07 +0000 + +gcl (2.6.7-93) unstable; urgency=low + + * remove C_GC_OFFSET for sparc64 + * remove ncurses dependency for readline + * Bug fix: "FTBFS: dpkg-buildpackage: error: dpkg-source -b gcl-2.6.7 + gave error exit status 2", thanks to Didier Raboud (Closes: #643131). + * Bug fix: "drops readline support if rebuilt", thanks to Sven Joachim + (Closes: #646735). + * lower opts on sparc64 asof gcc 4.6.1 + + -- Camm Maguire Wed, 11 Jan 2012 21:04:23 +0000 + +gcl (2.6.7-92) unstable; urgency=low + + * remove gprof on arm as mcount calls are 24/22bit -- marginally + accessible + + -- Camm Maguire Sat, 07 Jan 2012 02:42:06 +0000 + +gcl (2.6.7-91) unstable; urgency=low + + * s390x reloc support + * lower C optimization on ia64, arm and mips for now + + -- Camm Maguire Thu, 05 Jan 2012 17:30:01 +0000 + +gcl (2.6.7-90) unstable; urgency=low + + * libtirpc check for newest glibc + * read_preserving_whitespace fix + * armhf reloc support + * s390x support + * try C_GC_OFFSET for sparc64 + + -- Camm Maguire Wed, 04 Jan 2012 19:51:13 +0000 + +gcl (2.6.7-89) unstable; urgency=low + + * support new mips relocs + * lower opt to work around gcc 4.6 bug on arm + + -- Camm Maguire Wed, 11 May 2011 20:06:04 +0000 + +gcl (2.6.7-88) unstable; urgency=low + + * Bug fix: "FTBFS: gcl_arraylib.c:4:42: error: 'VV' undeclared + (first use in this function)", thanks to Lucas Nussbaum (Closes: + #625032). + + -- Camm Maguire Mon, 09 May 2011 16:00:21 +0000 + +gcl (2.6.7-87) unstable; urgency=low + + * mips reloc fix;configure default dlopen fix;clean rules and makefiles + + -- Camm Maguire Fri, 05 Nov 2010 13:29:05 +0000 + +gcl (2.6.7-86) unstable; urgency=low + + * remove binutils subdir, configure and make changes + + -- Camm Maguire Thu, 04 Nov 2010 17:55:48 +0000 + +gcl (2.6.7-85) unstable; urgency=low + + * fix mips relocs for non-static clines + + -- Camm Maguire Tue, 02 Nov 2010 13:56:40 +0000 + +gcl (2.6.7-84) unstable; urgency=low + + * better mips relocs, fix link on mingw32 + + -- Camm Maguire Sat, 30 Oct 2010 00:07:39 +0000 + +gcl (2.6.7-83) unstable; urgency=low + + * fix alpha stubs; fix sparc64 typo; print armhf relocs + + -- Camm Maguire Thu, 28 Oct 2010 13:43:16 +0000 + +gcl (2.6.7-82) unstable; urgency=low + + * mips64 fixes + + -- Camm Maguire Tue, 26 Oct 2010 18:20:04 +0000 + +gcl (2.6.7-81) unstable; urgency=low + + * sparc64;mips64 + + -- Camm Maguire Tue, 26 Oct 2010 03:33:52 +0000 + +gcl (2.6.7-80) unstable; urgency=low + + * alpha stubs; sgc mips kernel bug test; mips GPREL32 reloc + + -- Camm Maguire Mon, 25 Oct 2010 19:52:51 +0000 + +gcl (2.6.7-79) unstable; urgency=low + + * mips ld_bind_now, disable sgc workaround mips SIGBUS bug + + -- Camm Maguire Wed, 20 Oct 2010 15:31:59 +0000 + +gcl (2.6.7-78) unstable; urgency=low + + * mips local got relocs + + -- Camm Maguire Tue, 12 Oct 2010 17:15:35 +0000 + +gcl (2.6.7-77) unstable; urgency=low + + * workaround gcc alpha bug + * fix alpha reloc + + -- Camm Maguire Fri, 01 Oct 2010 21:25:11 +0000 + +gcl (2.6.7-76) unstable; urgency=low + + * fix page_multiple usage for runtime pagesize variance and stable mipsel builds + * sparc64 support + + -- Camm Maguire Fri, 01 Oct 2010 19:18:47 +0000 + +gcl (2.6.7-75) unstable; urgency=low + + * fix alpha bug + + -- Camm Maguire Tue, 28 Sep 2010 20:23:21 +0000 + +gcl (2.6.7-74) unstable; urgency=low + + * fix alpha relocs for axiom + + -- Camm Maguire Tue, 28 Sep 2010 16:07:38 +0000 + +gcl (2.6.7-73) unstable; urgency=low + + * sparc reloc updates + * fast-link fix + + -- Camm Maguire Fri, 24 Sep 2010 19:23:16 +0000 + +gcl (2.6.7-72) unstable; urgency=low + + * remove unused symbols from gcl_cmpopt.lsp + * reloc updates + * clear gcc warning + * default tilde expansion to HOME env in absence of passwd + * configure typo fix + + -- Camm Maguire Wed, 22 Sep 2010 19:32:52 +0000 + +gcl (2.6.7-71) unstable; urgency=low + + * print sparc64 relocs + + -- Camm Maguire Sat, 28 Aug 2010 14:50:00 +0000 + +gcl (2.6.7-70) unstable; urgency=low + + * sparc64/m68k + + -- Camm Maguire Fri, 27 Aug 2010 16:54:11 +0000 + +gcl (2.6.7-69) unstable; urgency=low + + * Bug fix: "non-standard gcc/g++ used for build (gcc-4.3)", thanks to + Matthias Klose (Closes: #594280). + + -- Camm Maguire Thu, 26 Aug 2010 19:08:39 +0000 + +gcl (2.6.7-68) unstable; urgency=low + + * ppc/mips elf reloc fixes + + -- Camm Maguire Mon, 23 Aug 2010 20:54:30 +0000 + +gcl (2.6.7-67) unstable; urgency=low + + * Fix compiler::link ansi combo + + -- Camm Maguire Sat, 21 Aug 2010 02:05:37 +0000 + +gcl (2.6.7-66) unstable; urgency=low + + * ppc autobuild fix + * Bug fix: "FTBFS: sfasli.c:139: error: invalid initializer", thanks to + Lucas Nussbaum (Closes: #593037). + * Bug fix: "FTBFS on powerpc: Error: The function TK::GET-AUTOLOADS is + undefined.", thanks to Mehdi Dogguy (Closes: #593191). + + -- Camm Maguire Fri, 20 Aug 2010 01:25:09 +0000 + +gcl (2.6.7-65) unstable; urgency=low + + * autobuilder fixes + + -- Camm Maguire Sat, 14 Aug 2010 11:30:46 +0000 + +gcl (2.6.7-64) unstable; urgency=low + + * configure fix + + -- Camm Maguire Fri, 13 Aug 2010 23:26:07 +0000 + +gcl (2.6.7-63) unstable; urgency=low + + * macosx support, ppc, i386 and x86_64 -- sfaslmacho.c + * windows/wine support -- sfaslcoff.c + * better custreloc support obviating my_plt -- sfaslelf.c + * debian default custreloc build where supported, all but ia64 and hppa + * fix mingw/wine path issues + + -- Camm Maguire Fri, 13 Aug 2010 16:08:49 +0000 + +gcl (2.6.7-62) unstable; urgency=high + + * more stable sgc detection via h/tsgc.h + * fix plt.h bug on hppa + * sublis1-inline fix for acl2 + + -- Camm Maguire Mon, 26 Jul 2010 16:03:54 +0000 + +gcl (2.6.7-61) unstable; urgency=high + + * mac osx support + * fix undef sgc bug in cmpinclude.h + + -- Camm Maguire Tue, 20 Jul 2010 14:50:19 +0000 + +gcl (2.6.7-60) unstable; urgency=high + + * fix sh4 support + + -- Camm Maguire Thu, 29 Apr 2010 18:09:04 +0000 + +gcl (2.6.7-59) unstable; urgency=high + + * fix hurd support + + -- Camm Maguire Fri, 23 Apr 2010 17:12:54 +0000 + +gcl (2.6.7-58) unstable; urgency=high + + * hurd support + * sh4 support + + -- Camm Maguire Fri, 23 Apr 2010 05:09:29 +0000 + +gcl (2.6.7-57) unstable; urgency=high + + * static function pointer wrapper for gcl_gmp_allocfun, stabilizing gmp + on hppa/ia64 + + -- Camm Maguire Mon, 12 Apr 2010 22:28:41 +0000 + +gcl (2.6.7-56) unstable; urgency=high + + * __builtin___clear_cache on arm + * gcc-4.3 on alpha + + -- Camm Maguire Thu, 28 Jan 2010 00:32:16 +0000 + +gcl (2.6.7-55) unstable; urgency=low + + * SGC fix, debian override fix, xgcl update + * SGC fix for relocatable and contiguous gmp storage + * configure fix for arm and hppa + + -- Camm Maguire Tue, 26 Jan 2010 19:43:08 +0000 + +gcl (2.6.7-54) unstable; urgency=low + + * robustify user_match, unrandomize, read-char-no-hang for sockets + * SA_SIGINFO for 386-linux + * if cmpinclude.h is not available, use *cmpinclude-string* in compiler-pass2 + + -- Camm Maguire Wed, 20 Jan 2010 19:02:28 +0000 + +gcl (2.6.7-53) unstable; urgency=low + + * revert round ratio to nearest + + -- Camm Maguire Tue, 05 Jan 2010 03:06:59 +0000 + +gcl (2.6.7-52) unstable; urgency=low + + * SIGINFO for kfreebsd-386 + + -- Camm Maguire Mon, 04 Jan 2010 17:49:05 +0000 + +gcl (2.6.7-51) unstable; urgency=low + + * user_match exscapes once only + + -- Camm Maguire Sun, 03 Jan 2010 05:31:20 +0000 + +gcl (2.6.7-50) unstable; urgency=low + + * gcc 4.4 warning cleanups + + -- Camm Maguire Thu, 31 Dec 2009 20:43:39 +0000 + +gcl (2.6.7-49) unstable; urgency=low + + * Bug fix: "/bin/sh: line 6: /bin/gcl: Permission denied", thanks to + Nobuhiro Iwamatsu (Closes: #561554). + + -- Camm Maguire Wed, 30 Dec 2009 23:04:39 +0000 + +gcl (2.6.7-48) unstable; urgency=low + + * round to nearest in ratio to double + + -- Camm Maguire Wed, 16 Dec 2009 15:01:55 +0000 + +gcl (2.6.7-47) unstable; urgency=low + + * Bug fix: "configure: error: Need zlib for bfd linking", thanks to + Cyril Brulebois (Closes: #560761). + * Bug fix: "Disfunctional maintainer address", thanks to Joerg Jaspert + (Closes: #560752). + + -- Camm Maguire Mon, 14 Dec 2009 19:06:45 +0000 + +gcl (2.6.7-46) unstable; urgency=low + + * support newer binutils with output_bfd element + * Fix 64bit interrupt bug + * reader error fix + * Ensure plt entries are not blank + * plt table reading fix + * Bug fix: "FTBFS: current binutils static libs need -lz", thanks to + Daniel Schepler (Closes: #521929). + * Bug fix: "replacing libreadline5-dev build dependency with + libreadline-dev", thanks to Matthias Klose (Closes: #553761). + * Bug fix: "crash after ctrl-C", thanks to Miroslaw Kwasniak (Closes: + #519903). + * Bug fix: "FTBFS with binutils-gold", thanks to Peter Fritzsche + (Closes: #554418). -ldl added to bfd linker args + * Bug fix: "[INTL:es] Spanish debconf template translation for gcl", + thanks to Francisco Javier Cuadrado (Closes: #508728). + * Bug fix: "[INTL:it] Italian translation", thanks to Vincenzo + Campanella (Closes: #560364). + * gcc error/warning cleanups + * fix plt table awk + + -- Camm Maguire Fri, 11 Dec 2009 17:45:14 +0000 + +gcl (2.6.7-45) unstable; urgency=high + + * proper word order detection macro, fixes armel + + -- Camm Maguire Mon, 01 Sep 2008 13:48:16 +0000 + +gcl (2.6.7-44) unstable; urgency=high + + * backoff on arm opts + * more careful handling of GCL_GPROF_START + + -- Camm Maguire Sat, 23 Aug 2008 21:28:52 +0000 + +gcl (2.6.7-43) unstable; urgency=low + + * redo unrandomize.h to enable compilation under -O2 -- FIXME; Closes: 494153 + + -- Camm Maguire Wed, 20 Aug 2008 21:18:43 +0000 + +gcl (2.6.7-42) unstable; urgency=low + + * more div/rem symbols for alpha + + -- Camm Maguire Sun, 03 Aug 2008 11:18:51 +0000 + +gcl (2.6.7-41) unstable; urgency=low + + * more div/rem symbols for arm and hppa + + -- Camm Maguire Sat, 02 Aug 2008 00:36:07 +0000 + +gcl (2.6.7-40) unstable; urgency=low + + * default gcc with pic enabled on mips/mipsel + + -- Camm Maguire Fri, 01 Aug 2008 13:28:00 -0400 + +gcl (2.6.7-39) unstable; urgency=high + + * gcc 4.2 for mips/mipsel for now + * __divdi3 et. al. symbols for ia64 and arm + * clean some compiler warnings + + -- Camm Maguire Fri, 01 Aug 2008 12:53:07 -0400 + +gcl (2.6.7-38) unstable; urgency=low + + * No infinite unrandomization loops + + -- Camm Maguire Thu, 31 Jul 2008 15:18:37 -0400 + +gcl (2.6.7-37) unstable; urgency=low + + * Non-maintainer upload to fix pending l10n issues + * Debconf templates and debian/control reviewed by the debian-l10n- + english team as part of the Smith review project. Closes: #457025 + * [Debconf translation updates] + - Portuguese. Closes: #457576 + - Czech. Closes: #457677 + - French. Closes: #458120 + - Finnish. Closes: #458255 + - Galician. Closes: #458529 + - Vietnamese. Closes: #459008 + - Russian. Closes: #459308 + - Dutch. Closes: #459541 + - German. Closes: #459887 + * [Lintian] Correct FSF address in debian/copyright + * [Lintian] Remove extra whitespaces at the end of + debian/in.gcl-doc.doc-base.tk + * [Lintian] Correct section in doc-base documents from Apps/Programming + to Programming + * Accept NMU + * Bug fix: "[INTL:sv] po-debconf file for gcl", thanks to Martin Ågren + (Closes: #492241). + * Bug fix: "gcl: FTBFS [amd64]: cannot trap sbrk", thanks to Daniel + Schepler (Closes: #487435). Modified and applied personality handling + patch. + * Bug fix: "gcl: Builds broken package with gcc-4.3", thanks to Daniel + Schepler (Closes: #467474). Added sincos to plttest.c + + -- Camm Maguire Thu, 31 Jul 2008 15:18:15 -0400 + +gcl (2.6.7-36) unstable; urgency=low + + * statsysbfd in Debian, incoporating modules into libgcl.a for + compiler::link support + + -- Camm Maguire Fri, 30 Nov 2007 12:03:31 -0500 + +gcl (2.6.7-35) unstable; urgency=low + + * drop gcc-3.4 on arm, Closes: #440421 + * Depend on emacs22 | emacsen, Closes: #440190 + * debconf translations Closes: #410683, Closes: #419736, Closes: #423706, Closes: #441408 + + -- Camm Maguire Fri, 23 Nov 2007 10:25:23 -0500 + +gcl (2.6.7-34) unstable; urgency=low + + * add read-byte,read-sequence,write-byte,write-sequence support + * fix some float parsing inaccuracies + * support GNU_HASH sections, Closes: #426135 + * safety 2 for certain low level functions in gcl_listlib.lsp, CLoses: + #415266 + + -- Camm Maguire Wed, 4 Jul 2007 16:23:25 -0400 + +gcl (2.6.7-33) unstable; urgency=low + + * Fix leading underscore behavior of my_plt + * add sqrt to plttest.c + * disable-nls added to the binutils subconfigures to avoid msgfmt + dependency + * remove -lintl from powerpc-macosx.defs + * update to make-user-init from cvs head to support hol88, fix link on + mingw + * solaris-i386 support + * fix read-char-no-hang on mingw + * fast compile without wrap-literals + * sigaltstack support + * fix cerror + + -- Camm Maguire Wed, 16 May 2007 12:45:40 -0400 + +gcl (2.6.7-32) unstable; urgency=low + + * static function pointers for hppa + + -- Camm Maguire Sun, 29 Oct 2006 02:15:13 -0500 + +gcl (2.6.7-31) unstable; urgency=low + + * no C optimization on hppa, gcc 4.x on hppa + * update cs.po, Closes: #389211 + + -- Camm Maguire Fri, 27 Oct 2006 13:06:55 -0400 + +gcl (2.6.7-30) unstable; urgency=low + + * make sure *tmp-dir* is set + * makeinfo is optional + + -- Camm Maguire Wed, 25 Oct 2006 17:37:54 -0400 + +gcl (2.6.7-29) unstable; urgency=low + + * Fix build issues on hppa and m68k + + -- Camm Maguire Sat, 21 Oct 2006 15:10:41 -0400 + +gcl (2.6.7-28) unstable; urgency=low + + * si::gettimeofday function for HOL88 build;macosx fixes + + -- Camm Maguire Wed, 18 Oct 2006 13:21:26 -0400 + +gcl (2.6.7-27) unstable; urgency=low + + * unrestricted gcc for alpha + * more default stack space + + -- Camm Maguire Tue, 17 Oct 2006 16:33:43 -0400 + +gcl (2.6.7-26) unstable; urgency=low + + * Fix large float read bug in c1constant-value + + -- Camm Maguire Mon, 16 Oct 2006 12:41:03 -0400 + +gcl (2.6.7-25) unstable; urgency=low + + * build-dep on gcc3.4 where appropriate + * Newer standards + + -- Camm Maguire Thu, 12 Oct 2006 09:37:08 -0400 + +gcl (2.6.7-24) unstable; urgency=low + + * build-dep on gcc3.4 where appropriate + * Newer standards + + -- Camm Maguire Thu, 12 Oct 2006 02:22:04 -0400 + +gcl (2.6.7-23) unstable; urgency=low + + * backoff to gcc-3.4 on alpha,arm,hppa, and m68k + + -- Camm Maguire Wed, 11 Oct 2006 10:16:59 -0400 + +gcl (2.6.7-22) unstable; urgency=low + + * HAVE_SYS_SOCKIO_H for solaris + * autolocbfd for solaris + * no -Wall when no gcc + * no -fomit-frame-pointer on m68k + * no profiling on mips + * $(AWK) instead of awk + * si::stat function + * fix 'the boolean type coersion error + * no varargs on cygwin + * while eval macro + * gensym counter fixes + * xgcl updates + + + -- Camm Maguire Fri, 15 Sep 2006 13:48:28 -0400 + +gcl (2.6.7-21) unstable; urgency=low + + * Fix socket write error + + -- Camm Maguire Wed, 6 Sep 2006 09:59:50 -0400 + +gcl (2.6.7-20) unstable; urgency=low + + * fix ia64 build + + -- Camm Maguire Thu, 31 Aug 2006 15:14:18 -0400 + +gcl (2.6.7-19) unstable; urgency=low + + * xgcl upgrade + * parse_number from cvs head with *read-base* fixes + * fix object_to_string + * install xgcl-2/sysdef.lisp + * fix info dir and emacs site lisp dir installation + * New xgcl readme + * Remove bashism from debian/rules, Closes: #376806, Closes: #385176. + * Fix dwdoc doc-base error, Closes: #385126 + + -- Camm Maguire Wed, 30 Aug 2006 12:13:46 -0400 + +gcl (2.6.7-18) unstable; urgency=low + + * remove emacs build dependency + * synch xgcl-2 with Novak edits + * fix build errors + * Remove power of two limit to MAXPAGE;fix X lib paths + * configure cleanup + * delete-file works on directories;build xgcl the old way;latest xgcl + from Gordon Novak + + -- Camm Maguire Wed, 23 Aug 2006 14:19:51 -0400 + +gcl (2.6.7-17) unstable; urgency=low + + * Bug fix: "gcl: [INTL:sv] Swedish debconf templates translation", + thanks to Daniel Nylander (Closes: #343695). + * Bug fix: "gcl: French debconf templates translation update", thanks to + Sylvain Archenault (Closes: #344629). + * clean xgcl-2/gmon.out + * cleanup latest gcc type-punning warnings + * defentry C proclamations and xgcl cleanup + + -- Camm Maguire Mon, 26 Jun 2006 16:45:09 +0000 + +gcl (2.6.7-16) unstable; urgency=high + + * Add missing build dependencies, omit html generation to avoid non-free + dependencies, CLoses: #372574. + + -- Camm Maguire Mon, 19 Jun 2006 14:05:59 +0000 + +gcl (2.6.7-15) unstable; urgency=low + + * Use internal gettext for bfd + * Restore xgcl2 + * Set compiler::*tmp-dir* at runtime + * report tmp-dir setting with system-banner to enable clean -eval - + batch operation; fix listen on socket streams; use (abs (getpid)) in + tmp names for Windows + * fix configure unbalanced quotes + * support for bignums in nth et.al. + * Fix branch cut of atanh + * Fix typep on simple-arrays + * prevent nested free errors + * revert atanh branch cut change + * Fix function documentation wrapping by compile + * cond evalmacro from cvs head + * Fix fixnum declarations in new smallnthcdr/bignthcdr + * fix simple-array typep + * updates for lsp/sys-proclaim + * xgcl integration + + -- Camm Maguire Fri, 9 Jun 2006 17:52:22 +0000 + +gcl (2.6.7-14) unstable; urgency=low + + * Add mount declaration to plt.c + + -- Camm Maguire Sun, 18 Dec 2005 12:56:51 +0000 + +gcl (2.6.7-13) unstable; urgency=low + + * Add feof to plttest.c for macosx + * plt related fixes for macosx + * fix configure + * Cleanup LEADING_UNDERSCORE case in plt.c et.al for macosx et.al. + * pass devices if present in compiler::get-temp-dir, fix disassemble + for new gazonk name pattern + + -- Camm Maguire Sat, 17 Dec 2005 15:22:40 +0000 + +gcl (2.6.7-12) unstable; urgency=low + + * Fix read-char-no-hang + * Strip emacs warnings when finding site-lisp directory + * mach-o update for latest binutils + * Latext bfd mach-o support from Aurelien + * revert to locbfd default on ppc-macosx + * More ppc macosx fixes from Aurelien + * revert a few macosx changes + * default to void * prototype on my_sbrk for latest macosx pending + Aureliens #ifdef + * Fix plt.h parsing on macosx + * Fix leading_underscore detection on mac + * macosx name mangling fixes + * multi-process safe gazonk names in compiler::*tmp-dir* + * Add underscore-mangled setjmp calls to plttest.c for macosx + * Fix POTFILES.in, Closes: #336207. + * Update templates, Closes: #324636 + * New French and Swedish translations, Closes: #333654, Closes: #336757. + + -- Camm Maguire Wed, 14 Dec 2005 18:52:49 +0000 + +gcl (2.6.7-11) unstable; urgency=low + + * Remove gcc-3.3 for arm in debian/rules + * make default maxpage depend on SIZEOF_LONG and PAGEWIDTH in a sane + fashion + + -- Camm Maguire Thu, 20 Oct 2005 00:08:37 +0000 + +gcl (2.6.7-10) unstable; urgency=low + + * Fix long-call gcc configure bug for ppc, add fdollars in + identifiers on arm + * remove gcc restrictions on arm + * revert 64bit coersion (gmp_big.c, maybe_replace_big) and replace with + code in siLnani (main.c) to get addresses from bignums. 2.7.0 will + have 64bit fixnums on 64bit machines, but this should not be + backported to 2.6.x + + -- Camm Maguire Wed, 12 Oct 2005 23:11:12 +0000 + +gcl (2.6.7-9) unstable; urgency=low + + * 64bit fixnum fasd data format fix from cvs head + + -- Camm Maguire Wed, 5 Oct 2005 18:49:50 +0000 + +gcl (2.6.7-8) unstable; urgency=low + + * Fix 64bit fixnum coersion bug using code from cvs HEAD + + -- Camm Maguire Fri, 30 Sep 2005 22:14:38 +0000 + +gcl (2.6.7-7) unstable; urgency=high + + * Scan .o file for init name when using dlopen + * Set init name using .o file instead of source file by default + * wrap-literals function from cvs head to allow optimizations using + compile or compile-file + * ADDR_NO_RANDOMIZE fix + + -- Camm Maguire Thu, 29 Sep 2005 17:50:56 +0000 + +gcl (2.6.7-6) unstable; urgency=high + + * Build bfd snapshot locally, Closes: #318681 + + -- Camm Maguire Tue, 20 Sep 2005 17:53:17 +0000 + +gcl (2.6.7-5) unstable; urgency=high + + * gcc-3.3 for arm + + -- Camm Maguire Thu, 15 Sep 2005 20:33:00 +0000 + +gcl (2.6.7-4) unstable; urgency=high + + * gcc 3.4 on arm to work around reserved '$' identifiers. + * gcl: French translation update + * French translation added, Closes: #325214 + * Czech translation added, Closes: #325869 + + -- Camm Maguire Thu, 15 Sep 2005 13:45:11 +0000 + +gcl (2.6.7-3) unstable; urgency=low + + * static wraper for compiled_regexp for ia64 + + -- Camm Maguire Sat, 10 Sep 2005 11:26:37 +0000 + +gcl (2.6.7-2) unstable; urgency=high + + * rebuild against libgmp3c2, Closes: #323765 + * 2.6.7 fixes all gcc 4.0 issues. Closes: #323979 + + -- Camm Maguire Wed, 24 Aug 2005 00:44:48 +0000 + +gcl (2.6.7-1) unstable; urgency=high + + * Fix (listen) with readline on + * fix control-d with readline + * libreadline5 support for Debian + * Support for pre-compiled regexps and new texinfo format + * Reenable run-process + * Push function 'accept into lisp, use select for 'listen on socket + streams + * New Upstream release version + * Native-reloc feature + * Add daemon capabilities to server sockets, document socket and + accept + * Some gcl-tk fixes + * Update wrapt-literals strategy to be consistent with CVS head -- + wrap evreything but symbols and integers, don't wrap when keeping + the gazonk files for linking in different images, this is really a + compile-file operation + * gcltk demo cleanups + * Probe-file, open_stream, and the like fail on directories + * Resolve symlinks in truename + * Place prototypes for defcfun in header files + * Support for unique init names for compiler::link and the like + * libreadline5 for Debian + * remove _o from init-names + * gcc-4.0 fixups + * Bug fix: "gcl: depends on binutils-dev <<= 2.1.5-999), so + uninstallable in unstable", thanks to Steve Langasek (Closes: + #318681). Rebuild with new release to autocompute this dep + * Bug fix: "gcl: Please switch to po-debconf", thanks to Lucas Wall + (Closes: #295930). Apply po-debconf patch + * Newer standards + + -- Camm Maguire Thu, 11 Aug 2005 15:00:26 +0000 + +gcl (2.6.6-1) unstable; urgency=high + + * New upstream release + * Allow .data section to be first in executable, as on solaris. Also + allow for new bfd section size semantics + * Don't try to write map file when not using GNU ld. Also allow + compile-file to process pathnames with whitespace on Windows + * Fix corner case fixnum arithmetic on 64bit machines + * Rework gmp_wrappers semantics for older gcc + * Explicitly mprotect loaded code pages PROT_EXEC on x86 Linux, as FC3 + now requires it. + * lisp-implementation-version is GCL + * Reader extension patch allowing for foo::(bar foobar) semantics + * a shell script variable fix in "unixport/makefile" for MSYS + * __MINGW32__ malloc initialisation fix in "o/alloc.c" + * Windows file/directory fixes in "o/unixfsys.c" + * MinGW32 -march in configure - removes deprecation warnings + * MinGW32 directory fix - "o/mingfile.c". + * Allow for sysconf to determine clock granularity at compile time to + fix time errors on the Itanium + * Disable SGC on macosx until the sgc/save problem can be fixed. + * Fix fixnum print bug on 64bit + * Fix nil types in room report + * 64bit fixes to fixnum_add and fixnum_sub + * Fix Mac SGC/save bug, at least in part + + -- Camm Maguire Sun, 16 Jan 2005 02:28:50 +0000 + +gcl (2.6.5-1) unstable; urgency=high + + * New gmp_wrappers.{c,h} files that prevent all GBC within gmp, + obviating the need for gmp patches and a local gmp configure. FIXME + -- extend to all gmp functions in a systematic way, and write header + information for future use in the compiler, making sure that plt.c + carries the needed gmp symbols at this point + * Build support for gmp_wrappers + * Support for gmp_wrappers in alloc_relblock/alloc_contblock;Support + for GCL_GPROF_START define in gprof functions + * dynsysgmp on by default; configure backs off to local gmp configure + and build automatically if needed either because gmp not present or + patched symbols are needed; autodetect and set the _start symbol + when using gprof + * Fix (setf (get ...) ...) return bug when interpreted + * Fix overwrite end of sgc_type_map bug + * Versioned depends on binutils-dev manually installed by Debian build + process + * New upstream release + * Proper binutils dependency for Debian + * head -1l -> head -n 1 for freebsd + * Cleanup gmp_wrapper code, check for in-place calls as write in one + step is not guaranteed in gmp according to its developers + * Rebuild against binutils 2.15, Closes: #266253, Closes: #263983 + + -- Camm Maguire Tue, 17 Aug 2004 18:22:27 +0000 + +gcl (2.6.4-1) unstable; urgency=high + + * New upstream release + * Make disassemble work when original system directory is gone + * New debian/support files for debconf image default selection support + * More descriptive compiled C function names for use in gprof when + profiling is compiled in + * Compiler fix for proclaimed vararg functions + * Allow sharp numbers to be bignums + * lintian fix in string-match + * Prototype for alloca for lint + * Improve gprof support + * Improve sgc page allocation which optimize-maximum-pages is in + effect and the hole is overrun + * Build a profiling set of images as well for Debian, toggle between + all four by default via debconf + * reset-sys-paths lisp function for moving image installation + directories, show profiling support in banner if present + * Fix typo in sys docs + * reset sys paths on installation + + -- Camm Maguire Thu, 5 Aug 2004 22:48:56 +0000 + +gcl (2.6.3-1) unstable; urgency=high + + * Correctly parse gcc version strings in gmp3 subconfigure on arm + * Fix variable capture error in dotimes macro + * Better sed separator for LI-CC in unixport/makefile + * Fix segfault in string-match + * vs_top=sup -> (reset-top) where possible in compiler. FIXME: a few + items of a different form which need to set *sup-used* too. + * Correct room report to show proper percentages when sgc is on + * Read in RELOC environment variable if set as default in debian/rules + * Remove local bfd libraries from libs variables as their objects are + incorporated into libgcl and as the source directory may not be + available at runtime + * Remove pcl/pcl_gazonk*lsp build-generated files from source + + -- Camm Maguire Thu, 15 Jul 2004 14:26:44 -0400 + +gcl (2.6.2-3) unstable; urgency=low + + * Fix value stack leak in rare compiled call sequence + + -- Camm Maguire Tue, 13 Jul 2004 10:17:02 -0400 + +gcl (2.6.2-2) unstable; urgency=low + + * New upstream point release + + -- Camm Maguire Tue, 13 Jul 2004 10:08:53 -0400 + +gcl (2.6.2-1) unstable; urgency=low + + * gcc-3.4 support + * Proper isnormal default courtesy of Magnus Henoch + * gclclean makefile target and other small makefile changes + * Proper check for C stack array body address in gbc.c and sgbc.c + * New upstream release + * acconfig.h update for isnormal default + * Fix bug in setting elements (si::aset) of 0 rank arrays uncovered by + the random tester + * No -fomit-frame-pointer on mingw + * Backport minimal ansi-test patches from HEAD to enable running of + the random tester + * installed tcl/tk patch for mingw + * Fix banner license detection code in lsp/gcl_mislib.lsp as + 8features* entries are now keywords + * o/makefile changes to work around trailing slash -I arguments gcc + bug on mingw + * Patch to mingwin.c:fix_filename to close long standing 'maxima + ignore-errors filename corruption' bug on mingw + * Check for too large rank supplied to make-array1 + * Fix potential stack overwrite bug in quick_call_sfun/eval.c + * Add -mprferred-stack-boundary=8 on amd64, as constant integers used + in a call must be retrievable with va_arg(,fixnum) + * Revert preferred-stack-boundary option on amd64 as it does not play + well with external libraries, also eliminate -m64 to allow for user + settings. Cast fixnum constant C arguments in gcl_cmploc.lsp + explicitly to (long) to ensure they can be extracted via + va_arg(,fixnum) + * reenable SA_SIGINFO on amd64 to restore SGC there + * Include elf.h in FreeBSD.h + * Allow for elf_abi.h in FreeBSD.h + * Add README.openbsd file + * readme.mingw updates + * solaris.h updates for custreloc option + * Close possibility of malloc failure due to intervening gbc arising + from the misordering of allocation calls + * C_GC_OFFSET is 2 on m68k-linux + * Add release notes, remove gcl document presumably based on dpANS for + now + * Fixup bad extern declaration of signals_handled in usig.c + + -- Camm Maguire Fri, 25 Jun 2004 22:43:52 +0000 + +gcl (2.6.1-39) unstable; urgency=high + + * Fix segfault in referencing (sgc_)type_map out of bounds which can + occurr when C stack is below heap, as on alpha. + * Cleanup compiler warnings on bcmp.c bzero.c and bcopy.c + * Clean up compiler warning in file.d + * Ensure set TLDFLAGS are used in finding DBEGIN in copnfigure.in, for + OpenBSD + + -- Camm Maguire Fri, 7 May 2004 21:50:03 +0000 + +gcl (2.6.1-38) unstable; urgency=low + + * Make *features* entries keywords -- add canonical host cpu and + kernel-system to *features*, disable h files specific + ADDITIONAL_FEATURES macro in main.c + * Fix merge-pathanames bug in concatenating default and supplied + directory lists + * Minor pathname and *features* fixes + * Fix recently introduced configure.in syntax bug + * Minor patches to support big gcl images -- all page integers must be + long ints, need stack space limits that scale with MAXPAGES at least + to allow free_map stack array in sgc_start. FIXME -- right now can + handle situations where page numbers are ints, but npage*PAGESIZE is + a long, need to handle npage >MAX_INT later. This is to support the + 'billion cons element acl2 image' requested by a gcl user + * Revert winnt features and debugging aids in configure.in + * OpenBSD support, gcc warning cleanups for long page integers + + -- Camm Maguire Mon, 3 May 2004 21:34:57 +0000 + +gcl (2.6.1-37) unstable; urgency=high + + * mprotect pages PROT_EXEC as CLEAR_CACHE step on amd64-linux + * Prevent recursive malloc calls for OpenBSD error reporting + * Push dummy 0 time for child runtime on windows to be compatible with + other platforms for now + * Make sure pages are mprotected PROT_EXEC for amd64 support + + -- Camm Maguire Tue, 13 Apr 2004 21:00:22 +0000 + +gcl (2.6.1-36) unstable; urgency=low + + * Improve optimize-maximum-pages algorithm + + -- Camm Maguire Tue, 6 Apr 2004 03:23:40 +0000 + +gcl (2.6.1-35) unstable; urgency=low + + * Fix sigcontext autodetection on sparc + + -- Camm Maguire Sun, 4 Apr 2004 19:26:48 +0000 + +gcl (2.6.1-34) unstable; urgency=low + + * Fix GNU_LD autodetection in configure.in + * Eliminate C_INCLUDE_PATH from shell script wrapper + * Use lisp rather than 'system touch' to make empty map file in + compiler::link + * fix small bug when info is passed bad second argument + * Don't try to open map file if doesn't stat (macosx) + * Add earlier forgotten branch patch to sfaslbfd.c for macosx + * Backport new eval-when keyword support from 2.7 to run random tester + * Perhormance improvement to gcl_seqlib.lsp -- no inner loop over + bignums + * Proper contblock/relblock determination when expanding string + streams + * Proper string type determination for *link-array* + * .ini files depend on plt.h + * plttest.c cannot depend on include.h + * Address longstanding FIXmE in gensym, so that two strings are not + allocated for each gensym + * Fix rare infinite loop bug in array.c + * Import si::info into 'user + * , -> # as sed separator + * Minro warning removals and fixups + * Binary searches through ordered arrays of referred and changed + variables for dramatic compiler performance improvement in the large + case -- support declarations and thereby optimizations of the form + (declare ((vector t) foo)), etc. + * Better 'time macro + * rebuild pcl_gaz* files + * cleanup room report and give more space to modern large heaps + * room report formatting + * Properly gensymmed time macro + * Allow for white space chars in compiled filenames + * Autodetect and work around sbrk randomization, e.g. on Fedora 1 + * Probe for sbrk before probing for randomized sbrk + * Openbsd changes -- maximize data seg resource if possible, avoid + mallocing error message when allocation routines fails + * Fix sigcontext configure tests + * Rename loop-finish -> sloop-finish in sloop package so that sloop + and ansi loop can be used simultaneously + * Handle arguments which are zero in LCM + * Fix typo in configure.in + * Improved dotimes macro which avoids unnecessary fixnum garbage + generation + * Backport of ignorable declaration keyword for new dotimes macro + * si::*OPTIMIZE-MAXIMUM-PAGES* support + * rebuild pcl generated lisp files + + -- Camm Maguire Sat, 3 Apr 2004 19:27:18 +0000 + +gcl (2.6.1-33) unstable; urgency=low + + * Remove extraneous symbols from plt.h, autodetect and correct for + leading underscore in object symbols + * complete readline version detection commit + * Backport support for new eval-when keywords + * Autodetect GNU ld and add -Wl,-Map only when appropriate + + -- Camm Maguire Wed, 10 Mar 2004 22:51:44 +0000 + +gcl (2.6.1-32) unstable; urgency=low + + * Try to automatically determine the form used for the explicitly + compiled in external function addresses in plt.c + * No need to explicitly write cr-lf on windows + * Autodetection of machine on FreeBSD + * Updated defs and h files for FreeBSD courtesy of Mark Murray + * Minor ifdefs needed for FreeBSD + * Refer to exported non-static C stub of fSmake_vector1 in plt.c + (needed on ia64) + * Readline 4.1/4.3 configure magic + + -- Camm Maguire Tue, 9 Mar 2004 01:58:43 +0000 + +gcl (2.6.1-31) unstable; urgency=low + + * Adjustments to vs_top reset logic to clear (hopefully last) + remaining bug found by the random-tester + * Allow args-info-referred-vars to match replaced vars, clearing bug + report submitted by Matt Kauffman + * Rework plt code yet again to be compatible with compiler::link for + axiom, and mingw32 + + -- Camm Maguire Mon, 8 Mar 2004 12:16:46 +0000 + +gcl (2.6.1-30) unstable; urgency=low + + * Fix rsym generated symbol tables for 64 bit platforms + * Make sure 'unwind' in frame.c does nt go below frs_org + * Do not define symbols with no value, either in bfd/rsym, or in + plt.c. Generates a clear and explicit error of an undefined symbol + when we've missed an address + * Define the external symbols known to be written at present in plt.c + * fix some more compiler errors found by the random tester -- all + related to proper unwinding of temporary reductions of vs_top from + te local supremum + + -- Camm Maguire Sat, 6 Mar 2004 02:05:59 +0000 + +gcl (2.6.1-29) unstable; urgency=low + + * Remove implicit dependency on gawk, optimize plt.c a little + + -- Camm Maguire Wed, 3 Mar 2004 16:08:30 +0000 + +gcl (2.6.1-28) unstable; urgency=low + + * make sure bfd fasload initializes dum.sm.sm_object1 for + read_fasl_vector + * When a tagbody contains ccb reference tags, and hence i itself + marked ccb, mark all the clb tags therein ccb too, as the tagbody + environment will be consed in c2tagbody-ccb. FIXME -- review this + logic carefully + * fix typoe in o/sfaslbfd.c + * Add code to unwind redefinitions of the stack supremum in c2expr-top + (used in c2multiple-value-prog1 and c2multiple-value-call in + evaluating arguments) on non-local exit + * Use new temporarry variables holding lisp stack supremum for lint + * Eliminate extraneous warning message when allocating fewer pages + than already allocated + * Rework internal plt symbol address capture + * Cleanup sfaslelf compiler warning + + -- Camm Maguire Wed, 3 Mar 2004 00:27:08 +0000 + +gcl (2.6.1-27) unstable; urgency=low + + * Modify default banner slightly + * Homebrew plt-like mechanism for ensuring that valid internal + addresses exist to which undefined symbols in compiled lisp objects + referring to external shared libraries can be relocated + * Make configure demand gettext when choosing --enable-locbfd + * Make sure references to ldb1, a stub conventionally optimized away, + can be resonled when optimization is turned off + * completion_matches -> rl_completion_matches in gcl_readline.d, + which is what is exported in the headers + + -- Camm Maguire Fri, 27 Feb 2004 23:50:49 +0000 + +gcl (2.6.1-26) unstable; urgency=low + + * Rework compiler::*ld-libs*, compiler::link, and unixport/makefile to + accomodate mingw need for firstfile.o and lastfile.o + * Remove incompatible -fomit-frame-pointer when compiling with -pg + profiling + * Load sys-proclaim.lisp files forimproved linking and smaller object + size across the board, install same for use with compiler::link + * Use pathnames instead of strings in compiler::link, also in image + init files, for Windows + * small mod to unixport/makefile re filtering of firstfile and + lastfile + * Backport zero divisor error cnditions from HEAD for + floor,ceiling,truncate + * Default to debug mode on hppa to work around gcc compiler + optimization bugs + * Add missing m4 and automake files in binutils directory to enable + automake and autoconf here + * Add mach-o specific files from cvs head to local bfd tree + * Add bfd/po makefiles + * Macosx defaults in configure.in + * bfd make and configure file changes to handle mach-o backend + * *gcl-version* -> *gcl-minor-version*,*gcl-extra-version* + * Support for more informative banner reading features list + * Support for both sigbus and sigsegv in sgbc.c as is customary in .h + files + * mach-o compatible changes in sfaslbfd.c + * Support for new debugging section names in sfaslelf.c + * powerpc-macosx h and defs files from cvs head + + -- Camm Maguire Wed, 25 Feb 2004 23:08:59 +0000 + +gcl (2.6.1-25) unstable; urgency=low + + * rl_putc_em a carriage return after invoking readline to ensure the + prompt in rl_putc_em_line is cleared. + * use standard sgc fault recovery element for hppa as recommended by + hppa kernel experts + * Store banner in si::*system-banner* for possible modification + in compatibly licensed programs + * exit with -1 when standard in ends in lisp debug mode + * Backport macosx files from cvs HEAD + * Document system return codes + + -- Camm Maguire Fri, 13 Feb 2004 20:44:54 +0000 + +gcl (2.6.1-24) unstable; urgency=low + + * Revert unixport/makefile link order fix for windows, breaks + compiler::link, find another way + * runtime SGC fault recovery test + * Protect read/fread in case SGC is enabled with safe (restartable) + versions + * SGC on for arm and hppa + * remove fast-link workaround now fixed for windows + * Backport HEAD makefile changes to clean .{c,h,data} files and + new_decl.h, remove said from repository (generated files) + + -- Camm Maguire Thu, 12 Feb 2004 05:56:29 +0000 + +gcl (2.6.1-23) unstable; urgency=low + + * Remove calls to init-readline with new automatic readline setup + + -- Camm Maguire Tue, 27 Jan 2004 20:27:20 +0000 + +gcl (2.6.1-22) unstable; urgency=low + + * Build depend on emacs21 | emacsen + + -- Camm Maguire Fri, 23 Jan 2004 22:01:15 +0000 + +gcl (2.6.1-21) unstable; urgency=low + + * Automatic readline initialization + * Add watch file + * Prevent circular error loops + * Prevent automatic optimization added to CFLAGS by autoconf + * Rework documentation installation in and outside of Debian + * Support user deined predicates at an elementary level in the form + '(satisfies foop) in gcl_predlib.lsp + * Install binary gcd algorithm for ~10% performance increase + * Rescale some default allocation parameters -- bignum allocation by + relblocks by default, default growth parameters are 1 (min), + 0.1*MAXPAGE (max), 0.5 (increase), 0.3 (percent free), holepage is + 4*MAXPAGE/1024, INIT_HOLEPAGE, INIT_NRBPAGE and RB_GETA scale + accordingly + * Clean windows/sysdir.bat + * Check for zero args in new gcd code + * Default hole is maxpages/10, holesize configure option added + * Fix syntax errors in older reloaction code: sfaslelf.c + + -- Camm Maguire Fri, 16 Jan 2004 16:57:50 +0000 + +gcl (2.6.1-20) unstable; urgency=low + + * Fix gcl-doc doc-base files + + -- Camm Maguire Tue, 30 Dec 2003 22:30:39 +0000 + +gcl (2.6.1-19) unstable; urgency=low + + * Fix bug in compiler::c2labels in which *ccb-vs* was missing a ocal + rebind + * Remove duplicate tags from compiled C switch statements + * Minor merges for DARWIN support + * Path to configure to make --enable-emacsdir work + * Check for readline/readline.h header before configuring for readline + * Improve system bfd library location detection + * Make sure external gmp lib is compatible via __GNU_MP_VERSION, else + backoff to local gmp build; prepend externally defined CFLAGS into + output CFLAGS, FINAL_CFLAGS, and NIFLAGS + * Remove --enable-gmp configure option; gmp is required for GCL + * Use --enable-emacsdir in debian/rules, make sure --enable-emacsdir + and --enable-infodir work when arg contains ${prefix} + * Fix typo in chap-6.texi + * Make sure to export SGC define from config.h to cmpinclude.h -- Now + that we used optimized structures in the compiler, we need at least + the definition of SGC_TOUCH there to prevent GBC errors. FIXME -- + handle header dependencies more robustly. Thanks to Robert Boyer + for the report + * Improve SGC define extraction for cmpinclude.h + * Fix variable reference errors which were occurring for compiled + local functions defined within closure-generating or other + environment stack pushing functions when safety is set to 3 (thanks + Paul Dietz for the report.). When constructing local functions and + closures within a 'mother' function, *ccb-vs* will hold the number + of closure environments stacked at the point of each closure + creation or call to a local function. This value is stored as the + cadr of a list pushed onto *local-funs*, and is read when writing + out the C code for the local function or closure, where it is used + to initialize *ccb-vs* and *initial-ccb-vs* for subsequent + processing. The latter is used as the reference point when + addressing variables in wt-ccb-vs, as the former could be still + further incremented within the closure or local function itself. + Local functions as opposed to closures do not increment *ccb-vs* and + do not push the environment. When a local function is defined + within a closure-generating flet/labels, or a tagbody or block which + pushes the environment, the value of *ccb-vs* written to the list + corresponding to the local function can be erroneously incremented + beyond the *initial-ccb-vs* value established before any environment + pushing operations were processed. It is this latter value which is + appropriate for use in wt-ccb-vs, as the local functions, unlike the + closures, receive an environment level with the mother generating + function. We therefore push *initial-ccb-vs* onto the end the list + pushed onto *local-funs* only when defining a local function, and use + it to initialize an added optional variable initialize-ccb-vs in + t3local-fun and t3local-dcfun, which default to the original ccb-vs. + We then bind *initial-ccb-vs* to this new optional parameter instead + of the former *ccb-vs, which was only appropriate for closures. + * Put in rudimentary logic for the selection of stack vs. heap storage + for bignums depending on the frame context. FIXME, this logic is + too conservative at present. SETQ_II and SETQ_IO take an additional + parameter which is malloc when *unwind-exit* is bound and contains + 'frame and alloca otherwise. New macro bignum-expansion-storage. + FIXME, ensure that IDECL does not need similar modification. + * Cleanup a few compiler warnings in the compiler + * Cleanup compiler warning in alloc.c + * Eliminate unneeded transformatio of contniguous pages to other pages + on save-system. + * malloc -> gcl_gmp_alloc in recent setjmp frame protected bignum + allocation + * Add -Wa,--execstack if on an exec-shield enabled system, can be + explicitly added otherwise by setting the CFLAGS variable before the + configure step + * Better execstack flag handling in configure + * Allow for commas in CFLAGS in sed command writing *cc* + * Preliminary gprof profiling support + * Rework html documentation generation and installation, Closes: + #221774 + * Remove parentheses from setf class-name info node in chap-7.texi + + -- Camm Maguire Tue, 30 Dec 2003 16:26:45 +0000 + +gcl (2.6.1-18) unstable; urgency=low + + * Portability patches to makefiles to support non-GNU grep (no -q), + and non-bash sh, C_INCLUDE_PATH=...;export C_INCLUDE_PATH + * copy the global *info* parameter in c1flet and c1labels to prevent + accumulation of old data -- FIXME -- make sure there are no other + copies required, and eventually replace this global parameter with + local variables + * Turn on some optimization on hppa, -O only + * Make all C defined functions installed into lisp static functions to + work around dynamic function descriptors on ia64, Closes: #217484, + Closes: #204789, (STATIC_FUNCTION_POINTERS define in config.h) + + -- Camm Maguire Thu, 6 Nov 2003 15:40:25 +0000 + +gcl (2.6.1-17) unstable; urgency=low + + * Repair weak symbol addition to the bfd symbol table in sfasli.c + * Be more thorough about adding fun-info to call-local info in + gcl_cmpflet.lsp, accompanying simplifications in gcl_cmpeval.lsp + (call-global lists have info updated by args already in (c1args args + info)), small changes in add-info in gcl_cmpinline.lsp, FIXME -- + study rational for *info* special variable in certain places as + opposed to more common copy-info + + -- Camm Maguire Thu, 30 Oct 2003 20:03:22 -0500 + +gcl (2.6.1-16) unstable; urgency=low + + * Fix sh syntax in debian/gcl.sh + * init_or_load1 -> gcl_init_or_load1 in xgcl-2/sysinit.lsp + * Load weak symbols as well as undefined symbols in + bfd_build_symbol_table, for the purposes of the static build + possibility + * Map t and nil stream indicators properly in optimized compiled + references to read_char1 and read_byte1 (in read.d) + + -- Camm Maguire Thu, 23 Oct 2003 16:43:15 +0000 + +gcl (2.6.1-15) unstable; urgency=low + + * Remove imod/ifloor functions in cmpaux.c and directly inline their + fixed equivalents in gcl_cmpopt.lsp + + -- Camm Maguire Mon, 13 Oct 2003 15:04:24 +0000 + +gcl (2.6.1-14) unstable; urgency=low + + * generate less garbage in add-info (gcl_cmpinline.lsp), enabling + maxima compile to complete in a finite time :-) + + -- Camm Maguire Fri, 10 Oct 2003 22:14:04 +0000 + +gcl (2.6.1-13) unstable; urgency=low + + * Fix compiler optimization bug in gcl_cmpopt.lsp -- missing parens + around inliner for max and min + * collect info structures for local functions in flet and labels + processing (gcl_cmpflet.lsp), and pass upwards to call-local and + call-global (gcl_cmpeval.lsp) to fix certain inlining bugs in via + more proper operation of args-info-changed-vars (gcl_cmpinline.lsp, + inline-args, gcl_cmplet.lsp, c2let) + * Fix an obviou int overflow in ifloor (o/cmpaux.c), handle more + proper fixnum/integer determination from declarations later + + -- Camm Maguire Fri, 10 Oct 2003 02:34:11 +0000 + +gcl (2.6.1-12) unstable; urgency=low + + * Restore mpz_to_mpz{1} in gmp_big.c, can be written by compiler + * tk8.4 patches + * Prevent destructive modification of bignum arguments in log_op/mp_op + in gmp_big.c + * Make sure to push stack variables onto newly allocated C variable + when inlining args and args cause side effects, in inline-args, + gcl_cmpinline.lsp + * Fix bug related to gcc-3.3 fixes in set_exponent in num_co.c + * Remove pcl_methods.c patch. as is apparently no longer needed, TODO + -- make sure VOL modifier is inserted where needed to prevent + longjmp clobbers + + -- Camm Maguire Thu, 2 Oct 2003 14:26:43 +0000 + +gcl (2.6.1-11) unstable; urgency=low + + * Add compilation step of compiling all lsp and cmpnew .lsp files from + an interpreted only saved_pre_gcl before the creation of saved_gcl - + - this enables us to use full optimization on these files while + getting the STREF constants right on 32bit and 64bit + * remove 'attic' from comment in gcl_loop.lsp + * configure changes for sizeof(struct contblock) detection + + -- Camm Maguire Wed, 24 Sep 2003 16:09:44 +0000 + +gcl (2.6.1-10) unstable; urgency=low + + * Mac OSX GET_FULL_PATH_SELF + * Preliminary subtypep checking for 'satisfies + * preliminary 'satisfies support in subtypep, more predicate type + pairs and reverse checking + * small compiler change to remove unused C variables from optimized + compiled macros + * Optional compiler init file is called gcl_cmpinit + * fasdmacros.lsp -> gcl_fasdmacros.lsp + * All cmpinit.lsp files named gcl_cmpinit.lsp; allow full lisp + optimization in all directories + * collectfn -> gcl_collectfn in lsp/gcl_auto.lsp + * collectfn -> gcl_collectfn in cmpnew/gcl_make-fn.lsp + * Make sure makefiles can generate sys-proclaim.lsp, regenerate these + files and recompile from lsp + * Rebuild with opts enabled + * Iterate sys-proclaim/rebuild generation once more + * Iterate sys-proclaim/rebuild for pcl and clcs + + -- Camm Maguire Tue, 23 Sep 2003 19:33:27 +0000 + +gcl (2.6.1-9) unstable; urgency=low + + * Close streams in fasldlsym.c + + -- Camm Maguire Tue, 16 Sep 2003 14:57:20 +0000 + +gcl (2.6.1-8) unstable; urgency=low + + * Add processor flag variable to flags in configure.in + * Autoadd full path to kcl_self to enable save-system when user moves + executable and calls without script wrapper + * Add special variables si::*collect-binary-modules* and si::*binary- + modules* as a facility for discovering the list of fasloaded objects + preceding a save-system is required for a subsequent compiler::link + * Add collectfn.lsp to distro + * Rename some files and init_ functions to eliminate namespace + conflicts when building images with compiler::link + * Enable compressed info reading + * Make sure no opt flags are set when enable debug is specified + * Use NIFlAGS to compile new_init with lower opts on ppc to work + around gcc bug, restore full opts to other files + + -- Camm Maguire Sun, 14 Sep 2003 02:18:28 +0000 + +gcl (2.6.1-7) unstable; urgency=low + + * Fix permissions bug in temporary gzipped file handling + * Propagate control changes correctly with package extension + * Newer standards + + -- Camm Maguire Tue, 9 Sep 2003 17:06:56 +0000 + +gcl (2.6.1-6) unstable; urgency=low + + * Remove build-dependency on autoconf as a temporary work around to + Debian autoconf's dependency bug on emacsen-common + + -- Camm Maguire Tue, 9 Sep 2003 15:29:06 +0000 + +gcl (2.6.1-5) unstable; urgency=low + + * Redefine temporary files in elisp/makefile + + -- Camm Maguire Mon, 8 Sep 2003 21:49:09 +0000 + +gcl (2.6.1-4) unstable; urgency=low + + * Fix to sfasli.c to avoid defining symbols in other than *UND* + sections + * Remove some 64 bit warnings + * Turn off def_static on ia64 for now -- its broken + + -- Camm Maguire Sat, 6 Sep 2003 17:22:10 +0000 + +gcl (2.6.1-3) unstable; urgency=low + + * Fix static detection fr ia64; contblock size detection on arm + * Fix gcc verion checking in gmp3 subconfigure, esp. for arm + * Escape all sgc code with #ifdef SGC + + -- Camm Maguire Fri, 5 Sep 2003 21:32:47 +0000 + +gcl (2.6.1-2) unstable; urgency=low + + * Add windows/install.lsp to clean target + * Add in macosx files to stable and cvs head + * Fix bad debelper postinst, Closes: #208765 + + -- Camm Maguire Fri, 5 Sep 2003 13:15:11 +0000 + +gcl (2.6.1-1) unstable; urgency=low + + * New upstream release + * Type-punning warning fixes + * small_fixnum overflow fixes + * off by one fix in cerror + * Fix compiler error which had not recognized defpackage as a package + operation + * Fix tkl.lisp call to open-named-socket + * Make values-list and nreconc signal errors when they should on + dotted lists. + * Avoid use of windows.h types as macros. + * New config.{sub,guess} + * Windows installer updates from CVS HEAD + * fix potential longjmp clobber in read.d;add some windows files to + main makefile clean target; + * Darwin revealed fixes to usig.c and unixtime.c + * Fix gbc time calculation in case of recursive gbc calls + * Run patch_sharp in LSharp_exclamation_reader to handle new case of + defpackage ops at head of fasl vector, required for maxima build + * Special symbol Dotnil has ordinary list Cnil for plist and hpack + * Small fixes for profiling support + * Restore pp() function for debugging; print out undefined symbol + names + * Small patch for fix xgcl demo (thanks Michael Koehne) + * Better bfd symbol table strategy + * Fix bfd table symbol counting for combined_table profiling + * amd64 linux support + * O6 -> O3 + * static linking on ia64 to work around current mechanism for runtime + generated function descriptors + * enable-static configure option + * Fix debian/gcl-doc.docs for latest texinfo file splitting policy, + Closes: #206017 + * Fix typo in o/sfasli.c + * Rework debian package structure to handle stable and cvs packages + simultaneously + * Add gazonk*.lsp to clean target + * syntax fix to lsp/gprof.hc + * Add support for SGC contblock pages + * Fixes to debian/rules + * Remove unused definitions of Vcs + * Increase default maxpages and stack sizes + * Maintain a persisten *system-directory* binding + * Push installed /h directory onto -I flags on cc command line + * Escape old in-package behavior with #ifdef ANSI_COMMON_LISP + * define HAVE_XDR in linux.h + * reduce resolution of contblock mark_table in gbc.c to match new + minimum granularity introduced via CPTR_ALIGN + * Remove exit function in main.c + + -- Camm Maguire Thu, 4 Sep 2003 02:20:52 +0000 + +gcl (2.5.3-2) unstable; urgency=low + + * gcc-3.3 all platforms + + -- Camm Maguire Mon, 7 Jul 2003 16:10:25 +0000 + +gcl (2.5.3-1) unstable; urgency=low + + * New upstream release + * Restore object_to_float and object_to_double, cmpaux.c, Closes: #195470. + * Remove obsolete functiion multiply-bignum-stack from documentation, + si-defs.texi + * Unstatic object_to_float, object_to_double + + -- Camm Maguire Mon, 2 Jun 2003 12:38:03 -0400 + +gcl (2.5.2-1) unstable; urgency=low + + * New upstream release + * Cleanup xdrfuns.c for Axiom + * Reenable xgcl build + + -- Camm Maguire Thu, 20 Mar 2003 09:15:54 -0500 + +gcl (2.5.1-1) unstable; urgency=high + + * some optimization now on hppa + * Add RELEASE-2.5.1 file + * Add dedication notice to the memory of W. Schelter + + -- Camm Maguire Sun, 2 Mar 2003 10:20:26 -0500 + +gcl (2.5.0.cvs20020625-80) unstable; urgency=low + + * enable japi configure flag, defaults to no + * enable -mlongcall on ppc when using gcc 3.3 or higher + * int -> fixnum in DEFUN function arguments for safety -- ensures + pointers and integers passed by lisp are of same size + * MYmake_fixnum macro simplification + * ufixnum typedef + * Prototypes for cmod et.al. -- restoring maxima build on ia64 + * Fix unaligned access message on ia64 generated by DFLT_aet_fix + * Integer va_arg uses fixnum + * Define __*i3 symbols used by GCL, supplied by libc, and written into + some GCL compiled objects, restores ARM build with ANSI image + * num_log.c miscompilation on ia64 apparently fixed, Closes: #156291 + * Ensure cmpinclude.h up to date in main makefile + + -- Camm Maguire Sat, 1 Mar 2003 17:33:29 -0500 + +gcl (2.5.0.cvs20020625-79) unstable; urgency=low + + * Fix Debian package install bug + + -- Camm Maguire Thu, 27 Feb 2003 23:17:55 -0500 + +gcl (2.5.0.cvs20020625-78) unstable; urgency=low + + * Add config.log config.status and config.cache to clean target + * Remove xgcl-2/debian directory + * Update clcs/sys-proclaim.lisp + + -- Camm Maguire Thu, 27 Feb 2003 18:48:38 -0500 + +gcl (2.5.0.cvs20020625-77) unstable; urgency=low + + * Lintian cleanups + * Don't strip libansi_gcl.a, need .data at end of .o, as with libgcl.a + * Take newlines out of doc string for init-cmp-anon + * Cleanup gcc-3.2 compiler warning + * 64 bit STREF fixes + * pcl and clcs need to have C rebuilt afresh, as 64 bit machines write + different STREF offsets into the C files + * Rework Debian package build a bit + * README.Debian explaining the toggling of the ANSI image + * Typo in debian/rules + * Remove debian/gcl.conffiles + + -- Camm Maguire Thu, 27 Feb 2003 15:56:11 -0500 + +gcl (2.5.0.cvs20020625-76) unstable; urgency=low + + * Debian Priority is optional + * Configure lowest common denominator on m68k to m68020 -- gcc-3.2 + can't handle m68000 -- no __mulsi3 + * Fix bit array bug + * Add upgraded-array-element-type + * Misc typep and subtypep fixes + * Proper error handling in certain array.c functions + * First needs exactly one arg + * Proper error handlin in LAST + * bit array allocation fixes in num_log.c + * eliminate Iapply_fun_n1 + * Dummy system find-class in traditional image, overwritten by pcl + version in ANSI + * Invalid variable is a program error, not a symbol is a type error + * Attempt at uninterned symbol support as slot names + * defstruct changes for ANSI conc-name handling + * Rework ansi build to follow existing pattern for traditional image, + enabling preliminary ansi support on dlopen systems + * Fix broken mingw probe in main makefile + * Rename pcl and clcs files to avoid init name conflict on dlopen + systems + * sys-proclaim for clcs + * Compiler goto indentation + * Compiler pointer cast in call_or_link_closure + * *keep-gaz* compiler variable to save anonymously generated lisp + * si::init-cmp-anon function to initialize anonymously generated and + compiled lisp from .text section of running executable + * Debian/rules builds and ships both images + * Check for small fixnum in make_fixnum macro + * Pass real integers to array functions to minimize fixnum garbage + * Larger SHARP_EQ_CONTEXT_SIZE in read.d + * Shadowing-import instead of import dummy symbols into common-lisp in + ansi_cl.lisp + * Rework object definition in makefiles + * Remove old gmp directory + * Remove old tests directory + * Reinsert JAPI configuration + * Spruce up clean target + * Use saved_gcl to recompile cmpnew files + * Toggle ansi image with GCL_ANSI environment variable + * Version 2.5.1 + + -- Camm Maguire Wed, 26 Feb 2003 21:31:04 -0500 + +gcl (2.5.0.cvs20020625-75) unstable; urgency=low + + * Export truename for dlopen systems + + -- Camm Maguire Fri, 14 Feb 2003 23:31:15 -0500 + +gcl (2.5.0.cvs20020625-74) unstable; urgency=low + + * Remove duplicates in apropos a la clisp + * Use static where possible, remove unused functions, decrease global + symbol count by about 1/3 (~ 600 global functions) + * Inline optimize cmod,cplus,ctimes and cdifference like maxima + * eliminate make-pure-array from lfun_list.lsp, not defined + * Prototypes for all possible compiler generated function calls + * relative symlink for cmpinclude.h in Debian package + + -- Camm Maguire Fri, 14 Feb 2003 20:17:31 -0500 + +gcl (2.5.0.cvs20020625-73) unstable; urgency=low + + * typep fixes for class types + * m68k Build-depend on gcc-2.95 as a temporary work around to bug + 179807 + * gcc-3.2 warning cleanups + * bfd_boolean syntax support for newer binutils + * gcc-3.2 on powerpc can't yet handle -O2 and higher + * Reenable gcc-3.2 for m68k and do some guesswork in configure + + -- Camm Maguire Mon, 10 Feb 2003 13:47:00 -0500 + +gcl (2.5.0.cvs20020625-72) unstable; urgency=high + + * Fix to siLbit_array_op for 0 dimension arrays + * Fixed aref of short-float vector + * nconc can take dotted lists + * tailp returns t if first arg is nil + * Repair nconc and tailp fixes + * varargs->stdarg for gcc 3.3 and higher + + -- Camm Maguire Sun, 9 Feb 2003 16:57:33 -0500 + +gcl (2.5.0.cvs20020625-71) unstable; urgency=high + + * ansi changes to sloop.lsp and conditions.lisp to fix symbol tests + * :definition-before-pcl -> definition-before-pcl + * Allow spaces in pathnames + * Significant fixes to gmp_num_log.c affecting bitwise ops on bignums + * Fix test segfault arising from faulty structure-type-included-type- + name in gcl-low.lisp ; Thanks Peter + * aref1 -> row-major-aref + * Fixes to certain numerical functions to handle denormalized floating + point numbers + * Number of argument check in IapplyVector + * Print offset bit vectors correctly + * Correct precision for formatting short and long doubles + * Added si::modf + * Do not trigger error in IapplyVector if max args is zero + * Fixes to with-package-iterator to cleanup compiler warnings + * :invalid-variable is a type error + * No max arg checking if &key or &rest present + * proper defun declarations in listlib.lsp + * class specifiers in typep, subtypep and coerce + * Corrections to allow-other-key processing in bind.c + * eval sfuns with argument error checking (in one place) + * copy-structure takes only one arg + * si::classp, si::class-of, and si::class-precedence-list overwritten + by pcl analogs when compiling ansi + * recompiled core lsp and compiler files + * restore dvi and html doc build for non-mingw + + -- Camm Maguire Fri, 24 Jan 2003 13:55:11 -0500 + +gcl (2.5.0.cvs20020625-70) unstable; urgency=high + + * loop fixes + * configure fixes + * :common-lisp in *features* + * :definition-before-clcs -> definition-before-clcs + * protect against sgc segfault within fread in fasdump.c -- fixes m68k + acl2 build + * SGC for s390 + + -- Camm Maguire Thu, 5 Dec 2002 08:02:17 -0500 + +gcl (2.5.0.cvs20020625-69) unstable; urgency=high + + * eval fix + * \-mlong-calls for arm + + -- Camm Maguire Mon, 25 Nov 2002 08:35:27 -0500 + +gcl (2.5.0.cvs20020625-68) unstable; urgency=high + + * enable emacsdir configure option + * reordered configure X lib detection for solaris + * redo integer declarations for gmp bignums to avoid compiler warnings + * Clear large and negative count errors for remove/delete + * Loop error fixes + * cache flush with page granularity on m68k + + -- Camm Maguire Thu, 21 Nov 2002 17:44:30 -0500 + +gcl (2.5.0.cvs20020625-67) unstable; urgency=high + + * Align cache flushes for powerpc and m68k on 32 byte boundaries, + should fix acl2 build + * Removed diagnostic SIGILL trapping in cmpaux.c + + -- Camm Maguire Tue, 12 Nov 2002 23:25:49 -0500 + +gcl (2.5.0.cvs20020625-66) unstable; urgency=high + + * Fix SIGILL trap in cmpaux.c + + -- Camm Maguire Mon, 11 Nov 2002 11:14:07 -0500 + +gcl (2.5.0.cvs20020625-65) unstable; urgency=high + + * Miscellaneous Freebsd patches + * non-recursive with-package-iterator + * map-into fill-pointer fixes + * changes to the user-init mechanism for portable acl2 build + + -- Camm Maguire Sun, 10 Nov 2002 12:33:59 -0500 + +gcl (2.5.0.cvs20020625-64) unstable; urgency=low + + * Fix epsilon calculations again to reenable arm build + + -- Camm Maguire Fri, 1 Nov 2002 07:08:33 -0500 + +gcl (2.5.0.cvs20020625-63) unstable; urgency=low + + * Add versioned dependency on the gcc used to build gcl + + -- Camm Maguire Tue, 29 Oct 2002 16:20:22 -0500 + +gcl (2.5.0.cvs20020625-62) unstable; urgency=low + + * with-package-iterator modifications + * with-package-iterator uses labels to correctly provide for recursion + * Fix doc directory problem with install target in info/makefile + * Fix info dir setting in configure + * Priority extra + + -- Camm Maguire Mon, 28 Oct 2002 23:45:07 -0500 + +gcl (2.5.0.cvs20020625-61) unstable; urgency=low + + * Placeholder support for optional condition in find-restart + * defpackage error on importing non-existent symbols + * working with-package-iterator macro + * various package errors reported as :package-error + * Destructuring-bind fixes + * delete-package error fix + * pcl functions use pcl-destructuring-bind for now -- fix later + * Trigger error if function calls use too many 'values' + * Maximum values increased to 50 + * Enable previously failing tests in multiple-value-{setq,prog1}.lsp + * prototype for system_time_zone_helper + * Initial changes for solaris support + * make -> $(MAKE) in makefiles + * Incorporated main GCL (ANSI) Lisp Documentation in distribution + + -- Camm Maguire Mon, 28 Oct 2002 04:31:33 -0500 + +gcl (2.5.0.cvs20020625-60) unstable; urgency=low + + * Still better acosh, courtesy of Barton Willis + * Better epsilon contant determination in ieee case + * Implicit tagbody in do-symbols and do-all-symbols + * Better epsilon handling in ieee case + * Add setf (values ... support + * invalid-function errors are type errors + * ecase and ccase take t and otherwise clauses + * ECASE/CCASE test fixes + * setf values fixes to use setf instead of setq when target value is + not a symbol + * ETYPECASE/CTYPECASE can take t and otherwise + * Backout of restart-clusters export + * fix handler.lisp + * Fix to bfd/GBC interaction + + -- Camm Maguire Wed, 23 Oct 2002 08:38:08 -0400 + +gcl (2.5.0.cvs20020625-59) unstable; urgency=low + + * wrong number of arguments, keyword errors in lambda list bindings, + are program errors + * acosh fix at -1.0 + * New config.sub and config.guess files and automatic updates in + binutils, gmp, and gmp3 subdirs + + -- Camm Maguire Wed, 16 Oct 2002 11:38:56 -0400 + +gcl (2.5.0.cvs20020625-58) unstable; urgency=low + + * GENSYM fixes + * add complement and constantly + * import certain symbols into common-lisp package + * Fix makefile bug in install target + * Prepend instead of overwrite C_INCLUDE_PATH in shell wrapper + * More shell variable fixes in main makefile + * Corrected order of push and pushnew + * Set bfd_error appropriately + * Report function for package-error in condition-definitions.lisp;fix + internal-package-error deinition and handling;export *restart- + clusters* to user error code specified in handler-case;package-error + error formatting changes;dummy optional argument added to compute- + restarts (for now);Paul Dietz patch to defpackage.lsp fixing several + tests (thanks);export/unexport error handling fixes + * Recompile c,h and data files + * Fix number of argument errors in debug.lsp;documentation support for + packages in defpackage.lsp and module.lsp;do-symbols loops over + inherited symbols too in packlib.lsp + * Reworked EXTRAS variable handling in unixport/makefile + * Build-depend on autotools-dev and automatic update of config.sub and + config.guess;newer config.sub and config.guess in cvs tree; Closes: + #164526 + * Remove stray comments in package.d + * elt errors of type type error + * bad-sequence limit returns type error + + -- Camm Maguire Tue, 15 Oct 2002 15:39:19 -0400 + +gcl (2.5.0.cvs20020625-57) unstable; urgency=low + + * Capitalization changes to names of special characters;graphic-char-p + fix + * fix shadowing of existing symbols in package.d + * (simple-)base-string not a subtype of (simple-)vector + * add package-error condition(preliminary);hash conditions only by the + error name, not the format string;pass error types for both + correctable and non-correctable situations;eliminate duplicate + loading of clcs/package.lisp;Allow t doc-types in documentation + (returning nil) for now;fix final type errors in predlib.lsp + (regarding base-string);other error functions to pass continuable + errors (needs cleaning up);package designators can be + characters;delete-package added;make-package doesn't :use lisp by + default;in-package returns error if package does not exist instead + of making the package(relatively big change -- need to address + instances of in-package in .lsp code);call make-package on relevant + packages in init_gcl.lsp.in and pcl/sys-package.lisp; + * \-ffunction-sections for hppa with no-optimization -- enables first + maxima build here + * separate lisp variables to specify optimization flags for level 2 + and 3 + * symbol-name throws a type error on bad input + * tk8.2 -> tk8.3 + * Fix bug in main makefile + * Newlines at end of test files + + -- Camm Maguire Wed, 9 Oct 2002 15:04:41 -0400 + +gcl (2.5.0.cvs20020625-56) unstable; urgency=high + + * ansi-test corrections; extra-libs option to LINK function; LINK doc + change; subtypep and string changes to pass more tests + * Add method-combination and structure-object symbols for ansi;remove + unused variables in debug.lsp;remove in-package system from + defstruct.lsp;make-keyword and defmacro temporary function + placeholders in destructuring_bind.lsp;predlib changes to fix ansi- + test type errors;break-call takes 2 args (sys-proclaim.lisp);char + and char-set protected by string dimension not fillpointer in + string.d;fix bug in string.d:member_char for vector types;redefine + slot reader and writer functions in pcl/impl/gcl/gcl-low.lisp + + -- Camm Maguire Sat, 5 Oct 2002 14:33:46 -0400 + +gcl (2.5.0.cvs20020625-55) unstable; urgency=high + + * Add LINK documentation to info pages + * 0 length last support + * make-sequence error check for 'null type and non-zero size + * Dotted-list support in member + * Reworked dotnil definitions and support macros + * add compile-file-pathname + * setup C_INCLUDE_PATH env variable in gcl shell wrapper + * POSITIVE-FIXNUM variable type,simple-error->type error where + indicated by various ansi tests, eq->eql in ldiff and tailp;proper + lists only in member et. al. + * rev keyword for member1 to reverse test arguments + * specific-error function to pass a given type of error from lisp + * set-exclusive-or preserves order of test arguments + * type-errors where appropriate in make-sequence + * nil keys accepted in remove/delete et.al. + * Reworked linking command line to ensure that certain symbols are + resolved in libgcl.a as opposed to certain system libraries, e.g. + gmp + * new gmp for m68k;no -ffloat-store for m68k a requested by user due + to performance impact (will alter test results in maxima + accordingly) + * libgclp.a for objects to be overriden by the C library if necessary + * readably support + * boolean type + * Missing ansi type support + * subtype code for boolean + * add missing ansi types as known types + * other preliminary subtype code for missing ansi types + * rework result-type check in make-sequence + * :element-type support in make-string (preliminary) + * (char ignores fill-pointer + * remove -O4 from debian/rules + + -- Camm Maguire Thu, 3 Oct 2002 01:52:45 -0400 + +gcl (2.5.0.cvs20020625-54) unstable; urgency=high + + * Fix delete et. al. :from-end error; typo in gbc.c + * character and string-char equal in type hierarchy + * concatenate/make-sequence fixes + * merge takes nil key argument + * make-sequence checks size against result type + * install endp macro for dotted list support + + -- Camm Maguire Tue, 24 Sep 2002 14:57:44 -0400 + +gcl (2.5.0.cvs20020625-53) unstable; urgency=high + + * Sleep with (in principle) microsecond precision + * nth-value macro added + * \-ffloat\-store and warning cleanups for m68k + * Compile hppa with debugging, will get a build but a broken one, ok + for now, Closes: #159591 + + -- Camm Maguire Fri, 20 Sep 2002 09:48:35 -0400 + +gcl (2.5.0.cvs20020625-52) unstable; urgency=high + + * Fixed gcc version bug in debian/rules + + -- Camm Maguire Thu, 12 Sep 2002 18:00:50 -0400 + +gcl (2.5.0.cvs20020625-51) unstable; urgency=high + + * static gmp for m68k + + -- Camm Maguire Thu, 12 Sep 2002 09:33:03 -0400 + +gcl (2.5.0.cvs20020625-50) unstable; urgency=high + + * Reworked static gmp target for new libgcl.a;gcc-3.2 for + hppa,ia64,and arm;libgmp2-dev for m68k;no rsym with + dynsysbfd;build_symbol_table earlier to shrink table size; + + -- Camm Maguire Thu, 12 Sep 2002 00:39:17 -0400 + +gcl (2.5.0.cvs20020625-49) unstable; urgency=high + + * Use old gmp for m68k until can pin down test failure with gmp3 + + -- Camm Maguire Tue, 10 Sep 2002 00:36:10 -0400 + +gcl (2.5.0.cvs20020625-48) unstable; urgency=high + + * Rework build and install so that custom images can be made without + the source tree, even when using dlopen + + -- Camm Maguire Mon, 9 Sep 2002 23:26:47 -0400 + +gcl (2.5.0.cvs20020625-47) unstable; urgency=high + + * Install cmpinclude.h in system include directory + + -- Camm Maguire Thu, 29 Aug 2002 23:31:55 -0400 + +gcl (2.5.0.cvs20020625-46) unstable; urgency=high + + * Keep a *much* smaller piece of gmp.h in cmpinclude.h, reducing image + size by almost 100k + * Check for _SHORT_LIMB and _LONG_LONG_LIMB in configure + * Remove build specific include directories from compile command in + final executable + * Include local regexp.h explicitly in cmpinclude.h, to eliminate + intereference with system regexp.h, and to fix bug in which gcl + compilation depended on existing build directories + * Correctly add directory paths to extra gmp file targets in + unixport/makefile for m68k + + -- Camm Maguire Thu, 29 Aug 2002 21:56:28 -0400 + +gcl (2.5.0.cvs20020625-45) unstable; urgency=high + + * Fix typo in rshift target for m68k + + -- Camm Maguire Wed, 28 Aug 2002 18:02:00 -0400 + +gcl (2.5.0.cvs20020625-44) unstable; urgency=high + + * Handle second argument to last; treat dotted lists correctly in + ldiff et. al., tailp fix + * optional key argument for assoc-if et.al.;eval getf deflt if in setf + * Fix infinite loop in assoc-if et.al. + * X_LIBS and X_CFLAGS determination in configure script + + -- Camm Maguire Wed, 21 Aug 2002 18:22:37 -0400 + +gcl (2.5.0.cvs20020625-43) unstable; urgency=high + + * Larger ihs stack;fix array-total-size-limit;check negative + fillp;allow #P + * don't make common_lisp package when not configuring with --enable- + ansi + * Patch gmp3/mpn/m68k/{l,r}shift.asm, restore gmp3 to m68k build + * Dynamic libgmp support, overriding with patched functions from local + source where necessary + + -- Camm Maguire Sun, 18 Aug 2002 12:10:55 -0400 + +gcl (2.5.0.cvs20020625-42) unstable; urgency=high + + * copy ansidecl.h and symcat.h in h/ for local bfd builds + * localize bfd.h includes to sfaslbfd.c + * take bfd/po out of the build loop + * import xgcl-2, but don't build by default + * oldgmp configure option, and made default for m68k as temporary + workaround + + -- Camm Maguire Mon, 12 Aug 2002 23:49:09 -0400 + +gcl (2.5.0.cvs20020625-41) unstable; urgency=high + + * Minor rules revision for i164 + + -- Camm Maguire Sun, 11 Aug 2002 13:49:03 -0400 + +gcl (2.5.0.cvs20020625-40) unstable; urgency=high + + * revamp CONST configure test for certain bfd versions + + -- Camm Maguire Sun, 11 Aug 2002 12:31:35 -0400 + +gcl (2.5.0.cvs20020625-39) unstable; urgency=high + + * gcc-3.1 for ia64 fixes a compilation bug in num_co.c for -O3 and + higher -- code takes address of a variable kept in a register + * compile num_log.c with -O only on ia64 to work around compiler bug + + -- Camm Maguire Sun, 11 Aug 2002 08:53:03 -0400 + +gcl (2.5.0.cvs20020625-38) unstable; urgency=high + + * check for long c statck addresses, fixing NULL_OR_ON_C_STACK macro + for ia64 + * Remove error in clean target + + -- Camm Maguire Sat, 10 Aug 2002 13:20:08 -0400 + +gcl (2.5.0.cvs20020625-37) unstable; urgency=high + + * Replace tmpnam and mktemp with less dangerous mkstemp + + -- Camm Maguire Fri, 9 Aug 2002 19:45:52 -0400 + +gcl (2.5.0.cvs20020625-36) unstable; urgency=high + + * Fix rsym compilation when not using bfd + + -- Camm Maguire Fri, 9 Aug 2002 19:10:16 -0400 + +gcl (2.5.0.cvs20020625-35) unstable; urgency=high + + * Don't build bfd/po subdir + * Build-depend on automake and gettext + + -- Camm Maguire Fri, 9 Aug 2002 14:36:58 -0400 + +gcl (2.5.0.cvs20020625-34) unstable; urgency=high + + * fix zero length array support + * reverse configure order for bfd and libiberty + + -- Camm Maguire Fri, 9 Aug 2002 11:52:38 -0400 + +gcl (2.5.0.cvs20020625-33) unstable; urgency=high + + * chmod +x for subconfigures + * dlopen for appropriate arches in debian/rules + * add custreloc configure option + + -- Camm Maguire Fri, 9 Aug 2002 10:16:55 -0400 + +gcl (2.5.0.cvs20020625-32) unstable; urgency=high + + * Local bfd build option to prepare for arch-specific patches + * Try default gmp3 build on m68k + * Fix merge-pathnames + + -- Camm Maguire Fri, 9 Aug 2002 00:13:16 -0400 + +gcl (2.5.0.cvs20020625-31) unstable; urgency=high + + * #undef bool in object.h for some gcc-3.1 installations + * New number_tan implementation using real tan, so optimized compiled + code will find symbol in -lm + + -- Camm Maguire Tue, 6 Aug 2002 18:37:52 -0400 + +gcl (2.5.0.cvs20020625-30) unstable; urgency=high + + * fix bug in cmpif.lsp and recompile compiler + * \-O6 \-fomit\-frame\-pointer for Linux, speed gain of ~ 10% + * clean saved_gcl_pcl + + -- Camm Maguire Mon, 5 Aug 2002 16:34:33 -0400 + +gcl (2.5.0.cvs20020625-29) unstable; urgency=high + + * Back out of hppa assembler register flush for hppa, apparently issue + is cleared by long/object function declaration fix + * Remove ansi2knr.1 man page, Closes: #155067 + * hppa still has gc leak, possibly due to faulty setjmp. Try Lamont + Jones' latest assembler to flush regs + + -- Camm Maguire Fri, 2 Aug 2002 20:50:21 -0400 + +gcl (2.5.0.cvs20020625-28) unstable; urgency=high + + * SGC support for alpha + * generic gmp3 build for m68k + * compiler changes to declare all functions as returning object, with + functions that actually return long being cast appropriately + * back out of m68k hack in eval.c and funlink.c + + -- Camm Maguire Fri, 2 Aug 2002 18:22:04 -0400 + +gcl (2.5.0.cvs20020625-27) unstable; urgency=high + + * Use generic lshift.c in gmp3 for m68k + * use SGC for ia64 + * m68k workaround, cast (object(*)()) to (long(*)()) in funlink.c and + eval.c + * GBC register spiil asm for hppa + * fix hash_equal declaration error in hash.d + + -- Camm Maguire Thu, 1 Aug 2002 18:12:49 -0400 + +gcl (2.5.0.cvs20020625-26) unstable; urgency=high + + * Remove extra load of tkl.o in install target of main makefile + * gcc-3.1 for hppa + * Remove gcc version spec for m68k + * \-fPIC for hppa, needed for dlopen + * cleanup gcc 3.1 warning in funlink.c + * cc instead of ld for -shared linking in fasldlsym.c (needed for + hppa) + + -- Camm Maguire Wed, 31 Jul 2002 18:46:54 -0400 + +gcl (2.5.0.cvs20020625-25) unstable; urgency=high + + * Move chmod +x gmp3/* into debian/rules + * Remove gclm.bat from Debian package + * Build-Depend on autoconf, Closes: #154909 + + -- Camm Maguire Wed, 31 Jul 2002 09:44:20 -0400 + +gcl (2.5.0.cvs20020625-24) unstable; urgency=high + + * chmod +x gmp3/configure + + -- Camm Maguire Wed, 31 Jul 2002 07:55:17 -0400 + +gcl (2.5.0.cvs20020625-23) unstable; urgency=high + + * 64bit SGC support + * SGC on by default for sparc-linux and mips(el)-linux + * Optimized logxor funtion + * Check for MP_LIMB_SIZE in fasdump.c, for 64bit support + * gbc fix for ia64 + * gmp3 import for ia64 + * system bzero, bcmp, and bcopy function prototypes + + -- Camm Maguire Tue, 30 Jul 2002 23:11:58 -0400 + +gcl (2.5.0.cvs20020625-22) unstable; urgency=high + + * ElfW macros in rsym*.c for 64bit + * Allow for 8 byte gmp mp_limbs + + -- Camm Maguire Thu, 25 Jul 2002 18:52:37 -0400 + +gcl (2.5.0.cvs20020625-21) unstable; urgency=high + + * Support for dlopen object loading where bfd is not yet working -- + ./configure --enable-dlopen + + -- Camm Maguire Thu, 25 Jul 2002 15:08:05 -0400 + +gcl (2.5.0.cvs20020625-20) unstable; urgency=high + + * Cleanups for --disable-bfd option + + -- Camm Maguire Wed, 24 Jul 2002 15:05:28 -0400 + +gcl (2.5.0.cvs20020625-19) unstable; urgency=high + + * 64bit fixes + + -- Camm Maguire Wed, 24 Jul 2002 12:16:42 -0400 + +gcl (2.5.0.cvs20020625-18) unstable; urgency=high + + * misc. lintian cleanups, mostly for 64 bit + + -- Camm Maguire Tue, 23 Jul 2002 23:35:03 -0400 + +gcl (2.5.0.cvs20020625-17) unstable; urgency=high + + * Fixed typeo in error.c preventing arm compilation + + -- Camm Maguire Mon, 22 Jul 2002 17:18:18 -0400 + +gcl (2.5.0.cvs20020625-16) unstable; urgency=high + + * Fix bad on_stack_list_vector args + + -- Camm Maguire Mon, 22 Jul 2002 16:10:16 -0400 + +gcl (2.5.0.cvs20020625-15) unstable; urgency=high + + * More lint changes for sundry arches + * Fixed bug in Iapply_ap + + -- Camm Maguire Sat, 20 Jul 2002 23:40:33 -0400 + +gcl (2.5.0.cvs20020625-14) unstable; urgency=high + + * include stdarg.h when defining _GNU_SOURCE + + -- Camm Maguire Sat, 20 Jul 2002 18:47:43 -0400 + +gcl (2.5.0.cvs20020625-13) unstable; urgency=high + + * Proper va_dcl declarations + + -- Camm Maguire Sat, 20 Jul 2002 10:40:02 -0400 + +gcl (2.5.0.cvs20020625-12) unstable; urgency=high + + * cvs updates for missing ptrdiff_t + + -- Camm Maguire Sat, 20 Jul 2002 08:41:37 -0400 + +gcl (2.5.0.cvs20020625-11) unstable; urgency=high + + * cvs changes to compile cleanly with -Wall + + -- Camm Maguire Sat, 20 Jul 2002 02:59:33 -0400 + +gcl (2.5.0.cvs20020625-10) unstable; urgency=high + + * Architecture any, though still have some issues + + -- Camm Maguire Fri, 12 Jul 2002 19:02:09 -0400 + +gcl (2.5.0.cvs20020625-9) unstable; urgency=high + + * cvs commits for 64bit support + + -- Camm Maguire Fri, 12 Jul 2002 18:01:21 -0400 + +gcl (2.5.0.cvs20020625-8) unstable; urgency=high + + * NULL_OR_ON_C_STACK macro correction for m68k + + -- Camm Maguire Fri, 12 Jul 2002 14:37:48 -0400 + +gcl (2.5.0.cvs20020625-7) unstable; urgency=high + + * arm is bigendian + + -- Camm Maguire Wed, 10 Jul 2002 18:04:22 -0400 + +gcl (2.5.0.cvs20020625-6) unstable; urgency=high + + * cvs updates for arm build + + -- Camm Maguire Tue, 9 Jul 2002 16:09:26 -0400 + +gcl (2.5.0.cvs20020625-5) unstable; urgency=high + + * CC environment variable setting in debian/rules to aid in porting + * gcc 2.95 for m68k + + -- Camm Maguire Sat, 6 Jul 2002 23:00:23 -0400 + +gcl (2.5.0.cvs20020625-4) unstable; urgency=high + + * gcc 3.0 for arm + * cachectl header for m68k + + -- Camm Maguire Mon, 1 Jul 2002 15:47:53 -0400 + +gcl (2.5.0.cvs20020625-3) unstable; urgency=high + + * Better libbfd detection for arm/alpha + + -- Camm Maguire Wed, 26 Jun 2002 17:27:21 -0400 + +gcl (2.5.0.cvs20020625-2) unstable; urgency=high + + * s390 support + + -- Camm Maguire Tue, 25 Jun 2002 21:25:35 -0400 + +gcl (2.5.0.cvs20020625-1) unstable; urgency=high + + * CVS updates, new s390 arch + + -- Camm Maguire Tue, 25 Jun 2002 19:26:36 -0400 + +gcl (2.5.0.cvs20020610-2) unstable; urgency=high + + * cvs updates + + -- Camm Maguire Thu, 13 Jun 2002 08:42:32 -0400 + +gcl (2.5.0.cvs20020610-1) unstable; urgency=high + + * cvs updates + + -- Camm Maguire Wed, 12 Jun 2002 23:04:57 -0400 + +gcl (2.5.0.cvs20020523-2) unstable; urgency=high + + * configure updates for better tk detection + + -- Camm Maguire Fri, 24 May 2002 18:50:22 -0400 + +gcl (2.5.0.cvs20020523-1) unstable; urgency=high + + * New upstream release + + -- Camm Maguire Fri, 24 May 2002 18:50:22 -0400 + +gcl (2.5.0.cvs20020429-1) unstable; urgency=high + + * Build-Depend on tk8.2-dev, Closes: #144330 + * New cvs updates + * Added sparc to arch list, Closes: #143465 + + -- Camm Maguire Mon, 29 Apr 2002 23:07:36 -0400 + +gcl (2.5.0.cvs20020219-2) unstable; urgency=medium + + * flavor ->debian-emacs-flavor in emacsen-startup + + -- Camm Maguire Mon, 4 Mar 2002 14:29:59 -0500 + +gcl (2.5.0.cvs20020219-1) unstable; urgency=medium + + * Updated package descriptions, Closes: #134402 + * Static linking of libbfd, Closes: #134647 + * Gcl currently only available on i386, arm and m68k as specified in + the Architecture control field, Closes: #133912 + + -- Camm Maguire Tue, 19 Feb 2002 12:04:29 -0500 + +gcl (2.5.0.cvs-3) unstable; urgency=medium + + * Build-depend on texi2html, Closes: #133699 + + -- Camm Maguire Wed, 13 Feb 2002 16:22:35 -0500 + +gcl (2.5.0.cvs-2) unstable; urgency=medium + + * Put in versioned dependency on binutils for libbfd support, rebuilt + with latest binutils, Closes: #133004 + + -- Camm Maguire Tue, 12 Feb 2002 13:19:12 -0500 + +gcl (2.5.0.cvs-1) unstable; urgency=medium + + * Latest patches from CVS, enabling libbfd relocations, among other + things + * /etc/emacs/site-start.d/50gcl.el as conffile, Closes: #132137 + * limited arm and m68k support + + -- Camm Maguire Mon, 4 Feb 2002 09:32:29 -0500 + +gcl (2.5.0-1) unstable; urgency=medium + + * New maintainer + * New upstream release + * New release so far builds only on i386, Closes: #116070, Closes: + #123371 + * New release so far builds only on i386, Closes: #115041 + * Gcl must currently use its own copy of gmp, as the upstream version + of gmp uses malloc, which interferes with gcl's garbage collection + and relocation scheme. The change from malloc to alloca has been + suggested to upstream gmp developers. Closes: #108910 + * Tcl/Tk support now in. Closes: #113197 + + -- Camm Maguire Fri, 21 Dec 2001 00:03:43 -0500 + +gcl (2.4.0-3) unstable; urgency=medium + + * Make gcl use libgmp3 package. (closes: #108910) + * Remove tk support. (closes: #108909) + * Fix stupid missing dependency line. (closes: #108907, #108908) + * Removed readme.mingw from the debian package, this package is not compiled under + mingw (windows gcc port). + * Close ITA bug. (closes: #112312) + + -- Baruch Even Sat, 22 Sep 2001 00:27:14 +0300 + +gcl (2.4.0-2) unstable; urgency=low + + * Change tclsh Build-Depends to tcl8.0 because apt is broken. (closes: #99261) + + -- JP Sugarbroad Wed, 30 May 2001 14:34:53 -0500 + +gcl (2.4.0-1) unstable; urgency=low + + * New upstream release + + -- JP Sugarbroad Sun, 13 May 2001 20:31:01 -0500 + +gcl (2.3.7+beta3-3) unstable; urgency=low + + * Move gcl-doc to section doc (closes: #78666) + + -- JP Sugarbroad Sun, 13 May 2001 20:26:28 -0500 + +gcl (2.3.7+beta3-2) unstable; urgency=low + + * Remove alpha from arch list + * Move tcl/tk from Depends to Suggests + + -- JP Sugarbroad Fri, 4 May 2001 16:24:11 -0500 + +gcl (2.3.7+beta3-1) unstable; urgency=low + + * New maintainer + * Repackaged with debhelper (closes: #42045, #86097, #91475, #91478) + * New upstream release (closes: #59577, #71096) + * Added sparc+alpha, removed m68k (closes: #87407) + + -- JP Sugarbroad Mon, 30 Apr 2001 19:07:49 -0500 + +gcl (2.2.1-6) unstable; urgency=low + + * Disable stripping of "saved_gcl" binary. (#45778) + + -- Steve Dunham Fri, 24 Sep 1999 14:39:15 -0400 + +gcl (2.2.1-5) unstable; urgency=low + + * Fix m68k build + + -- Steve Dunham Tue, 6 Jul 1999 09:45:09 -0400 + +gcl (2.2.1-4) unstable; urgency=low + + * Fix bug #31718 + + -- Steve Dunham Fri, 2 Jul 1999 11:11:12 -0400 + +gcl (2.2.1-3) unstable; urgency=low + + * Add m68k patches + + -- Steve Dunham Wed, 16 Dec 1998 14:25:46 -0500 + +gcl (2.2.1-2) unstable; urgency=low + + * Compile against libc6. New maintainer. + + -- Steve Dunham Wed, 5 Nov 1997 10:09:12 -0500 + +gcl (2.2.1-1) unstable; urgency=low + + * New upstream release; suggests tcl76, tk42. + * gcl-doc contains gcl-si and gcl-tk info pages. + * debian/rules: clean target removes temporary files from h and o + subdirectories (bug #5984). + + -- Karl Sackett Fri, 3 Jan 1997 10:16:40 -0600 + +gcl (2.2-5) unstable; urgency=low + + * Converted package to 2.1.1.0 standard. + * Stripped gcltkaux (bug #5074). + * gcl-si and gcl-tk info pages converted to HTML. + + -- Karl Sackett Tue, 5 Nov 1996 13:30:30 -0600 + +2.2-4 + * add-defs: patched locates for tk.tcl, init.tcl + * gcl-tk/tkAppInit.c: patched for tk4.1 support + * gcl-tk/tkMain.c: patched for tk4.1 support +2.2-3 + * Debian support files now partily architecture independent. + There are, however, no add-defs files except for 386-linux. + * Rebuilt package to correct corrupted upload problem. +2.2-2 + * Removed tk support from distribution. This was written to + use tk-3.6 and doesn't support tk-4.0 or tk-4.1. I am not aware + of any plans to upgrade the code. (Closes bug #2865) +2.2-1 + * Added Debian support files + * h/386-linux.defs: set OFLAG = -O2 + * h/386-linux.h: undid patch that swaped signal.h for sigcontext.h diff --git a/compat b/compat new file mode 100644 index 00000000..ec635144 --- /dev/null +++ b/compat @@ -0,0 +1 @@ +9 diff --git a/control b/control new file mode 100644 index 00000000..e1e6d464 --- /dev/null +++ b/control @@ -0,0 +1,39 @@ +Source: gcl +Section: lisp +Priority: optional +Maintainer: Camm Maguire +Homepage: http://gnu.org/software/gcl +Build-Depends: debhelper (>= 5), libreadline-dev, m4, tk8.6-dev, libgmp-dev, autotools-dev, libxmu-dev, libxaw7-dev, po-debconf, zlib1g-dev, tcl +Standards-Version: 4.4.1 + +Package: gcl +Architecture: any +Depends: ${shlibs:Depends}, ${misc:Depends}, ${gcc}, debconf (>= 1.2.0), emacs24 | emacsen, ucf +Breaks: emacsen-common (<< 2.0.0) +Suggests: gcl-doc +Description: GNU Common Lisp compiler + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains the Lisp system itself. Documentation + is provided in the gcl-doc package. + +Package: gcl-doc +Section: doc +Architecture: all +Conflicts: gclinfo +Replaces: gclinfo +Depends: dpkg (>= 1.15.4) | install-info, ${misc:Depends} +Description: Documentation for GNU Common Lisp + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains Documentation in info format of both the + system internals, as well as the graphical interface currently + implemented in Tcl/Tk. diff --git a/control. b/control. new file mode 100644 index 00000000..e1e6d464 --- /dev/null +++ b/control. @@ -0,0 +1,39 @@ +Source: gcl +Section: lisp +Priority: optional +Maintainer: Camm Maguire +Homepage: http://gnu.org/software/gcl +Build-Depends: debhelper (>= 5), libreadline-dev, m4, tk8.6-dev, libgmp-dev, autotools-dev, libxmu-dev, libxaw7-dev, po-debconf, zlib1g-dev, tcl +Standards-Version: 4.4.1 + +Package: gcl +Architecture: any +Depends: ${shlibs:Depends}, ${misc:Depends}, ${gcc}, debconf (>= 1.2.0), emacs24 | emacsen, ucf +Breaks: emacsen-common (<< 2.0.0) +Suggests: gcl-doc +Description: GNU Common Lisp compiler + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains the Lisp system itself. Documentation + is provided in the gcl-doc package. + +Package: gcl-doc +Section: doc +Architecture: all +Conflicts: gclinfo +Replaces: gclinfo +Depends: dpkg (>= 1.15.4) | install-info, ${misc:Depends} +Description: Documentation for GNU Common Lisp + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains Documentation in info format of both the + system internals, as well as the graphical interface currently + implemented in Tcl/Tk. diff --git a/control.cvs b/control.cvs new file mode 100644 index 00000000..36d5b5cb --- /dev/null +++ b/control.cvs @@ -0,0 +1,39 @@ +Source: gclcvs +Section: lisp +Priority: optional +Maintainer: Camm Maguire +Homepage: http://gnu.org/software/gcl +Build-Depends: debhelper (>= 5), libreadline-dev, m4, tk8.6-dev, libgmp-dev, autotools-dev, libxmu-dev, libxaw7-dev, po-debconf, zlib1g-dev, tcl +Standards-Version: 4.4.1 + +Package: gclcvs +Architecture: any +Depends: ${shlibs:Depends}, ${misc:Depends}, ${gcc}, debconf (>= 1.2.0), emacs24 | emacsen, ucf +Breaks: emacsen-common (<< 2.0.0) +Suggests: gclcvs-doc +Description: GNU Common Lisp compiler, CVS snapshot + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains the Lisp system itself. Documentation + is provided in the gclcvs-doc package. + +Package: gclcvs-doc +Section: doc +Architecture: all +Conflicts: gclinfo +Replaces: gclinfo +Depends: dpkg (>= 1.15.4) | install-info, ${misc:Depends} +Description: Documentation for GNU Common Lisp, CVS snapshot + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains Documentation in info format of both the + system internals, as well as the graphical interface currently + implemented in Tcl/Tk. diff --git a/copyright b/copyright new file mode 100644 index 00000000..c58a9836 --- /dev/null +++ b/copyright @@ -0,0 +1,65 @@ +This package was debianized by JP Sugarbroad on +Mon, 30 Apr 2001 19:07:49 -0500. + +It was downloaded from http://savannah.gnu.org/projects/gcl + +Upstream Author: Bill Schelter + +Copyright: + + This package is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This package is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this package; if not, write to the Free + Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA + 02110-1301, USA. + +On Debian GNU/Linux systems, the complete text of the GNU Lesser General +Public License can be found in `/usr/share/common-licenses/LGPL-2'. + +The source under xgcl-2 is + +Copyright (c) 1995 Gordon S. Novak Jr., Hiep Huu Nguyen, William F. Schelter, +and The University of Texas at Austin. + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 1, or (at your option) +any later version. + +and + +;;********************************************************** +;;Copyright 1987 by Digital Equipment Corporation, Maynard, Massachusetts, +;;and the Massachusetts Institute of Technology, Cambridge, Massachusetts. + +;; All Rights Reserved + +;;Permission to use, copy, modify, and distribute this software and its +;;documentation for any purpose and without fee is hereby granted, +;;provided that the above copyright notice appear in all copies and that +;;both that copyright notice and this permission notice appear in +;;supporting documentation, and that the names of Digital or MIT not be +;;used in advertising or publicity pertaining to distribution of the +;;software without specific, written prior permission. + +;;DIGITAL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING +;;ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL +;;DIGITAL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR +;;ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, +;;WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, +;;ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS +;;SOFTWARE. + +;;***************************************************************** + +On Debian GNU/Linux systems, the complete text of the GNU General +Public License can be found in `/usr/share/common-licenses/GPL-1'. diff --git a/gcl.lintian-overrides b/gcl.lintian-overrides new file mode 100644 index 00000000..35cdb234 --- /dev/null +++ b/gcl.lintian-overrides @@ -0,0 +1,9 @@ +gcl: binary-compiled-with-profiling-enabled usr/lib/gcl-2.6.12-prof/unixport/saved_ansi_gcl +gcl: binary-compiled-with-profiling-enabled usr/lib/gcl-2.6.12-prof/unixport/saved_gcl +gcl: binary-compiled-with-profiling-enabled usr/lib/gcl-2.6.12/unixport/saved_ansi_gcl +gcl: binary-compiled-with-profiling-enabled usr/lib/gcl-2.6.12/unixport/saved_gcl +gcl: hardening-no-pie usr/lib/gcl-2.6.12-prof/unixport/saved_ansi_gcl +gcl: hardening-no-pie usr/lib/gcl-2.6.12-prof/unixport/saved_gcl +gcl: hardening-no-pie usr/lib/gcl-2.6.12/unixport/saved_ansi_gcl +gcl: hardening-no-pie usr/lib/gcl-2.6.12/unixport/saved_gcl +gcl: emacsen-common-without-dh-elpa diff --git a/gcl.sh b/gcl.sh new file mode 100755 index 00000000..9ea80184 --- /dev/null +++ b/gcl.sh @@ -0,0 +1,28 @@ +#!/bin/sh + +EXT=@EXT@ +VERS=@VERS@ + +. /etc/default/gcl$EXT +if ! set | grep -q -w GCL_ANSI ; then GCL_ANSI=$DEFAULT_GCL_ANSI ; fi +if ! set | grep -q -w GCL_PROF ; then GCL_PROF=$DEFAULT_GCL_PROF ; fi + +if [ "$GCL_PROF" = "" ] ; then + DIR=/usr/lib/gcl-$VERS ; +else + DIR=/usr/lib/gcl-$VERS-prof ; +fi + +if [ "$GCL_ANSI" = "" ] ; then + EXE=saved_gcl; +else + EXE=saved_ansi_gcl; +fi +SYS=$DIR/unixport + +exec $SYS/$EXE -dir $SYS/ -libdir $DIR/ \ + -eval '(setq si::*allow-gzipped-file* t)' \ + -eval '(setq si::*tk-library* "/usr/lib/tk@TKVERS@")' \ + "$@" + +# other options: -load /tmp/foo.o -load jo.lsp -eval "(joe 3)" diff --git a/gcl.templates b/gcl.templates new file mode 100644 index 00000000..3bc069d7 --- /dev/null +++ b/gcl.templates @@ -0,0 +1,38 @@ +# These templates have been reviewed by the debian-l10n-english +# team +# +# If modifications/additions/rewording are needed, please ask +# debian-l10n-english@lists.debian.org for advice. +# +# Even minor modifications require translation updates and such +# changes should be coordinated with translators and reviewers. + +Template: gcl@EXT@/default_gcl_ansi +Type: boolean +_Description: Use the work-in-progress ANSI build by default? + GCL is in the process of providing an ANSI compliant image in addition to + its traditional CLtL1 image still in production use. + . + Please see the README.Debian file for a brief description of these terms. + Choosing this option will determine which image will be used by default + when executing 'gcl@EXT@'. + . + This setting may be overridden by setting the GCL_ANSI + environment variable to any non-empty string for the ANSI build, and to + the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The + currently enforced build flavor will be reported in the initial startup + banner. + +Template: gcl@EXT@/default_gcl_prof +Type: boolean +_Description: Use the profiling build by default? + GCL has optional support for profiling via gprof. + . + Please see the documentation for si::gprof-start and si::gprof-quit + for details. As this build is slower than builds without gprof + support, it is not recommended for final production use. + . + Set the GCL_PROF environment variable to the empty string for more + optimized builds, or any non-empty string for profiling support; e.g. + GCL_PROF=t gcl@EXT@. If profiling is enabled, this will be reported + in the initial startup banner. diff --git a/in.gcl-doc.README.Debian b/in.gcl-doc.README.Debian new file mode 100644 index 00000000..b8d01a66 --- /dev/null +++ b/in.gcl-doc.README.Debian @@ -0,0 +1,9 @@ +New in 2.6.2 +------------ + +The gcl.texi files and the resulting html, info, and pdf outputs have +been removed pending an enquiry into the copyright and license status +of the dpANS documents upon which they are presumably based. + + + -- Camm Maguire , Fri, 9 May 2014 19:08:59 +0000 diff --git a/in.gcl-doc.doc-base.si b/in.gcl-doc.doc-base.si new file mode 100644 index 00000000..faa0bc6a --- /dev/null +++ b/in.gcl-doc.doc-base.si @@ -0,0 +1,12 @@ +Document: gcl@EXT@-si-doc +Title: GNU Common Lisp Documentation -- System Internals +Author: W. Schelter +Abstract: Documentation on GCL-specific Lisp system functions +Section: Programming + +Format: PDF +Files: /usr/share/doc/gcl@EXT@-doc/gcl-si*.pdf.gz /usr/share/doc/gcl@EXT@-doc/gcl-si*.pdf.gz + +Format: HTML +Index: /usr/share/doc/gcl@EXT@-doc/gcl-si/index.html +Files: /usr/share/doc/gcl@EXT@-doc/gcl-si/*.html diff --git a/in.gcl-doc.doc-base.tk b/in.gcl-doc.doc-base.tk new file mode 100644 index 00000000..23d74ee7 --- /dev/null +++ b/in.gcl-doc.doc-base.tk @@ -0,0 +1,12 @@ +Document: gcl@EXT@-tk-doc +Title: GNU Common Lisp Tk Interface Documentation +Author: W. Schelter +Abstract: Documentation for Graphical Interface to GCL using TCL/Tk +Section: Programming + +Format: PDF +Files: /usr/share/doc/gcl@EXT@-doc/gcl-tk*.pdf.gz /usr/share/doc/gcl@EXT@-doc/gcl-tk*.pdf.gz + +Format: HTML +Index: /usr/share/doc/gcl@EXT@-doc/gcl-tk/index.html +Files: /usr/share/doc/gcl@EXT@-doc/gcl-tk/*.html diff --git a/in.gcl-doc.doc-base.xgcl b/in.gcl-doc.doc-base.xgcl new file mode 100644 index 00000000..a78b27be --- /dev/null +++ b/in.gcl-doc.doc-base.xgcl @@ -0,0 +1,15 @@ +Document: gcl@EXT@-xgcl-doc +Title: GNU Common Lisp Documentation -- System Internals +Author: W. Schelter +Abstract: Documentation on GCL-specific Lisp system functions +Section: Programming + +Format: Text +Files: /usr/share/doc/gcl@EXT@-doc/dwdoc.tex.gz + +Format: PDF +Files: /usr/share/doc/gcl@EXT@-doc/dwdoc.pdf.gz + +Format: HTML +Index: /usr/share/doc/gcl@EXT@-doc/dwdoc/dwdoc1.html +Files: /usr/share/doc/gcl@EXT@-doc/dwdoc/*.html diff --git a/in.gcl-doc.docs b/in.gcl-doc.docs new file mode 100644 index 00000000..2757ff23 --- /dev/null +++ b/in.gcl-doc.docs @@ -0,0 +1,3 @@ +faq +readme +readme.xgcl diff --git a/in.gcl-doc.info b/in.gcl-doc.info new file mode 100644 index 00000000..cedf3f17 --- /dev/null +++ b/in.gcl-doc.info @@ -0,0 +1,4 @@ +debian/tmp/usr/share/info/gcl@EXT@-si.info +debian/tmp/usr/share/info/gcl@EXT@-tk.info +debian/tmp/usr/share/info/gcl@EXT@-tk.info-1 +debian/tmp/usr/share/info/gcl@EXT@-tk.info-2 diff --git a/in.gcl-doc.install b/in.gcl-doc.install new file mode 100644 index 00000000..8e31d17d --- /dev/null +++ b/in.gcl-doc.install @@ -0,0 +1 @@ +debian/tmp/usr/share/doc/gcl@EXT@-doc diff --git a/in.gcl.config b/in.gcl.config new file mode 100644 index 00000000..0d960b11 --- /dev/null +++ b/in.gcl.config @@ -0,0 +1,19 @@ +#!/bin/sh +CONFIGFILE=/etc/default/gcl@EXT@ +set -e +. /usr/share/debconf/confmodule + +# Load config file, if it exists. +if [ -e $CONFIGFILE ]; then + . $CONFIGFILE || true + + # Store values from config file into + # debconf db. + db_set gcl@EXT@/default_gcl_ansi $DEFAULT_GCL_ANSI + db_set gcl@EXT@/default_gcl_prof $DEFAULT_GCL_PROF +fi + +# Ask questions. +db_input medium gcl@EXT@/default_gcl_ansi || true +db_input medium gcl@EXT@/default_gcl_prof || true +db_go || true diff --git a/in.gcl.docs b/in.gcl.docs new file mode 100644 index 00000000..b50c9454 --- /dev/null +++ b/in.gcl.docs @@ -0,0 +1,2 @@ +ansi-tests/test_results +RELEASE-2.6.2.html diff --git a/in.gcl.emacsen-compat b/in.gcl.emacsen-compat new file mode 100644 index 00000000..573541ac --- /dev/null +++ b/in.gcl.emacsen-compat @@ -0,0 +1 @@ +0 diff --git a/in.gcl.emacsen-install b/in.gcl.emacsen-install new file mode 100644 index 00000000..ed972091 --- /dev/null +++ b/in.gcl.emacsen-install @@ -0,0 +1,46 @@ +#! /bin/sh -e +# /usr/lib/emacsen-common/packages/install/#PACKAGE# + +# Written by Jim Van Zandt , borrowing heavily +# from the install scripts for gettext by Santiago Vila +# and octave by Dirk Eddelbuettel . + +FLAVOR=$1 +PACKAGE=gcl@EXT@ + +if [ ${FLAVOR} = emacs ]; then exit 0; fi + +echo install/${PACKAGE}: Handling install for emacsen flavor ${FLAVOR} + +#FLAVORTEST=`echo $FLAVOR | cut -c-6` +#if [ ${FLAVORTEST} = xemacs ] ; then +# SITEFLAG="-no-site-file" +#else +# SITEFLAG="--no-site-file" +#fi +FLAGS="${SITEFLAG} -q -batch -l path.el -f batch-byte-compile" + +ELDIR=/usr/share/emacs/site-lisp/${PACKAGE} +ELCDIR=/usr/share/${FLAVOR}/site-lisp/${PACKAGE} + +# Install-info-altdir does not actually exist. +# Maybe somebody will write it. +if test -x /usr/sbin/install-info-altdir; then + echo install/${PACKAGE}: install Info links for ${FLAVOR} + install-info-altdir --quiet --section "" "" --dirname=${FLAVOR} /usr/info/${PACKAGE}.info.gz +fi + +install -m 755 -d ${ELCDIR} +cd ${ELDIR} +FILES=`echo *.el` +cp ${FILES} ${ELCDIR} +cd ${ELCDIR} + +cat << EOF > path.el +(setq load-path (cons "." load-path) byte-compile-warnings nil) +EOF +${FLAVOR} ${FLAGS} ${FILES} +rm -f *.el path.el + +exit 0 + diff --git a/in.gcl.emacsen-remove b/in.gcl.emacsen-remove new file mode 100644 index 00000000..699eca18 --- /dev/null +++ b/in.gcl.emacsen-remove @@ -0,0 +1,15 @@ +#!/bin/sh -e +# /usr/lib/emacsen-common/packages/remove/#PACKAGE# + +FLAVOR=$1 +PACKAGE=gcl@EXT@ + +if [ ${FLAVOR} != emacs ]; then + if test -x /usr/sbin/install-info-altdir; then + echo remove/${PACKAGE}: removing Info links for ${FLAVOR} + install-info-altdir --quiet --remove --dirname=${FLAVOR} /usr/info/#PACKAGE#.info.gz + fi + + echo remove/${PACKAGE}: purging byte-compiled files for ${FLAVOR} + rm -rf /usr/share/${FLAVOR}/site-lisp/${PACKAGE} +fi diff --git a/in.gcl.emacsen-startup b/in.gcl.emacsen-startup new file mode 100644 index 00000000..e64d9a80 --- /dev/null +++ b/in.gcl.emacsen-startup @@ -0,0 +1,19 @@ +;; -*-emacs-lisp-*- +;; +;; Emacs startup file for the Debian GNU/Linux #PACKAGE# package +;; +;; Originally contributed by Nils Naumann +;; Modified by Dirk Eddelbuettel +;; Adapted for dh-make by Jim Van Zandt + +;; The #PACKAGE# package follows the Debian/GNU Linux 'emacsen' policy and +;; byte-compiles its elisp files for each 'emacs flavor' (emacs19, +;; xemacs19, emacs20, xemacs20...). The compiled code is then +;; installed in a subdirectory of the respective site-lisp directory. +;; We have to add this to the load-path: +(setq load-path (cons (concat "/usr/share/" + (symbol-name debian-emacs-flavor) + "/site-lisp/gcl@EXT@") load-path)) + +(autoload 'run@EXT@ "gcl@EXT@" "" t) +(autoload 'dbl@EXT@ "dbl@EXT@" "" t) diff --git a/in.gcl.install b/in.gcl.install new file mode 100644 index 00000000..731600b6 --- /dev/null +++ b/in.gcl.install @@ -0,0 +1,3 @@ +debian/tmp/usr/lib +debian/tmp/usr/bin +debian/tmp/usr/share/emacs diff --git a/in.gcl.manpages b/in.gcl.manpages new file mode 100644 index 00000000..0b22534b --- /dev/null +++ b/in.gcl.manpages @@ -0,0 +1 @@ +debian/tmp/usr/share/man/man1/gcl@EXT@.1 diff --git a/in.gcl.postinst b/in.gcl.postinst new file mode 100644 index 00000000..c7875887 --- /dev/null +++ b/in.gcl.postinst @@ -0,0 +1,40 @@ +#!/bin/sh +case "$1" in + configure) + + CONFIGFILE=$(tempfile -m 644) + set -e + . /usr/share/debconf/confmodule + + if [ "$1" = "configure" ] || [ "$1" = "reconfigure" ] ; then + + db_get gcl@EXT@/default_gcl_ansi + + if [ "$RET" = "true" ] ; then + DEFAULT_GCL_ANSI=t + else + DEFAULT_GCL_ANSI= + fi + + db_get gcl@EXT@/default_gcl_prof + + if [ "$RET" = "true" ] ; then + DEFAULT_GCL_PROF=y + else + DEFAULT_GCL_PROF= + fi + + echo "DEFAULT_GCL_ANSI=$DEFAULT_GCL_ANSI" >> $CONFIGFILE + echo "DEFAULT_GCL_PROF=$DEFAULT_GCL_PROF" >> $CONFIGFILE + + fi + + ucf --debconf-ok $CONFIGFILE /etc/default/gcl@EXT@ + ucfr gcl@EXT@ /etc/default/gcl@EXT@ + +# chmod 644 /etc/default/gcl@EXT@ + +esac + +#DEBHELPER# + diff --git a/in.gcl.postrm b/in.gcl.postrm new file mode 100644 index 00000000..5360f7dc --- /dev/null +++ b/in.gcl.postrm @@ -0,0 +1,22 @@ +#!/bin/sh + +set -e + +case "$1" in + purge) + for ext in '~' '%' .bak .ucf-new .ucf-old .ucf-dist; do + rm -f /etc/default/gcl@EXT@$ext + done + + rm -f /etc/default/gcl@EXT@ + + if which ucf >/dev/null; then + ucf --purge /etc/default/gcl@EXT@ + fi + if which ucfr >/dev/null; then + ucfr --purge gcl@EXT@ /etc/default/gcl@EXT@ + fi + ;; +esac + +#DEBHELPER# diff --git a/old.in.gcl-doc.doc-base.main b/old.in.gcl-doc.doc-base.main new file mode 100644 index 00000000..2d6f3d12 --- /dev/null +++ b/old.in.gcl-doc.doc-base.main @@ -0,0 +1,12 @@ +Document: gcl@EXT@-doc +Title: GNU Common Lisp Documentation +Author: W. Schelter +Abstract: A Common Lisp compiler and interpreter based on C +Section: Apps/Programming + +Format: DVI +Files: /usr/share/doc/gcl@EXT@-doc/gcl.dvi.gz /usr/share/doc/gcl@EXT@-doc/gcl.dvi + +Format: HTML +Index: /usr/share/doc/gcl@EXT@-doc/gcl/index.html +Files: /usr/share/doc/gcl@EXT@-doc/gcl/*.html diff --git a/patches/Version_2_6_13pre1 b/patches/Version_2_6_13pre1 new file mode 100644 index 00000000..2599262b --- /dev/null +++ b/patches/Version_2_6_13pre1 @@ -0,0 +1,13167 @@ +Description: + 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 + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- 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<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 + /* 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=page(core_end)) +- error("out of core in set_writable"); ++ last_page=last_result=0; ++ ++ if (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=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 +@@ -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=start) || (new_start=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_holepagetm_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;ik+phys_pages-j ? k+phys_pages-j : d; ++ if (d<=0) ++ return 0; ++ ++ for (i=t_start;i((double)phys_pages/(j+d))*(tm_table+i==my_tm ? z : tm_table[i].tm_maxpage)) */ ++ /* return 0; */ ++ /* for (i=t_start;i0 && 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>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(cbpppcb_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)cb_size; ++ delete_contblock(pp,cbpp); ++ if (ncb_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+nn) + 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)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 scb_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< 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=v && *ps.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 (ps.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 (;pst.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.std.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 (;oc.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;iht.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;istr.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;irt.rt_self[i].rte_macro,i); ++ for (i=0;irt.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;iin_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;iin_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_pointertm_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);ipromotion_pointer1) { */ ++/* object *p,st; */ ++/* promoting=1; */ ++/* st=alloc_simple_string(""); */ ++/* for (p=promotion_pointer1;pst.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= 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;ktm_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;ktm_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)))>(PAGEWIDTH-10); ++ massert((l=open("/proc/meminfo",O_RDONLY))!=-1); ++ massert((n=read(l,b,sizeof(b)))>(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<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;is.s_dbind!=Cnil) { + +- new_holepage=available_pages/starting_hole_div; +- k=available_pages/20; +- j*=starting_relb_heap_mult; +- j=j>1); ++ } ++ ++ new_holepage=0; ++ for (i=t_start;i= 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)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 + +-/* 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 *)*cbppcb_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);itm_alt_npage=page(rb_start)-page(old_rb_start); +- for (i=page(rb_start);is.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) && ist.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* "") (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" diff --git a/patches/Version_2_6_13pre12 b/patches/Version_2_6_13pre12 new file mode 100644 index 00000000..8d55df80 --- /dev/null +++ b/patches/Version_2_6_13pre12 @@ -0,0 +1,1168 @@ +Description: + 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-10) unstable; urgency=medium + . + * rebuild in clean sid environment +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/bin/dpp.c ++++ gcl-2.6.12/bin/dpp.c +@@ -430,7 +430,8 @@ put_declaration() + { + int i; + +- fprintf(out, "\tint narg;\n"); ++ if (nopt || rest_flag || key_flag) ++ fprintf(out, "\tint narg;\n"); + fprintf(out, "\tregister object *DPPbase=vs_base;\n"); + + for (i = 0; i < nopt; i++) +@@ -453,12 +454,12 @@ put_declaration() + fprintf(out, "#define\t%s\tDPPbase[%d+%d+2*%d+%d]\n", + aux[i].a_var, nreq, nopt, nkey, i); + fprintf(out, "\n"); +- fprintf(out, "\tnarg = vs_top - vs_base;\n"); + if (nopt == 0 && !rest_flag && !key_flag) + fprintf(out, "\tcheck_arg(%d);\n", nreq); + else { +- fprintf(out, "\tif (narg < %d)\n", nreq); +- fprintf(out, "\t\ttoo_few_arguments();\n"); ++ fprintf(out, "\tnarg = vs_top - vs_base;\n"); ++ fprintf(out, "\tif (narg < %d)\n", nreq); ++ fprintf(out, "\t\ttoo_few_arguments();\n"); + } + for (i = 0; i < nopt; i++) + if (optional[i].o_svar != NULL) { +--- gcl-2.6.12.orig/cmpnew/gcl_cmpfun.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpfun.lsp +@@ -976,9 +976,13 @@ + (wt-nl "}}") + (wt-nl "vs_top=(vs_base=base+" base ")+" (- *vs* base) ";") + (unwind-exit 'fun-val nil (cons 'values 2)))) +- ((unwind-exit (get-inline-loc `((t t) t #.(flags rfa) +- ,(concatenate 'string +- "({struct htent *_z=gethash" +- (if *safe-compile* "_with_check" "") +- "(#0,#1);_z->hte_key==OBJNULL ? (#2) : _z->hte_value;})")) +- args))))) ++ ((let ((*inline-blocks* 0) ++ (*restore-avma* *restore-avma*) ++ (fd `((t t) t #.(flags rfa) ++ ,(concatenate 'string ++ "({struct htent *_z=gethash" ++ (if *safe-compile* "_with_check" "") ++ "(#0,#1);_z->hte_key==OBJNULL ? (#2) : _z->hte_value;})")))) ++ (save-avma fd) ++ (unwind-exit (get-inline-loc fd args)) ++ (close-inline-blocks))))) +--- gcl-2.6.12.orig/cmpnew/gcl_cmptag.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmptag.lsp +@@ -62,6 +62,7 @@ + ((and (eq (car clause) 'go) + (tag-p (setq tem (cadddr (cdr clause)))) + (eq (tag-name tem) tag-name))) ++ ((eq (car clause) 'location) nil) + (t (or (jumps-to-p (car clause) tag-name) + (jumps-to-p (cdr clause) tag-name))))) + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4171,18 +4171,52 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu + #fi + # subst GCC not only under 386-linux, but where available -- CM + ++TCFLAGS="-fsigned-char" ++ + if test "$GCC" = "yes" ; then + +- TCFLAGS="-Wall -fsigned-char" ++ TCFLAGS="$TCFLAGS -Wall" + +- #FIXME -Wno-unused-but-set-variable when time +- TMPF=-Wno-unused-but-set-variable +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFLAG $TMPF" >&5 +-$as_echo_n "checking for CFLAG $TMPF... " >&6; } +- CFLAGS_ORI=$CFLAGS +- CFLAGS="$CFLAGS $TMPF" ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for clang" >&5 ++$as_echo_n "checking for clang... " >&6; } + + if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "cannot run test program while cross compiling ++See \`config.log' for more details" "$LINENO" 5; } ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++ ++ ++ int main() { ++ return ++ #ifdef __clang__ ++ 0 ++ #else ++ 1 ++ #endif ++ ;} ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } ++ clang="yes" ++ TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body" ++ ++$as_echo "#define CLANG 1" >>confdefs.h ++ ++else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } ++ #FIXME -Wno-unused-but-set-variable when time ++ TMPF=-Wno-unused-but-set-variable ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFLAG $TMPF" >&5 ++$as_echo_n "checking for CFLAG $TMPF... " >&6; } ++ CFLAGS_ORI=$CFLAGS ++ CFLAGS="$CFLAGS $TMPF" ++ if test "$cross_compiling" = yes; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } + else +@@ -4201,11 +4235,14 @@ rm -f core *.core core.conftest.* gmon.o + conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +- CFLAGS=$CFLAGS_ORI ++ CFLAGS=$CFLAGS_ORI ++fi ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++fi + +-else +- TCFLAGS="-fsigned-char" + fi ++ + if test "$GCC" = "yes" ; then + TCFLAGS="$TCFLAGS -pipe" + case $use in +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -483,21 +483,37 @@ AC_SUBST(CC) + #fi + # subst GCC not only under 386-linux, but where available -- CM + +-if test "$GCC" = "yes" ; then ++TCFLAGS="-fsigned-char" + +- TCFLAGS="-Wall -fsigned-char" ++if test "$GCC" = "yes" ; then + +- #FIXME -Wno-unused-but-set-variable when time +- TMPF=-Wno-unused-but-set-variable +- AC_MSG_CHECKING([for CFLAG $TMPF]) +- CFLAGS_ORI=$CFLAGS +- CFLAGS="$CFLAGS $TMPF" +- AC_TRY_RUN([int main() {return 0;}],TCFLAGS="$TCFLAGS $TMPF";AC_MSG_RESULT(yes),AC_MSG_RESULT(no),AC_MSG_RESULT(no)) +- CFLAGS=$CFLAGS_ORI ++ TCFLAGS="$TCFLAGS -Wall" + +-else +- TCFLAGS="-fsigned-char" ++ AC_MSG_CHECKING([for clang]) ++ AC_RUN_IFELSE([ ++ AC_LANG_SOURCE([[ ++ int main() { ++ return ++ #ifdef __clang__ ++ 0 ++ #else ++ 1 ++ #endif ++ ;}]])], ++ [AC_MSG_RESULT([yes]) ++ clang="yes" ++ TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body" ++ AC_DEFINE([CLANG],[1],[running clang compiler])], ++ [AC_MSG_RESULT([no]) ++ #FIXME -Wno-unused-but-set-variable when time ++ TMPF=-Wno-unused-but-set-variable ++ AC_MSG_CHECKING([for CFLAG $TMPF]) ++ CFLAGS_ORI=$CFLAGS ++ CFLAGS="$CFLAGS $TMPF" ++ AC_TRY_RUN([int main() {return 0;}],TCFLAGS="$TCFLAGS $TMPF";AC_MSG_RESULT(yes),AC_MSG_RESULT(no),AC_MSG_RESULT(no)) ++ CFLAGS=$CFLAGS_ORI]) + fi ++ + if test "$GCC" = "yes" ; then + TCFLAGS="$TCFLAGS -pipe" + case $use in +--- gcl-2.6.12.orig/gcl-tk/comm.c ++++ gcl-2.6.12/gcl-tk/comm.c +@@ -183,7 +183,7 @@ int m; + { bcopy(sfd->valid_data,sfd->read_buffer,sfd->valid_data_size); + sfd->valid_data=sfd->read_buffer;} + /* there is at least a packet size of space available */ +- if ((fix(FFN(fScheck_fd_for_input)(sfd->fd,sfd->write_timeout))>0)); ++ if ((fix(FFN(fScheck_fd_for_input)(sfd->fd,sfd->write_timeout))>0)) + again: + {char *start = sfd->valid_data+sfd->valid_data_size; + nread = SAFE_READ(sfd->fd,start, +--- gcl-2.6.12.orig/gcl-tk/guis.c ++++ gcl-2.6.12/gcl-tk/guis.c +@@ -455,7 +455,7 @@ struct connection_state *sfd; + int tot; + struct message_header *msg; + msg = (struct message_header *) buf; +- m= read1(sfd,msg,MESSAGE_HEADER_SIZE,DEFAULT_TIMEOUT_FOR_TK_READ); ++ m= read1(sfd,(void *)msg,MESSAGE_HEADER_SIZE,DEFAULT_TIMEOUT_FOR_TK_READ); + if (m == MESSAGE_HEADER_SIZE) + { + if ( msg->magic1!=MAGIC1 +@@ -468,7 +468,7 @@ struct connection_state *sfd; + if (tot >= bufleng) + {msg = (void *)malloc(tot+1); + bcopy(buf,msg,MESSAGE_HEADER_SIZE);} +- m = read1(sfd,&(msg->body), ++ m = read1(sfd,(void *)&(msg->body), + body_length,DEFAULT_TIMEOUT_FOR_TK_READ); + if (m == body_length) + { return msg;}} +--- gcl-2.6.12.orig/h/compbas.h ++++ gcl-2.6.12/h/compbas.h +@@ -4,7 +4,7 @@ + #define EXTER extern + #endif + #ifndef INLINE +-#if defined(__GNUC__) && __GNUC__ <= 4 ++#if (defined(__GNUC__) && __GNUC__ <= 4) && !defined __clang__ + #define INLINE extern inline + #else + #define INLINE inline +--- gcl-2.6.12.orig/h/fixnum.h ++++ gcl-2.6.12/h/fixnum.h +@@ -13,7 +13,7 @@ + #define is_imm_fix(a_) INT_IN_BITS(a_,LOW_SHFT-1) + #elif defined (IM_FIX_BASE) && defined(IM_FIX_LIM) + #define make_imm_fixnum(a_) ((object)((a_)+(IM_FIX_BASE+(IM_FIX_LIM>>1)))) +-#define fix_imm_fixnum(a_) (((fixnum)(a_))-(IM_FIX_BASE+(IM_FIX_LIM>>1))) ++#define fix_imm_fixnum(a_) ((fixnum)(((fixnum)(a_))-(IM_FIX_BASE+(IM_FIX_LIM>>1)))) + #define mark_imm_fixnum(a_) ((a_)=((object)(((fixnum)(a_)) | IM_FIX_LIM))) + #define unmark_imm_fixnum(a_) ((a_)=((object)(((fixnum)(a_)) &~ IM_FIX_LIM))) + #define is_imm_fixnum(a_) (((ufixnum)(a_))>=IM_FIX_BASE) +--- gcl-2.6.12.orig/h/gclincl.h.in ++++ gcl-2.6.12/h/gclincl.h.in +@@ -9,9 +9,6 @@ + /* punt guess for no randomize value */ + #undef ADDR_NO_RANDOMIZE + +-/* compile ansi compliant image */ +-#undef ANSI_COMMON_LISP +- + /* binding stack size */ + #undef BDSSIZE + +@@ -21,6 +18,9 @@ + /* can prevent sbrk from returning random values */ + #undef CAN_UNRANDOMIZE_SBRK + ++/* running clang compiler */ ++#undef CLANG ++ + /* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP + systems. This function is required for `alloca.c' support on those systems. + */ +--- gcl-2.6.12.orig/h/object.h ++++ gcl-2.6.12/h/object.h +@@ -342,7 +342,8 @@ EXTER long holepage; /* hole pages * + EXTER long new_holepage,starting_hole_div,starting_relb_heap_mult; + + +-EXTER char *rb_start; /* relblock start */ ++EXTER char *new_rb_start; /* desired relblock start after next gc */ ++EXTER char *rb_start; /* relblock start */ + EXTER char *rb_end; /* relblock end */ + EXTER char *rb_limit; /* relblock limit */ + EXTER char *rb_pointer; /* relblock pointer */ +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1946,3 +1946,12 @@ get_pageinfo(void *); + + void + add_page_to_freelist(char *, struct typemanager *); ++ ++ufixnum ++sum_maxpages(void); ++ ++void ++resize_hole(ufixnum,enum type); ++ ++void ++setup_rb(void); +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -325,14 +325,29 @@ empty_relblock(void) { + + } + +-static inline void ++void ++setup_rb(void) { ++ ++ int init=new_rb_start!=rb_start || rb_pointer>=rb_end; ++ ++ rb_start=new_rb_start; ++ rb_end=rb_start+(nrbpage<>PAGEWIDTH))); ++ ++} ++ ++void + resize_hole(ufixnum hp,enum type tp) { + +- char *new_start=heap_end+hp*PAGESIZE; + char *start=rb_pointer=start) || (new_start=start+size)) { ++ new_rb_start=heap_end+hp*PAGESIZE; ++ ++ if ((new_rb_start=start) || (new_rb_start=start+size)) { + fprintf(stderr,"Toggling relblock when resizing hole to %lu\n",hp); + fflush(stderr); + tm_table[t_relocatable].tm_adjgbccnt--; +@@ -340,9 +355,11 @@ resize_hole(ufixnum hp,enum type tp) { + return resize_hole(hp,tp); + } + +- holepage=hp; +- tm_of(tp)->tm_adjgbccnt--; +- GBC(tp); ++ if (size) { ++ tm_of(tp)->tm_adjgbccnt--; ++ GBC(tp); ++ } else ++ setup_rb(); + + } + +@@ -355,7 +372,7 @@ alloc_page(long n) { + + if (!s) { + +- if (nn>holepage) { ++ if (nn>((rb_start-heap_end)>>PAGEWIDTH)) { + + + fixnum d=available_pages-nn; +@@ -373,12 +390,11 @@ alloc_page(long n) { + e=heap_end; + v=e+nn*PAGESIZE; + +- if (!s) { ++ if (!s) + +- holepage -= nn; + heap_end=v; + +- } else if (v>(void *)core_end) { ++ else if (v>(void *)core_end) { + + massert(!mbrk(v)); + core_end=v; +@@ -395,7 +411,7 @@ alloc_page(long n) { + + struct pageinfo *cell_list_head=NULL,*cell_list_tail=NULL;; + +-static inline ufixnum ++ufixnum + sum_maxpages(void) { + + ufixnum i,j; +@@ -516,7 +532,7 @@ rebalance_maxpages(struct typemanager *m + k+=(tm_table[i].tm_maxpage-tm_table[i].tm_npage)*(i==t_relocatable ? 2 : 1); + + e=e>k ? k : e; +- if (e+phys_pages-j<=0) ++ if (e+phys_pages<=j) + return 0; + + f=k ? 1.0-(double)e/k : 1.0; +@@ -895,17 +911,20 @@ add_pages(struct typemanager *tm,fixnum + + case t_relocatable: + +- if (rb_pointer>rb_end) { ++ if (rb_pointer>rb_end && m>((rb_start-heap_end)>>PAGEWIDTH)) { + fprintf(stderr,"Moving relblock low before expanding relblock pages\n"); + fflush(stderr); + tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + } + nrbpage+=m; +- rb_end+=m*PAGESIZE; + rb_limit+=m*PAGESIZE; ++ if (rb_pointer>rb_end) ++ rb_start-=m*PAGESIZE; ++ else ++ rb_end+=m*PAGESIZE; + +- alloc_page(-(2*nrbpage+holepage)); ++ alloc_page(-(2*nrbpage+((rb_start-heap_end)>>PAGEWIDTH))); + + break; + +@@ -1116,7 +1135,7 @@ DEFUNM_NEW("ALLOCATED",object,fSallocate + { struct typemanager *tm=(&tm_table[t_from_type(typ)]); + tm = & tm_table[tm->tm_type]; + if (tm->tm_type == t_relocatable) +- { tm->tm_npage = (rb_end-rb_start)/PAGESIZE; ++ { tm->tm_npage = (rb_end-rb_start)>>PAGEWIDTH; + tm->tm_nfree = rb_limit -rb_pointer; + } + else if (tm->tm_type == t_contiguous) +@@ -1242,11 +1261,8 @@ object malloc_list=Cnil; + + void + maybe_set_hole_from_maxpages(void) { +- if (rb_start==heap_end && rb_end==rb_start && rb_limit==rb_start && rb_pointer==rb_start) { +- holepage=new_holepage; +- alloc_page(-holepage); +- rb_start=rb_end=rb_limit=rb_pointer=heap_end+(holepage<= (void*)baby_malloc_data && ptr - (void*)baby_malloc_data st.st_fillp = size; + return(ptr); + } else { +- j = x->st.st_dim; + x->st.st_self = alloc_contblock(size); + x->st.st_fillp = x->st.st_dim = 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 */ + return(x->st.st_self); + } + } +--- gcl-2.6.12.orig/o/assignment.c ++++ gcl-2.6.12/o/assignment.c +@@ -259,7 +259,7 @@ DEFUNO_NEW("FMAKUNBOUND",object,fLfmakun + static void + FFN(Fsetf)(object form) + { +- object result,*t,*t1; ++ object *t,*t1; + if (endp(form)) { + vs_base = vs_top; + vs_push(Cnil); +@@ -269,7 +269,7 @@ FFN(Fsetf)(object form) + vs_top = top; + if (endp(MMcdr(form))) + FEinvalid_form("No value for ~S.", form->c.c_car); +- result = setf(MMcar(form), MMcadr(form)); ++ setf(MMcar(form), MMcadr(form)); + form = MMcddr(form); + } while (!endp(form)); + t=vs_base; +--- gcl-2.6.12.orig/o/cfun.c ++++ gcl-2.6.12/o/cfun.c +@@ -343,7 +343,8 @@ turbo_closure(object fun) + + if(1)/*(fun->cc.cc_turbo==NULL)*/ + {BEGIN_NO_INTERRUPT; +- for (n = 0, l = fun->cc.cc_env; !endp(l); n++, l = l->c.c_cdr); ++ for (n = 0, l = fun->cc.cc_env; !endp(l); n++, l = l->c.c_cdr) ++ ; + { + block= AR_ALLOC(alloc_relblock,(1+n),object); + *block=make_fixnum(n); +--- gcl-2.6.12.orig/o/format.c ++++ gcl-2.6.12/o/format.c +@@ -170,6 +170,22 @@ object sSAindent_formatted_outputA; + fmt_string = old_fmt_string ; \ + fmt_paramp = old_fmt_paramp + ++#define fmt_old1 VOL object old_fmt_stream; \ ++ VOL int old_ctl_origin; \ ++ VOL int old_ctl_index; \ ++ VOL int old_ctl_end; \ ++ jmp_bufp VOL old_fmt_jmp_bufp; \ ++ VOL int old_fmt_indents; \ ++ VOL object old_fmt_string ; \ ++ VOL format_parameter *old_fmt_paramp ++#define fmt_save1 old_fmt_stream = fmt_stream; \ ++ old_ctl_origin = ctl_origin; \ ++ old_ctl_index = ctl_index; \ ++ old_ctl_end = ctl_end; \ ++ old_fmt_jmp_bufp = fmt_jmp_bufp; \ ++ old_fmt_indents = fmt_indents; \ ++ old_fmt_string = fmt_string ; \ ++ old_fmt_paramp = fmt_paramp + #define fmt_restore1 fmt_stream = old_fmt_stream; \ + ctl_origin = old_ctl_origin; \ + ctl_index = old_ctl_index; \ +@@ -1776,7 +1792,7 @@ fmt_case(bool colon, bool atsign) + { + VOL object x; + VOL int i, j; +- fmt_old; ++ fmt_old1; + jmp_buf fmt_jmp_buf0; + int up_colon; + bool b; +@@ -1787,7 +1803,7 @@ fmt_case(bool colon, bool atsign) + j = fmt_skip(); + if (ctl_string[--j] != ')' || ctl_string[--j] != '~') + fmt_error("~) expected"); +- fmt_save; ++ fmt_save1; + fmt_jmp_bufp = &fmt_jmp_buf0; + if ((up_colon = setjmp(*fmt_jmp_bufp))) + ; +@@ -1850,7 +1866,7 @@ fmt_conditional(bool colon, bool atsign) + object x; + int n=0; + bool done; +- fmt_old; ++ fmt_old1; + + fmt_not_colon_atsign(colon, atsign); + if (colon) { +@@ -1863,11 +1879,11 @@ fmt_conditional(bool colon, bool atsign) + if (ctl_string[--k] != ']' || ctl_string[--k] != '~') + fmt_error("~] expected"); + if (fmt_advance() == Cnil) { +- fmt_save; ++ fmt_save1; + format(fmt_stream, ctl_origin + i, j - i); + fmt_restore1; + } else { +- fmt_save; ++ fmt_save1; + format(fmt_stream, ctl_origin + j + 2, k - (j + 2)); + fmt_restore1; + } +@@ -1880,7 +1896,7 @@ fmt_conditional(bool colon, bool atsign) + ; + else { + --fmt_index; +- fmt_save; ++ fmt_save1; + format(fmt_stream, ctl_origin + i, j - i); + fmt_restore1; + } +@@ -1899,7 +1915,7 @@ fmt_conditional(bool colon, bool atsign) + for (k = j; ctl_string[--k] != '~';) + ; + if (n == 0) { +- fmt_save; ++ fmt_save1; + format(fmt_stream, ctl_origin + i, k - i); + fmt_restore1; + done = TRUE; +@@ -1925,7 +1941,7 @@ fmt_conditional(bool colon, bool atsign) + if (ctl_string[--j] != ']' || ctl_string[--j] != '~') + fmt_error("~] expected"); + if (!done) { +- fmt_save; ++ fmt_save1; + format(fmt_stream, ctl_origin + i, j - i); + fmt_restore1; + } +@@ -2062,7 +2078,7 @@ fmt_justification(volatile bool colon, b + { + int mincol=0, colinc=0, minpad=0, padchar=0; + object fields[FORMAT_DIRECTIVE_LIMIT]; +- fmt_old; ++ fmt_old1; + jmp_buf fmt_jmp_buf0; + VOL int i,j,n,j0; + int k,l,m,l0; +@@ -2089,7 +2105,7 @@ fmt_justification(volatile bool colon, b + ; + fields[n] = make_string_output_stream(64); + vs_push(fields[n]); +- fmt_save; ++ fmt_save1; + fmt_jmp_bufp = &fmt_jmp_buf0; + if ((up_colon = setjmp(*fmt_jmp_bufp))) { + --n; +@@ -2116,7 +2132,7 @@ fmt_justification(volatile bool colon, b + special = 1; + for (j = j0; ctl_string[j] != '~'; --j) + ; +- fmt_save; ++ fmt_save1; + format(fmt_stream, ctl_origin + j, j0 - j + 2); + fmt_restore1; + spare_spaces = fmt_spare_spaces; +--- 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 +@@ -149,15 +149,6 @@ pageinfo_p(void *v) { + + } + +-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; +-} +- + static inline char + get_bit(char *v,struct pageinfo *pi,void *x) { + void *ve=CB_DATA_START(pi); +@@ -168,15 +159,15 @@ get_bit(char *v,struct pageinfo *pi,void + return (v[i]>>s)&0x1; + } + +-static inline void +-set_bit(char *v,struct pageinfo *pi,void *x) { +- void *ve=CB_DATA_START(pi); +- fixnum off=(x-ve)>>LOG_BYTES_CONTBLOCK,i=off>>LOG_BITS_CHAR,s=off&~(~0UL<>LOG_BYTES_CONTBLOCK,i=off>>LOG_BITS_CHAR,s=off&~(~0UL<>s)&0x1) + #define bit_set(v,i,s) (v[i]|=(1UL<cb_link,ncb++); ++ ++ return ncb; ++ ++} ++ ++ + void + GBC(enum type t) { + +@@ -1196,21 +1204,8 @@ GBC(enum type t) { + + if (gc_time >=0 && !gc_recursive++) {gc_start=runtime();} + +- if (COLLECT_RELBLOCK_P) { +- +- char *new_start=heap_end+holepage*PAGESIZE,*new_end=new_start+nrbpage*PAGESIZE; +- +- if (new_start!=rb_start) { +- rb_pointer=new_start; +- rb_limit=new_end; +- } else { +- rb_pointer=(rb_pointer>PAGEWIDTH)); + printf("relblock: %ld bytes used %ld bytes free %ld pages\n", + (long)(rb_pointer - rb_start), (long)(rb_end - rb_pointer), nrbpage); + printf("GBC ended\n"); +@@ -1425,10 +1421,10 @@ FFN(siLheap_report)(void) { + i=sizeof(fixnum)*CHAR_SIZE-2; + i=1<>1)); + vs_push(make_fixnum(CSTACK_ALIGNMENT)); +- vs_push(make_fixnum(abs(cs_limit-cs_org)));/*CSSIZE*/ ++ vs_push(make_fixnum(labs(cs_limit-cs_org)));/*CSSIZE*/ + #if defined(IM_FIX_BASE) && defined(IM_FIX_LIM) + #ifdef LOW_IM_FIX + vs_push(make_fixnum(-LOW_IM_FIX)); +@@ -1456,14 +1452,9 @@ FFN(siLroom_report)(void) { + vs_push(make_fixnum(available_pages)); + vs_push(make_fixnum(ncbpage)); + vs_push(make_fixnum(maxcbpage)); +- { +- 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(count_contblocks())); + vs_push(make_fixnum(cbgbccount)); +- vs_push(make_fixnum(holepage)); ++ vs_push(make_fixnum((rb_start-heap_end)>>PAGEWIDTH)); + vs_push(make_fixnum(rb_pointer - (rb_pointerc.c_car,depth)^rtb[abs(depth%(sizeof(rtb)/sizeof(*rtb)))]; ++ h^=ihash_equal(x->c.c_car,depth)^rtb[abs((int)(depth%(sizeof(rtb)/sizeof(*rtb))))];/*FIXME: clang faulty warning*/ + x = x->c.c_cdr; + goto BEGIN; + break; +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -207,11 +207,19 @@ get_proc_meminfo_value_in_pages(const ch + + static ufixnum + get_phys_pages_no_malloc(char freep) { +- return freep ? ++ ufixnum k=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:"); ++ const char *e=getenv("GCL_MEM_MULTIPLE"); ++ if (e) { ++ double d; ++ massert(sscanf(e,"%lf",&d)==1); ++ massert(d>=0.0); ++ k*=d; ++ } ++ return k; + } + + #endif +@@ -221,9 +229,9 @@ void *initial_sbrk=NULL; + int + update_real_maxpage(void) { + +- ufixnum i,j,k; ++ ufixnum i,j; + void *end,*cur,*beg; +- ufixnum free_phys_pages=get_phys_pages_no_malloc(1),maxpages; ++ ufixnum maxpages; + #ifdef __MINGW32__ + static fixnum n; + +@@ -233,7 +241,7 @@ update_real_maxpage(void) { + } + #endif + +- phys_pages=get_phys_pages_no_malloc(1); ++ phys_pages=get_phys_pages_no_malloc(0); + + massert(cur=sbrk(0)); + beg=data_start ? data_start : cur; +@@ -253,15 +261,14 @@ update_real_maxpage(void) { + + maxpages=real_maxpage-page(beg); + +- free_phys_pages=free_phys_pages>maxpages ? maxpages : free_phys_pages; ++ phys_pages=phys_pages>maxpages ? maxpages : phys_pages; + + resv_pages=available_pages=0; + available_pages=check_avail_pages(); + +- for (i=t_start,j=0;i>1); ++ if (j>1); + } + + new_holepage=0; +@@ -297,15 +302,15 @@ minimize_image(void) { + fixnum i; + + empty_relblock(); +- holepage=nrbpage=0; +- core_end=rb_start=rb_end=rb_limit=rb_pointer=heap_end; ++ nrbpage=0; ++ resize_hole(0,t_relocatable); + + #ifdef GCL_GPROF + gprof_cleanup(); + #endif + + #if defined(BSD) || defined(ATT) +- mbrk(core_end); ++ mbrk(core_end=heap_end); + #endif + + cbgbccount = tm_table[t_contiguous].tm_adjgbccnt = tm_table[t_contiguous].tm_opt_maxpage = 0; +@@ -992,7 +997,6 @@ FFN(siLsave_system)(void) { + saving_system = FALSE; + + siLsave(); +- alloc_page(-(holepage+2*nrbpage)); + + } + +--- gcl-2.6.12.orig/o/nfunlink.c ++++ gcl-2.6.12/o/nfunlink.c +@@ -212,19 +212,24 @@ IapplyVector(object fun, int nargs, obje + else { abase = vs_top; + for (i=0; i < nargs ; i++, atypes >>= F_TYPE_WIDTH) + { object next = base[i]; +- int atyp = atypes & MASK_RANGE(0,F_TYPE_WIDTH); +- if (atyp == F_object) +- next = next; +- else if (atyp == F_int) +- { ASSURE_TYPE(next,t_fixnum); +- next = COERCE_F_TYPE(next,F_object,F_int);} +- else if (atyp == F_shortfloat) +- { ASSURE_TYPE(next,t_shortfloat); +- next = COERCE_F_TYPE(next,F_object,F_shortfloat);} +- else if (atyp == F_double_ptr) +- { ASSURE_TYPE(next,t_longfloat); +- next = COERCE_F_TYPE(next,F_object,F_double_ptr);} +- else {FEerror("cant get here!",0);} ++ switch (atypes & MASK_RANGE(0,F_TYPE_WIDTH)) { ++ case F_object: ++ break; ++ case F_int: ++ ASSURE_TYPE(next,t_fixnum); ++ next = COERCE_F_TYPE(next,F_object,F_int); ++ break; ++ case F_shortfloat: ++ ASSURE_TYPE(next,t_shortfloat); ++ next = COERCE_F_TYPE(next,F_object,F_shortfloat); ++ break; ++ case F_double_ptr: ++ ASSURE_TYPE(next,t_longfloat); ++ next = COERCE_F_TYPE(next,F_object,F_double_ptr); ++ break; ++ default: ++ FEerror("cant get here!",0); ++ } + vs_push(next);} + + } +--- gcl-2.6.12.orig/o/nsocket.c ++++ gcl-2.6.12/o/nsocket.c +@@ -204,7 +204,7 @@ CreateSocket(int port, char *host, int s + * attempt to do an async connect. Otherwise + * do a synchronous connect or bind. */ + { +- int status, sock, asyncConnect, curState, origState; ++ int status, sock, /* asyncConnect, */curState, origState; + struct sockaddr_in sockaddr; /* socket address */ + struct sockaddr_in mysockaddr; /* Socket address for client */ + +@@ -230,7 +230,7 @@ CreateSocket(int port, char *host, int s + + fcntl(sock, F_SETFD, FD_CLOEXEC); + +- asyncConnect = 0; ++ /* asyncConnect = 0; */ + status = 0; + if (server) { + +@@ -285,7 +285,7 @@ CreateSocket(int port, char *host, int s + sizeof(sockaddr)); + if (status < 0) { + if (errno == EINPROGRESS) { +- asyncConnect = 1; ++ /* asyncConnect = 1; */ + status = 0; + } + } +--- gcl-2.6.12.orig/o/prelink.c ++++ gcl-2.6.12/o/prelink.c +@@ -5,8 +5,14 @@ + extern FILE *stdin __attribute__((weak)); + extern FILE *stderr __attribute__((weak)); + extern FILE *stdout __attribute__((weak)); ++ ++#if RL_READLINE_VERSION < 0x0600 ++extern Function *rl_completion_entry_function __attribute__((weak)); ++extern char *rl_readline_name __attribute__((weak)); ++#else + extern rl_compentry_func_t *rl_completion_entry_function __attribute__((weak)); + extern const char *rl_readline_name __attribute__((weak)); ++#endif + + void + prelink_init(void) { +--- gcl-2.6.12.orig/o/print.d ++++ gcl-2.6.12/o/print.d +@@ -341,7 +341,7 @@ truncate_double(char *b,double d,int dp) + for (p=c1;*p && *p!='e';p++); + pp=p>c1 && p[-1]!='.' ? p-1 : p; + for (;pp>c1 && pp[-1]=='0';pp--); +- strcpy(pp,p); ++ memmove(pp,p,1+strlen(p)); + if (pp!=p && COMP(c1,&pp,d,dp)) + k=truncate_double(n=c1,d,dp); + +--- gcl-2.6.12.orig/o/read.d ++++ gcl-2.6.12/o/read.d +@@ -2476,6 +2476,7 @@ object in; + + /* to prevent longjmp clobber */ + i=(long)&vsp; ++ i+=i; + vsp=&vspo; + old_READtable = READtable; + old_READdefault_float_format = READdefault_float_format; +--- gcl-2.6.12.orig/o/run_process.c ++++ gcl-2.6.12/o/run_process.c +@@ -354,7 +354,6 @@ static int open_connection(host,server) + char *host; + int server; + { +- int res; + int pid; + int sock; + struct hostent *hp; +@@ -396,9 +395,9 @@ int server; + } + + #ifdef OVM_IO +- res = fcntl(sock,F_SETFL,FASYNC | FNDELAY); ++ fcntl(sock,F_SETFL,FASYNC | FNDELAY); + #else +- res = fcntl(sock,F_SETFL,FASYNC); ++ fcntl(sock,F_SETFL,FASYNC); + #endif + return(sock); + } +--- gcl-2.6.12.orig/o/sockets.c ++++ gcl-2.6.12/o/sockets.c +@@ -338,7 +338,7 @@ DEFUN_NEW("OUR-READ-WITH-OFFSET",object, + OO,OI,II,OO,(object fd,object buffer,fixnum offset,fixnum nbytes,fixnum timeout), + "Read from STATE-FD into string BUFFER putting data at OFFSET and reading NBYTES, waiting for TIMEOUT before failing") + +-{ return make_fixnum(read1(OBJ_TO_CONNECTION_STATE(fd),&((buffer)->ust.ust_self[offset]),nbytes,timeout)); ++{ return make_fixnum(read1(OBJ_TO_CONNECTION_STATE(fd),&((buffer)->st.st_self[offset]),nbytes,timeout)); + } + + +--- gcl-2.6.12.orig/o/unexelf.c ++++ gcl-2.6.12/o/unexelf.c +@@ -660,7 +660,7 @@ unexec (char *new_name, char *old_name, + int n, nn; + int old_bss_index, old_sbss_index; + int old_data_index, new_data2_index; +- int old_mdebug_index; ++ /* int old_mdebug_index; */ + struct stat stat_buf; + + /* Open the old file, allocate a buffer of the right size, and read +@@ -703,8 +703,8 @@ unexec (char *new_name, char *old_name, + + /* Find the mdebug section, if any. */ + +- old_mdebug_index = find_section (".mdebug", old_section_names, +- old_name, old_file_h, old_section_h, 1); ++ /* old_mdebug_index = find_section (".mdebug", old_section_names, */ ++ /* old_name, old_file_h, old_section_h, 1); */ + + /* Find the old .bss section. Figure out parameters of the new + * data2 and bss sections. +--- gcl-2.6.12.orig/xgcl-2/gcl_general.lsp ++++ gcl-2.6.12/xgcl-2/gcl_general.lsp +@@ -61,7 +61,7 @@ + + ;; General routines. + (defCfun "object lisp_string(object a_string, fixnum c_string) " 0 +- "extern long strlen(const char *);" ++ "extern unsigned long strlen(const char *);" + "fixnum len = strlen((void *)c_string);" + "a_string->st.st_dim = len;" + "a_string->st.st_fillp = len;" diff --git a/patches/Version_2_6_13pre13 b/patches/Version_2_6_13pre13 new file mode 100644 index 00000000..f019ef78 --- /dev/null +++ b/patches/Version_2_6_13pre13 @@ -0,0 +1,103 @@ +Description: + 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-12) unstable; urgency=medium + . + * Version_2_6_13pre13 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1918,7 +1918,7 @@ void + allocate_code_block_reserve(void); + + void * +-alloc_contblock_no_gc(size_t); ++alloc_contblock_no_gc(size_t,char *); + + void + reset_contblock_freelist(void); +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -1047,7 +1047,7 @@ alloc_contblock(size_t n) { + } + + void * +-alloc_contblock_no_gc(size_t n) { ++alloc_contblock_no_gc(size_t n,char *limit) { + + struct typemanager *tm=tm_of(t_contiguous); + void *p; +@@ -1057,7 +1057,7 @@ alloc_contblock_no_gc(size_t n) { + 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))) ++ if (tpage(tm,n)<(limit-heap_end)>>PAGEWIDTH && (p=alloc_after_adding_pages(tm,n))) + return p; + + return NULL; +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -431,29 +431,21 @@ collecting(void *p) { + + static ufixnum ngc_thresh; + static union {struct dummy d;ufixnum f;} rst={.f=-1}; +-/* static object lcv=Cnil; */ ++static void *static_promotion_limit; + + static inline void + mark_leaf_data(object x,void **pp,ufixnum s,ufixnum r) { + +- void *p=*pp,*dp/* ,*dpe */; ++ void *p=*pp,*dp; + + if (!marking(p)||!collecting(p)) + return; + +- /* 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))) { ++ (dp=alloc_contblock_no_gc(s,static_promotion_limit))) { + +- /* 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; + + return; +@@ -1204,8 +1196,10 @@ GBC(enum type t) { + + if (gc_time >=0 && !gc_recursive++) {gc_start=runtime();} + +- if (COLLECT_RELBLOCK_P) ++ if (COLLECT_RELBLOCK_P) { ++ static_promotion_limit=rb_start + 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-12) unstable; urgency=medium + . + * Version_2_6_13pre13 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -2915,10 +2915,10 @@ case $canonical in + use=386-macosx + if test "$build_cpu" = "x86_64" ; then + CFLAGS="-m64 $CFLAGS"; +- LDFLAGS="-m64 -Wl,-headerpad,72 $LDFLAGS"; ++ LDFLAGS="-m64 -Wl,-headerpad,72 -Wl,-no_pie $LDFLAGS"; + else + CFLAGS="-m32 $CFLAGS"; +- LDFLAGS="-m32 -Wl,-headerpad,56 $LDFLAGS"; ++ LDFLAGS="-m32 -Wl,-headerpad,56 -Wl,-no_pie $LDFLAGS"; + fi;; + + alpha-dec-osf) +@@ -4203,7 +4203,7 @@ if ac_fn_c_try_run "$LINENO"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } + clang="yes" +- TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body" ++ TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign" + + $as_echo "#define CLANG 1" >>confdefs.h + +@@ -4246,7 +4246,12 @@ fi + if test "$GCC" = "yes" ; then + TCFLAGS="$TCFLAGS -pipe" + case $use in +- *mingw*|*gnuwin*) ++ *mingw*) ++# echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." ++# echo " It is otherwise needed for the Unexec stuff to work." ++# if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi ++ TCFLAGS="$TCFLAGS -fno-zero-initialized-in-bss -mms-bitfields";; ++ *gnuwin*) + # echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." + # echo " It is otherwise needed for the Unexec stuff to work." + # if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi +@@ -5193,7 +5198,7 @@ $as_echo_n "checking \"for leading under + cat>foo.c < + #include +-int main() {FILE *f;double d=0.0;getc(f);cos(d);return 0;} ++int main() {FILE *f;double d=0.0;getc(f);d=cos(d);return 0;} + EOFF + $CC -c foo.c -o foo.o + if nm foo.o |grep " U " | grep "_cos" >/dev/null || nm foo.o |grep " U " | grep " _getc" >/dev/null ; then +@@ -6071,7 +6076,50 @@ $as_echo "$ac_cv_lib_tirpc_xdr_double" > + if test "x$ac_cv_lib_tirpc_xdr_double" = xyes; then : + + $as_echo "#define HAVE_XDR 1" >>confdefs.h +- TLIBS="$TLIBS -ltirpc" ++ ++ TLIBS="$TLIBS -ltirpc" TCFLAGS="$TCFLAGS -I/usr/include/tirpc" ++else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -lgssrpc" >&5 ++$as_echo_n "checking for xdr_double in -lgssrpc... " >&6; } ++if ${ac_cv_lib_gssrpc_xdr_double+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ ac_check_lib_save_LIBS=$LIBS ++LIBS="-lgssrpc $LIBS" ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++ ++/* Override any GCC internal prototype to avoid an error. ++ Use char because int might match the return type of a GCC ++ builtin and then its argument prototype would still apply. */ ++#ifdef __cplusplus ++extern "C" ++#endif ++char xdr_double (); ++int ++main () ++{ ++return xdr_double (); ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_link "$LINENO"; then : ++ ac_cv_lib_gssrpc_xdr_double=yes ++else ++ ac_cv_lib_gssrpc_xdr_double=no ++fi ++rm -f core conftest.err conftest.$ac_objext \ ++ conftest$ac_exeext conftest.$ac_ext ++LIBS=$ac_check_lib_save_LIBS ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gssrpc_xdr_double" >&5 ++$as_echo "$ac_cv_lib_gssrpc_xdr_double" >&6; } ++if test "x$ac_cv_lib_gssrpc_xdr_double" = xyes; then : ++ ++$as_echo "#define HAVE_XDR 1" >>confdefs.h ++ ++ TLIBS="$TLIBS -lgssrpc" TCFLAGS="$TCFLAGS -I/usr/include/gssrpc" + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -lrpc" >&5 + $as_echo_n "checking for xdr_double in -lrpc... " >&6; } +@@ -6112,7 +6160,8 @@ $as_echo "$ac_cv_lib_rpc_xdr_double" >&6 + if test "x$ac_cv_lib_rpc_xdr_double" = xyes; then : + + $as_echo "#define HAVE_XDR 1" >>confdefs.h +- TLIBS="$TLIBS -lrpc" ++ ++ TLIBS="$TLIBS -lrpc" TCFLAGS="$TCFLAGS -I/usr/include/rpc" + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -loncrpc" >&5 + $as_echo_n "checking for xdr_double in -loncrpc... " >&6; } +@@ -6153,7 +6202,10 @@ $as_echo "$ac_cv_lib_oncrpc_xdr_double" + if test "x$ac_cv_lib_oncrpc_xdr_double" = xyes; then : + + $as_echo "#define HAVE_XDR 1" >>confdefs.h +- TLIBS="$TLIBS -loncrpc" ++ ++ TLIBS="$TLIBS -loncrpc" TCFLAGS="$TCFLAGS -I/usr/include/oncrpc" ++fi ++ + fi + + fi +@@ -6870,7 +6922,6 @@ else + + #include + #include +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + #include "h/unrandomize.h" + return 0;} +@@ -6899,7 +6950,6 @@ else + /* end confdefs.h. */ + #include + #include +- void gprof_cleanup() {}; + int main(int argc,char * argv[],char * envp[]) { + FILE *f; + #ifdef CAN_UNRANDOMIZE_SBRK +@@ -6930,7 +6980,6 @@ else + /* end confdefs.h. */ + #include + #include +- void gprof_cleanup() {}; + int main(int argc,char * argv[],char * envp[]) { + FILE *f; + #ifdef CAN_UNRANDOMIZE_SBRK +@@ -6997,7 +7046,6 @@ else + return (void *)&i; + } + +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + void *v ; + FILE *fp = fopen("conftest1","w"); +@@ -7055,7 +7103,6 @@ else + return (void *)&i; + } + +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + void *v ; + FILE *fp = fopen("conftest1","w"); +@@ -7108,7 +7155,6 @@ else + + #include + #include +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" +@@ -7147,7 +7193,6 @@ else + + #include + #include +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + void *b,*c; + FILE *fp = fopen("conftest1","w"); +@@ -7200,7 +7245,6 @@ else + return (void *)&i; + } + +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + char *b; + FILE *fp = fopen("conftest1","w"); +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -195,10 +195,10 @@ case $canonical in + use=386-macosx + if test "$build_cpu" = "x86_64" ; then + CFLAGS="-m64 $CFLAGS"; +- LDFLAGS="-m64 -Wl,-headerpad,72 $LDFLAGS"; ++ LDFLAGS="-m64 -Wl,-headerpad,72 -Wl,-no_pie $LDFLAGS"; + else + CFLAGS="-m32 $CFLAGS"; +- LDFLAGS="-m32 -Wl,-headerpad,56 $LDFLAGS"; ++ LDFLAGS="-m32 -Wl,-headerpad,56 -Wl,-no_pie $LDFLAGS"; + fi;; + + alpha-dec-osf) +@@ -502,7 +502,7 @@ if test "$GCC" = "yes" ; then + ;}]])], + [AC_MSG_RESULT([yes]) + clang="yes" +- TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body" ++ TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign" + AC_DEFINE([CLANG],[1],[running clang compiler])], + [AC_MSG_RESULT([no]) + #FIXME -Wno-unused-but-set-variable when time +@@ -517,7 +517,12 @@ fi + if test "$GCC" = "yes" ; then + TCFLAGS="$TCFLAGS -pipe" + case $use in +- *mingw*|*gnuwin*) ++ *mingw*) ++# echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." ++# echo " It is otherwise needed for the Unexec stuff to work." ++# if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi ++ TCFLAGS="$TCFLAGS -fno-zero-initialized-in-bss -mms-bitfields";; ++ *gnuwin*) + # echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." + # echo " It is otherwise needed for the Unexec stuff to work." + # if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi +@@ -889,7 +894,7 @@ AC_MSG_CHECKING("for leading underscore + cat>foo.c < + #include +-int main() {FILE *f;double d=0.0;getc(f);cos(d);return 0;} ++int main() {FILE *f;double d=0.0;getc(f);d=cos(d);return 0;} + EOFF + $CC -c foo.c -o foo.o + if nm foo.o |grep " U " | grep "_cos" >/dev/null || nm foo.o |grep " U " | grep " _getc" >/dev/null ; then +@@ -1160,9 +1165,14 @@ fi + + if test "$enable_xdr" = "yes" ; then + AC_CHECK_FUNC(xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]), +- AC_CHECK_LIB(tirpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) TLIBS="$TLIBS -ltirpc", +- AC_CHECK_LIB(rpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) TLIBS="$TLIBS -lrpc", +- AC_CHECK_LIB(oncrpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) TLIBS="$TLIBS -loncrpc")))) ++ AC_CHECK_LIB(tirpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) ++ TLIBS="$TLIBS -ltirpc" TCFLAGS="$TCFLAGS -I/usr/include/tirpc", ++ AC_CHECK_LIB(gssrpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) ++ TLIBS="$TLIBS -lgssrpc" TCFLAGS="$TCFLAGS -I/usr/include/gssrpc", ++ AC_CHECK_LIB(rpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) ++ TLIBS="$TLIBS -lrpc" TCFLAGS="$TCFLAGS -I/usr/include/rpc", ++ AC_CHECK_LIB(oncrpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) ++ TLIBS="$TLIBS -loncrpc" TCFLAGS="$TCFLAGS -I/usr/include/oncrpc"))))) + fi + + +@@ -1442,7 +1452,6 @@ if test "$HAVE_SBRK" = "1" ; then + AC_LANG_SOURCE([[ + #include + #include +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + #include "h/unrandomize.h" + return 0;}]])], +@@ -1453,7 +1462,6 @@ if test "$HAVE_SBRK" = "1" ; then + AC_MSG_CHECKING([that sbrk is (now) non-random]) + AC_TRY_RUN([#include + #include +- void gprof_cleanup() {}; + int main(int argc,char * argv[],char * envp[]) { + FILE *f; + #ifdef CAN_UNRANDOMIZE_SBRK +@@ -1468,7 +1476,6 @@ if test "$HAVE_SBRK" = "1" ; then + fi + AC_TRY_RUN([#include + #include +- void gprof_cleanup() {}; + int main(int argc,char * argv[],char * envp[]) { + FILE *f; + #ifdef CAN_UNRANDOMIZE_SBRK +@@ -1552,7 +1559,6 @@ AC_RUN_IFELSE([AC_LANG_SOURCE([[ + return (void *)&i; + } + +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + void *v ; + FILE *fp = fopen("conftest1","w"); +@@ -1586,7 +1592,6 @@ AC_RUN_IFELSE([AC_LANG_SOURCE([[ + return (void *)&i; + } + +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + void *v ; + FILE *fp = fopen("conftest1","w"); +@@ -1615,7 +1620,6 @@ AC_MSG_CHECKING(NEG_CSTACK_ADDRESS) + AC_RUN_IFELSE([AC_LANG_SOURCE([[ + #include + #include +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" +@@ -1632,7 +1636,6 @@ AC_MSG_CHECKING([finding CSTACK_ALIGNMEN + AC_RUN_IFELSE([AC_LANG_SOURCE([[ + #include + #include +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + void *b,*c; + FILE *fp = fopen("conftest1","w"); +@@ -1661,7 +1664,6 @@ AC_RUN_IFELSE([AC_LANG_SOURCE([[ + return (void *)&i; + } + +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + char *b; + FILE *fp = fopen("conftest1","w"); +--- gcl-2.6.12.orig/h/mingw.h ++++ gcl-2.6.12/h/mingw.h +@@ -243,3 +243,6 @@ extern int mingwlisten(FILE *); + #include + + ++#define NO_FILE_LOCKING /*FIXME*/ ++ ++#define sleep(n) Sleep(1000*n) +--- gcl-2.6.12.orig/h/object.h ++++ gcl-2.6.12/h/object.h +@@ -340,15 +340,68 @@ EXTER long holepage; /* hole pages * + #define maxrbpage tm_table[t_relocatable].tm_maxpage + #define rbgbccount tm_table[t_relocatable].tm_gbccount + EXTER long new_holepage,starting_hole_div,starting_relb_heap_mult; +- ++ ++EXTER ufixnum recent_allocation,wait_on_abort; ++EXTER double gc_alloc_min,mem_multiple,gc_page_min,gc_page_max; ++EXTER bool multiprocess_memory_pool; + + EXTER char *new_rb_start; /* desired relblock start after next gc */ + 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 *\/ */ ++ ++#ifndef INLINE ++#define INLINE ++#endif ++ ++INLINE ufixnum ++rb_size(void) { ++ return rb_end-rb_start; ++} ++ ++INLINE bool ++rb_high(void) { ++ return rb_pointer>=rb_end&&rb_size(); ++} ++ ++INLINE char * ++rb_begin(void) { ++ return rb_high() ? rb_end : rb_start; ++} ++ ++INLINE bool ++rb_emptyp(void) { ++ return rb_pointer == rb_begin(); ++} ++ ++INLINE ufixnum ++ufmin(ufixnum a,ufixnum b) { ++ return a<=b ? a : b; ++} ++ ++INLINE ufixnum ++ufmax(ufixnum a,ufixnum b) { ++ return a>=b ? a : b; ++} ++ ++#include ++#include ++#include ++INLINE int ++emsg(const char *s,...) { ++ va_list args; ++ ufixnum n=0; ++ void *v=NULL; ++ va_start(args,s); ++ n=vsnprintf(v,n,s,args)+1; ++ va_end(args); ++ v=alloca(n); ++ va_start(args,s); ++ vsnprintf(v,n,s,args); ++ va_end(args); ++ return write(2,v,n-1) ? n : -1; ++} + + EXTER char *heap_end; /* heap end */ + EXTER char *core_end; /* core end */ +--- /dev/null ++++ gcl-2.6.12/h/pool.h +@@ -0,0 +1,170 @@ ++static ufixnum ++data_pages(void) { ++ ++ return page(2*(rb_end-rb_start)+((void *)heap_end-data_start)); ++ ++} ++ ++#ifndef NO_FILE_LOCKING ++ ++#include ++#include ++#include ++#include ++#include ++ ++static int pool=-1; ++static struct pool { ++ ufixnum pid; ++ ufixnum n; ++ ufixnum s; ++} *Pool; ++ ++static struct flock pl; ++ ++static const char *gcl_pool="/tmp/gcl_pool"; ++ ++static int ++set_lock(void) { ++ ++ errno=0; ++ if (fcntl(pool,F_SETLKW,&pl)) { ++ if (errno==EINTR) ++ set_lock(); ++ return -1; ++ } ++ return 0; ++ ++} ++ ++static void ++lock_pool(void) { ++ ++ pl.l_type=F_WRLCK; ++ massert(!set_lock()); ++ ++} ++ ++static void ++unlock_pool(void) { ++ ++ pl.l_type=F_UNLCK; ++ massert(!set_lock()); ++ ++} ++ ++static void ++register_pool(int s) { ++ lock_pool(); ++ Pool->n+=s; ++ Pool->s+=s*data_pages(); ++ unlock_pool(); ++} ++ ++static void ++open_pool(void) { ++ ++ if (pool==-1) { ++ ++ struct flock f; ++ ++ massert((pool=open(gcl_pool,O_CREAT|O_RDWR,0644))!=-1); ++ massert(!ftruncate(pool,sizeof(struct pool))); ++ massert((Pool=mmap(NULL,sizeof(struct pool),PROT_READ|PROT_WRITE,MAP_SHARED,pool,0))!=(void *)-1); ++ ++ pl.l_type=F_WRLCK; ++ pl.l_whence=SEEK_SET; ++ pl.l_start=sizeof(Pool->pid);; ++ pl.l_len=0; ++ ++ f=pl; ++ f.l_start=0; ++ f.l_len=sizeof(Pool->pid); ++ ++ if (!fcntl(pool,F_SETLK,&f)) { ++ ++ Pool->pid=getpid(); ++ ++ lock_pool(); ++ Pool->n=0; ++ Pool->s=0; ++ unlock_pool(); ++ ++ f.l_type=F_UNLCK; ++ massert(!fcntl(pool,F_SETLK,&f)); ++ ++ fprintf(stderr,"Initializing pool\n"); ++ fflush(stderr); ++ ++ } ++ ++ f.l_type=F_RDLCK; ++ massert(!fcntl(pool,F_SETLK,&f)); ++ ++ register_pool(1); ++ massert(!atexit(close_pool)); ++ ++ } ++ ++} ++#endif ++ ++void ++close_pool(void) { ++ ++#ifndef NO_FILE_LOCKING ++ if (pool!=-1) { ++ register_pool(-1); ++ massert(!close(pool)); ++ massert(!munmap(Pool,sizeof(struct pool))); ++ pool=-1; ++ } ++#endif ++ ++} ++ ++static void ++update_pool(fixnum val) { ++ ++#ifndef NO_FILE_LOCKING ++ if (multiprocess_memory_pool) { ++ open_pool(); ++ lock_pool(); ++ Pool->s+=val; ++ unlock_pool(); ++ } ++#endif ++ ++} ++ ++static ufixnum ++get_pool(void) { ++ ++ ufixnum s; ++ ++#ifndef NO_FILE_LOCKING ++ if (multiprocess_memory_pool) { ++ ++ open_pool(); ++ lock_pool(); ++ s=Pool->s; ++ unlock_pool(); ++ ++ } else ++#endif ++ ++ s=data_pages(); ++ ++ return s; ++ ++} ++ ++ ++static void ++pool_check(void) { ++ ++ /* if (pool!=-1) */ ++ /* massert(get_pool()==data_pages() */ ++ /* ||!fprintf(stderr,"%lu %lu %lu\n",get_pool(),page((void *)heap_end-data_start),page(((rb_end-rb_start))))); */ ++ ++} +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1951,7 +1951,16 @@ ufixnum + sum_maxpages(void); + + void +-resize_hole(ufixnum,enum type); ++resize_hole(ufixnum,enum type,bool); + + void +-setup_rb(void); ++setup_rb(bool); ++ ++void ++close_pool(void); ++ ++void ++gcl_cleanup(int); ++ ++void ++do_gcl_abort(void); +--- gcl-2.6.12.orig/h/unrandomize.h ++++ gcl-2.6.12/h/unrandomize.h +@@ -49,10 +49,10 @@ + } + n[k]="GCL_UNRANDOMIZE=t"; + n[k+1]=0; +-#ifdef GCL_GPROF +- gprof_cleanup(); +-#endif + errno=0; ++#ifdef HAVE_GCL_CLEANUP ++ gcl_cleanup(0); ++#endif + execve(*a,a,n); + printf("execve failure %d\n",errno); + exit(-1); +--- gcl-2.6.12.orig/lsp/gcl_top.lsp ++++ gcl-2.6.12/lsp/gcl_top.lsp +@@ -89,7 +89,7 @@ + + (when (boundp '*system-banner*) + (format t *system-banner*) +- (format t "Temporary directory for compiler files set to ~a~%" *tmp-dir*)) ++ (format t "Temporary directory for compiler files:~%~a~%" *tmp-dir*)) + + (loop + (setq +++ ++ ++ + + -) +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -38,6 +38,8 @@ Foundation, 675 Mass Ave, Cambridge, MA + static int + t_from_type(object); + ++#include "pool.h" ++ + + DEFVAR("*AFTER-GBC-HOOK*",sSAafter_gbc_hookA,SI,sLnil,""); + DEFVAR("*IGNORE-MAXIMUM-PAGES*",sSAignore_maximum_pagesA,SI,sLt,""); +@@ -67,7 +69,6 @@ sbrk1(n) + + long starting_hole_div=10; + long starting_relb_heap_mult=2; +-long new_holepage; + long resv_pages=0; + + #ifdef BSD +@@ -317,7 +318,7 @@ 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;) { ++ for (;!rb_emptyp();) { + tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + } +@@ -326,40 +327,44 @@ empty_relblock(void) { + } + + void +-setup_rb(void) { ++setup_rb(bool preserve_rb_pointerp) { + +- int init=new_rb_start!=rb_start || rb_pointer>=rb_end; ++ int lowp=new_rb_start!=rb_start || rb_high(); + ++ update_pool(2*(nrbpage-page(rb_size()))); + rb_start=new_rb_start; + rb_end=rb_start+(nrbpage<>PAGEWIDTH))); + + } + + void +-resize_hole(ufixnum hp,enum type tp) { ++resize_hole(ufixnum hp,enum type tp,bool in_placep) { + +- char *start=rb_pointer=start) || (new_rb_start=start+size)) { +- fprintf(stderr,"Toggling relblock when resizing hole to %lu\n",hp); +- fflush(stderr); ++ if (!in_placep && ++ ((new_start<=start && starttm_adjgbccnt--; + GBC(tp); +- } else +- setup_rb(); ++ } + + } + +@@ -378,11 +383,13 @@ alloc_page(long n) { + fixnum d=available_pages-nn; + + d*=0.2; +- d=d<0.01*real_maxpage ? available_pages-n : d; ++ d=d<0.01*real_maxpage ? available_pages-nn : d; + d=d<0 ? 0 : d; +- d=new_holepage(void *)core_end) { ++ update_pool(nn); ++ pool_check(); ++ ++ } else if (v>(void *)core_end) { + + massert(!mbrk(v)); + core_end=v; +@@ -510,94 +519,6 @@ 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-(a_)->tm_alt_npage +- +-static int +-rebalance_maxpages(struct typemanager *my_tm,fixnum z) { +- +- fixnum d; +- ufixnum i,j,r=(my_tm->tm_type==t_relocatable ? 2 : 1); +- +- +- d=(z-my_tm->tm_maxpage)*r; +- j=sum_maxpages(); +- +- if (j+d>phys_pages) { +- +- ufixnum k,e=j+d-phys_pages; +- double f; +- +- for (k=0,i=t_start;ik ? k : e; +- if (e+phys_pages<=j) +- return 0; +- +- f=k ? 1.0-(double)e/k : 1.0; +- +- for (i=t_start;itm_maxpage*r+(phys_pages-sum_maxpages()))/r)); +- +- return 1; +- +- } else +- +- return set_tm_maxpage(my_tm,z); +- +-} +- +-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,j; +- +- if (page(core_end)>0.8*real_maxpage) +- return 0; +- +- for (tm=tm_table,tme=tm+sizeof(tm_table)/sizeof(*tm_table);tmtm_adjgbccnt; +- y+=MMAX_PG(tm); +- } +- mmax_page=MMAX_PG(my_tm); +-#if 0 +- if (sgc_enabled) { +- y-=(tro=sgc_count_read_only_type(-1)); +- mmax_page-=(mro=sgc_count_read_only_type(my_tm->tm_type)); +- } +-#endif +- +- 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_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 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; +- +-} + + static object + exhausted_report(enum type t,struct typemanager *tm) { +@@ -735,14 +656,12 @@ print_cb(int print) { + 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",(unsigned long)(cbppp-cbsrch1),*cbppp,**cbppp,(**cbppp)->cb_size,k); ++ emsg("%lu %p %p %lu %lu\n",(unsigned long)(cbppp-cbsrch1),*cbppp,**cbppp,(**cbppp)->cb_size,k); + } + massert(cbppp==cbsrche); + massert(*cbppp==cbpp); + massert(!**cbppp); + +- fflush(stderr); +- + } + + void +@@ -808,8 +727,8 @@ alloc_from_freelist(struct typemanager * + break; + + case t_relocatable: +- if (rb_pointer>rb_end && rb_pointer+n>rb_limit && rb_pointer+nrb_end && rb_pointer+n>rb_limit && rb_pointer+nn) + return ((rb_pointer+=n)-n); + break; +@@ -847,7 +766,7 @@ too_full_p(struct typemanager *tm) { + + switch (tm->tm_type) { + case t_relocatable: +- return 100*(rb_limit-rb_pointer)cb_link) k+=cbp->cb_size; +@@ -867,10 +786,31 @@ too_full_p(struct typemanager *tm) { + + } + ++static inline bool ++do_gc_p(struct typemanager *tm,fixnum n) { ++ ++ ufixnum cpool,pp; ++ ++ if (!GBC_enable) ++ return FALSE; ++ ++ if (!sSAoptimize_maximum_pagesA || sSAoptimize_maximum_pagesA->s.s_dbind==Cnil) ++ return tm->tm_npage+tpage(tm,n)>tm->tm_maxpage; ++ ++ if ((cpool=get_pool())<=gc_page_min*phys_pages) ++ return FALSE; ++ ++ pp=gc_page_max*phys_pages; ++ ++ return page(recent_allocation)>(1.0+gc_alloc_min-(double)ufmin(cpool,pp)/pp)*data_pages(); ++ ++} ++ ++ + static inline void * + alloc_after_gc(struct typemanager *tm,fixnum n) { + +- if (tm->tm_npage+tpage(tm,n)>tm->tm_maxpage && GBC_enable) { ++ if (do_gc_p(tm,n)) { + + switch (jmp_gmp) { + case 0: /* not in gmp call*/ +@@ -911,21 +851,13 @@ add_pages(struct typemanager *tm,fixnum + + case t_relocatable: + +- if (rb_pointer>rb_end && m>((rb_start-heap_end)>>PAGEWIDTH)) { +- fprintf(stderr,"Moving relblock low before expanding relblock pages\n"); +- fflush(stderr); ++ if (rb_high() && m>((rb_start-heap_end)>>PAGEWIDTH)) { ++ emsg("Moving relblock low before expanding relblock pages\n"); + tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + } + nrbpage+=m; +- rb_limit+=m*PAGESIZE; +- if (rb_pointer>rb_end) +- rb_start-=m*PAGESIZE; +- else +- rb_end+=m*PAGESIZE; +- +- alloc_page(-(2*nrbpage+((rb_start-heap_end)>>PAGEWIDTH))); +- ++ resize_hole(page(rb_start-heap_end)-(rb_high() ? m : 0),t_relocatable,1); + break; + + default: +@@ -1011,6 +943,8 @@ alloc_mem(struct typemanager *tm,fixnum + + CHECK_INTERRUPT; + ++ recent_allocation+=n; ++ + if ((p=alloc_from_freelist(tm,n))) + return p; + if ((p=alloc_after_gc(tm,n))) +@@ -1135,7 +1069,7 @@ DEFUNM_NEW("ALLOCATED",object,fSallocate + { struct typemanager *tm=(&tm_table[t_from_type(typ)]); + tm = & tm_table[tm->tm_type]; + if (tm->tm_type == t_relocatable) +- { tm->tm_npage = (rb_end-rb_start)>>PAGEWIDTH; ++ { tm->tm_npage = page(rb_size()); + tm->tm_nfree = rb_limit -rb_pointer; + } + else if (tm->tm_type == t_contiguous) +@@ -1262,7 +1196,7 @@ object malloc_list=Cnil; + void + maybe_set_hole_from_maxpages(void) { + if (rb_start==heap_end && rb_end==rb_start && rb_limit==rb_start && rb_pointer==rb_start) +- resize_hole(new_holepage,t_relocatable); ++ resize_hole(available_pages/3,t_relocatable,0); + } + + void +@@ -1361,10 +1295,10 @@ gcl_init_alloc(void *cs_start) { + initial_sbrk=data_start=heap_end; + first_data_page=page(data_start); + +-#ifdef GCL_GPROF +- if (new_holepage>PAGEWIDTH)); + } + + +@@ -1751,9 +1685,7 @@ DEFUN_NEW("SET-STARTING-RELBLOCK-HEAP-MU + + DEFUNM_NEW("SET-HOLE-SIZE",object,fSset_hole_size,SI,1,2,NONE,OO,OO,OO,OO,(object onpages,...),"") { + +- printf("This function is obsolete -- use SET-STARTING-HOLE-DIVISOR instead\n"); +- +- RETURN2(make_fixnum(new_holepage),make_fixnum(reserve_pages_for_signal_handler)); ++ RETURN2(make_fixnum((rb_start-heap_end)>>PAGEWIDTH),make_fixnum(reserve_pages_for_signal_handler)); + + } + +@@ -1811,7 +1743,7 @@ static char *baby_malloc(n) + if ((res +m-baby_malloc_data) > sizeof(baby_malloc_data)) + { + printf("failed in baby malloc"); +- exit(1); ++ do_gcl_abort(); + } + last_baby += m; + *((int *)res)=n; +@@ -1904,18 +1836,16 @@ free(void *ptr) { + #endif + return; + } +-#ifdef NOFREE_ERR +- return; +-#else + if (ptr!=initial_monstartup_pointer_echo) { + static void *old_ptr; + if (old_ptr==ptr) return; + old_ptr=ptr; ++#ifndef NOFREE_ERR + FEerror("free(3) error.",0); ++#endif + } + initial_monstartup_pointer_echo=NULL; + return; +-#endif + } + + void * +--- gcl-2.6.12.orig/o/error.c ++++ gcl-2.6.12/o/error.c +@@ -40,8 +40,8 @@ assert_error(const char *a,unsigned l,co + make_simple_string(a),make_fixnum(l), + make_simple_string(f),make_simple_string(n)); + else { +- fprintf(stderr,"The assertion %s on line %d of %s in function %s failed",a,l,f,n); +- exit(-1); ++ emsg("The assertion %s on line %d of %s in function %s failed",a,l,f,n); ++ do_gcl_abort(); + } + + } +@@ -386,7 +386,7 @@ DEFUN_NEW("UNIVERSAL-ERROR-HANDLER",obje + for (i = 0; i < error_fmt_string->st.st_fillp; i++) + fputc(error_fmt_string->st.st_self[i],stdout); + printf("\nLisp initialization failed.\n"); +- exit(0); ++ do_gcl_abort(); + RETURN1(x0); + } + +--- gcl-2.6.12.orig/o/fasldlsym.c ++++ gcl-2.6.12/o/fasldlsym.c +@@ -84,7 +84,7 @@ fasload(object faslfile) { + massert(!psystem(b)); + + if (!(dlp = dlopen(buf,RTLD_NOW))) { +- fputs(dlerror(),stderr); ++ emsg(dlerror()); + FEerror("Cannot open for dynamic link ~a",1,make_simple_string(filename)); + } + +@@ -94,7 +94,7 @@ fasload(object faslfile) { + memcpy(b,x->st.st_self,x->st.st_fillp); + b[x->st.st_fillp]=0; + if (!(fptr=dlsym(dlp,b))) { +- fputs(dlerror(),stderr); ++ emsg(dlerror()); + FEerror("Cannot lookup ~a in ~a",2,make_simple_string(b),make_simple_string(filename)); + } + +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -548,10 +548,8 @@ BEGIN: + + + case smm_socket: +- if (SOCKET_STREAM_FD(strm) < 2) { +- fprintf(stderr,"tried Clsing %d ! as scoket \n",SOCKET_STREAM_FD(strm)); +- fflush(stderr); +- } ++ if (SOCKET_STREAM_FD(strm) < 2) ++ emsg("tried Closing %d ! as socket \n",SOCKET_STREAM_FD(strm)); + else { + #ifdef HAVE_NSOCKET + if (GET_STREAM_FLAG(strm,gcl_sm_output)) +@@ -2180,10 +2178,7 @@ FFN(siLfp_input_stream)() + #ifdef HAVE_NSOCKET + + #ifdef DODEBUG +-#define dprintf(s,arg) \ +- do {fprintf(stderr,s,arg); \ +- fflush(stderr); }\ +- while(0) ++#define dprintf(s,arg) emsg(s,arg) + #else + #define dprintf(s,arg) + #endif +@@ -2457,7 +2452,7 @@ object x=Cnil; + exit(0); + break; + case -1: +- abort(); ++ do_gcl_abort(); + break; + default: + close_stream(y); +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -85,11 +85,9 @@ 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); ++ for (cbpp=&cb_pointer,i=0;*cbpp;cbpp=&((*cbpp)->cb_link),i++) ++ emsg("%lu at %p\n",(*cbpp)->cb_size,*cbpp); ++ emsg("%u blocks\n",i); + return 0; + } + +@@ -285,7 +283,6 @@ long first_protectable_page =0; + static char *copy_relblock(char *p, int s); + + long real_maxpage; +-long new_holepage; + + struct apage { + char apage_self[PAGESIZE]; +@@ -1122,7 +1119,8 @@ GBC(enum type t) { + } + + ngc_thresh=fix(sSAleaf_collection_thresholdA->s.s_dbind); +- ++ recent_allocation=0; ++ + if (in_signal_handler && t == t_relocatable) + error("cant gc relocatable in signal handler"); + +@@ -1198,7 +1196,7 @@ GBC(enum type t) { + + if (COLLECT_RELBLOCK_P) { + static_promotion_limit=rb_starts.s_dbind->v.v_self; +@@ -1337,7 +1331,7 @@ GBC(enum type t) { + tm_table[(int)tm_table[i].tm_type].tm_name); + } + printf("contblock: %ld blocks %ld pages\n", count_contblocks(), ncbpage); +- printf("hole: %ld pages\n", ((rb_start-heap_end)>>PAGEWIDTH)); ++ printf("hole: %lu pages\n", (ufixnum)page(rb_start-heap_end)); + printf("relblock: %ld bytes used %ld bytes free %ld pages\n", + (long)(rb_pointer - rb_start), (long)(rb_end - rb_pointer), nrbpage); + printf("GBC ended\n"); +@@ -1362,34 +1356,6 @@ GBC(enum type t) { + + } + +- { +- extern long opt_maxpage(struct typemanager *); +- +-#define IGNORE_MAX_PAGES (sSAignore_maximum_pagesA ==0 || sSAignore_maximum_pagesA->s.s_dbind !=sLnil) +-#define OPTIMIZE_MAX_PAGES (sSAoptimize_maximum_pagesA ==0 || sSAoptimize_maximum_pagesA->s.s_dbind !=sLnil) +- +- if (IGNORE_MAX_PAGES && OPTIMIZE_MAX_PAGES) +- opt_maxpage(tm_table+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; +@@ -1449,8 +1415,8 @@ FFN(siLroom_report)(void) { + vs_push(make_fixnum(count_contblocks())); + vs_push(make_fixnum(cbgbccount)); + vs_push(make_fixnum((rb_start-heap_end)>>PAGEWIDTH)); +- vs_push(make_fixnum(rb_pointer - (rb_pointercb_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); ++ emsg("%lu %lu starting at %p\n",k,s,p); + } +- fprintf(stderr,"\nTotal free %lu in %lu pieces\n\n",i,j); ++ emsg("\nTotal free %lu in %lu pieces\n\n",i,j); + + for (i=j=k=0;kv.v_fillp && (v=(void *)contblock_array->v.v_self[k]);k++,i+=v->in_use,j++) +- 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); ++ emsg("%lu pages at %p\n",(unsigned long)v->in_use,v); ++ emsg("\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) { +@@ -1548,13 +1514,13 @@ DEFUN_NEW("CONTIGUOUS-REPORT",object,fSc + for (p=pagetochar(page(v)),k=0;ktm_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); ++ emsg("%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); ++ emsg("\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); +@@ -1616,14 +1582,14 @@ DEFUN_NEW("CONTIGUOUS-REPORT",object,fSc + 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); ++ emsg("%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); ++ emsg("\nTotal leaf bytes %lu in %lu pieces\n",i,j); + + return Cnil; + +--- gcl-2.6.12.orig/o/gcl_readline.d ++++ gcl-2.6.12/o/gcl_readline.d +@@ -42,6 +42,8 @@ Foundation, 675 Mass Ave, Cambridge, MA + #include + #include + #include ++#include ++#include + #include + #include + +--- gcl-2.6.12.orig/o/gmp.c ++++ gcl-2.6.12/o/gmp.c +@@ -9,7 +9,7 @@ static void *gcl_gmp_realloc(void *oldme + { + unsigned int *old,*new; + if (!jmp_gmp) { /* No gc in alloc if jmp_gmp */ +- if (MP_SELF(big_gcprotect)) abort(); ++ if (MP_SELF(big_gcprotect)) do_gcl_abort(); + MP_SELF(big_gcprotect)=oldmem; + MP_ALLOCATED(big_gcprotect)=oldsize/MP_LIMB_SIZE; + } +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -204,26 +204,89 @@ get_proc_meminfo_value_in_pages(const ch + massert(!strncmp(c+m," kB\n",4)); + return n>>(PAGEWIDTH-10); + } +- ++ + static ufixnum + get_phys_pages_no_malloc(char freep) { +- ufixnum k=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:"); +- const char *e=getenv("GCL_MEM_MULTIPLE"); +- if (e) { +- double d; +- massert(sscanf(e,"%lf",&d)==1); +- massert(d>=0.0); +- k*=d; +- } +- return k; ++ + } + + #endif + ++static ufixnum ++get_phys_pages(char freep) { ++ ++ return get_phys_pages_no_malloc(freep); ++ ++} ++ ++static void ++get_gc_environ(void) { ++ ++ const char *e;; ++ ++ mem_multiple=1.0; ++ if ((e=getenv("GCL_MEM_MULTIPLE"))) { ++ massert(sscanf(e,"%lf",&mem_multiple)==1); ++ massert(mem_multiple>=0.0); ++ } ++ ++ gc_alloc_min=0.1; ++ if ((e=getenv("GCL_GC_ALLOC_MIN"))) { ++ massert(sscanf(e,"%lf",&gc_alloc_min)==1); ++ massert(gc_alloc_min>=0.0); ++ } ++ ++ gc_page_min=0.5; ++ if ((e=getenv("GCL_GC_PAGE_THRESH"))) { ++ massert(sscanf(e,"%lf",&gc_page_min)==1); ++ massert(gc_page_min>=0.0); ++ } ++ ++ gc_page_max=0.75; ++ if ((e=getenv("GCL_GC_PAGE_MAX"))) { ++ massert(sscanf(e,"%lf",&gc_page_max)==1); ++ massert(gc_page_max>=0.0); ++ } ++ ++ multiprocess_memory_pool=(e=getenv("GCL_MULTIPROCESS_MEMORY_POOL")) && *e; ++ ++ wait_on_abort=0; ++ if ((e=getenv("GCL_WAIT_ON_ABORT"))) ++ massert(sscanf(e,"%lu",&wait_on_abort)==1); ++ ++} ++ ++static void ++setup_maxpages(double scale) { ++ ++ void *beg=data_start ? data_start : sbrk(0); ++ ufixnum maxpages=real_maxpage-page(beg),npages,i; ++ ++ for (npages=0,i=t_start;i=npages); ++ ++ maxpages*=scale; ++ phys_pages*=scale; ++ real_maxpage=maxpages+page(beg); ++ ++ resv_pages=available_pages=0; ++ available_pages=check_avail_pages(); ++ ++ resv_pages=40PAGESIZE;j>>=1) +@@ -253,44 +313,11 @@ update_real_maxpage(void) { + } + massert(!mbrk(cur)); + +-/* 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 */ ++ phys_pages=ufmin(get_phys_pages(0)+page(beg),real_maxpage)-page(beg); + +- maxpages=real_maxpage-page(beg); +- +- phys_pages=phys_pages>maxpages ? maxpages : phys_pages; +- +- resv_pages=available_pages=0; +- available_pages=check_avail_pages(); ++ get_gc_environ(); ++ setup_maxpages(mem_multiple); + +- for (i=t_start;is.s_dbind!=Cnil) { +- +- for (i=t_start,j=0;i>1); +- } +- +- new_holepage=0; +- for (i=t_start;i= dend) { + minimize_image(); +- log_maxpage_bound=l; ++ log_maxpage_bound=l;/*FIXME maybe this should be under mem_multiple, not over*/ + update_real_maxpage(); + maybe_set_hole_from_maxpages(); + } +@@ -384,6 +410,43 @@ gcl_mprotect(void *v,unsigned long l,int + + DEFVAR("*CODE-BLOCK-RESERVE*",sSAcode_block_reserveA,SI,Cnil,""); + ++#define HAVE_GCL_CLEANUP ++ ++void ++gcl_cleanup(int gc) { ++ ++ if (getenv("GCL_WAIT")) ++ sleep(30); ++ ++#ifdef CLEANUP_CODE ++ CLEANUP_CODE ++#elif defined(USE_CLEANUP) ++ {extern void _cleanup(void);_cleanup();} ++#endif ++ ++#ifdef GCL_GPROF ++ gprof_cleanup(); ++#endif ++ ++ if (gc) { ++ ++ saving_system=TRUE; ++ GBC(t_other); ++ saving_system=FALSE; ++ ++ minimize_image(); ++ ++ raw_image=FALSE; ++ cs_org=0; ++ initial_sbrk=core_end; ++ ++ } ++ ++ close_pool(); ++ ++} ++ ++ + int + main(int argc, char **argv, char **envp) { + +@@ -497,6 +560,14 @@ void install_segmentation_catcher(void) + (void) gcl_signal(SIGBUS,segmentation_catcher); + } + ++void ++do_gcl_abort(void) { ++ if (wait_on_abort) ++ sleep(wait_on_abort); ++ gcl_cleanup(0); ++ abort(); ++} ++ + int catch_fatal=1; + void + error(char *s) +@@ -512,7 +583,7 @@ error(char *s) + FEerror("Caught fatal error [memory may be damaged]",0); } + printf("\nUnrecoverable error: %s.\n", s); + fflush(stdout); +- abort(); ++ do_gcl_abort(); + } + + static void +@@ -529,7 +600,7 @@ initlisp(void) { + || NULL_OR_ON_C_STACK(pagetoinfo(first_data_page)) + || NULL_OR_ON_C_STACK(core_end-1)) { + /* check person has correct definition of above */ +- fprintf(stderr,"%p %d " ++ emsg("%p %d " + #if defined(IM_FIX_BASE) + "%p %d %p %d " + #endif +@@ -941,7 +1012,7 @@ static void + FFN(siLinitialization_failure)(void) { + check_arg(0); + printf("lisp initialization failed\n"); +- exit(0); ++ do_gcl_abort(); + } + + DEFUNO_NEW("IDENTITY",object,fLidentity,LISP +@@ -970,7 +1041,6 @@ DEFUN_NEW("LISP-IMPLEMENTATION-VERSION", + RETURN1((make_simple_string(LISP_IMPLEMENTATION_VERSION))); + } + +- + static void + FFN(siLsave_system)(void) { + +@@ -990,12 +1060,6 @@ FFN(siLsave_system)(void) { + DO_BEFORE_SAVE + #endif + +- saving_system = TRUE; +- +- minimize_image(); +- +- saving_system = FALSE; +- + siLsave(); + + } +--- gcl-2.6.12.orig/o/makefile ++++ gcl-2.6.12/o/makefile +@@ -91,6 +91,9 @@ $(DECL): $(HDIR)/make-decl.h $(INI_FILES + grab_defs: grab_defs.c + ${CC} $(OFLAGS) -o grab_defs grab_defs.c + ++wpool: wpool.c ++ $(CC) $(CFLAGS) $(DEFS) -o $@ $< ++ + $(GCLIB): ${ALIB} + rm -f gcllib.a + $(AR) gcllib.a ${ALIB} +@@ -98,6 +101,6 @@ $(GCLIB): ${ALIB} + + clean: + rm -f $(OBJS) ${ALIB} new_init.o $(LAST_FILE) $(FIRST_FILE) *.a grab_defs$(EXE) *.ini tmpx foo.c +- rm -f cmpinclude.h new_init.c $(DECL) def undef udef.h void.h TAGS boot.h ++ rm -f cmpinclude.h new_init.c $(DECL) def undef udef.h void.h TAGS boot.h wpool + + .INTERMEDIATE: $(patsubst %.d,%.c,$(shell ls -1 *.d)) +--- gcl-2.6.12.orig/o/mingwin.c ++++ gcl-2.6.12/o/mingwin.c +@@ -8,10 +8,7 @@ + #include "stdlib.h" + + #ifdef DODEBUG +-#define dprintf(s,arg) \ +- do {fprintf(stderr,s,arg); \ +- fflush(stderr); }\ +- while(0) ++#define dprintf(s,arg) emsg(s,arg) + #else + #define dprintf(s,arg) + #endif +@@ -237,8 +234,7 @@ InitSockets() + * Initialize the winsock library and check the version number. + */ + if ((*winSock.WSAStartup)(MAKEWORD(2,2), &wsaData) != 0) { +- fprintf(stderr,"unloading"); +- fflush(stderr); ++ emsg("unloading"); + goto unloadLibrary; + } + #ifdef WSA_VERSION_REQD +@@ -380,10 +376,8 @@ CreateSocketAddress(sockaddrPtr, host, p + #ifdef DEBUG + static void myerr(char *s,int d) + { +- if (0) { +- fprintf(stderr,s,d); +- fflush(stderr); +- } ++ if (0) ++ emsg(s,d); + + } + #else +@@ -769,8 +763,7 @@ sigint() + #if 0 + BOOL WINAPI inthandler(DWORD i) + { +- fprintf(stderr,"in handler %d",i); +- fflush(stderr); ++ emsg("in handler %d",i); + terminal_interrupt(1); + return TRUE; + } +@@ -812,14 +805,14 @@ void sigterm() + #ifdef SIGABRT + void sigabrt() + { +- exit(SIGABRT); ++ do_gcl_abort(); + } + #endif + + + void sigkill() + { +- exit(SIGKILL); ++ do_gcl_abort(); + } + + +--- gcl-2.6.12.orig/o/nsocket.c ++++ gcl-2.6.12/o/nsocket.c +@@ -4,10 +4,7 @@ + #include + + #ifdef DODEBUG +-#define dprintf(s,arg) \ +- do {fprintf(stderr,s,arg); \ +- fflush(stderr); }\ +- while(0) ++#define dprintf(s,arg) emsg(s,arg) + #else + #define dprintf(s,arg) + #endif +@@ -65,7 +62,7 @@ + #endif + + #define VOID void +-#define ERROR_MESSAGE(msg) do{ fprintf(stderr,msg); exit(1) ; } while(0) ++#define ERROR_MESSAGE(msg) do{ emsg(msg); do_gcl_abort() ; } while(0) + + #ifdef STAND + +@@ -87,7 +84,7 @@ main(argc,argv) + fd = doConnect(argv[1],atoi(argv[2])); + if (fd < 0) { + perror("cant connect"); +- exit(1); ++ do_gcl_abort(); + } + + while (1) { int high; +@@ -512,8 +509,7 @@ getOneChar(FILE *fp) + int high; + /* fprintf(stderr,"",fp); + fflush(stderr); */ +- fprintf(stderr,"in getOneChar, fd=%d,fp=%p",fd,fp); +- fflush(stderr); ++ emsg("in getOneChar, fd=%d,fp=%p",fd,fp); + if (fd == 0) + { joe(fd); + return -1; +@@ -529,16 +525,14 @@ getOneChar(FILE *fp) + if (high > 0) + { + int ch ; +- fprintf(stderr,"in getOneChar, fd=%d,fp=%p",fd,fp); +- fflush(stderr); ++ emsg("in getOneChar, fd=%d,fp=%p",fd,fp); + ch = getc(fp); + if ( ch != EOF || feof(fp) ) { + /* fprintf(stderr,"< 0x%x returning %d,%c>\n",fp,ch,ch); + fflush(stderr); + */ + } +- fprintf(stderr,"in getOneChar, ch= %c,%d\n",ch,ch); +- fflush(stderr); ++ emsg("in getOneChar, ch= %c,%d\n",ch,ch); + CHECK_INTERRUPT; + if (ch != EOF) return ch; + if (feof(fp)) return EOF; +@@ -548,10 +542,7 @@ getOneChar(FILE *fp) + } + + #ifdef DODEBUG +-#define dprintf(s,arg) \ +- do {fprintf(stderr,s,arg); \ +- fflush(stderr); }\ +- while(0) ++#define dprintf(s,arg) emsg(s,arg) + #else + #define dprintf(s,arg) + #endif +--- gcl-2.6.12.orig/o/prelink.c ++++ gcl-2.6.12/o/prelink.c +@@ -2,6 +2,7 @@ + + #include "include.h" + ++#if !defined(__MINGW32__) && !defined(__CYGWIN__) + extern FILE *stdin __attribute__((weak)); + extern FILE *stderr __attribute__((weak)); + extern FILE *stdout __attribute__((weak)); +@@ -13,6 +14,7 @@ extern char *rl_readline_name __attribu + extern rl_compentry_func_t *rl_completion_entry_function __attribute__((weak)); + extern const char *rl_readline_name __attribute__((weak)); + #endif ++#endif + + void + prelink_init(void) { +--- gcl-2.6.12.orig/o/print.d ++++ gcl-2.6.12/o/print.d +@@ -390,14 +390,14 @@ edit_double(int n, double d, int *sp, ch + + truncate_double(b,d,n!=7); + +- if (isdigit(b[0])) { ++ if (isdigit((int)b[0])) { + b[1]=b[0]; + (*ep)++; + } + if (b[2]=='0') (*ep)++; + b[2] = b[1]; + p = b + 2; +- for (i=0;i sizeof(buf)) +- { fprintf(stderr,"wow that is badly defined regexp.."); +- exit(1);} ++ { emsg("wow that is badly defined regexp.."); ++ do_gcl_abort();} + regcp --; + { char *p=buf; + +@@ -567,8 +567,8 @@ regatom(int *flagp) + while (p < regcp) + { result[*(unsigned char *)p] = matches; + if (case_fold_search) +- {result[tolower(*p)] = matches; +- result[toupper(*p)] = matches; p++;} ++ {result[tolower((int)*p)] = matches; ++ result[toupper((int)*p)] = matches; p++;} + else + result[*(unsigned char *)p++] = matches; + +@@ -912,9 +912,9 @@ regexec(register regexp *prog, register + if (prog->regstart != '\0') + /* We know what char it must start with. */ + { if (case_fold_search) +- {char ch = tolower(prog->regstart); ++ {char ch = tolower((int)prog->regstart); + while (*s) +- { if (tolower(*s)==ch) ++ { if (tolower((int)*s)==ch) + {if (regtry(prog, s)) + RETURN_VAL(1);} + s++;}} +@@ -1025,12 +1025,12 @@ regmatch(char *prog) + scan = prog; + #ifdef DEBUG + if (scan != NULL && regnarrate) +- fprintf(stderr, "%s(\n", regprop(scan)); ++ emsg("%s(\n", regprop(scan)); + #endif + while (scan != NULL) { + #ifdef DEBUG + if (regnarrate) +- fprintf(stderr, "%s...\n", regprop(scan)); ++ emsg("%s...\n", regprop(scan)); + #endif + next = regnext(scan); + +@@ -1055,7 +1055,7 @@ regmatch(char *prog) + opnd = OPERAND(scan); + if (case_fold_search) + while (*opnd ) +- { if (tolower(*opnd) != tolower(*ch)) ++ { if (tolower((int)*opnd) != tolower((int)*ch)) + return 0; + else { ch++; opnd++;}} + else +@@ -1175,7 +1175,7 @@ regmatch(char *prog) + if (OP(next) == EXACTLY) + nextch = *OPERAND(next); + if (case_fold_search) +- nextch = tolower(nextch); ++ nextch = tolower((int)nextch); + min = (OP(scan) == STAR) ? 0 : 1; + save = reginput; + no = regrepeat(OPERAND(scan)); +@@ -1184,7 +1184,7 @@ regmatch(char *prog) + if (nextch == '\0' || + *reginput == nextch + || (case_fold_search && +- tolower(*reginput) == nextch)) ++ tolower((int)*reginput) == nextch)) + if (regmatch(next)) + return(1); + /* Couldn't or didn't -- back up. */ +@@ -1237,8 +1237,8 @@ regrepeat(char *p) + case EXACTLY: + { char ch = *opnd; + if (case_fold_search) +- { ch = tolower(*opnd); +- while (ch == tolower(*scan)) ++ { ch = tolower((int)*opnd); ++ while (ch == tolower((int)*scan)) + { + count++; + scan++;}} +@@ -1488,7 +1488,7 @@ min_initial_branch_length(regexp *x, uns + { op = OP(s); + next = (s) + NEXT(s); + if (op != END && op != BRANCH) +- abort(); ++ do_gcl_abort(); + s = s+3; + { int this = 0; + int anythis =0; +@@ -1509,8 +1509,8 @@ min_initial_branch_length(regexp *x, uns + n--; + while(1) + { if (case_fold_search) +- {MINIMIZE(buf[tolower(*ss)],n); +- MINIMIZE(buf[toupper(*ss)],n); ++ {MINIMIZE(buf[tolower((int)*ss)],n); ++ MINIMIZE(buf[toupper((int)*ss)],n); + } + else + { MINIMIZE(buf[*(unsigned char *)ss],n);} +@@ -1575,7 +1575,7 @@ min_initial_branch_length(regexp *x, uns + void + regerror(char *s) + { +- fprintf(stderr, "regexp error %s\n", s); ++ emsg("regexp error %s\n", s); + } + #endif + +--- gcl-2.6.12.orig/o/run_process.c ++++ gcl-2.6.12/o/run_process.c +@@ -140,19 +140,19 @@ void run_process ( char *name ) + if ( ! CloseHandle ( hChildStderrWrite ) ) DisplayError ( "CloseHandle: Error write" ); + + #if 0 +- fprintf ( stderr, "Before write\n" ); ++ emsg("Before write\n" ); + WriteFile ( hChildStdinWrite, chBuf, strlen ( chBuf ), + &dwWritten, NULL); + FlushFileBuffers ( hChildStdinWrite ); + FlushFileBuffers ( hChildStdoutRead ); +- fprintf ( stderr, "Before read\n" ); ++ emsg("Before read\n" ); + if ( ! ReadFile( hChildStdoutRead, chBuf, 2, &dwRead, NULL ) || + dwRead == 0 ) { + DisplayError ( "Nothing read\n" ); + } else { +- fprintf ( stderr, "Got Back: %s\n", chBuf ); ++ emsg("Got Back: %s\n", chBuf ); + } +- fprintf ( stderr, "After read\n" ); ++ emsg("After read\n" ); + #endif + + +@@ -168,8 +168,7 @@ void run_process ( char *name ) + fprintf ( ifp, "button .wibble\n" ); + fflush (ifp); + fgets ( buf, 2, ofp ); +- fprintf ( stderr, +- "run_process: ofd = %x, ofp = %x, ifd = %x, ifp = %x, buf[0] = %x, buf[1] = %x, buf = %s\n", ++ emsg("run_process: ofd = %x, ofp = %x, ifd = %x, ifp = %x, buf[0] = %x, buf[1] = %x, buf = %s\n", + ofd, ofp, ifd, ifp, buf[0], buf[1], buf ); + } + #endif +@@ -276,7 +275,7 @@ void siLrun_process() + strcat ( cmdline, " "); + } + strcat ( cmdline, vs_base[i]->st.st_self ); +- fprintf ( stderr, "siLrun_process: cmdline=%s\n", cmdline ); ++ emsg("siLrun_process: cmdline=%s\n", cmdline ); + argc++; + } + signals_allowed = sig_at_read; +@@ -540,12 +539,11 @@ char **argv; + massert(dup(fdin)>=0); + close(1); + massert(dup(fdout)>=0); +- fprintf(stderr, "\n***** Spawning process %s ", pname); ++ emsg("\n***** Spawning process %s ", pname); + if (execvp(pname, argv) == -1) + { +- fprintf(stderr, "\n***** Error in process spawning *******"); +- fflush(stderr); +- exit(1); ++ emsg("\n***** Error in process spawning *******"); ++ do_gcl_abort(); + } + } + +@@ -604,7 +602,7 @@ getpagesize() + } + + dlclose() +-{fprintf(stderr,"calling 'dl' function sun did not supply..exitting") ;exit(1);} ++{emsg("calling 'dl' function sun did not supply..exitting") ;do_gcl_abort();} + dgettext() + {dlclose();} + dlopen() +--- gcl-2.6.12.orig/o/save.c ++++ gcl-2.6.12/o/save.c +@@ -20,21 +20,12 @@ 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); + +-#ifdef CLEANUP_CODE +- CLEANUP_CODE +-#elif defined(USE_CLEANUP) +- _cleanup(); +-#endif +- +- raw_image=FALSE; +- cs_org=0; +- initial_sbrk=core_end; ++ gcl_cleanup(1); + + #ifdef MEMORY_SAVE + MEMORY_SAVE(kcl_self,filename); +--- gcl-2.6.12.orig/o/sfaslcoff.c ++++ gcl-2.6.12/o/sfaslcoff.c +@@ -175,7 +175,7 @@ relocate_symbols(struct syment *sym,stru + if ((answ=find_sym_ptable(s))) + sym->n_value=answ->address; + else +- massert(!fprintf(stderr,"Unrelocated non-local symbol: %s\n",s)); ++ massert(!emsg("Unrelocated non-local symbol: %s\n",s)); + + if (c) + sym->n.n_name[8]=c; +--- gcl-2.6.12.orig/o/sfaslelf.c ++++ gcl-2.6.12/o/sfaslelf.c +@@ -181,7 +181,7 @@ relocate(Sym *sym1,void *v,ul a,ul start + #include RELOC_H + + default: +- fprintf(stderr, "Unknown reloc type %lu\n", tp); ++ emsg("Unknown reloc type %lu\n", tp); + massert(tp&~tp); + + } +@@ -234,7 +234,7 @@ relocate_symbols(Sym *sym,Sym *syme,Shdr + sym->st_value=a->address; + + else if (ELF_ST_BIND(sym->st_info)!=STB_LOCAL) +- massert(!fprintf(stderr,"Unrelocated non-local symbol: %s\n",st1+sym->st_name)); ++ massert(!emsg("Unrelocated non-local symbol: %s\n",st1+sym->st_name)); + + } + +--- gcl-2.6.12.orig/o/sfasli.c ++++ gcl-2.6.12/o/sfasli.c +@@ -146,6 +146,15 @@ use_symbols(double d,...) { + + } + #endif ++#else ++int ++use_symbols(double d,...) { ++ ++ d=sin(d)+cos(d); ++ ++ return (int)d; ++ ++} + #endif + + void +--- gcl-2.6.12.orig/o/sfaslmacho.c ++++ gcl-2.6.12/o/sfaslmacho.c +@@ -144,7 +144,7 @@ relocate_symbols(struct nlist *n1,struct + else if ((nd=find_sym_ptable(st1+n->n_un.n_strx))) + n->n_value=nd->address; + else if (n->n_type&(N_PEXT|N_EXT)) +- massert(!fprintf(stderr,"Unrelocated non-local symbol: %s\n",st1+n->n_un.n_strx)); ++ massert(!emsg("Unrelocated non-local symbol: %s\n",st1+n->n_un.n_strx)); + + return 0; + +--- gcl-2.6.12.orig/o/sfaslmacosx.c ++++ gcl-2.6.12/o/sfaslmacosx.c +@@ -37,17 +37,7 @@ typedef int (*func) (); + /* Externalize the command line used to build loadable object files (a.k.a. bundles). */ + object sSAmacosx_ldcmdA = 0L; + +-static void sfasl_error (char *format, ...) +-{ +- va_list ap; +- +- va_start (ap, format); +- fprintf (stderr, "fasload: "); +- vfprintf (stderr, format, ap); +- fprintf (stderr, "\n"); +- va_end (ap); +- exit (1); +-} ++#define sfasl_error(a,b...) {emsg(a,b);do_gcl_abort();} + + /* static void get_init_name (object faslfile, char *init_fun) */ + /* { */ +--- gcl-2.6.12.orig/o/sgbc.c ++++ gcl-2.6.12/o/sgbc.c +@@ -266,32 +266,32 @@ overlap_check(struct contblock *t1,struc + + if (!inheap(t1)) { + fprintf(stderr,"%p not in heap\n",t1); +- exit(1); ++ do_gcl_abort(); + } + + for (p=t2;p;p=p->cb_link) { + + if (!inheap(p)) { + fprintf(stderr,"%p not in heap\n",t1); +- exit(1); ++ do_gcl_abort(); + } + + if ((p<=t1 && (void *)p+p->cb_size>(void *)t1) || + (t1<=p && (void *)t1+t1->cb_size>(void *)p)) { + fprintf(stderr,"Overlap %u %p %u %p\n",t1->cb_size,t1,p->cb_size,p); +- exit(1); ++ do_gcl_abort(); + } + + if (p==p->cb_link) { + fprintf(stderr,"circle detected at %p\n",p); +- exit(1); ++ do_gcl_abort(); + } + + } + + if (t1==t1->cb_link) { + fprintf(stderr,"circle detected at %p\n",t1); +- exit(1); ++ do_gcl_abort(); + } + + } +@@ -365,7 +365,7 @@ memprotect_handler_test(int sig, long co + + if (memprotect_handler_invocations) { + memprotect_result=memprotect_multiple_invocations; +- exit(-1); ++ do_gcl_abort(); + } + memprotect_handler_invocations=1; + if (faddr!=memprotect_test_address) +@@ -387,7 +387,7 @@ memprotect_test(void) { + return memprotect_result!=memprotect_success; + if (atexit(memprotect_print)) { + fprintf(stderr,"Cannot setup memprotect_print on exit\n"); +- exit(-1); ++ do_gcl_abort(); + } + + if (!(b1=alloca(2*p))) { +--- gcl-2.6.12.orig/o/sockets.c ++++ gcl-2.6.12/o/sockets.c +@@ -70,7 +70,7 @@ int w32_socket_init(void) + } else { + if (WSAStartup(0x0101, &WSAData)) { + w32_socket_initialisations = 0; +- fprintf ( stderr, "WSAStartup failed\n" ); ++ emsg("WSAStartup failed\n" ); + WSACleanup(); + rv = -1; + } +@@ -158,13 +158,9 @@ the socket. If PORT is zero do automati + #endif + (cRetry < BIND_MAX_RETRY)); + if (0) +- { +- fprintf(stderr, +- "\nAssigned automatic address to socket : port(%d), errno(%d), bind_rc(%d), iLastAddressUsed(%d), retries(%d)\n" ++ emsg("\nAssigned automatic address to socket : port(%d), errno(%d), bind_rc(%d), iLastAddressUsed(%d), retries(%d)\n" + , addr.sin_port, errno, rc, iLastAddressUsed, cRetry + ); +- fflush(stderr); +- } + } + else + { +@@ -221,8 +217,7 @@ and returns (list* named_socket fd name1 + fd = accept(fix(car(named_socket)) , (struct sockaddr *)&addr, &n); + if (fd < 0) + { +- perror("ERROR ! accept on socket failed in sock_accept_connection"); +- fflush(stderr); ++ emsg("ERROR ! accept on socket failed in sock_accept_connection"); + return Cnil; + } + x = alloc_simple_string(sizeof(struct connection_state)); +@@ -432,7 +427,7 @@ fill pointer, and this will be advanced. + + + break; +- default: abort(); ++ default: do_gcl_abort(); + } + + switch (t) { +@@ -446,7 +441,7 @@ fill pointer, and this will be advanced. + if (downcase) + while (--len>=0) + { char c = *p++; +- c=tolower(c); ++ c=tolower((int)c); + if(needs_quoting[(unsigned char)c]) + PUSH('\\'); + PUSH(c);} +--- gcl-2.6.12.orig/o/unexelf.c ++++ gcl-2.6.12/o/unexelf.c +@@ -401,7 +401,7 @@ Filesz Memsz Flags Alig + Instead we read the whole file, modify it, and write it out. */ + + #ifndef emacs +-#define fatal(a, b...) fprintf (stderr, a, ##b), exit (1) ++#define fatal(a, b...) emsg(a,##b),do_gcl_abort() + #else + #include "config.h" + extern void fatal (char *, ...); +@@ -604,7 +604,7 @@ find_section (char *name, char *section_ + for (idx = 1; idx < old_file_h->e_shnum; idx++) + { + #ifdef DEBUG +- fprintf (stderr, "Looking for %s - found %s\n", name, ++ emsg("Looking for %s - found %s\n", name, + section_names + OLD_SECTION_H (idx).sh_name); + #endif + if (!strcmp (section_names + OLD_SECTION_H (idx).sh_name, +@@ -752,13 +752,13 @@ unexec (char *new_name, char *old_name, + (new_data2_addr - OLD_SECTION_H (old_data_index).sh_addr); + + #ifdef DEBUG +- fprintf (stderr, "old_bss_index %d\n", old_bss_index); +- fprintf (stderr, "old_bss_addr %x\n", old_bss_addr); +- fprintf (stderr, "old_bss_size %x\n", old_bss_size); +- fprintf (stderr, "new_bss_addr %x\n", new_bss_addr); +- fprintf (stderr, "new_data2_addr %x\n", new_data2_addr); +- fprintf (stderr, "new_data2_size %x\n", new_data2_size); +- fprintf (stderr, "new_data2_offset %x\n", new_data2_offset); ++ emsg("old_bss_index %d\n", old_bss_index); ++ emsg("old_bss_addr %x\n", old_bss_addr); ++ emsg("old_bss_size %x\n", old_bss_size); ++ emsg("new_bss_addr %x\n", new_bss_addr); ++ emsg("new_data2_addr %x\n", new_data2_addr); ++ emsg("new_data2_size %x\n", new_data2_size); ++ emsg("new_data2_offset %x\n", new_data2_offset); + #endif + + if ((unsigned) new_bss_addr < (unsigned) old_bss_addr + old_bss_size) +@@ -806,10 +806,10 @@ unexec (char *new_name, char *old_name, + new_file_h->e_shnum += 1; + + #ifdef DEBUG +- fprintf (stderr, "Old section offset %x\n", old_file_h->e_shoff); +- fprintf (stderr, "Old section count %d\n", old_file_h->e_shnum); +- fprintf (stderr, "New section offset %x\n", new_file_h->e_shoff); +- fprintf (stderr, "New section count %d\n", new_file_h->e_shnum); ++ emsg("Old section offset %x\n", old_file_h->e_shoff); ++ emsg("Old section count %d\n", old_file_h->e_shnum); ++ emsg("New section offset %x\n", new_file_h->e_shoff); ++ emsg("New section count %d\n", new_file_h->e_shnum); + #endif + + /* Fix up a new program header. Extend the writable data segment so +--- gcl-2.6.12.orig/o/unexmacosx.c ++++ gcl-2.6.12/o/unexmacosx.c +@@ -299,18 +299,7 @@ unexec_copy (off_t dest, off_t src, ssiz + + /* Debugging and informational messages routines. */ + +-static void +-unexec_error (char *format, ...) +-{ +- va_list ap; +- +- va_start (ap, format); +- fprintf (stderr, "unexec: "); +- vfprintf (stderr, format, ap); +- fprintf (stderr, "\n"); +- va_end (ap); +- exit (1); +-} ++#define unexec_error(a,b...) emsg(a,##b),do_gcl_abort() + + /* More informational messages routines. */ + +--- gcl-2.6.12.orig/o/unexnt.c ++++ gcl-2.6.12/o/unexnt.c +@@ -108,7 +108,7 @@ void recreate_heap1() + if (GetModuleFileName (NULL, executable_path, MAX_PATH) == 0) + { + printf ("Failed to find path for executable.\n"); +- exit (1); ++ do_gcl_abort(); + } + recreate_heap (executable_path); + } +@@ -156,7 +156,7 @@ _start (void) + if (GetModuleFileName (NULL, executable_path, MAX_PATH) == 0) + { + printf ("Failed to find path for executable.\n"); +- exit (1); ++ do_gcl_abort(); + } + + #if 1 +@@ -214,7 +214,7 @@ unexec (char *new_name, char *old_name, + void *entry_address) + { + #ifdef __CYGWIN32__ +- file_data in_file, out_file; ++ static file_data in_file, out_file; + char out_filename[MAX_PATH], in_filename[MAX_PATH]; + char filename[MAX_PATH]; + unsigned long size; +@@ -244,7 +244,7 @@ unexec (char *new_name, char *old_name, + strcat(filename, (strcmp (ptr, ".exe") && strcmp (ptr, ".EXE"))?".exe":""); + cygwin_conv_to_full_win32_path(filename,out_filename); + #else +- file_data in_file, out_file; ++ static file_data in_file, out_file; + char out_filename[MAX_PATH], in_filename[MAX_PATH]; + unsigned long size; + char *ptr; +@@ -284,7 +284,7 @@ unexec (char *new_name, char *old_name, + { + printf ("Failed to open %s (%ld)...bailing.\n", + in_filename, GetLastError ()); +- exit (1); ++ do_gcl_abort(); + } + + /* Get the interesting section info, like start and size of .bss... */ +@@ -305,7 +305,7 @@ unexec (char *new_name, char *old_name, + { + printf ("Failed to open %s (%ld)...bailing.\n", + out_filename, GetLastError ()); +- exit (1); ++ do_gcl_abort(); + } + + /* Set the flag (before dumping). */ +@@ -452,7 +452,7 @@ get_bss_info_from_map_file (file_data *p + { + printf ("Failed to open map file %s, error %d...bailing out.\n", + map_filename, GetLastError ()); +- exit (-1); ++ do_gcl_abort(); + } + + while (fgets (buffer, sizeof (buffer), map)) +@@ -463,7 +463,7 @@ get_bss_info_from_map_file (file_data *p + if (n != 2) + { + printf ("Failed to scan the .bss section line:\n%s", buffer); +- exit (-1); ++ do_gcl_abort(); + } + break; + } +@@ -534,7 +534,7 @@ get_section_info (file_data *p_infile) + if (dos_header->e_magic != IMAGE_DOS_SIGNATURE) + { + printf ("Unknown EXE header in %s...bailing.\n", p_infile->name); +- exit (1); ++ do_gcl_abort(); + } + nt_header = (PIMAGE_NT_HEADERS) (((unsigned long) dos_header) + + dos_header->e_lfanew); +@@ -542,7 +542,7 @@ get_section_info (file_data *p_infile) + { + printf ("Failed to find IMAGE_NT_HEADER in %s...bailing.\n", + p_infile->name); +- exit (1); ++ do_gcl_abort(); + } + + /* Check the NT header signature ... */ +@@ -729,7 +729,7 @@ read_in_bss (char *filename) + if (file == INVALID_HANDLE_VALUE) + { + i = GetLastError (); +- exit (1); ++ do_gcl_abort(); + } + + /* Seek to where the .bss section is tucked away after the heap... */ +@@ -737,7 +737,7 @@ read_in_bss (char *filename) + if (SetFilePointer (file, index, NULL, FILE_BEGIN) == 0xFFFFFFFF) + { + i = GetLastError (); +- exit (1); ++ do_gcl_abort(); + } + + +@@ -746,7 +746,7 @@ read_in_bss (char *filename) + if (!ReadFile (file, bss_start, bss_size, &n_read, (void *)NULL)) + { + i = GetLastError (); +- exit (1); ++ do_gcl_abort(); + } + + CloseHandle (file); +@@ -767,7 +767,7 @@ map_in_heap (char *filename) + if (file == INVALID_HANDLE_VALUE) + { + i = GetLastError (); +- exit (1); ++ do_gcl_abort(); + } + + size = GetFileSize (file, &upper_size); +@@ -776,7 +776,7 @@ map_in_heap (char *filename) + if (!file_mapping) + { + i = GetLastError (); +- exit (1); ++ do_gcl_abort(); + } + + size = get_committed_heap_size (); +@@ -797,7 +797,7 @@ map_in_heap (char *filename) + MEM_RESERVE | MEM_COMMIT, PAGE_READWRITE) == NULL) + { + i = GetLastError (); +- exit (1); ++ do_gcl_abort(); + } + + /* Seek to the location of the heap data in the executable. */ +@@ -805,7 +805,7 @@ map_in_heap (char *filename) + if (SetFilePointer (file, i, NULL, FILE_BEGIN) == 0xFFFFFFFF) + { + i = GetLastError (); +- exit (1); ++ do_gcl_abort(); + } + + /* Read in the data. */ +@@ -813,7 +813,7 @@ map_in_heap (char *filename) + get_committed_heap_size (), &n_read, (void *)NULL)) + { + i = GetLastError (); +- exit (1); ++ do_gcl_abort(); + } + + CloseHandle (file); +@@ -1009,7 +1009,7 @@ sbrk (ptrdiff_t increment) + if (((unsigned long) data_region_base & ~VALMASK) != 0) + { + printf ("Error: The heap was allocated in upper memory.\n"); +- exit (1); ++ do_gcl_abort(); + } + + data_region_end = data_region_base; +@@ -1090,7 +1090,7 @@ recreate_heap (char *executable_path) { + MEM_RESERVE, + PAGE_NOACCESS); + if (!tmp) +- exit (1); ++ do_gcl_abort(); + + /* We read in the data for the .bss section from the executable + first and map in the heap from the executable second to prevent +--- gcl-2.6.12.orig/o/unixsave.c ++++ gcl-2.6.12/o/unixsave.c +@@ -105,16 +105,16 @@ char *original_file, *save_file; + */ + + if (stdin != original || original->_file != 0) { +- fprintf(stderr, "Can't open the original file.\n"); +- exit(1); ++ emsg("Can't open the original file.\n"); ++ do_gcl_abort(); + } + setbuf(original, stdin_buf); + fclose(stdout); + unlink(save_file); + n = open(save_file, O_CREAT|O_WRONLY, 0777); + if (n != 1 || (save = fdopen(n, "w")) != stdout) { +- fprintf(stderr, "Can't open the save file.\n"); +- exit(1); ++ emsg("Can't open the save file.\n"); ++ do_gcl_abort(); + } + setbuf(save, stdout_buf); + +--- gcl-2.6.12.orig/o/unixsys.c ++++ gcl-2.6.12/o/unixsys.c +@@ -28,11 +28,6 @@ Foundation, 675 Mass Ave, Cambridge, MA + + #include "include.h" + +-#ifdef _WIN32 +-#include +-#define sleep(n) Sleep(1000 * n) +-#endif +- + #ifdef ATT3B2 + #include + int +--- gcl-2.6.12.orig/o/usig.c ++++ gcl-2.6.12/o/usig.c +@@ -295,12 +295,18 @@ sigio(void) + {ifuncall1(sSsigio_interrupt,Cnil);} + + ++static void ++sigterm(void) ++{do_gcl_abort();} ++ ++ + + void + install_default_signals(void) + { gcl_signal(SIGFPE, sigfpe3); + gcl_signal(SIGPIPE, sigpipe); + gcl_signal(SIGINT, sigint); ++ gcl_signal(SIGTERM, sigterm); + gcl_signal(SIGUSR1, sigusr1); + gcl_signal(SIGIO, sigio); + gcl_signal(SIGALRM, sigalrm); +--- gcl-2.6.12.orig/o/usig2.c ++++ gcl-2.6.12/o/usig2.c +@@ -259,7 +259,7 @@ before_interrupt(struct save_for_interru + /* #define XS(a) *pp++ = * (void **) (&a); */ + #include "usig2_aux.c" + if ((pp - (&(p->save_objects)[0])) >= (sizeof(p->save_objects)/sizeof(void *))) +- abort(); ++ do_gcl_abort(); + } + #define MINN(a,b) (atoken_st_dim = MINN(token->st.st_dim,tok_leng+1); +--- /dev/null ++++ gcl-2.6.12/o/wpool.c +@@ -0,0 +1,35 @@ ++#include ++ ++#define NO_PRELINK_UNEXEC_DIVERSION ++char *rb_end=NULL,*rb_start=NULL,*heap_end=NULL; ++void *data_start=NULL; ++int use_pool=1; ++ ++#include "include.h" ++#include "page.h" ++#include "pool.h" ++ ++/*lintian*/ ++void ++assert_error(const char *a,unsigned l,const char *f,const char *n) { ++ update_pool(0); ++ get_pool(); ++ pool_check(); ++} ++ ++int ++main(int argc,char * argv[],char * envp[]) { ++ ++ int s; ++ ++ sscanf(argv[1],"%d",&s); ++ open_pool(); ++ for (;;) { ++ lock_pool(); ++ fprintf(stderr,"master pid %lu %lu processess %lu pages\n",Pool->pid,Pool->n,Pool->s); ++ fflush(stderr); ++ unlock_pool(); ++ sleep(s); ++ } ++ return 0; ++} diff --git a/patches/Version_2_6_13pre17 b/patches/Version_2_6_13pre17 new file mode 100644 index 00000000..354686f7 --- /dev/null +++ b/patches/Version_2_6_13pre17 @@ -0,0 +1,76 @@ +Description: + 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-13) unstable; urgency=medium + . + * Version_2_6_13pre16 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -749,11 +749,15 @@ alloc_from_freelist(struct typemanager * + static inline void + grow_linear1(struct typemanager *tm) { + +- fixnum maxgro=resv_pages ? available_pages : 0; ++ if (!sSAoptimize_maximum_pagesA || sSAoptimize_maximum_pagesA->s.s_dbind==Cnil) { + +- if (tm->tm_type==t_relocatable) maxgro>>=1; ++ fixnum maxgro=resv_pages ? available_pages : 0; + +- set_tm_maxpage(tm,grow_linear(tm->tm_npage,tm->tm_growth_percent,tm->tm_min_grow, tm->tm_max_grow,maxgro)); ++ if (tm->tm_type==t_relocatable) maxgro>>=1; ++ ++ set_tm_maxpage(tm,grow_linear(tm->tm_npage,tm->tm_growth_percent,tm->tm_min_grow, tm->tm_max_grow,maxgro)); ++ ++ } + + } + +@@ -802,7 +806,8 @@ do_gc_p(struct typemanager *tm,fixnum n) + + pp=gc_page_max*phys_pages; + +- return page(recent_allocation)>(1.0+gc_alloc_min-(double)ufmin(cpool,pp)/pp)*data_pages(); ++ return page(recent_allocation)>(1.0+gc_alloc_min-(double)ufmin(cpool,pp)/pp)*data_pages() || ++ 2*tpage(tm,n)>available_pages; + + } + +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -236,7 +236,7 @@ get_gc_environ(void) { + massert(mem_multiple>=0.0); + } + +- gc_alloc_min=0.1; ++ gc_alloc_min=0.05; + if ((e=getenv("GCL_GC_ALLOC_MIN"))) { + massert(sscanf(e,"%lf",&gc_alloc_min)==1); + massert(gc_alloc_min>=0.0); +@@ -280,7 +280,7 @@ setup_maxpages(double scale) { + resv_pages=available_pages=0; + available_pages=check_avail_pages(); + +- resv_pages=40 + 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-14) unstable; urgency=medium + . + * Version_2_6_13pre17 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -82,7 +82,7 @@ + + (defun safe-system (string) + (multiple-value-bind +- (code result) (system (ts string)) ++ (code result) (system (mysub (ts string) "$" "\\$")) + (unless (and (zerop code) (zerop result)) + (cerror "Continues anyway." + "(SYSTEM ~S) returned a non-zero value ~D." +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -715,6 +715,7 @@ infodir + docdir + oldincludedir + includedir ++runstatedir + localstatedir + sharedstatedir + sysconfdir +@@ -821,6 +822,7 @@ datadir='${datarootdir}' + sysconfdir='${prefix}/etc' + sharedstatedir='${prefix}/com' + localstatedir='${prefix}/var' ++runstatedir='${localstatedir}/run' + includedir='${prefix}/include' + oldincludedir='/usr/include' + docdir='${datarootdir}/doc/${PACKAGE}' +@@ -1073,6 +1075,15 @@ do + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + ++ -runstatedir | --runstatedir | --runstatedi | --runstated \ ++ | --runstate | --runstat | --runsta | --runst | --runs \ ++ | --run | --ru | --r) ++ ac_prev=runstatedir ;; ++ -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ ++ | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ ++ | --run=* | --ru=* | --r=*) ++ runstatedir=$ac_optarg ;; ++ + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ +@@ -1210,7 +1221,7 @@ fi + for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ +- libdir localedir mandir ++ libdir localedir mandir runstatedir + do + eval ac_val=\$$ac_var + # Remove trailing slashes. +@@ -1363,6 +1374,7 @@ Fine tuning of the installation director + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] ++ --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] +@@ -4423,6 +4435,7 @@ case $use in + # if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi + ;; + mips*) ++ TCFLAGS="$TCFLAGS -mplt" + # if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 + ;; + ia64*) +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -640,6 +640,7 @@ case $use in + # if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi + ;; + mips*) ++ TCFLAGS="$TCFLAGS -mplt" + # if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 + ;; + ia64*) +--- gcl-2.6.12.orig/h/elf32_mips_reloc.h ++++ gcl-2.6.12/h/elf32_mips_reloc.h +@@ -19,10 +19,7 @@ + case R_MIPS_CALL16: + gote=got+sym->st_size-1; + store_val(where,MASK(16),((void *)gote-(void *)got)); +- if (s>=ggot && sst_other) s=gpd=(ul)got-(sym->st_other==2 ? 0 : (ul)where); +@@ -37,7 +34,8 @@ + a+=(a&0x8000)<<1; + store_val(where,MASK(16),a); + a=0x10000|(a>>16); +- for (hr=hr ? hr : r;--r>=hr && ELF_R_TYPE(r->r_info)==R_MIPS_HI16;) +- relocate(sym1,r,a,start,got,gote); ++ for (hr=hr ? hr : r;--r>=hr;) ++ if (ELF_R_TYPE(r->r_info)==R_MIPS_HI16) ++ relocate(sym1,r,a,start,got,gote); + hr=NULL;gpd=0; + break; +--- gcl-2.6.12.orig/h/elf32_mips_reloc_special.h ++++ gcl-2.6.12/h/elf32_mips_reloc_special.h +@@ -1,65 +1,9 @@ +-static ul gpd,ggot,ggote; static Rel *hr; +- +-static int +-write_stub(ul s,ul *got,ul *gote) { +- +- *gote=(ul)(gote+2); +- *++gote=s; +- s=((void *)gote-(void *)got); +- *++gote=(0x23<<26)|(0x1c<<21)|(0x19<<16)|s; +- *++gote=(0x23<<26)|(0x19<<21)|(0x19<<16)|0; +- *++gote=0x03200008; +- *++gote=0x00200825; +- +- return 0; +- +-} +- +-static int +-make_got_room_for_stub(Shdr *sec1,Shdr *sece,Sym *sym,const char *st1,ul *gs) { +- +- Shdr *ssec=sec1+sym->st_shndx; +- struct node *a; +- if ((ssec>=sece || !ALLOC_SEC(ssec)) && +- (a=find_sym_ptable(st1+sym->st_name)) && +- a->address>=ggot && a->addresssh_addr,pe=p+sec->sh_size;psh_entsize) { +- q=p; +- if (q[0]==DT_MIPS_GOTSYM) +- gotsym=q[1]; +- if (q[0]==DT_MIPS_LOCAL_GOTNO) +- locgotno=q[1]; +- +- } +- massert(gotsym && locgotno); +- +- massert(sec=get_section(".MIPS.stubs",sec1,sece,sn)); +- stub=sec->sh_addr; +- stube=sec->sh_addr+sec->sh_size; +- +- massert(sec=get_section(".got",sec1,sece,sn)); +- ggot=sec->sh_addr+locgotno*sec->sh_entsize; +- ggote=sec->sh_addr+sec->sh_size; +- +- for (ds1+=gotsym,sym=ds1;symst_value || (sym->st_value>=stub && sym->st_valuest_value=ggot+(sym-ds1)*sec->sh_entsize; +- + return 0; + + } +@@ -74,7 +18,7 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + ul q; + + for (q=0,sym=sym1;symst_name; ++ const char *s=st1+sym->st_name; + if ((sym->st_other=strcmp(s,"_gp_disp") ? (strcmp(s,"__gnu_local_gp") ? 0 : 2) : 1)) { + q++; + sym->st_info=ELF_ST_INFO(STB_LOCAL,ELF_ST_TYPE(sym->st_info)); +@@ -94,10 +38,8 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + + sym=sym1+ELF_R_SYM(r->r_info); + +- if (!sym->st_size) { ++ if (!sym->st_size) + sym->st_size=++*gs; +- massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); +- } + + } + +--- gcl-2.6.12.orig/h/elf64_mips_reloc.h ++++ gcl-2.6.12/h/elf64_mips_reloc.h +@@ -15,10 +15,7 @@ + gote=got+(a>>32)-1; + a&=MASK(32); + store_val(where,MASK(16),((void *)gote-(void *)got)); +- if (s>=ggot && s=hr && ELF_R_TYPE(ra->r_info)==R_MIPS_HI16;) +- relocate(sym1,ra,ra->r_addend|(1L<<32)|(a<<32),start,got,gote); ++ for (hr=hr ? hr : (void *)ra;--ra>=hr;) ++ if (ELF_R_TYPE(ra->r_info)==R_MIPS_HI16) ++ relocate(sym1,ra,ra->r_addend|(1L<<32)|(a<<32),start,got,gote); + } + hr=NULL; + break; +--- gcl-2.6.12.orig/h/elf64_mips_reloc_special.h ++++ gcl-2.6.12/h/elf64_mips_reloc_special.h +@@ -1,4 +1,4 @@ +-static ul ggot,ggote; static Rela *hr; ++static Rela *hr; + + #undef ELF_R_SYM + #define ELF_R_SYM(a_) (a_&0xffffffff) +@@ -7,68 +7,9 @@ static ul ggot,ggote; static Rela *hr; + #define ELF_R_FTYPE(a_) ((a_>>56)&0xff) + + static int +-write_stub(ul s,ul *got,ul *gote) { +- +- int *goti; +- +- +- *gote=(ul)(goti=(void *)(gote+2)); +- *++gote=s; +- s=((void *)gote-(void *)got); +- *goti++=(0x37<<26)|(0x1c<<21)|(0x19<<16)|s; +- *goti++=(0x37<<26)|(0x19<<21)|(0x19<<16)|0; +- *goti++=0x03200008; +- *goti++=0x00200825; +- +- return 0; +- +-} +- +-static int +-make_got_room_for_stub(Shdr *sec1,Shdr *sece,Sym *sym,const char *st1,ul *gs) { +- +- Shdr *ssec=sec1+sym->st_shndx; +- struct node *a; +- if ((ssec>=sece || !ALLOC_SEC(ssec)) && +- (a=find_sym_ptable(st1+sym->st_name)) && +- a->address>=ggot && a->addresssh_addr,pe=p+sec->sh_size;psh_entsize) { +- q=p; +- if (q[0]==DT_MIPS_GOTSYM) +- gotsym=q[1]; +- if (q[0]==DT_MIPS_LOCAL_GOTNO) +- locgotno=q[1]; +- +- } +- massert(gotsym && locgotno); +- +- massert(sec=get_section(".MIPS.stubs",sec1,sece,sn)); +- stub=sec->sh_addr; +- stube=sec->sh_addr+sec->sh_size; +- +- massert(sec=get_section(".got",sec1,sece,sn)); +- ggot=sec->sh_addr+locgotno*sec->sh_entsize; +- ggote=sec->sh_addr+sec->sh_size; +- +- for (ds1+=gotsym,sym=ds1;symst_value || (sym->st_value>=stub && sym->st_valuest_value=ggot+(sym-ds1)*sec->sh_entsize; +- + return 0; + + } +@@ -104,8 +45,6 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + sym->st_size|=(q<<(a*16)); + } + +- massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); +- + } + + b=sizeof(r->r_addend)*4; +--- gcl-2.6.12.orig/h/mips-linux.h ++++ gcl-2.6.12/h/mips-linux.h +@@ -21,5 +21,4 @@ + #define SPECIAL_RELOC_H "elf64_mips_reloc_special.h" + #endif + +-/*Remove when .MIPS.stubs are replaced with callable .plt entries*/ +-#define LD_BIND_NOW ++#define NEED_STACK_CHK_GUARD +--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp ++++ gcl-2.6.12/lsp/gcl_iolib.lsp +@@ -38,26 +38,24 @@ + + + (defmacro with-input-from-string ((var string &key index start end) . body) +- (if index +- (multiple-value-bind (ds b) +- (find-declarations body) +- `(let ((,var (make-string-input-stream ,string ,start ,end))) +- ,@ds +- (unwind-protect +- (progn ,@b) +- (setf ,index (si:get-string-input-stream-index ,var))))) +- `(let ((,var (make-string-input-stream ,string ,start ,end))) +- ,@body))) ++ (multiple-value-bind (ds b) ++ (find-declarations body) ++ `(let ((,var (make-string-input-stream ,string ,start ,end))) ++ ,@ds ++ (unwind-protect ++ (progn ,@b) ++ (when ,index (setf ,index (si:get-string-input-stream-index ,var))) ++ (when ,var (close ,var)))))) + ++(defmacro with-output-to-string ((var &optional string &key element-type) . body) ++ (multiple-value-bind (ds b) ++ (find-declarations body) ++ `(let ((,var ,(if string `(make-string-output-stream-from-string ,string) `(make-string-output-stream)))) ++ ,@ds ++ (unwind-protect ++ (progn ,@b ,@(unless string `((get-output-stream-string ,var)))) ++ (when ,var (close ,var)))))) + +-(defmacro with-output-to-string ((var &optional string) . body) +- (if string +- `(let ((,var (make-string-output-stream-from-string ,string))) +- ,@body) +- `(let ((,var (make-string-output-stream))) +- ,@body +- (get-output-stream-string ,var)))) +- + + (defun read-from-string (string + &optional (eof-error-p t) eof-value +--- gcl-2.6.12.orig/lsp/gcl_numlib.lsp ++++ gcl-2.6.12/lsp/gcl_numlib.lsp +@@ -71,29 +71,53 @@ + + (defun cis (x) (exp (* imag-one x))) + +-(defun asin (x) +- (let ((c (- (* imag-one +- (log (+ (* imag-one x) +- (sqrt (- 1.0d0 (* x x))))))))) +- (if (or (and (not (complexp x)) +- (<= x 1.0d0) +- (>= x -1.0d0) +- ) +- (zerop (imagpart c))) +- (realpart c) +- c))) +- +-(defun acos (x) +- (let ((c (- (* imag-one +- (log (+ x (* imag-one +- (sqrt (- 1.0d0 (* x x)))))))))) +- (if (or (and (not (complexp x)) +- (<= x 1.0d0) +- (>= x -1.0d0) +- ) +- (zerop (imagpart c))) +- (realpart c) +- c))) ++(defun real-asinh (x) ++ (declare (real x)) ++ (float (log (+ x (sqrt (+ 1.0 (* x x))))) (float x))) ++ ++(defun asin (z) ++ (declare (optimize (safety 1))) ++ (check-type z number) ++ (if (unless (complexp z) (<= -1 z 1)) ++ (atan z (sqrt (- 1 (* z z)))) ++ (let* ((a (sqrt (- 1 z))) ++ (b (sqrt (+ 1 z)))) ++ (complex (atan (realpart z) (realpart (* a b))) ++ (real-asinh (imagpart (* (conjugate a) b))))))) ++ ++(defun acos (z) ++ (declare (optimize (safety 1))) ++ (check-type z number) ++ (if (unless (complexp z) (<= -1 z 1)) ++ (* 2 (atan (- 1 z) (sqrt (- 1 (* z z))))) ++ (let* ((a (sqrt (- 1 z))) ++ (b (sqrt (+ 1 z)))) ++ (complex (* 2 (atan (realpart a) (realpart b))) ++ (real-asinh (imagpart (* (conjugate b) a))))))) ++ ++(defun asinh (x) ++ (declare (optimize (safety 1))) ++ (check-type x number) ++ (if (realp x) ++ (real-asinh x) ++ (let* ((r (asin (complex (- (imagpart x)) (realpart x))))) ++ (complex (imagpart r) (- (realpart r)))))) ++ ++(defun acosh (z) ++ (declare (optimize (safety 1))) ++ (check-type z number) ++ (if (unless (complexp z) (>= z 1)) ++ (real-asinh (sqrt (- (* z z) 1))) ++ (let* ((a (sqrt (- z 1))) ++ (b (sqrt (+ z 1)))) ++ (complex (real-asinh (realpart (* (conjugate a) b))) (* 2 (atan (imagpart a) (realpart b))))))) ++ ++(defun atanh (x) ++ (declare (optimize (safety 1))) ++ (check-type x number) ++ (if (unless (complexp x) (< -1 x 1)) ++ (/ (log (/ (+ 1 x) (- 1 x))) 2) ++ (/ (- (log (+ 1 x)) (log (- 1 x))) 2))) + + + (defun sinh (z) +@@ -140,27 +164,6 @@ + ;(defun cosh (x) (/ (+ (exp x) (exp (- x))) 2.0d0)) + (defun tanh (x) (/ (sinh x) (cosh x))) + +-(defun asinh (x) (log (+ x (sqrt (+ 1.0d0 (* x x)))))) +-;(defun acosh (x) +-; (log (+ x +-; (* (1+ x) +-; (sqrt (/ (1- x) (1+ x))))))) +-;(defun acosh (x) +-; (log (+ x +-; (sqrt (* (1- x) (1+ x)))))) +-(defun acosh (x) +- (* 2 (log (+ (sqrt (/ (1+ x) 2)) (sqrt (/ (1- x) 2)))))) +-(defun atanh (x) +- (when (or (= x 1.0d0) (= x -1.0d0)) +- (error "The argument, ~s, is a logarithmic singularity.~ +- ~%Don't be foolish, GLS." +- x)) +- (log (/ (1+ x) (sqrt (- 1 (* x x)))))) +-;; (let ((y (log (/ (1+ x) (sqrt (- 1 (* x x))))))) +-;; (if (and (= (imagpart x) 0) (complexp y)) +-;; (complex (realpart y) (- (imagpart y))) +-;; y))) +- + + (defun rational (x) + (etypecase x +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -523,7 +523,41 @@ object if_exists, if_does_not_exist; + + static void + gclFlushSocket(object); +-/* ++ ++ ++DEFUN_NEW("OPEN-STREAM-P",object,fLopen_stream_p,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ ++ check_type_stream(&x); ++ ++ switch(x->sm.sm_mode) { ++ case smm_output: ++ case smm_input: ++ case smm_io: ++ case smm_probe: ++ case smm_socket: ++ case smm_string_input: ++ case smm_string_output: ++ return x->d.tt==1 ? Cnil : Ct; ++ case smm_synonym: ++ return FFN(fLopen_stream_p)(symbol_value(x->sm.sm_object0)); ++ case smm_broadcast: ++ case smm_concatenated: ++ for (x=x->sm.sm_object0;!endp(x);x=x->c.c_cdr) ++ if (!FFN(fLopen_stream_p(x))) ++ return Cnil; ++ return Ct; ++ case smm_two_way: ++ case smm_echo: ++ if (FFN(fLopen_stream_p(STREAM_INPUT_STREAM(x)))==Cnil) ++ return Cnil; ++ return FFN(fLopen_stream_p(STREAM_OUTPUT_STREAM(x))); ++ default: ++ error("illegal stream mode"); ++ return Cnil; ++ } ++ ++} ++ /* + Close_stream(strm) closes stream strm. + The abort_flag is not used now. + */ +@@ -535,6 +569,8 @@ object strm; + object x; + + BEGIN: ++ strm->d.tt=1; ++ + switch (strm->sm.sm_mode) { + case smm_output: + if (strm->sm.sm_fp == stdout) +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -471,12 +471,6 @@ main(int argc, char **argv, char **envp) + #include "unrandomize.h" + #endif + +-#ifdef LD_BIND_NOW +-#include +-#include +-#include "ld_bind_now.h" +-#endif +- + setbuf(stdin, stdin_buf); + setbuf(stdout, stdout_buf); + #ifdef _WIN32 +--- gcl-2.6.12.orig/o/print.d ++++ gcl-2.6.12/o/print.d +@@ -349,7 +349,7 @@ truncate_double(char *b,double d,int dp) + for (p=c;*p && *p!='e';p++); + if (p[-1]!='.' && char_inc(c,p-1) && COMP(c,&pp,d,dp)) { + j=truncate_double(c,d,dp); +- if (j + 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-15) unstable; urgency=medium + . + * Version_2_6_13pre18 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp ++++ gcl-2.6.12/lsp/gcl_iolib.lsp +@@ -38,23 +38,28 @@ + + + (defmacro with-input-from-string ((var string &key index start end) . body) +- (multiple-value-bind (ds b) +- (find-declarations body) +- `(let ((,var (make-string-input-stream ,string ,start ,end))) +- ,@ds +- (unwind-protect +- (progn ,@b) +- (when ,index (setf ,index (si:get-string-input-stream-index ,var))) +- (when ,var (close ,var)))))) +- ++ (let ((x (sgen "X"))) ++ (multiple-value-bind (ds b) ++ (find-declarations body) ++ `(let ((,var (make-string-input-stream ,string ,start ,end))) ++ ,@ds ++ (unwind-protect ++ ,(let ((f `(progn ,@b))) ++ (if index ++ `(let ((,x (multiple-value-list ,f))) (setf ,index (get-string-input-stream-index ,var)) (values-list ,x)) ++ f)) ++ (close ,var)))))) ++ + (defmacro with-output-to-string ((var &optional string &key element-type) . body) +- (multiple-value-bind (ds b) +- (find-declarations body) +- `(let ((,var ,(if string `(make-string-output-stream-from-string ,string) `(make-string-output-stream)))) +- ,@ds +- (unwind-protect +- (progn ,@b ,@(unless string `((get-output-stream-string ,var)))) +- (when ,var (close ,var)))))) ++ (let ((s (sgen "STRING"))(bl (sgen "BLOCK"))(e (sgen "ELEMENT-TYPE"))(x (sgen "X"))) ++ (multiple-value-bind (ds b) ++ (find-declarations body) ++ `(let* ((,s ,string)(,e ,element-type) ++ (,var (if ,s (make-string-output-stream-from-string ,s) (make-string-output-stream :element-type ,e)))) ++ ,@ds ++ (unwind-protect ++ (let ((,x (multiple-value-list (progn ,@b)))) (if ,s (values-list ,x) (get-output-stream-string ,var))) ++ (close ,var)))))) + + + (defun read-from-string (string +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -1668,12 +1668,11 @@ for the string ~S.", + 3, istart, iend, strng); + @) + +-static void +-FFN(Lmake_string_output_stream)() +-{ +- check_arg(0); +- vs_push(make_string_output_stream(64)); +-} ++@(static defun make_string_output_stream (&k element_type) ++@ ++ element_type=Cnil;/*FIXME*/ ++ @(return `make_string_output_stream(64)`) ++@) + + LFD(Lget_output_stream_string)() + { diff --git a/patches/Version_2_6_13pre1a b/patches/Version_2_6_13pre1a new file mode 100644 index 00000000..81441842 --- /dev/null +++ b/patches/Version_2_6_13pre1a @@ -0,0 +1,86 @@ +Description: + 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 + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -1269,10 +1269,11 @@ gcl_init_alloc(void *cs_start) { + update_real_maxpage(); + + 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<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 */ + (pp)->c.c_car->st.st_self = NULL; + *p = pp->c.c_cdr; + #ifdef GCL_GPROF + if (initial_monstartup_pointer==ptr) { ++ initial_monstartup_pointer_echo=ptr; + initial_monstartup_pointer=NULL; +- if (core_end-heap_end>=sizeof(ptr)) +- *(void **)heap_end=ptr; + } + #endif + return; +@@ -1840,12 +1835,13 @@ free(void *ptr) { + #ifdef NOFREE_ERR + return; + #else +- if (core_end-heap_end + 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 + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/makefile ++++ gcl-2.6.12/makefile +@@ -195,7 +195,7 @@ install1: + if gcc --version | grep -i mingw >/dev/null 2>&1 ; then if grep -i oncrpc makedefs >/dev/null 2>&1 ; then cp /mingw/bin/oncrpc.dll $(DESTDIR)$(INSTALL_LIB_DIR)/$(PORTDIR); fi ; fi + cd $(DESTDIR)$(INSTALL_LIB_DIR)/$(PORTDIR) && \ + mv $(FLISP)$(EXE) temp$(EXE) && \ +- echo '(reset-sys-paths "$(INSTALL_LIB_DIR)/")(si::save-system "$(FLISP)$(EXE)")' | ./temp$(EXE) && \ ++ echo '(si::reset-sys-paths "$(INSTALL_LIB_DIR)/")(si::save-system "$(FLISP)$(EXE)")' | ./temp$(EXE) && \ + rm -f temp$(EXE) + if [ -e "unixport/rsym$(EXE)" ] ; then cp unixport/rsym$(EXE) $(DESTDIR)$(INSTALL_LIB_DIR)/unixport/ ; fi + # ln $(SYMB) $(INSTALL_LIB_DIR)/$(PORTDIR)/$(FLISP)$(EXE) \ diff --git a/patches/Version_2_6_13pre2 b/patches/Version_2_6_13pre2 new file mode 100644 index 00000000..c9a97635 --- /dev/null +++ b/patches/Version_2_6_13pre2 @@ -0,0 +1,229 @@ +Description: + 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 + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/bsd.h ++++ gcl-2.6.12/h/bsd.h +@@ -33,39 +33,7 @@ filecpy(save, original, stsize - sizeof( + + extern char etext; + +- +- +- +-/* #define SET_REAL_MAXPAGE do { struct rlimit data_rlimit; \ */ +-/* extern char etext; \ */ +-/* real_maxpage = MAXPAGE ; \ */ +-/* getrlimit(RLIMIT_DATA, &data_rlimit); \ */ +-/* real_maxpage = ((unsigned int)&etext/PAGESIZE + data_rlimit.rlim_cur/PAGESIZE); \ */ +-/* if (real_maxpage > MAXPAGE) \ */ +-/* real_maxpage = MAXPAGE ; } while(0) */ +- +-#define ROUND_UP_SBRK(x) \ +- do {long i; \ +- if ((i = ((long)x & (PAGESIZE - 1)))) \ +- x=sbrk(PAGESIZE - i); } while(0); +- +-#define FIX_RANDOM_SBRK \ +-do {char *x=sbrk(0); \ +- if (core_end != x) \ +- { ROUND_UP_SBRK(x); x=sbrk(0);\ +- while (core_end < x) \ +- { \ +- core_end = core_end + PAGESIZE;} \ +- if (core_end !=x) error("Someone allocated my memory");}} while (0) +- +- +-#define INIT_ALLOC \ +- heap_end = sbrk(0); ROUND_UP_SBRK(heap_end);\ +- heap_end = core_end = sbrk(0); +- +-#define IF_ALLOCATE_ERR \ +- FIX_RANDOM_SBRK; \ +- if (core_end != sbrk(PAGESIZE*(n - m))) ++#define INIT_ALLOC heap_end = core_end = sbrk(0); + + #define SYM_EXTERNAL_P(sym) ((sym)->n_type & N_EXT) + +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1935,3 +1935,6 @@ empty_relblock(void); + + fixnum + check_avail_pages(void); ++ ++inline int ++mbrk(void *); +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -223,61 +223,53 @@ resize_hole(ufixnum hp,enum type tp) { + inline void * + alloc_page(long n) { + +- fixnum d,m; +- +- if (n>=0) { ++ bool s=n<0; ++ ufixnum nn=s ? -n : n; ++ void *v,*e; ++ ++ if (!s) { + +- if (n>(holepage - (in_signal_handler? 0 : ++ if (nn>(holepage - (in_signal_handler? 0 : + available_pages-n<=reserve_pages_for_signal_handler ? 0 : + reserve_pages_for_signal_handler))) { + + +- if (in_signal_handler) { +- fprintf(stderr,"Cant do relocatable gc in signal handler. \ +-Try to allocate more space to save for allocation during signals: \ +-eg to add 20 more do (si::set-hole-size %ld %d)\n...start over ", +- new_holepage, 20+ reserve_pages_for_signal_handler); fflush(stderr); exit(1); +- } +- ++ fixnum d=available_pages-nn; + +- d=available_pages-n; + d*=0.2; + d=d<0.01*real_maxpage ? available_pages-n : d; + d=d<0 ? 0 : d; + d=new_holepagecb_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); ++ fprintf(stderr,"%lu %p %p %lu %lu\n",(unsigned long)(cbppp-cbsrch1),*cbppp,**cbppp,(**cbppp)->cb_size,k); + } + massert(cbppp==cbsrche); + massert(*cbppp==cbpp); +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -120,6 +120,7 @@ fixnum log_maxpage_bound=sizeof(fixnum)* + + inline int + mbrk(void *v) { ++ + ufixnum uv=(ufixnum)v,uc=(ufixnum)sbrk(0),ux,um; + fixnum m=((1UL<<(sizeof(fixnum)*8-1))-1); + +@@ -134,9 +135,12 @@ mbrk(void *v) { + um=uc; + ux=uv; + } ++ + if (((fixnum)(ux-um))<0) + return mbrk((void *)uc+(uvs.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) { + diff --git a/patches/Version_2_6_13pre20 b/patches/Version_2_6_13pre20 new file mode 100644 index 00000000..66ade458 --- /dev/null +++ b/patches/Version_2_6_13pre20 @@ -0,0 +1,45 @@ +Description: + 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-16) unstable; urgency=medium + . + * Version_2_6_13pre19 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -543,14 +543,14 @@ DEFUN_NEW("OPEN-STREAM-P",object,fLopen_ + case smm_broadcast: + case smm_concatenated: + for (x=x->sm.sm_object0;!endp(x);x=x->c.c_cdr) +- if (!FFN(fLopen_stream_p(x))) ++ if (!FFN(fLopen_stream_p)(x)) + return Cnil; + return Ct; + case smm_two_way: + case smm_echo: +- if (FFN(fLopen_stream_p(STREAM_INPUT_STREAM(x)))==Cnil) ++ if (FFN(fLopen_stream_p)(STREAM_INPUT_STREAM(x))==Cnil) + return Cnil; +- return FFN(fLopen_stream_p(STREAM_OUTPUT_STREAM(x))); ++ return FFN(fLopen_stream_p)(STREAM_OUTPUT_STREAM(x)); + default: + error("illegal stream mode"); + return Cnil; diff --git a/patches/Version_2_6_13pre22 b/patches/Version_2_6_13pre22 new file mode 100644 index 00000000..cf61cc63 --- /dev/null +++ b/patches/Version_2_6_13pre22 @@ -0,0 +1,357 @@ +Description: + 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-17) unstable; urgency=medium + . + * Version_2_6_13pre20 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -6553,6 +6553,7 @@ else + + #include + #define EXTER ++ #define INLINE + #include "$MP_INCLUDE" + #include "./h/enum.h" + #define OBJ_ALIGN +@@ -6681,6 +6682,7 @@ else + /* end confdefs.h. */ + #include + #define EXTER ++ #define INLINE + #include "$MP_INCLUDE" + #include "h/enum.h" + #include "h/type.h" +@@ -6710,6 +6712,7 @@ else + /* end confdefs.h. */ + #include + #define EXTER ++ #define INLINE + #include "$MP_INCLUDE" + #include "`pwd`/h/enum.h" + #include "`pwd`/h/type.h" +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -1301,6 +1301,7 @@ AC_MSG_CHECKING([for required object ali + AC_RUN_IFELSE([AC_LANG_PROGRAM([[ + #include + #define EXTER ++ #define INLINE + #include "$MP_INCLUDE" + #include "./h/enum.h" + #define OBJ_ALIGN +@@ -1341,6 +1342,7 @@ AC_MSG_CHECKING(sizeof struct contblock) + if test "$use" = "mingw" ; then + AC_TRY_RUN([#include + #define EXTER ++ #define INLINE + #include "$MP_INCLUDE" + #include "h/enum.h" + #include "h/type.h" +@@ -1357,6 +1359,7 @@ AC_TRY_RUN([#include + else + AC_TRY_RUN([#include + #define EXTER ++ #define INLINE + #include "$MP_INCLUDE" + #include "`pwd`/h/enum.h" + #include "`pwd`/h/type.h" +--- gcl-2.6.12.orig/gcl-tk/guis.h ++++ gcl-2.6.12/gcl-tk/guis.h +@@ -7,6 +7,7 @@ + #define IMMNUM_H + #define GMP_WRAPPERS_H + #define ERROR_H ++#undef INLINE + + #include "include.h" + +--- gcl-2.6.12.orig/h/elf64_mips_reloc.h ++++ gcl-2.6.12/h/elf64_mips_reloc.h +@@ -15,7 +15,10 @@ + gote=got+(a>>32)-1; + a&=MASK(32); + store_val(where,MASK(16),((void *)gote-(void *)got)); +- *gote=s+(a&~MASK(16))+((a&0x8000)<<1); ++ if (s>=ggot && s>56)&0xff) + + static int ++write_stub(ul s,ul *got,ul *gote) { ++ ++ int *goti; ++ ++ *gote=(ul)(goti=(void *)(gote+2)); ++ *++gote=s; ++ s=((void *)gote-(void *)got); ++ *goti++=(0x37<<26)|(0x1c<<21)|(0x19<<16)|s; ++ *goti++=(0x37<<26)|(0x19<<21)|(0x19<<16)|0; ++ *goti++=0x03200008; ++ *goti++=0x00200825; ++ ++ return 0; ++ ++} ++ ++static int ++make_got_room_for_stub(Shdr *sec1,Shdr *sece,Sym *sym,const char *st1,ul *gs) { ++ ++ Shdr *ssec=sec1+sym->st_shndx; ++ struct node *a; ++ if ((ssec>=sece || !ALLOC_SEC(ssec)) && ++ (a=find_sym_ptable(st1+sym->st_name)) && ++ a->address>=ggot && a->addresssh_addr,pe=p+sec->sh_size;psh_entsize) { ++ q=p; ++ if (q[0]==DT_MIPS_GOTSYM) ++ gotsym=q[1]; ++ if (q[0]==DT_MIPS_LOCAL_GOTNO) ++ locgotno=q[1]; ++ } ++ massert(gotsym && locgotno); ++ ++ massert(sec=get_section(".MIPS.stubs",sec1,sece,sn)); ++ stub=sec->sh_addr; ++ stube=sec->sh_addr+sec->sh_size; ++ ++ massert(sec=get_section(".got",sec1,sece,sn)); ++ ggot=sec->sh_addr+locgotno*sec->sh_entsize; ++ ggote=sec->sh_addr+sec->sh_size; ++ ++ for (ds1+=gotsym,sym=ds1;symst_value || (sym->st_value>=stub && sym->st_valuest_value=ggot+(sym-ds1)*sec->sh_entsize; ++ + return 0; + + } +@@ -45,6 +102,8 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + sym->st_size|=(q<<(a*16)); + } + ++ massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); ++ + } + + b=sizeof(r->r_addend)*4; +--- gcl-2.6.12.orig/h/notcomp.h ++++ gcl-2.6.12/h/notcomp.h +@@ -364,3 +364,13 @@ extern bool writable_malloc; + #define pfork() prof_block(fork()) + + #include "error.h" ++ ++#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2) ++extern void __gmp_randget_mt (); ++extern void __gmp_randclear_mt (); ++extern void __gmp_randiset_mt (); ++ ++typedef struct {void *a,*b,*c,*d;} gmp_randfnptr_t; ++EXTER gmp_randfnptr_t Mersenne_Twister_Generator_Noseed; ++#endif ++ +--- gcl-2.6.12.orig/h/object.h ++++ gcl-2.6.12/h/object.h +@@ -349,11 +349,7 @@ EXTER char *new_rb_start; /* desired r + EXTER char *rb_start; /* relblock start */ + EXTER char *rb_end; /* relblock end */ + EXTER char *rb_limit; /* relblock limit */ +-EXTER char *rb_pointer; /* relblock pointer */ +- +-#ifndef INLINE +-#define INLINE +-#endif ++EXTER char *rb_pointer; /* relblock pointer */ + + INLINE ufixnum + rb_size(void) { +--- gcl-2.6.12.orig/o/big.c ++++ gcl-2.6.12/o/big.c +@@ -70,6 +70,32 @@ DEFUN_NEW("SET-GMP-ALLOCATE-RELOCATABLE" + RETURN1(flag); + } + ++#ifndef GMP_USE_MALLOC ++object big_gcprotect; ++object big_fixnum1; ++ ++#include "gmp.c" ++ ++void ++gcl_init_big1(void) { ++ ++ mp_set_memory_functions( gcl_gmp_alloc,gcl_gmp_realloc,gcl_gmp_free); ++ jmp_gmp=0; ++ ++#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2) ++ Mersenne_Twister_Generator_Noseed.b=__gmp_randget_mt; ++ Mersenne_Twister_Generator_Noseed.c=__gmp_randclear_mt; ++ Mersenne_Twister_Generator_Noseed.d=__gmp_randiset_mt; ++#endif ++ ++} ++ ++#else ++gcl_init_big1() ++{ ++} ++#endif ++ + #ifdef GMP + #include "gmp_big.c" + #else +@@ -93,7 +119,6 @@ void zero_big(object x) + ZERO_BIG(x); + } + +- + #ifndef HAVE_MP_COERCE_TO_STRING + + double digitsPerBit[37]={ 0,0, +--- gcl-2.6.12.orig/o/gmp_big.c ++++ gcl-2.6.12/o/gmp_big.c +@@ -81,27 +81,6 @@ static object verify_big_or_zero(object + #define verify_big_or_zero(x) + #endif + +- +- +- +- +-#ifndef GMP_USE_MALLOC +-object big_gcprotect; +-object big_fixnum1; +- +-#include "gmp.c" +-void +-gcl_init_big1(void) { +- mp_set_memory_functions( gcl_gmp_alloc,gcl_gmp_realloc,gcl_gmp_free); +- jmp_gmp=0; +-} +- +-#else +-gcl_init_big1() +-{ +-} +-#endif +- + object + new_bignum(void) + { object ans; +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -511,9 +511,7 @@ main(int argc, char **argv, char **envp) + + terminal_io->sm.sm_object0->sm.sm_fp = stdin; + terminal_io->sm.sm_object1->sm.sm_fp = stdout; +-#ifdef LD_BIND_NOW /*FIXME currently mips only, verify that these two requirements are the same*/ +- reinit_gmp(); +-#endif ++ + gcl_init_big1(); + #ifdef HAVE_READLINE + gcl_init_readline_function(); +--- gcl-2.6.12.orig/o/num_rand.c ++++ gcl-2.6.12/o/num_rand.c +@@ -104,34 +104,6 @@ trap_gcl_gmp_allocfun(size_t size){ + } + #endif + +-#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2) +-extern void +-__gmp_randget_mt (); +-extern void +-__gmp_randclear_mt (); +-extern void +-__gmp_randiset_mt (); +- +-typedef struct {void *a,*b,*c,*d;} gmp_randfnptr_t; +-static gmp_randfnptr_t Mersenne_Twister_Generator_Noseed = { +- NULL, +- __gmp_randget_mt, +- __gmp_randclear_mt, +- __gmp_randiset_mt +-}; +-#endif +- +-void +-reinit_gmp() { +- +-#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2) +- Mersenne_Twister_Generator_Noseed.b=__gmp_randget_mt; +- Mersenne_Twister_Generator_Noseed.c=__gmp_randclear_mt; +- Mersenne_Twister_Generator_Noseed.d=__gmp_randiset_mt; +-#endif +- +-} +- + void + init_gmp_rnd_state(__gmp_randstate_struct *x) { + +--- gcl-2.6.12.orig/unixport/sys_init.lsp.in ++++ gcl-2.6.12/unixport/sys_init.lsp.in +@@ -66,9 +66,7 @@ + *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* ++(import 'si::(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) +@@ -79,3 +77,4 @@ + #-ansi-cl(do-symbols (s :cltl1-compat) (export s :lisp))) + + #+ansi-cl (use-package :pcl :user) ++(import 'si::(clines defentry defcfun object void int double quit bye gbc system) :user) diff --git a/patches/Version_2_6_13pre25 b/patches/Version_2_6_13pre25 new file mode 100644 index 00000000..6e13958b --- /dev/null +++ b/patches/Version_2_6_13pre25 @@ -0,0 +1,185 @@ +Description: + 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-19) unstable; urgency=medium + . + * Use-dpkg-buidflags-opt-levels-in-debian-rules, -O3 has bug in 5.2.1 + * Version_2_6_13pre24 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/config.guess ++++ gcl-2.6.12/config.guess +@@ -1,8 +1,8 @@ + #! /bin/sh + # Attempt to guess a canonical system name. +-# Copyright 1992-2014 Free Software Foundation, Inc. ++# Copyright 1992-2015 Free Software Foundation, Inc. + +-timestamp='2014-03-23' ++timestamp='2015-08-20' + + # This file is free software; you can redistribute it and/or modify it + # under the terms of the GNU General Public License as published by +@@ -24,12 +24,12 @@ timestamp='2014-03-23' + # program. This Exception is an additional permission under section 7 + # of the GNU General Public License, version 3 ("GPLv3"). + # +-# Originally written by Per Bothner. ++# Originally written by Per Bothner; maintained since 2000 by Ben Elliston. + # + # You can get the latest version of this script from: + # http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD + # +-# Please send patches with a ChangeLog entry to config-patches@gnu.org. ++# Please send patches to . + + + me=`echo "$0" | sed -e 's,.*/,,'` +@@ -50,7 +50,7 @@ version="\ + GNU config.guess ($timestamp) + + Originally written by Per Bothner. +-Copyright 1992-2014 Free Software Foundation, Inc. ++Copyright 1992-2015 Free Software Foundation, Inc. + + This is free software; see the source for copying conditions. There is NO + warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." +@@ -168,20 +168,27 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ + # Note: NetBSD doesn't particularly care about the vendor + # portion of the name. We always set it to "unknown". + sysctl="sysctl -n hw.machine_arch" +- UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \ +- /usr/sbin/$sysctl 2>/dev/null || echo unknown)` ++ UNAME_MACHINE_ARCH=`(uname -p 2>/dev/null || \ ++ /sbin/$sysctl 2>/dev/null || \ ++ /usr/sbin/$sysctl 2>/dev/null || \ ++ echo unknown)` + case "${UNAME_MACHINE_ARCH}" in + armeb) machine=armeb-unknown ;; + arm*) machine=arm-unknown ;; + sh3el) machine=shl-unknown ;; + sh3eb) machine=sh-unknown ;; + sh5el) machine=sh5le-unknown ;; ++ earmv*) ++ arch=`echo ${UNAME_MACHINE_ARCH} | sed -e 's,^e\(armv[0-9]\).*$,\1,'` ++ endian=`echo ${UNAME_MACHINE_ARCH} | sed -ne 's,^.*\(eb\)$,\1,p'` ++ machine=${arch}${endian}-unknown ++ ;; + *) machine=${UNAME_MACHINE_ARCH}-unknown ;; + esac + # The Operating System including object format, if it has switched + # to ELF recently, or will in the future. + case "${UNAME_MACHINE_ARCH}" in +- arm*|i386|m68k|ns32k|sh3*|sparc|vax) ++ arm*|earm*|i386|m68k|ns32k|sh3*|sparc|vax) + eval $set_cc_for_build + if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ELF__ +@@ -197,6 +204,13 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ + os=netbsd + ;; + esac ++ # Determine ABI tags. ++ case "${UNAME_MACHINE_ARCH}" in ++ earm*) ++ expr='s/^earmv[0-9]/-eabi/;s/eb$//' ++ abi=`echo ${UNAME_MACHINE_ARCH} | sed -e "$expr"` ++ ;; ++ esac + # The OS release + # Debian GNU/NetBSD machines have a different userland, and + # thus, need a distinct triplet. However, they do not need +@@ -207,13 +221,13 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ + release='-gnu' + ;; + *) +- release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` ++ release=`echo ${UNAME_RELEASE} | sed -e 's/[-_].*//' | cut -d. -f1,2` + ;; + esac + # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: + # contains redundant information, the shorter form: + # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. +- echo "${machine}-${os}${release}" ++ echo "${machine}-${os}${release}${abi}" + exit ;; + *:Bitrig:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` +@@ -235,6 +249,9 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ + *:MirBSD:*:*) + echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} + exit ;; ++ *:Sortix:*:*) ++ echo ${UNAME_MACHINE}-unknown-sortix ++ exit ;; + alpha:OSF1:*:*) + case $UNAME_RELEASE in + *4.0) +@@ -579,8 +596,9 @@ EOF + else + IBM_ARCH=powerpc + fi +- if [ -x /usr/bin/oslevel ] ; then +- IBM_REV=`/usr/bin/oslevel` ++ if [ -x /usr/bin/lslpp ] ; then ++ IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc | ++ awk -F: '{ print $3 }' | sed s/[0-9]*$/0/` + else + IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} + fi +@@ -932,6 +950,9 @@ EOF + crisv32:Linux:*:*) + echo ${UNAME_MACHINE}-axis-linux-${LIBC} + exit ;; ++ e2k:Linux:*:*) ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} ++ exit ;; + frv:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; +@@ -1020,7 +1041,7 @@ EOF + echo ${UNAME_MACHINE}-dec-linux-${LIBC} + exit ;; + x86_64:Linux:*:*) +- echo ${UNAME_MACHINE}-unknown-linux-${LIBC} ++ echo ${UNAME_MACHINE}-pc-linux-${LIBC} + exit ;; + xtensa*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} +--- gcl-2.6.12.orig/unixport/sys_init.lsp.in ++++ gcl-2.6.12/unixport/sys_init.lsp.in +@@ -66,8 +66,9 @@ + *opt-two* @LI-OPT-TWO@ + *init-lsp* @LI-INIT-LSP@) + +-(import 'si::(commonp *break-on-warnings* +- make-char char-bits char-font char-bit set-char-bit string-char-p int-char ++(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) +@@ -77,4 +78,4 @@ + #-ansi-cl(do-symbols (s :cltl1-compat) (export s :lisp))) + + #+ansi-cl (use-package :pcl :user) +-(import 'si::(clines defentry defcfun object void int double quit bye gbc system) :user) ++#+ansi-cl (import 'si::(clines defentry defcfun object void int double quit bye gbc system) :user) diff --git a/patches/Version_2_6_13pre26 b/patches/Version_2_6_13pre26 new file mode 100644 index 00000000..798646de --- /dev/null +++ b/patches/Version_2_6_13pre26 @@ -0,0 +1,235 @@ +Description: + 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-20) unstable; urgency=medium + . + * Version_2_6_13pre25 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4435,7 +4435,6 @@ case $use in + # if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi + ;; + mips*) +- TCFLAGS="$TCFLAGS -mplt" + # if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 + ;; + ia64*) +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -640,7 +640,6 @@ case $use in + # if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi + ;; + mips*) +- TCFLAGS="$TCFLAGS -mplt" + # if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 + ;; + ia64*) +--- gcl-2.6.12.orig/h/elf32_mips_reloc.h ++++ gcl-2.6.12/h/elf32_mips_reloc.h +@@ -4,7 +4,12 @@ + add_val(where,~0L,s+a-(ul)got); + break; + case R_MIPS_26: +- add_val(where,MASK(26),(s+a)>>2); ++ if (((s+a)>>28)!=(((ul)where)>>28)) { ++ gote=got+sym->st_size-1; ++ massert(!write_26_stub(s+a,got,gote)); ++ store_val(where,MASK(26),((ul)gote)>>2); ++ } else ++ add_val(where,MASK(26),(s+a)>>2); + break; + case R_MIPS_32: + add_val(where,~0L,s+a); +@@ -19,7 +24,10 @@ + case R_MIPS_CALL16: + gote=got+sym->st_size-1; + store_val(where,MASK(16),((void *)gote-(void *)got)); +- *gote=s; ++ if (s>=ggot && sst_other) s=gpd=(ul)got-(sym->st_other==2 ? 0 : (ul)where); +--- gcl-2.6.12.orig/h/elf32_mips_reloc_special.h ++++ gcl-2.6.12/h/elf32_mips_reloc_special.h +@@ -1,9 +1,88 @@ +-static ul gpd; static Rel *hr; ++#include ++ ++static ul gpd,ggot,ggote,can_gp; static Rel *hr; ++ ++typedef struct { ++ ul addr_hi,addr_lo,jr,nop; ++} mips_26_tramp; ++ ++static int ++write_26_stub(ul s,ul *got,ul *gote) { ++ ++ static mips_26_tramp t1={(0xf<<26)|(0x0<<21)|(0x19<<16), /*lui t9*/ ++ (0xe<<26)|(0x19<<21)|(0x19<<16), /*ori t9,t9 */ ++ 0x03200008, /*jr t9*/ ++ 0x00200825}; /*mv at,at */; ++ mips_26_tramp *t=(void *)gote; ++ ++ *t=t1; ++ t->addr_hi|=s>>16; ++ t->addr_lo|=s&0xffff; ++ ++ return 0; ++ ++} ++ ++typedef struct { ++ ul entry,addr_hi,addr_lo,lw,jr,lwcan; ++} call_16_tramp; ++ ++static int ++write_stub(ul s,ul *got,ul *gote) { ++ ++ static call_16_tramp t1={0, ++ (0xf<<26)|(0x0<<21)|(0x19<<16), /*lui t9*/ ++ (0xe<<26)|(0x19<<21)|(0x19<<16), /*ori t9,t9 */ ++ (0x23<<26)|(0x19<<21)|(0x19<<16), /*lw t9,(0)t9*/ ++ 0x03200008, /*jr t9*/ ++ /*stub addresses need veneer setting gp to canonical*/ ++ (0x23<<26)|(0x1c<<21)|(0x1c<<16)};/*lw gp,(0)gp*/ ++ call_16_tramp *t=(void *)gote++; ++ ++ *t=t1; ++ *got=can_gp; ++ ++ t->entry=(ul)gote; ++ t->addr_hi|=s>>16; ++ t->addr_lo|=s&0xffff; ++ ++ return 0; ++ ++} + + static int + find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, + const char *st1,Sym *ds1,Sym *dse,Sym *sym,Sym *syme) { + ++ Shdr *sec; ++ ul *q,gotsym=0,locgotno=0,stub,stube; ++ void *p,*pe; ++ ++ massert(sec=get_section(".dynamic",sec1,sece,sn)); ++ for (p=(void *)sec->sh_addr,pe=p+sec->sh_size;psh_entsize) { ++ q=p; ++ if (q[0]==DT_MIPS_GOTSYM) ++ gotsym=q[1]; ++ if (q[0]==DT_MIPS_LOCAL_GOTNO) ++ locgotno=q[1]; ++ if (q[0]==DT_PLTGOT) ++ can_gp=q[1]+0x7ff0; ++ ++ } ++ massert(gotsym && locgotno && can_gp); ++ ++ massert(sec=get_section(".MIPS.stubs",sec1,sece,sn)); ++ stub=sec->sh_addr; ++ stube=sec->sh_addr+sec->sh_size; ++ ++ massert(sec=get_section(".got",sec1,sece,sn)); ++ ggot=sec->sh_addr+locgotno*sec->sh_entsize; ++ ggote=sec->sh_addr+sec->sh_size; ++ ++ for (ds1+=gotsym,sym=ds1;symst_value || (sym->st_value>=stub && sym->st_valuest_value=ggot+(sym-ds1)*sec->sh_entsize; ++ + return 0; + + } +@@ -13,9 +92,10 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + + Rel *r; + Sym *sym; +- Shdr *sec; ++ Shdr *sec,*ssec; + void *v,*ve; + ul q; ++ struct node *a; + + for (q=0,sym=sym1;symst_name; +@@ -29,20 +109,32 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + for (sym=sym1;symst_size=0; + +- for (*gs=0,sec=sec1;secsh_type==SHT_REL) ++ for (*gs=1,sec=sec1;secsh_type==SHT_REL)/*no addend*/ + for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) + +- if (ELF_R_TYPE(r->r_info)==R_MIPS_CALL16|| +- ELF_R_TYPE(r->r_info)==R_MIPS_GOT16) { ++ if (!(sym=sym1+ELF_R_SYM(r->r_info))->st_size) + +- sym=sym1+ELF_R_SYM(r->r_info); ++ switch(ELF_R_TYPE(r->r_info)) { + +- if (!sym->st_size) +- sym->st_size=++*gs; ++ case R_MIPS_26: ++ if (((ul)(pagetochar(page(heap_end))+r->r_offset))>>28) { ++ sym->st_size=++*gs; ++ (*gs)+=sizeof(mips_26_tramp)/sizeof(ul)-1; ++ } ++ break; ++ case R_MIPS_CALL16: ++ sym->st_size=++*gs; ++ if (((ssec=sec1+sym->st_shndx)>=sece || !ALLOC_SEC(ssec)) && ++ (a=find_sym_ptable(st1+sym->st_name)) && ++ a->address>=ggot && a->addressst_size=++*gs; ++ break; ++ } + +- } +- + return 0; + + } +--- gcl-2.6.12.orig/o/nsocket.c ++++ gcl-2.6.12/o/nsocket.c +@@ -645,11 +645,11 @@ getCharGclSocket(object strm, object blo + { int high; + AGAIN: + /* under cygwin a too large timout like (1<<30) does not work */ +- timeout.tv_sec = (block != Ct ? 0 : 0); ++ timeout.tv_sec = 0; + timeout.tv_usec = 10000; + FD_ZERO(&readfds); + FD_SET(fd,&readfds); +- high = select(fd+1,&readfds,NULL,NULL,&timeout); ++ high = select(fd+1,&readfds,NULL,NULL,block==Ct ? NULL : &timeout); + if (high > 0) + { object bufp = SOCKET_STREAM_BUFFER(strm); + int n; diff --git a/patches/Version_2_6_13pre27 b/patches/Version_2_6_13pre27 new file mode 100644 index 00000000..fea955b1 --- /dev/null +++ b/patches/Version_2_6_13pre27 @@ -0,0 +1,161 @@ +Description: + 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-21) unstable; urgency=medium + . + * Version_2_6_13pre26 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/att_ext.h ++++ gcl-2.6.12/h/att_ext.h +@@ -217,6 +217,10 @@ frame_ptr frs_sch_catch(); + /* gbc.c */ + EXTER bool GBC_enable; + ++#ifdef CAN_UNRANDOMIZE_SBRK ++EXTER bool gcl_unrandomized; ++#endif ++ + /* let.c */ + + /* lex.c */ +--- gcl-2.6.12.orig/h/gnuwin95.h ++++ gcl-2.6.12/h/gnuwin95.h +@@ -7,15 +7,6 @@ + #define DBEGIN_TY unsigned long + extern DBEGIN_TY _dbegin; + +- +- +-/* define if there is no _cleanup, do here what needs +- to be done before calling unexec +- */ +-#define CLEANUP_CODE \ +- setbuf(stdin,0); \ +- setbuf(stdout,0); +- + /* size to use for mallocs done */ + /* #define BABY_MALLOC_SIZE 0x5000 */ + +--- gcl-2.6.12.orig/h/linux.h ++++ gcl-2.6.12/h/linux.h +@@ -130,10 +130,6 @@ do { int c = 0; \ + + #define SET_SESSION_ID() (setpgrp() ? -1 : 0) + +-#define CLEANUP_CODE \ +- setbuf(stdin,0); \ +- setbuf(stdout,0); +- + #include + #include + #define GET_FULL_PATH_SELF(a_) do {\ +--- gcl-2.6.12.orig/h/mingw.h ++++ gcl-2.6.12/h/mingw.h +@@ -47,13 +47,6 @@ + #define DBEGIN_TY unsigned int + extern DBEGIN_TY _stacktop, _stackbottom, _dbegin; + +-/* define if there is no _cleanup, do here what needs +- to be done before calling unexec +- */ +-#define CLEANUP_CODE \ +- setbuf(stdin,0); \ +- setbuf(stdout,0); +- + #define NO_SYS_PARAM_H + #define NO_SYS_TIMES_H + +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -1796,6 +1796,10 @@ malloc(size_t size) { + + if (!gcl_alloc_initialized) + gcl_init_alloc(&size); ++#ifdef CAN_UNRANDOMIZE_SBRK ++ else if (!gcl_unrandomized) ++ return sbrk(size); ++#endif + + CHECK_INTERRUPT; + +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -412,16 +412,18 @@ DEFVAR("*CODE-BLOCK-RESERVE*",sSAcode_bl + + #define HAVE_GCL_CLEANUP + ++#ifdef CAN_UNRANDOMIZE_SBRK ++bool gcl_unrandomized=FALSE; ++#endif ++ + void + gcl_cleanup(int gc) { + + if (getenv("GCL_WAIT")) + sleep(30); + +-#ifdef CLEANUP_CODE +- CLEANUP_CODE +-#elif defined(USE_CLEANUP) +- {extern void _cleanup(void);_cleanup();} ++#if defined(USE_CLEANUP) ++ {extern void _cleanup(void);_cleanup();} + #endif + + #ifdef GCL_GPROF +@@ -440,6 +442,10 @@ gcl_cleanup(int gc) { + cs_org=0; + initial_sbrk=core_end; + ++#ifdef CAN_UNRANDOMIZE_SBRK ++ gcl_unrandomized=FALSE; ++#endif ++ + } + + close_pool(); +@@ -450,6 +456,13 @@ gcl_cleanup(int gc) { + int + main(int argc, char **argv, char **envp) { + ++#ifdef CAN_UNRANDOMIZE_SBRK ++#include ++#include ++#include "unrandomize.h" ++ gcl_unrandomized=TRUE; ++#endif ++ + gcl_init_alloc(&argv); + + #ifdef GET_FULL_PATH_SELF +@@ -465,12 +478,6 @@ main(int argc, char **argv, char **envp) + #endif + *argv=kcl_self; + +-#ifdef CAN_UNRANDOMIZE_SBRK +-#include +-#include +-#include "unrandomize.h" +-#endif +- + setbuf(stdin, stdin_buf); + setbuf(stdout, stdout_buf); + #ifdef _WIN32 diff --git a/patches/Version_2_6_13pre28 b/patches/Version_2_6_13pre28 new file mode 100644 index 00000000..563b08d5 --- /dev/null +++ b/patches/Version_2_6_13pre28 @@ -0,0 +1,353 @@ +Description: + 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-23) unstable; urgency=medium + . + * Version_2_6_13pre28 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/linux.h ++++ gcl-2.6.12/h/linux.h +@@ -132,20 +132,18 @@ do { int c = 0; \ + + #include + #include +-#define GET_FULL_PATH_SELF(a_) do {\ +- char b[20];\ +- static char q[PATH_MAX];\ +- struct stat ss;\ +- if (snprintf(b,sizeof(b),"/proc/%d/exe",getpid())<=0)\ +- error("Cannot write proc exe pathname");\ +- if (stat(b,&ss)) \ +- (a_)=argv[0];\ +- else {\ +- if (!realpath(b,q)) \ +- error("realpath error");\ +- (a_)=q;\ +- }\ +-} while(0) ++#define GET_FULL_PATH_SELF(a_) do { \ ++ static char q[PATH_MAX]; \ ++ const char *s="/proc/self/exe"; \ ++ struct stat ss; \ ++ if (stat(s,&ss)) \ ++ (a_)=argv[0]; \ ++ else { \ ++ if (!realpath(s,q)) \ ++ error("realpath error"); \ ++ (a_)=q; \ ++ } \ ++ } while(0) + + + #define UC(a_) ((ucontext_t *)a_) +--- gcl-2.6.12.orig/h/unrandomize.h ++++ gcl-2.6.12/h/unrandomize.h +@@ -23,6 +23,7 @@ + int i,j,k; + char **n,**a; + void *v; ++ argv[0]="/proc/self/exe"; + for (i=j=0;argv[i];i++) + j+=strlen(argv[i])+1; + for (k=0;envp[k];k++) +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -351,7 +351,8 @@ resize_hole(ufixnum hp,enum type tp,bool + + if (!in_placep && + ((new_start<=start && starts.s_dbind != Cnil) ++ emsg("Toggling relblock when resizing hole to %lu\n",hp); + tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + return resize_hole(hp,tp,in_placep); +@@ -387,7 +388,8 @@ alloc_page(long n) { + d=d<0 ? 0 : d; + d=(available_pages/3)s.s_dbind != Cnil) ++ emsg("Hole overrun\n"); + + resize_hole(d+nn,t_relocatable,0); + +@@ -857,7 +859,8 @@ add_pages(struct typemanager *tm,fixnum + case t_relocatable: + + if (rb_high() && m>((rb_start-heap_end)>>PAGEWIDTH)) { +- emsg("Moving relblock low before expanding relblock pages\n"); ++ if (sSAnotify_gbcA->s.s_dbind != Cnil) ++ emsg("Moving relblock low before expanding relblock pages\n"); + tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + } +@@ -1652,22 +1655,15 @@ DEFUN_NEW("GPROF-QUIT",object,fSgprof_qu + if (!gprof_on) + return Cnil; + +- if (!getcwd(b,sizeof(b))) +- FEerror("Cannot get working directory", 0); +- if (chdir(P_tmpdir)) +- FEerror("Cannot change directory to tmpdir", 0); ++ massert(getcwd(b,sizeof(b))); ++ massert(!chdir(P_tmpdir)); + _mcleanup(); +- if (snprintf(b1,sizeof(b1),"gprof %s",kcl_self)<=0) +- FEerror("Cannot write gprof command line", 0); +- if (!(pp=popen(b1,"r"))) +- FEerror("Cannot open gprof pipe", 0); ++ massert(snprintf(b1,sizeof(b1),"gprof %s",kcl_self)>0); ++ massert((pp=popen(b1,"r"))); + while ((n=fread(b1,1,sizeof(b1),pp))) +- if (!fwrite(b1,1,n,stdout)) +- FEerror("Cannot write gprof output",0); +- if (pclose(pp)<0) +- FEerror("Cannot close gprof pipe", 0); +- if (chdir(b)) +- FEerror("Cannot restore working directory", 0); ++ massert(fwrite(b1,1,n,stdout)); ++ massert(pclose(pp)>=0); ++ massert(!chdir(b)); + gprof_on=0; + + return Cnil; +@@ -1785,28 +1781,37 @@ static char *baby_malloc(n) + + bool writable_malloc=0; + +-void * +-malloc(size_t size) { +- +- static bool in_malloc; +- +- if (in_malloc) +- return NULL; +- in_malloc=1; ++static void * ++malloc_internal(size_t size) { + +- if (!gcl_alloc_initialized) +- gcl_init_alloc(&size); + #ifdef CAN_UNRANDOMIZE_SBRK +- else if (!gcl_unrandomized) +- return sbrk(size); ++ if (core_end && core_end!=sbrk(0))/*malloc before main in saved_image*/ ++ return sbrk(size);/*will never get to gcl_init_alloc, so brk point irrelevant*/ + #endif +- ++ if (!gcl_alloc_initialized) { ++ static bool recursive_malloc; ++ if (recursive_malloc) ++ error("Bad malloc"); ++ recursive_malloc=1; ++ gcl_init_alloc(&size); ++ recursive_malloc=0; ++ } ++ + CHECK_INTERRUPT; + + malloc_list = make_cons(alloc_simple_string(size), malloc_list); + malloc_list->c.c_car->st.st_self = alloc_contblock(size); + malloc_list->c.c_car->st.st_adjustable=writable_malloc; + ++ return(malloc_list->c.c_car->st.st_self); ++ ++} ++ ++void * ++malloc(size_t size) { ++ ++ void *v=malloc_internal(size);; ++ + /* FIXME: this is just to handle clean freeing of the + monstartup memory allocated automatically on raw image + startup. In saved images, monstartup memory is only +@@ -1814,12 +1819,11 @@ malloc(size_t size) { + #ifdef GCL_GPROF + if (raw_image && size>(textend-textstart) && !initial_monstartup_pointer) { + massert(!atexit(gprof_cleanup)); +- initial_monstartup_pointer=malloc_list->c.c_car->st.st_self; ++ initial_monstartup_pointer=v; + } + #endif + +- in_malloc=0; +- return(malloc_list->c.c_car->st.st_self); ++ return v; + + } + +--- gcl-2.6.12.orig/o/error.c ++++ gcl-2.6.12/o/error.c +@@ -35,7 +35,7 @@ object sSterminal_interrupt; + void + assert_error(const char *a,unsigned l,const char *f,const char *n) { + +- if (!raw_image) ++ if (!raw_image && core_end && core_end==sbrk(0)) + FEerror("The assertion ~a on line ~a of ~a in function ~a failed",4, + make_simple_string(a),make_fixnum(l), + make_simple_string(f),make_simple_string(n)); +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -1170,15 +1170,15 @@ GBC(enum type t) { + gc_time=0; + + #ifdef SGC +- printf("[%s for %ld %s pages..", +- (sgc_enabled ? "SGC" : "GC"), +- (sgc_enabled ? sgc_count_type(t) : tm_of(t)->tm_npage), +- (tm_table[(int)t].tm_name)+1); ++ emsg("[%s for %ld %s pages..", ++ (sgc_enabled ? "SGC" : "GC"), ++ (sgc_enabled ? sgc_count_type(t) : tm_of(t)->tm_npage), ++ (tm_table[(int)t].tm_name)+1); + #else +- printf("[%s for %ld %s pages..", +- ("GC"), +- (tm_of(t)->tm_npage), +- (tm_table[(int)t].tm_name)+1); ++ emsg("[%s for %ld %s pages..", ++ ("GC"), ++ (tm_of(t)->tm_npage), ++ (tm_table[(int)t].tm_name)+1); + #endif + + #ifdef SGC +@@ -1349,10 +1349,9 @@ GBC(enum type t) { + if (sSAnotify_gbcA->s.s_dbind != Cnil) { + + if (gc_recursive) +- fprintf(stdout, "(T=...).GC finished]\n"); ++ emsg("(T=...).GC finished]\n"); + else +- fprintf(stdout, "(T=%d).GC finished]\n",gc_start); +- fflush(stdout); ++ emsg("(T=%d).GC finished]\n",gc_start); + + } + +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -205,21 +205,21 @@ get_proc_meminfo_value_in_pages(const ch + return n>>(PAGEWIDTH-10); + } + ++#include ++ + static 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:"); ++ struct sysinfo s; ++ sysinfo(&s); ++ return (freep ? s.freeram : s.totalram)>>PAGEWIDTH; + + } + + #endif + + static ufixnum +-get_phys_pages(char freep) { ++get_phys_pages1(char freep) { + + return get_phys_pages_no_malloc(freep); + +@@ -313,7 +313,7 @@ update_real_maxpage(void) { + } + massert(!mbrk(cur)); + +- phys_pages=ufmin(get_phys_pages(0)+page(beg),real_maxpage)-page(beg); ++ phys_pages=ufmin(get_phys_pages1(0)+page(beg),real_maxpage)-page(beg); + + get_gc_environ(); + setup_maxpages(mem_multiple); +@@ -412,10 +412,6 @@ DEFVAR("*CODE-BLOCK-RESERVE*",sSAcode_bl + + #define HAVE_GCL_CLEANUP + +-#ifdef CAN_UNRANDOMIZE_SBRK +-bool gcl_unrandomized=FALSE; +-#endif +- + void + gcl_cleanup(int gc) { + +@@ -442,10 +438,6 @@ gcl_cleanup(int gc) { + cs_org=0; + initial_sbrk=core_end; + +-#ifdef CAN_UNRANDOMIZE_SBRK +- gcl_unrandomized=FALSE; +-#endif +- + } + + close_pool(); +@@ -460,7 +452,6 @@ main(int argc, char **argv, char **envp) + #include + #include + #include "unrandomize.h" +- gcl_unrandomized=TRUE; + #endif + + gcl_init_alloc(&argv); +--- gcl-2.6.12.orig/o/sfaslelf.c ++++ gcl-2.6.12/o/sfaslelf.c +@@ -181,8 +181,7 @@ relocate(Sym *sym1,void *v,ul a,ul start + #include RELOC_H + + default: +- emsg("Unknown reloc type %lu\n", tp); +- massert(tp&~tp); ++ massert(!emsg("Unknown reloc type %lu\n", tp)); + + } + +--- gcl-2.6.12.orig/o/sgbc.c ++++ gcl-2.6.12/o/sgbc.c +@@ -789,10 +789,8 @@ sgc_start(void) { + sgc_enabled=1; + if (memory_protect(1)) + sgc_quit(); +- if (sSAnotify_gbcA->s.s_dbind != Cnil) { +- printf("[SGC on]"); +- fflush(stdout); +- } ++ if (sSAnotify_gbcA->s.s_dbind != Cnil) ++ emsg("[SGC on]"); + + sSAoptimize_maximum_pagesA->s.s_dbind=omp; + +@@ -826,7 +824,7 @@ sgc_quit(void) { + memory_protect(0); + + if(sSAnotify_gbcA->s.s_dbind != Cnil) +- printf("[SGC off]"); fflush(stdout); ++ emsg("[SGC off]"); + + if (sgc_enabled==0) + return 0; diff --git a/patches/Version_2_6_13pre29 b/patches/Version_2_6_13pre29 new file mode 100644 index 00000000..9752a187 --- /dev/null +++ b/patches/Version_2_6_13pre29 @@ -0,0 +1,47 @@ +Description: + 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-23) unstable; urgency=medium + . + * Version_2_6_13pre28 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -1203,8 +1203,8 @@ object malloc_list=Cnil; + + void + maybe_set_hole_from_maxpages(void) { +- if (rb_start==heap_end && rb_end==rb_start && rb_limit==rb_start && rb_pointer==rb_start) +- resize_hole(available_pages/3,t_relocatable,0); ++ if (rb_pointer==rb_begin()) ++ resize_hole(ufmin(phys_pages,available_pages/3),t_relocatable,0); + } + + void +@@ -1358,7 +1358,7 @@ gcl_init_alloc(void *cs_start) { + set_tm_maxpage(tm_table+t_relocatable,1); + nrbpage=0; + +- resize_hole(ufmin(phys_pages,available_pages/3),t_relocatable,0); ++ maybe_set_hole_from_maxpages(); + #ifdef SGC + tm_table[(int)t_relocatable].tm_sgc = 50; + #endif diff --git a/patches/Version_2_6_13pre3 b/patches/Version_2_6_13pre3 new file mode 100644 index 00000000..e3360795 --- /dev/null +++ b/patches/Version_2_6_13pre3 @@ -0,0 +1,124 @@ +Description: + 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-3) unstable; urgency=medium + . + * Version_2_6_13pre2 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1938,3 +1938,6 @@ check_avail_pages(void); + + inline int + mbrk(void *); ++ ++void ++maybe_set_hole_from_maxpages(void); +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -259,19 +259,15 @@ eg to add 20 more do (si::set-hole-size + + holepage -= nn; + heap_end=v; +- return e; + ++ } else if (v>(void *)core_end) { ++ ++ massert(!mbrk(v)); ++ core_end=v; ++ + } +- +- if (nn<=(core_end-heap_end)/PAGESIZE) +- return(heap_end); +- +- if (mbrk(v)) +- error("Can't allocate. Good-bye!"); +- +- core_end=v; +- +- return(heap_end); ++ ++ return(e); + + } + +@@ -1177,6 +1173,15 @@ object malloc_list=Cnil; + #include + + void ++maybe_set_hole_from_maxpages(void) { ++ if (rb_start==heap_end && rb_end==rb_start && rb_limit==rb_start && rb_pointer==rb_start) { ++ holepage=new_holepage; ++ alloc_page(-holepage); ++ rb_start=rb_end=rb_limit=rb_pointer=heap_end+(holepage<s.s_fillp = i; + sym->s.s_self = alloc_relblock(i); ++ sym->s.s_fillp = i; + i=this_gensym_prefix->st.st_fillp; + for (j = 0; j < i; j++) + sym->s.s_self[j] = this_gensym_prefix->st.st_self[j]; +--- gcl-2.6.12.orig/pcl/makefile ++++ gcl-2.6.12/pcl/makefile +@@ -17,6 +17,7 @@ SETUP='(load "defsys.lisp")' \ + '(setq compiler::*default-c-file* t)'\ + '(setq compiler::*default-data-file* t)'\ + '(setq compiler::*default-system-p* t)' \ ++ '(setq si::*code-block-reserve* (make-array 10000000 :element-type (quote character) :static t) a nil)' \ + '(setq compiler::*keep-gaz* t compiler::*tmp-dir* "")' + + all: $(addsuffix .c,$(AFILES)) $(addsuffix .o,$(AFILES)) diff --git a/patches/Version_2_6_13pre30 b/patches/Version_2_6_13pre30 new file mode 100644 index 00000000..20b2b33f --- /dev/null +++ b/patches/Version_2_6_13pre30 @@ -0,0 +1,111 @@ +Description: + 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-23) unstable; urgency=medium + . + * Version_2_6_13pre29 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4435,6 +4435,10 @@ case $use in + # if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi + ;; + mips*) ++ case $canonical in ++ mips64*linux*) ++ TLIBS="$TLIBS -Wl,-z -Wl,now";; ++ esac + # if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 + ;; + ia64*) +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -640,6 +640,10 @@ case $use in + # if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi + ;; + mips*) ++ case $canonical in ++ mips64*linux*) ++ TLIBS="$TLIBS -Wl,-z -Wl,now";; ++ esac + # if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 + ;; + ia64*) +--- gcl-2.6.12.orig/h/elf64_mips_reloc_special.h ++++ gcl-2.6.12/h/elf64_mips_reloc_special.h +@@ -6,18 +6,28 @@ static ul ggot,ggote; static Rela *hr; + #define ELF_R_TYPE(a_) (((a_>>40)&0xff) ? ((a_>>40)&0xff) : ((a_>>56)&0xff)) + #define ELF_R_FTYPE(a_) ((a_>>56)&0xff) + ++typedef struct { ++ ul entry,gotoff; ++ unsigned int ld_gotoff,lw,jr,lwcan; ++} call_16_tramp; ++ + static int + write_stub(ul s,ul *got,ul *gote) { + +- int *goti; +- +- *gote=(ul)(goti=(void *)(gote+2)); +- *++gote=s; +- s=((void *)gote-(void *)got); +- *goti++=(0x37<<26)|(0x1c<<21)|(0x19<<16)|s; +- *goti++=(0x37<<26)|(0x19<<21)|(0x19<<16)|0; +- *goti++=0x03200008; +- *goti++=0x00200825; ++ static call_16_tramp t1={0,0, ++ (0x37<<26)|(0x1c<<21)|(0x19<<16), /*ld t9,(0)gp*/ ++ (0x37<<26)|(0x19<<21)|(0x19<<16), /*ld t9,(0)t9*/ ++ 0x03200008, /*jr t9*/ ++ 0 /*nop*/ ++ }; ++ call_16_tramp *t=(void *)gote; ++ ++ *t=t1; ++ *got=can_gp; ++ ++ t->entry=(ul)(gote+2); ++ t->gotoff=s; ++ t->ld_gotoff|=((void *)(gote+1)-(void *)got); + + return 0; + +@@ -31,7 +41,7 @@ make_got_room_for_stub(Shdr *sec1,Shdr * + if ((ssec>=sece || !ALLOC_SEC(ssec)) && + (a=find_sym_ptable(st1+sym->st_name)) && + a->address>=ggot && a->address>PAGEWIDTH; ++ return ((freep ? s.freeram : s.totalram)>>PAGEWIDTH)*s.mem_unit; + + } + diff --git a/patches/Version_2_6_13pre31 b/patches/Version_2_6_13pre31 new file mode 100644 index 00000000..4ec9d79b --- /dev/null +++ b/patches/Version_2_6_13pre31 @@ -0,0 +1,115 @@ +Description: + 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-24) unstable; urgency=medium + . + * Version_2_6_13pre30 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/386-kfreebsd.h ++++ gcl-2.6.12/h/386-kfreebsd.h +@@ -46,3 +46,4 @@ + #define RELOC_H "elf32_i386_reloc.h" + + #define BRK_DOES_NOT_GUARANTEE_ALLOCATION ++#define FREEBSD +--- gcl-2.6.12.orig/h/amd64-kfreebsd.h ++++ gcl-2.6.12/h/amd64-kfreebsd.h +@@ -23,3 +23,4 @@ + #define RELOC_H "elf64_i386_reloc.h" + + #define BRK_DOES_NOT_GUARANTEE_ALLOCATION ++#define FREEBSD +--- gcl-2.6.12.orig/h/elf64_mips_reloc_special.h ++++ gcl-2.6.12/h/elf64_mips_reloc_special.h +@@ -23,7 +23,6 @@ write_stub(ul s,ul *got,ul *gote) { + call_16_tramp *t=(void *)gote; + + *t=t1; +- *got=can_gp; + + t->entry=(ul)(gote+2); + t->gotoff=s; +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -152,6 +152,7 @@ mbrk(void *v) { + + static ufixnum + get_phys_pages_no_malloc(char n) { ++ + MEMORYSTATUS m; + + m.dwLength=sizeof(m); +@@ -166,6 +167,7 @@ get_phys_pages_no_malloc(char n) { + + static ufixnum + get_phys_pages_no_malloc(char n) { ++ + uint64_t s; + size_t z=sizeof(s); + int m[2]={CTL_HW,HW_MEMSIZE}; +@@ -186,33 +188,30 @@ get_phys_pages_no_malloc(char n) { + + } + +-#else ++#elif defined(FREEBSD) ++ ++#include ++#include ++ ++static ufixnum ++get_phys_pages_no_malloc(char n) { ++ ++ size_t i,len=sizeof(i); + +-ufixnum +-get_proc_meminfo_value_in_pages(const char *k) { +- int l,m; +- char b[PAGESIZE],*c; +- ufixnum n; ++ return (sysctlbyname("hw.physmem",&i,&len,NULL,0) ? 0 : i)>>PAGEWIDTH; + +- massert((l=open("/proc/meminfo",O_RDONLY))!=-1); +- massert((n=read(l,b,sizeof(b)))>(PAGEWIDTH-10); + } + ++#else /*Linux*/ ++ + #include + + static ufixnum + get_phys_pages_no_malloc(char freep) { + + struct sysinfo s; +- sysinfo(&s); +- return ((freep ? s.freeram : s.totalram)>>PAGEWIDTH)*s.mem_unit; ++ ++ return sysinfo(&s) ? 0 : ((freep ? s.freeram : s.totalram)>>PAGEWIDTH)*s.mem_unit; + + } + diff --git a/patches/Version_2_6_13pre32 b/patches/Version_2_6_13pre32 new file mode 100644 index 00000000..4c42fbf6 --- /dev/null +++ b/patches/Version_2_6_13pre32 @@ -0,0 +1,57 @@ +Description: + 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-25) unstable; urgency=medium + . + * Version_2_6_13pre31, kfreebsd and mips64 FTBFS fix +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/elf64_mips_reloc.h ++++ gcl-2.6.12/h/elf64_mips_reloc.h +@@ -1,6 +1,7 @@ + case R_MIPS_JALR: + break; + case R_MIPS_64: ++ if (ELF_R_FTYPE(r->r_info)==R_MIPS_GPREL32) s-=(ul)got; + add_val(where,~0L,s+a); + break; + case R_MIPS_GPREL32: +--- gcl-2.6.12.orig/h/elf64_mips_reloc_special.h ++++ gcl-2.6.12/h/elf64_mips_reloc_special.h +@@ -3,7 +3,7 @@ static ul ggot,ggote; static Rela *hr; + #undef ELF_R_SYM + #define ELF_R_SYM(a_) (a_&0xffffffff) + #undef ELF_R_TYPE +-#define ELF_R_TYPE(a_) (((a_>>40)&0xff) ? ((a_>>40)&0xff) : ((a_>>56)&0xff)) ++#define ELF_R_TYPE(a_) (((a_>>40)&0xff) ? ((a_>>40)&0xff) : (((a_>>48)&0xff) ? ((a_>>48)&0xff) : ((a_>>56)&0xff))) + #define ELF_R_FTYPE(a_) ((a_>>56)&0xff) + + typedef struct { +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -179,7 +179,7 @@ get_phys_pages_no_malloc(char n) { + + } + +-#elif defined(__sun__) ++#elif defined(__sun__) || defined(__GNU__) + + static ufixnum + get_phys_pages_no_malloc(char n) { diff --git a/patches/Version_2_6_13pre33 b/patches/Version_2_6_13pre33 new file mode 100644 index 00000000..3f918464 --- /dev/null +++ b/patches/Version_2_6_13pre33 @@ -0,0 +1,232 @@ +Description: + 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-26) unstable; urgency=medium + . + * Version_2_6_13pre32 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -161,7 +161,7 @@ + + + (defun compile-file1 (input-pathname +- &key (output-file input-pathname) ++ &key (output-file (truename input-pathname)) + (o-file t) + (c-file *default-c-file*) + (h-file *default-h-file*) +--- gcl-2.6.12.orig/h/elf64_mips_reloc.h ++++ gcl-2.6.12/h/elf64_mips_reloc.h +@@ -1,18 +1,28 @@ + case R_MIPS_JALR: + break; +- case R_MIPS_64: +- if (ELF_R_FTYPE(r->r_info)==R_MIPS_GPREL32) s-=(ul)got; +- add_val(where,~0L,s+a); +- break; + case R_MIPS_GPREL32: ++ recurse(s+a-(ul)got); + add_val(where,MASK(32),s+a-(ul)got); + break; ++ case R_MIPS_GPREL16: ++ recurse(s+a-(ul)got); ++ add_val(where,MASK(16),s+a-(ul)got); ++ break; ++ case R_MIPS_SUB: ++ recurse(-(s+a)); ++ break;/*???*/ ++ case R_MIPS_64: ++ recurse(s+a); ++ add_val(where,~0L,s+a); ++ break; + case R_MIPS_32: ++ recurse(s+a); + add_val(where,MASK(32),s+a); + break; + case R_MIPS_GOT_DISP: + case R_MIPS_CALL16: + case R_MIPS_GOT_PAGE: ++ recurse(s+a); + gote=got+(a>>32)-1; + a&=MASK(32); + store_val(where,MASK(16),((void *)gote-(void *)got)); +@@ -22,28 +32,27 @@ + *gote=s+(a&~MASK(16))+((a&0x8000)<<1); + break; + case R_MIPS_GOT_OFST: ++ recurse(s+a); + store_val(where,MASK(16),a); + break; + case R_MIPS_HI16: +- s+=a&MASK(32); +- if (ELF_R_FTYPE(r->r_info)==R_MIPS_GPREL16) s=(ul)got-s; ++ recurse(s+a); + if (!hr) hr=(void *)r; +- if (a&(1L<<32)) add_vals(where,MASK(16),(s+(a>>32))>>16); ++ if (lr)/*==(Rela *)r*/ ++ add_vals(where,MASK(16),(s+a+la)>>16); + break; + case R_MIPS_LO16: ++ recurse(s+a); + s+=a; +- if (ELF_R_FTYPE(r->r_info)==R_MIPS_GPREL16) s=(ul)got-s; + a=*where&MASK(16); + if (a&0x8000) a|=0xffffffffffff0000; + a+=s&MASK(16); + a+=(a&0x8000)<<1; + store_val(where,MASK(16),a); +- a&=~MASK(16); +- { +- Rela *ra=(void *)r; +- for (hr=hr ? hr : (void *)ra;--ra>=hr;) +- if (ELF_R_TYPE(ra->r_info)==R_MIPS_HI16) +- relocate(sym1,ra,ra->r_addend|(1L<<32)|(a<<32),start,got,gote); +- } +- hr=NULL; ++ for (la=a&~MASK(16),lr=(Rela *)r,hr=hr ? hr : lr;--lr>=hr;) ++ if (ELF_R_TYPE1(lr->r_info)==R_MIPS_HI16|| ++ ELF_R_TYPE2(lr->r_info)==R_MIPS_HI16|| ++ ELF_R_TYPE3(lr->r_info)==R_MIPS_HI16) ++ relocate(sym1,lr,lr->r_addend,start,got,gote); ++ hr=lr=NULL; + break; +--- gcl-2.6.12.orig/h/elf64_mips_reloc_special.h ++++ gcl-2.6.12/h/elf64_mips_reloc_special.h +@@ -1,10 +1,21 @@ +-static ul ggot,ggote; static Rela *hr; ++static ul ggot,ggote,la; static Rela *hr,*lr; + + #undef ELF_R_SYM + #define ELF_R_SYM(a_) (a_&0xffffffff) ++#define ELF_R_TYPE1(a_) ((a_>>56)&0xff) ++#define ELF_R_TYPE2(a_) ((a_>>48)&0xff) ++#define ELF_R_TYPE3(a_) ((a_>>40)&0xff) ++#define recurse(val) ({ \ ++ if (ELF_R_TYPE2(r->r_info)) { \ ++ ul i=r->r_info; \ ++ r->r_info=(((r->r_info>>32)&MASK(24))<<40)|(r->r_info&MASK(32)); \ ++ relocate(sym1,r,(val)-s,start,got,gote); \ ++ r->r_info=i; \ ++ break; \ ++ }}) ++ + #undef ELF_R_TYPE +-#define ELF_R_TYPE(a_) (((a_>>40)&0xff) ? ((a_>>40)&0xff) : (((a_>>48)&0xff) ? ((a_>>48)&0xff) : ((a_>>56)&0xff))) +-#define ELF_R_FTYPE(a_) ((a_>>56)&0xff) ++#define ELF_R_TYPE(a_) ELF_R_TYPE1(a_) + + typedef struct { + ul entry,gotoff; +--- gcl-2.6.12.orig/h/object.h ++++ gcl-2.6.12/h/object.h +@@ -568,6 +568,12 @@ EXTER unsigned plong signals_allowed, si + + #define IMMNIL(x) (is_imm_fixnum(x)||x==Cnil) + +-#define eql(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (!IMMNIL(_a)&&!IMMNIL(_b)&&eql1(_a,_b));}) +-#define equal(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (!IMMNIL(_a)&&!IMMNIL(_b)&&equal1(_a,_b));}) +-#define equalp(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (_a!=Cnil&&_b!=Cnil&&equalp1(_a,_b));}) ++/*gcc boolean expression tail position bug*/ ++ ++/* #define eql(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (!IMMNIL(_a)&&!IMMNIL(_b)&&eql1(_a,_b));}) */ ++/* #define equal(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (!IMMNIL(_a)&&!IMMNIL(_b)&&equal1(_a,_b));}) */ ++/* #define equalp(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (_a!=Cnil&&_b!=Cnil&&equalp1(_a,_b));}) */ ++ ++#define eql(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b ? TRUE : (IMMNIL(_a)||IMMNIL(_b) ? FALSE : eql1(_a,_b));}) ++#define equal(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b ? TRUE : (IMMNIL(_a)||IMMNIL(_b) ? FALSE : equal1(_a,_b));}) ++#define equalp(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b ? TRUE : (_a==Cnil||_b==Cnil ? FALSE : equalp1(_a,_b));}) +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -443,6 +443,23 @@ gcl_cleanup(int gc) { + + } + ++/*gcc boolean expression tail position bug*/ ++ ++void * ++cclear_stack(unsigned long size) { ++ void *v=alloca(size); ++ memset(v,0,size); ++ return v; ++} ++ ++DEFUN_NEW("EQUAL-TAIL-RECURSION-CHECK",object,fSequal_tail_recursion_check,SI,1,1,NONE,II,OO,OO,OO,(fixnum s),"") { ++ object x0=make_list(s/sizeof(object)),x1=make_list(s/sizeof(object)); ++ char *u=cclear_stack(s),*w; ++ fLequal(x0,x1); ++ for (w=u;wc.c_car,y->c.c_car)) { +- x=x->c.c_cdr; +- y=y->c.c_cdr; +- if (x==y) return TRUE; +- if (IMMNIL(x)||IMMNIL(y)) return FALSE; +- goto BEGIN; +- } else +- return FALSE; +- } +-#else +- +- if (valid_cdr(x)) return valid_cdr(y)&&equal(x->c.c_car,y->c.c_car)&&equal(x->c.c_cdr,y->c.c_cdr); +- +-#endif ++ /*gcc boolean expression tail position bug*/ ++ /* if (valid_cdr(x)) return valid_cdr(y)&&equal(x->c.c_car,y->c.c_car)&&equal(x->c.c_cdr,y->c.c_cdr); */ ++ if (valid_cdr(x)) return !valid_cdr(y)||!equal(x->c.c_car,y->c.c_car) ? FALSE : equal(x->c.c_cdr,y->c.c_cdr); + + if (valid_cdr(y)) return FALSE; + +@@ -524,7 +510,9 @@ equalp1(register object x, register obje + + /*x and y are not == and not Cnil*/ + +- if (listp(x)) return listp(y)&&equalp(x->c.c_car,y->c.c_car)&&equalp(x->c.c_cdr,y->c.c_cdr); ++ /*gcc boolean expression tail position bug*/ ++ /* if (listp(x)) return listp(y)&&equalp(x->c.c_car,y->c.c_car)&&equalp(x->c.c_cdr,y->c.c_cdr); */ ++ if (listp(x)) return !listp(y)||!equalp(x->c.c_car,y->c.c_car) ? FALSE : equalp(x->c.c_cdr,y->c.c_cdr); + + if (listp(y)) return FALSE; + +--- gcl-2.6.12.orig/unixport/sys_init.lsp.in ++++ gcl-2.6.12/unixport/sys_init.lsp.in +@@ -79,3 +79,7 @@ + + #+ansi-cl (use-package :pcl :user) + #+ansi-cl (import 'si::(clines defentry defcfun object void int double quit bye gbc system) :user) ++ ++(let* ((i 4096)(j (si::equal-tail-recursion-check i))) ++ (unless (eql i j) ++ (warn "equal is not tail recursive ~s ~s" i j))) diff --git a/patches/Version_2_6_13pre34 b/patches/Version_2_6_13pre34 new file mode 100644 index 00000000..15aa00d9 --- /dev/null +++ b/patches/Version_2_6_13pre34 @@ -0,0 +1,34 @@ +Description: + 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-27) unstable; urgency=medium + . + * Version_2_6_13pre33; mips64 relocs; stack saving tail-recursive equal. +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/unixport/sys_init.lsp.in ++++ gcl-2.6.12/unixport/sys_init.lsp.in +@@ -81,5 +81,5 @@ + #+ansi-cl (import 'si::(clines defentry defcfun object void int double quit bye gbc system) :user) + + (let* ((i 4096)(j (si::equal-tail-recursion-check i))) +- (unless (eql i j) ++ (unless (<= (ash i -1) j) + (warn "equal is not tail recursive ~s ~s" i j))) diff --git a/patches/Version_2_6_13pre35 b/patches/Version_2_6_13pre35 new file mode 100644 index 00000000..90ea7eae --- /dev/null +++ b/patches/Version_2_6_13pre35 @@ -0,0 +1,40 @@ +Description: + 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-27) unstable; urgency=medium + . + * Version_2_6_13pre34; mips64 relocs; stack saving tail-recursive equal. +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/o/predicate.c ++++ gcl-2.6.12/o/predicate.c +@@ -501,6 +501,12 @@ oequal(object x,object y) { + DEFUN_NEW("EQUAL",object,fLequal,LISP,2,2,NONE,OO,OO,OO,OO,(object x0,object x1),"") { + RETURN1(equal(x0, x1) ? Ct : Cnil); + } ++#ifdef STATIC_FUNCTION_POINTERS ++object ++fLequal(object x,object y) { ++ return FFN(fLequal)(x,y); ++} ++#endif + + bool + equalp1(register object x, register object y) { diff --git a/patches/Version_2_6_13pre36 b/patches/Version_2_6_13pre36 new file mode 100644 index 00000000..ac9a53ca --- /dev/null +++ b/patches/Version_2_6_13pre36 @@ -0,0 +1,89 @@ +Description: + 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-28) unstable; urgency=medium + . + * Version_2_6_13pre35; restore hppa build +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/o/makefile ++++ gcl-2.6.12/o/makefile +@@ -34,7 +34,7 @@ boot.o: boot.c $(DECL) boot.h + $(CC) -c $(CFLAGS) $(DEFS) -fPIC $*.c $(AUX_INFO) + + prelink.o: prelink.c $(DECL) +- $(CC) -fPIE -c $(CFLAGS) $(DEFS) $*.c $(AUX_INFO) ++ $(CC) -fPIE -c $(filter-out -pg,$(CFLAGS)) $(DEFS) $*.c $(AUX_INFO) + + %.o: %.c $(DECL) + $(CC) -c $(CFLAGS) $(DEFS) $*.c $(AUX_INFO) +--- gcl-2.6.12.orig/o/sfasli.c ++++ gcl-2.6.12/o/sfasli.c +@@ -111,46 +111,17 @@ LFD(build_symbol_table)(void) { + + } + +-extern int mcount(); +-extern int _mcount(); +-extern int __divdi3(); +-extern int __moddi3(); +-extern int __udivdi3(); +-extern int __umoddi3(); +-extern void sincos(double,double *,double *); +-extern int __divsi3(); +-extern int __modsi3(); +-extern int __udivsi3(); +-extern int __umodsi3(); +-extern int $$divI(); +-extern int $$divU(); +-extern int $$remI(); +-extern int $$remU(); +-extern int __divq(); +-extern int __divqu(); +-extern int __remq(); +-extern int __remqu(); +- +-#ifndef DARWIN + #ifndef _WIN32 + int + use_symbols(double d,...) { + +- sincos(d,&d,&d); +- +-#ifdef GCL_GPROF +- _mcount(); +-#endif +- +- return (int)d; ++#ifndef DARWIN ++ extern void sincos(double,double *,double *); + +-} +-#endif ++ sincos(d,&d,&d); + #else +-int +-use_symbols(double d,...) { +- + d=sin(d)+cos(d); ++#endif + + return (int)d; + diff --git a/patches/Version_2_6_13pre38 b/patches/Version_2_6_13pre38 new file mode 100644 index 00000000..7feda75d --- /dev/null +++ b/patches/Version_2_6_13pre38 @@ -0,0 +1,308 @@ +Description: + 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-29) unstable; urgency=medium + . + * Version_2_6_13pre35; support latest binutils + * Bug fix: "gcl ftbfs on amd64 and i386 with binutils from + experimental", thanks to Matthias Klose (Closes: #803214). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/803214 + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpvs.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpvs.lsp +@@ -75,8 +75,8 @@ + (defun wt-vs* (vs) + (wt "(" )(wt-vs vs) (wt "->c.c_car)")) + +-(defun wt-ccb-vs (ccb-vs) +- (wt "(fun->cc.cc_turbo[" (- *initial-ccb-vs* ccb-vs) "]->c.c_car)")) ++(defun wt-ccb-vs (ccb-vs);;FIXME harmonize *closure-p* with *clink* ++ (wt "(" (if *closure-p* "fun->cc.cc_turbo" "base0") "[" (- *initial-ccb-vs* ccb-vs) "]->c.c_car)")) + + (defun clink (vs) (setq *clink* vs)) + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -7663,7 +7663,7 @@ fi + if test "${enable_ansi+set}" = set; then : + enableval=$enable_ansi; + else +- enable_ansi="no" ++ enable_ansi="yes" + fi + + +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -2133,7 +2133,7 @@ AC_ARG_ENABLE(readline, + + # ansi lisp + AC_ARG_ENABLE(ansi,[--enable-ansi builds a large gcl aiming for ansi compliance, +- --disable-ansi builds the smaller traditional CLtL1 image],,enable_ansi="no") ++ --disable-ansi builds the smaller traditional CLtL1 image],,enable_ansi="yes") + + if test "$enable_ansi" = "yes" ; then + SYSTEM=ansi_gcl +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -1241,7 +1241,7 @@ gcl_init_alloc(void *cs_start) { + + massert(!getrlimit(RLIMIT_STACK, &rl)); + if (rl.rlim_cur!=RLIM_INFINITY && (rl.rlim_max == RLIM_INFINITY || rl.rlim_max > rl.rlim_cur)) { +- rl.rlim_cur = rl.rlim_max == RLIM_INFINITY ? rl.rlim_max : rl.rlim_max/64; ++ rl.rlim_cur = rl.rlim_max; + massert(!setrlimit(RLIMIT_STACK,&rl)); + } + cssize = rl.rlim_cur/sizeof(*cs_org) - sizeof(*cs_org)*CSGETA; +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -2407,17 +2407,18 @@ object x=Cnil; + inPort = (myport == Cnil ? 0 : fix(Iis_fixnum(myport))); + + #ifdef BSD ++ + if (isServer && daemon != Cnil) { + + long pid,i; + struct rlimit r; +- struct sigaction sa; ++ struct sigaction sa,osa; + + sa.sa_handler=SIG_IGN; + sa.sa_flags=SA_NOCLDWAIT; + sigemptyset(&sa.sa_mask); + +- sigaction(SIGCHLD,&sa,NULL); ++ massert(!sigaction(SIGCHLD,&sa,&osa)); + + switch((pid=pfork())) { + case -1: +@@ -2425,8 +2426,7 @@ object x=Cnil; + break; + case 0: + +- if (setsid()<0) +- FEerror("setsid error", 0); ++ massert(setsid()>=0); + + if (daemon == sKpersistent) + switch(pfork()) { +@@ -2440,23 +2440,17 @@ object x=Cnil; + break; + } + ++ massert(!chdir("/")); ++ + memset(&r,0,sizeof(r)); +- if (getrlimit(RLIMIT_NOFILE,&r)) +- FEerror("Cannot get resourse usage",0); ++ massert(!getrlimit(RLIMIT_NOFILE,&r)); + + for (i=0;i=0); ++ massert((i=dup(i))>=0); ++ massert((i=dup(i))>=0); + + umask(0); + +@@ -2473,16 +2467,14 @@ object x=Cnil; + + FD_ZERO(&fds); + FD_SET(fd,&fds); +- i=select(fd+1,&fds,NULL,NULL,NULL); + +- if (i>0) { ++ if (select(fd+1,&fds,NULL,NULL,NULL)>0) { + + y=maccept(x); + +- sigaction(SIGCHLD,&sa,NULL); +- + switch((pid=pfork())) { + case 0: ++ massert(!sigaction(SIGCHLD,&osa,NULL)); + ifuncall1(server,y); + exit(0); + break; +@@ -2506,6 +2498,8 @@ object x=Cnil; + break; + } + ++ massert(!sigaction(SIGCHLD,&osa,NULL)); ++ + } else + + #endif +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -227,9 +227,9 @@ get_phys_pages1(char freep) { + static void + get_gc_environ(void) { + +- const char *e;; ++ const char *e; + +- mem_multiple=1.0; ++ mem_multiple=0.85; + if ((e=getenv("GCL_MEM_MULTIPLE"))) { + massert(sscanf(e,"%lf",&mem_multiple)==1); + massert(mem_multiple>=0.0); +--- gcl-2.6.12.orig/o/nsocket.c ++++ gcl-2.6.12/o/nsocket.c +@@ -630,50 +630,43 @@ doReverse(char *s, int n) + of the buffer may be changed. + */ + int +-getCharGclSocket(object strm, object block) +-{ +- object bufp = SOCKET_STREAM_BUFFER(strm); +- if (bufp->ust.ust_fillp > 0) { +- dprintf("getchar returns (%c)\n",bufp->ust.ust_self[-1+(bufp->ust.ust_fillp)]); ++getCharGclSocket(object strm, object block) { ++ ++ object bufp=SOCKET_STREAM_BUFFER(strm); ++ int fd=SOCKET_STREAM_FD(strm); ++ ++ if (bufp->ust.ust_fillp > 0) + return bufp->ust.ust_self[--(bufp->ust.ust_fillp)]; +- } +- else { ++ ++ if (fd>=0) { ++ + fd_set readfds; +- struct timeval timeout; +- int fd = SOCKET_STREAM_FD(strm); +- if (1) +- { int high; +- AGAIN: +- /* under cygwin a too large timout like (1<<30) does not work */ +- timeout.tv_sec = 0; +- timeout.tv_usec = 10000; +- FD_ZERO(&readfds); +- FD_SET(fd,&readfds); +- high = select(fd+1,&readfds,NULL,NULL,block==Ct ? NULL : &timeout); +- if (high > 0) +- { object bufp = SOCKET_STREAM_BUFFER(strm); +- int n; +- n = SAFE_READ(fd,bufp->st.st_self ,bufp->ust.ust_dim); ++ struct timeval t,t1={0,10000},*tp=block==Ct ? NULL : &t; ++ int high,n; ++ ++ FD_ZERO(&readfds); ++ FD_SET(fd,&readfds); ++ ++ for (;(errno=0,t=t1,high=select(fd+1,&readfds,NULL,NULL,tp))==-1 && !tp && errno==EINTR;); ++ ++ if (high > 0) { ++ ++ massert((n=SAFE_READ(fd,bufp->st.st_self,bufp->ust.ust_dim))>=0); ++ ++ if (n) { + doReverse(bufp->st.st_self,n); + bufp->ust.ust_fillp=n; +- if (n > 0) +- { +- dprintf("getchar returns (%c)\n",bufp->ust.ust_self[-1+(bufp->ust.ust_fillp)]); +- return bufp->ust.ust_self[--(bufp->ust.ust_fillp)]; +- } +- else +- { +- SOCKET_STREAM_FD(strm)=-1; +- return EOF; +- FEerror("select said there was stuff there but there was not",0); +- } +- } +- /* probably a signal interrupted us.. */ +- if (block == Ct) +- goto AGAIN; +- return EOF; +- } ++ } else ++ SOCKET_STREAM_FD(strm)=-1; ++ ++ return getCharGclSocket(strm,block); ++ ++ } ++ + } ++ ++ return EOF; ++ + } + + #else +--- gcl-2.6.12.orig/o/prelink.c ++++ gcl-2.6.12/o/prelink.c +@@ -7,6 +7,7 @@ extern FILE *stdin __attribute__((weak)) + extern FILE *stderr __attribute__((weak)); + extern FILE *stdout __attribute__((weak)); + ++#ifdef HAVE_READLINE + #if RL_READLINE_VERSION < 0x0600 + extern Function *rl_completion_entry_function __attribute__((weak)); + extern char *rl_readline_name __attribute__((weak)); +@@ -15,6 +16,7 @@ extern rl_compentry_func_t *rl_completio + extern const char *rl_readline_name __attribute__((weak)); + #endif + #endif ++#endif + + void + prelink_init(void) { +--- gcl-2.6.12.orig/o/sfasli.c ++++ gcl-2.6.12/o/sfasli.c +@@ -116,14 +116,20 @@ int + use_symbols(double d,...) { + + #ifndef DARWIN ++ + extern void sincos(double,double *,double *); ++ double d2; ++ ++ sincos(d,&d,&d2); + +- sincos(d,&d,&d); + #else ++ + d=sin(d)+cos(d); ++ d2=sin(d)+cos(d); ++ + #endif + +- return (int)d; ++ return (int)(d+d2); + + } + #endif diff --git a/patches/Version_2_6_13pre39 b/patches/Version_2_6_13pre39 new file mode 100644 index 00000000..5ffdcd04 --- /dev/null +++ b/patches/Version_2_6_13pre39 @@ -0,0 +1,53 @@ +Description: + 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-30) unstable; urgency=medium + . + * Version_2_6_13pre38 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4379,7 +4379,10 @@ $as_echo "Reducing optimization on profi + enable_debug=yes;; + esac + TCFLAGS="$TCFLAGS -pg"; +- TLIBS="$TLIBS -pg"; ++ case $use in ++ s390*) ;; # relocation truncation bug in gcc ++ *) TLIBS="$TLIBS -pg";; ++ esac + TFPFLAG="" + + $as_echo "#define GCL_GPROF 1" >>confdefs.h +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -587,7 +587,10 @@ if test "$enable_gprof" = "yes" ; then + enable_debug=yes;; + esac + TCFLAGS="$TCFLAGS -pg"; +- TLIBS="$TLIBS -pg"; ++ case $use in ++ s390*) ;; # relocation truncation bug in gcc ++ *) TLIBS="$TLIBS -pg";; ++ esac + TFPFLAG="" + AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) + else diff --git a/patches/Version_2_6_13pre3a b/patches/Version_2_6_13pre3a new file mode 100644 index 00000000..db3902c5 --- /dev/null +++ b/patches/Version_2_6_13pre3a @@ -0,0 +1,62 @@ +Description: + 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-4) unstable; urgency=medium + . + * Version_2_6_13pre3 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/bsd.h ++++ gcl-2.6.12/h/bsd.h +@@ -33,7 +33,7 @@ filecpy(save, original, stsize - sizeof( + + extern char etext; + +-#define INIT_ALLOC heap_end = core_end = sbrk(0); ++#define INIT_ALLOC heap_end = core_end = PCEI(sbrk(0),PAGESIZE); + + #define SYM_EXTERNAL_P(sym) ((sym)->n_type & N_EXT) + +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -229,9 +229,7 @@ alloc_page(long n) { + + if (!s) { + +- if (nn>(holepage - (in_signal_handler? 0 : +- available_pages-n<=reserve_pages_for_signal_handler ? 0 : +- reserve_pages_for_signal_handler))) { ++ if (nn>holepage) { + + + fixnum d=available_pages-nn; +@@ -241,12 +239,6 @@ alloc_page(long n) { + d=d<0 ? 0 : d; + d=new_holepage + 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-4) unstable; urgency=medium + . + * Version_2_6_13pre3a +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/elf64_ppcle_reloc_special.h ++++ gcl-2.6.12/h/elf64_ppcle_reloc_special.h +@@ -15,8 +15,6 @@ find_special_params(void *v,Shdr *sec1,S + Shdr *sec; + Rela *r; + void *ve; +- ul j,*u; +- + + massert((sec=get_section(".rela.plt",sec1,sece,sn))); + +--- gcl-2.6.12.orig/h/page.h ++++ gcl-2.6.12/h/page.h +@@ -88,7 +88,8 @@ extern int reserve_pages_for_signal_hand + /* #define CONT_MARK_PAGE (((page(heap_end)-first_data_page)*(PAGESIZE/(CPTR_SIZE*CHAR_SIZE))+PAGESIZE-1)/PAGESIZE) */ + /* #define available_pages ((fixnum)(real_maxpage-page(heap_end)-2*nrbpage-CONT_MARK_PAGE-resv_pages)) */ + +-extern struct pageinfo *cell_list_head,*cell_list_tail,*contblock_list_head,*contblock_list_tail; ++extern struct pageinfo *cell_list_head,*cell_list_tail/* ,*contblock_list_head,*contblock_list_tail */; ++extern object contblock_array; + + #define PAGE_MAGIC 0x2e + +@@ -114,7 +115,7 @@ EXTER void *data_start,*initial_sbrk; + #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 cpage(m_) CEI(({ufixnum _m=(m_);ceil(sizeof(struct pageinfo)+_m+2*ceil(_m,(CB_BITS-2)),PAGESIZE);}),256) + #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)+1) : (tm_->tm_type==t_contiguous ? cpage(m_) : npage(m_))) + +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1941,3 +1941,12 @@ mbrk(void *); + + void + maybe_set_hole_from_maxpages(void); ++ ++void * ++alloc_code_space(size_t); ++ ++object ++fSmake_vector1_2(fixnum,fixnum,object,object); ++ ++inline struct pageinfo * ++get_pageinfo(void *); +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -78,6 +78,72 @@ struct rlimit data_rlimit; + #endif + #endif + ++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; ++ ++} ++ ++ ++object contblock_array=Cnil; ++ ++static inline void ++expand_contblock_array(void) { ++ ++ if (contblock_array==Cnil) { ++ contblock_array=fSmake_vector1_2(16,aet_fix,Cnil,make_fixnum(0)); ++ contblock_array->v.v_self[0]=(object)&cb_pointer; ++ enter_mark_origin(&contblock_array); ++ } ++ ++ if (contblock_array->v.v_fillp==contblock_array->v.v_dim) { ++ ++ void *v=alloc_relblock(2*contblock_array->v.v_dim*sizeof(fixnum)); ++ ++ memcpy(v,contblock_array->v.v_self,contblock_array->v.v_dim*sizeof(fixnum)); ++ contblock_array->v.v_self=v; ++ contblock_array->v.v_dim*=2; ++ ++ } ++ ++} ++ ++static void ++contblock_array_push(void *p) { ++ ++ expand_contblock_array(); ++ contblock_array->v.v_self[contblock_array->v.v_fillp]=p; ++ contblock_array->v.v_fillp++; ++ ++} ++ ++static inline int ++acomp(const void *v1,const void *v2) { ++ ++ void *p1=*(void * const *)v1,*p2=*(void * const *)v2; ++ ++ return p1v.v_self,contblock_array->v.v_fillp,sizeof(*contblock_array->v.v_self),acomp); ++ struct pageinfo *p=(void *)pp>(void *)contblock_array->v.v_self ? pp[-1] : NULL; ++ ++ return p && (void *)p+p->in_use*PAGESIZE>x ? p : NULL; ++ ++} ++ + inline void + add_page_to_contblock_list(void *p,fixnum m) { + +@@ -89,13 +155,8 @@ add_page_to_contblock_list(void *p,fixnu + massert(pp->in_use==m); + pp->magic=PAGE_MAGIC; + +- if (contblock_list_head==NULL) +- contblock_list_tail=contblock_list_head=p; +- else if (pp > contblock_list_tail) { +- contblock_list_tail->next=p; +- contblock_list_tail=p; +- } +- ++ contblock_array_push(p); ++ + bzero(pagetochar(page(pp)),CB_DATA_START(pp)-(void *)pagetochar(page(pp))); + #ifdef SGC + if (sgc_enabled && tm_table[t_contiguous].tm_sgc) { +@@ -458,7 +519,7 @@ rebalance_maxpages(struct typemanager *m + for (i=t_start;iv.v_self[0]=(object)&cb_pointer; + enter_mark_origin(&cbv); + } +@@ -612,21 +673,6 @@ cbcomp(const void *v1,const void *v2) { + + } + +-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) { + +@@ -777,7 +823,7 @@ grow_linear1(struct typemanager *tm) { + static inline int + too_full_p(struct typemanager *tm) { + +- fixnum j,k,pf=tm->tm_percent_free ? tm->tm_percent_free : 30; ++ fixnum i,j,k,pf=tm->tm_percent_free ? tm->tm_percent_free : 30; + struct contblock *cbp; + struct pageinfo *pi; + +@@ -787,11 +833,13 @@ too_full_p(struct typemanager *tm) { + break; + case t_contiguous: + for (cbp=cb_pointer,k=0;cbp;cbp=cbp->cb_link) k+=cbp->cb_size; +- for (pi=contblock_list_head,j=0;pi;pi=pi->next) ++ for (i=j=0;iv.v_fillp;i++) { ++ pi=(void *)contblock_array->v.v_self[i]; + #ifdef SGC + if (!sgc_enabled || pi->sgc_flags&SGC_PAGE_FLAG) + #endif + j+=pi->in_use; ++ } + return 100*ktm_maxpage-tm->tm_npage; */ + add_pages(tm,m); + + return alloc_from_freelist(tm,n); +@@ -997,6 +1042,34 @@ alloc_contblock_no_gc(size_t n) { + + } + ++#ifndef MAX_CODE_ADDRESS ++#define MAX_CODE_ADDRESS -1UL ++#endif ++ ++void * ++alloc_code_space(size_t sz) { ++ ++ void *v; ++ ++ sz=CEI(sz,CPTR_SIZE); ++ ++ 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 && (unsigned long)(v+sz)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) { + void *ve=CB_DATA_START(pi); +@@ -811,7 +784,7 @@ mark_stack_carefully(void *topv, void *b + + for (j=top ; j >= bottom ; j--) { + +- void *v=(void *)(*j),**a; ++ void *v=(void *)(*j); + struct pageinfo *pi; + + if (!VALID_DATA_ADDRESS_P(v)) continue; +@@ -822,7 +795,7 @@ mark_stack_carefully(void *topv, void *b + pi=pagetoinfo(p); + if (!pageinfo_p(pi)) continue; + +- if ((a=contblock_stack_list) && in_contblock_stack_list(pi,&a)) continue; ++ if (get_pageinfo(pi)) continue; + + tm=tm_of(pi->type); + if (tm->tm_type>=t_end) continue; +@@ -1067,14 +1040,24 @@ sweep_phase(void) { + static void + contblock_sweep_phase(void) { + ++ struct pageinfo *v; + STATIC char *s, *e, *p, *q; +- STATIC struct pageinfo *v; ++ object o; ++ ufixnum i; + + reset_contblock_freelist(); +- +- for (v=contblock_list_head;v;v=v->next) { ++ ++ o=sSAleaf_collection_thresholdA->s.s_dbind; ++ sSAleaf_collection_thresholdA->s.s_dbind=make_fixnum(-1); ++ ++ for (i=0;iv.v_fillp && (v=(void *)contblock_array->v.v_self[i]);i++) { ++ + bool z; + ++#ifdef SGC ++ if (sgc_enabled && !(v->sgc_flags&SGC_PAGE_FLAG)) continue; ++#endif ++ + s=CB_DATA_START(v); + e=(void *)v+v->in_use*PAGESIZE; + +@@ -1090,14 +1073,9 @@ contblock_sweep_phase(void) { + bzero(CB_MARK_START(v),CB_SGCF_START(v)-CB_MARK_START(v)); + + } +-#ifdef DEBUG +- if (debug) { +- for (cbp = cb_pointer; cbp != NULL; cbp = cbp->cb_link) +- printf("%lud-byte contblock\n", cbp->cb_size); +- fflush(stdout); +- } +-#endif +- ++ ++ sSAleaf_collection_thresholdA->s.s_dbind=o; ++ + sweep_link_array(); + + } +@@ -1143,24 +1121,6 @@ GBC(enum type t) { + + 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;iin_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"); + +@@ -1312,12 +1272,7 @@ GBC(enum type t) { + } + #endif + +-#ifdef SGC +- if (sgc_enabled) +- sgc_contblock_sweep_phase(); +- else +-#endif +- contblock_sweep_phase(); ++ contblock_sweep_phase(); + #ifdef DEBUG + if (debug) + printf("contblock sweep ended (%d)\n", +@@ -1574,7 +1529,7 @@ mark_contblock(void *p, int s) { + sizeof(struct contblock). CM 20030827 */ + x = (char *)PFLR(p,CPTR_SIZE); + y = (char *)PCEI(q,CPTR_SIZE); +- v=get_pageinfo(x); ++ massert(v=get_pageinfo(x)); + #ifdef SGC + if (!sgc_enabled || (v->sgc_flags&SGC_PAGE_FLAG)) + #endif +@@ -1595,7 +1550,7 @@ DEFUN_NEW("CONTIGUOUS-REPORT",object,fSc + } + 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) ++ for (i=j=k=0;kv.v_fillp && (v=(void *)contblock_array->v.v_self[k]);k++,i+=v->in_use,j++) + 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); + +--- gcl-2.6.12.orig/o/sfaslelf.c ++++ gcl-2.6.12/o/sfaslelf.c +@@ -242,32 +242,6 @@ 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)cfd.cfd_size=sz; + memory->cfd.cfd_self=0; + memory->cfd.cfd_start=0; +- memory->cfd.cfd_start=alloc_memory(sz); ++ memory->cfd.cfd_start=alloc_code_space(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 +@@ -99,7 +99,7 @@ sgc_mark_phase(void) { + + /* mark all non recent data on writable contiguous pages */ + if (what_to_collect == t_contiguous) +- for (v=contblock_list_head;v;v=v->next) ++ for (i=0;iv.v_fillp && (v=(void *)contblock_array->v.v_self[i]);i++) + if (v->sgc_flags&SGC_PAGE_FLAG) { + void *s=CB_DATA_START(v),*e=CB_DATA_END(v),*p,*q; + bool z=get_sgc_bit(v,s); +@@ -213,40 +213,6 @@ sgc_sweep_phase(void) { + } + } + +- +-static void +-sgc_contblock_sweep_phase(void) { +- +- STATIC char *s, *e, *p, *q; +- STATIC struct pageinfo *v; +- +- reset_contblock_freelist(); +- +- for (v=contblock_list_head;v;v=v->next) { +- bool z; +- +- if (!(v->sgc_flags&SGC_PAGE_FLAG)) continue; +- +- s=CB_DATA_START(v); +- e=CB_DATA_END(v); +- +- z=get_mark_bit(v,s); +- for (p=s;pnext) { ++ for (i=0;iv.v_fillp && (pi=(void *)contblock_array->v.v_self[i]) && countv.v_fillp; + + if (maxcbpagev.v_fillp); + +- contblock_list_tail->sgc_flags=SGC_PAGE_FLAG; ++ ((struct pageinfo *)contblock_array->v.v_self[fp])->sgc_flags=SGC_PAGE_FLAG; + + } + +@@ -743,17 +709,19 @@ sgc_start(void) { + { + + struct pageinfo *pi; +- ++ ufixnum j; ++ + { + + struct contblock **cbpp; + void *p=NULL,*pe; + struct pageinfo *pi; ++ ufixnum i; + + old_cb_pointer=cb_pointer; + reset_contblock_freelist(); + +- for (pi=contblock_list_head;pi;pi=pi->next) { ++ for (i=0;iv.v_fillp && (pi=(void *)contblock_array->v.v_self[i]);i++) { + + if (pi->sgc_flags!=SGC_PAGE_FLAG) continue; + +@@ -786,7 +754,7 @@ sgc_start(void) { + else + tm_of(pi->type)->tm_alt_npage++; + } +- for (pi=contblock_list_head;pi;pi=pi->next)/*FIXME*/ ++ for (j=0;jv.v_fillp && (pi=(void *)contblock_array->v.v_self[j]);j++) + if (pi->sgc_flags&SGC_WRITABLE) + for (i=0;iin_use;i++) + SET_WRITABLE(page(pi)+i); +@@ -932,7 +900,7 @@ sgc_quit(void) { + ((object) p)->d.s=SGC_NORMAL; + #endif + +- for (v=contblock_list_head;v;v=v->next) ++ for (i=0;iv.v_fillp &&(v=(void *)contblock_array->v.v_self[i]);i++) + if (v->sgc_flags&SGC_PAGE_FLAG) + bzero(CB_SGCF_START(v),CB_DATA_START(v)-CB_SGCF_START(v)); + +@@ -940,7 +908,7 @@ sgc_quit(void) { + struct pageinfo *pi; + for (pi=cell_list_head;pi;pi=pi->next) + pi->sgc_flags&=SGC_PERM_WRITABLE; +- for (pi=contblock_list_head;pi;pi=pi->next) ++ for (i=0;iv.v_fillp &&(pi=(void *)contblock_array->v.v_self[i]);i++) + pi->sgc_flags&=SGC_PERM_WRITABLE; + } + diff --git a/patches/Version_2_6_13pre41 b/patches/Version_2_6_13pre41 new file mode 100644 index 00000000..67e553ec --- /dev/null +++ b/patches/Version_2_6_13pre41 @@ -0,0 +1,185 @@ +Description: + 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-32) unstable; urgency=medium + . + * Version_2_6_13pre40 + * Bug fix: "[INTL:pt_BR] Brazilian Portuguese debconf templates + translation", thanks to Adriano Rafael Gomes (Closes: #811523). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/811523 + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/notcomp.h ++++ gcl-2.6.12/h/notcomp.h +@@ -300,7 +300,8 @@ gcl_init_cmp_anon(void); + + #include "gmp_wrappers.h" + +-#define massert(a_) if (!(a_)) assert_error(#a_,__LINE__,__FILE__,__FUNCTION__) ++#include ++#define massert(a_) ({errno=0;if (!(a_)||errno) assert_error(#a_,__LINE__,__FILE__,__FUNCTION__);}) + + extern bool writable_malloc; + #define writable_malloc_wrap(f_,rt_,a_...) ({rt_ v;bool w=writable_malloc;writable_malloc=1;v=f_(a_);writable_malloc=w;v;}) +--- gcl-2.6.12.orig/lsp/gcl_mislib.lsp ++++ gcl-2.6.12/lsp/gcl_mislib.lsp +@@ -131,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" "") +- (gcl-compile-time) ++ *gcl-release-date* + "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) +--- gcl-2.6.12.orig/lsp/gcl_predlib.lsp ++++ gcl-2.6.12/lsp/gcl_predlib.lsp +@@ -777,6 +777,7 @@ + (defvar *gcl-extra-version* nil) + (defvar *gcl-minor-version* nil) + (defvar *gcl-major-version* nil) ++(defvar *gcl-release-date* nil) + + (defun warn-version (majvers minvers extvers) + (and *gcl-major-version* *gcl-minor-version* *gcl-extra-version* +--- gcl-2.6.12.orig/makefile ++++ gcl-2.6.12/makefile +@@ -34,9 +34,9 @@ TESTDIR = ansi-tests + + VERSION=`cat majvers`.`cat minvers` + +-all: $(BUILD_BFD) system command cmpnew/gcl_collectfn.o lsp/gcl_info.o do-gcl-tk # do-info ++all: $(BUILD_BFD) system command cmpnew/gcl_collectfn.o lsp/gcl_info.o do-gcl-tk release # do-info + +-ASRC:=$(shell ls -1 o/*.c lsp/*.lsp cmpnew/*.lsp mod/*.lsp pcl/*sp clcs/*sp xgcl-2/*p) #o/*.d o/*.h h/*.h ++ASRC:=$(shell ls -1 o/*.c lsp/*.lsp cmpnew/*.lsp pcl/*sp clcs/*sp xgcl-2/*p) #o/*.d o/*.h h/*.h + TAGS: $(ASRC) + etags --regex='/\#.`(defun[ \n\t]+\([^ \n\t]+\)/' $^ + +@@ -44,6 +44,9 @@ system: $(PORTDIR)/$(FLISP) + # [ "$(X_LIBS)" == "" ] || (cd xgcl-2 && make saved_xgcl LISP=../$< && mv saved_xgcl ../$(PORTDIR)/$(FLISP)) + touch $@ + ++release: majvers minvers ++ date >$@ ++ + xgcl: $(PORTDIR)/saved_xgcl + + $(PORTDIR)/saved_xgcl: $(PORTDIR)/saved_gcl +--- gcl-2.6.12.orig/o/error.c ++++ gcl-2.6.12/o/error.c +@@ -27,6 +27,7 @@ Foundation, 675 Mass Ave, Cambridge, MA + */ + + #include ++#include + #include "include.h" + object siSuniversal_error_handler; + +@@ -36,11 +37,11 @@ void + assert_error(const char *a,unsigned l,const char *f,const char *n) { + + if (!raw_image && core_end && core_end==sbrk(0)) +- FEerror("The assertion ~a on line ~a of ~a in function ~a failed",4, ++ FEerror("The assertion ~a on line ~a of ~a in function ~a failed: ~a",5, + make_simple_string(a),make_fixnum(l), +- make_simple_string(f),make_simple_string(n)); ++ make_simple_string(f),make_simple_string(n),make_simple_string(strerror(errno))); + else { +- emsg("The assertion %s on line %d of %s in function %s failed",a,l,f,n); ++ emsg("The assertion %s on line %d of %s in function %s failed: %s",a,l,f,n,strerror(errno)); + do_gcl_abort(); + } + +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -242,7 +242,7 @@ get_gc_environ(void) { + } + + gc_page_min=0.5; +- if ((e=getenv("GCL_GC_PAGE_THRESH"))) { ++ if ((e=getenv("GCL_GC_PAGE_MIN"))) { + massert(sscanf(e,"%lf",&gc_page_min)==1); + massert(gc_page_min>=0.0); + } +@@ -1028,12 +1028,6 @@ DEFUNO_NEW("IDENTITY",object,fLidentity, + RETURN1 (x0); + } + +-DEFUNO_NEW("GCL-COMPILE-TIME",object,fSgcl_compile_time,SI +- ,0,0,NONE,OO,OO,OO,OO,void,Lgcl_compile_time,(void),"") +-{ +- RETURN1 (make_simple_string(__DATE__ " " __TIME__)); +-} +- + DEFUNO_NEW("LDB1",object,fSldb1,SI + ,3,3,NONE,OI,II,OO,OO,void,Lldb1,(fixnum a,fixnum b, fixnum c),"") + { +--- gcl-2.6.12.orig/o/sfasli.c ++++ gcl-2.6.12/o/sfasli.c +@@ -115,10 +115,9 @@ LFD(build_symbol_table)(void) { + int + use_symbols(double d,...) { + ++ double d2; + #ifndef DARWIN +- + extern void sincos(double,double *,double *); +- double d2; + + sincos(d,&d,&d2); + +--- /dev/null ++++ gcl-2.6.12/release +@@ -0,0 +1 @@ ++Fri Apr 22 15:51:11 UTC 2016 +--- gcl-2.6.12.orig/unixport/makefile ++++ gcl-2.6.12/unixport/makefile +@@ -72,10 +72,11 @@ $(LSPDIR)/auto_new.lsp: $(LSPDIR)/auto.l + sys_init.lsp: sys_init.lsp.in + + cat $< | sed \ +- -e "s#@LI-VERS@#(`cat ../majvers`.`cat ../minvers`) `date`#1" \ ++ -e "s#@LI-VERS@#(`cat ../majvers`.`cat ../minvers`) `cat ../release`#1" \ + -e "s#@LI-EXTVERS@#`cat ../minvers | cut -f2 -d.`#1" \ + -e "s#@LI-MINVERS@#`cat ../minvers | cut -f1 -d.`#1" \ + -e "s#@LI-MAJVERS@#`cat ../majvers`#1" \ ++ -e "s#@LI-RELEASE@#`cat ../release`#1" \ + -e "s#@LI-CC@#\"$(CC) -c $(FINAL_CFLAGS)\"#1" \ + -e "s#@LI-LD@#\"$(CC) $(LD_FLAGS) -o \"#1" \ + -e "s#@LI-LD-LIBS@#\" $(LD_LIBS_PRE) -l$* $(LD_LIBS_POST)\"#1" \ +--- gcl-2.6.12.orig/unixport/sys_init.lsp.in ++++ gcl-2.6.12/unixport/sys_init.lsp.in +@@ -51,7 +51,8 @@ + + (setq *gcl-extra-version* @LI-EXTVERS@ + *gcl-minor-version* @LI-MINVERS@ +- *gcl-major-version* @LI-MAJVERS@) ++ *gcl-major-version* @LI-MAJVERS@ ++ *gcl-release-date* "@LI-RELEASE@") + + (defvar *system-banner* (default-system-banner)) + (setq *optimize-maximum-pages* t) +@@ -83,3 +84,5 @@ + (let* ((i 4096)(j (si::equal-tail-recursion-check i))) + (unless (<= (ash i -1) j) + (warn "equal is not tail recursive ~s ~s" i j))) ++ ++(format t "~s heap words available~%" (multiple-value-bind (a b c d) (si::heap-report) (/ (- d c) (/ a 8)))) diff --git a/patches/Version_2_6_13pre45 b/patches/Version_2_6_13pre45 new file mode 100644 index 00000000..4adb1a28 --- /dev/null +++ b/patches/Version_2_6_13pre45 @@ -0,0 +1,253 @@ +Description: + 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-34) unstable; urgency=medium + . + * Version_2_6_13pre45 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-09-23 + +--- gcl-2.6.12.orig/h/unrandomize.h ++++ gcl-2.6.12/h/unrandomize.h +@@ -23,7 +23,6 @@ + int i,j,k; + char **n,**a; + void *v; +- argv[0]="/proc/self/exe"; + for (i=j=0;argv[i];i++) + j+=strlen(argv[i])+1; + for (k=0;envp[k];k++) +--- gcl-2.6.12.orig/lsp/gcl_serror.lsp ++++ gcl-2.6.12/lsp/gcl_serror.lsp +@@ -174,7 +174,7 @@ + (format *error-output* "~&If continued: ") + (funcall (restart-report-function correctable) *error-output*)) + (force-output *error-output*) +- (break-level condition))) ++ (when *break-enable* (break-level condition)))) + + + (defun dbl-eval (- &aux (break-command t)) +@@ -186,54 +186,51 @@ + (t (setq break-command nil) (evalhook - nil nil *break-env*)))))) + (cons break-command val-list))) + +-(defun do-break-level (at env p-e-p debug-level break-level &aux (first t)) ++(defun dbl-rpl-loop (p-e-p) + +- (do nil (nil) +- +- (unless +- (with-simple-restart +- (abort "Return to debug level ~D." debug-level) +- (not +- (catch 'step-continue +- (let* ((*break-level* break-level) +- (*break-enable* (unless p-e-p *break-enable*)) +- (*readtable* (or *break-readtable* *readtable*)) +- *break-env* *read-suppress*); *error-stack*) +- +- (setq +++ ++ ++ + + -) +- +- (when first +- (catch-fatal 1) +- (setq *interrupt-enable* t first nil) +- (cond (p-e-p +- (format *debug-io* "~&~A~2%" at) +- (set-current) +- (setq *no-prompt* nil) +- (show-restarts)) +- ((set-back at env)))) +- +- (if *no-prompt* +- (setq *no-prompt* nil) +- (format *debug-io* "~&~a~a>~{~*>~}" +- (if p-e-p "" "dbl:") +- (if (eq *package* (find-package 'user)) "" (package-name *package*)) +- break-level)) +- (force-output *error-output*) +- +- (setq - (dbl-read *debug-io* nil *top-eof*)) +- (when (eq - *top-eof*) (bye -1)) +- (let* ((ev (dbl-eval -)) +- (break-command (car ev)) +- (values (cdr ev))) +- (and break-command (eq (car values) :resume)(return)) +- (setq /// // // / / values *** ** ** * * (car /)) +- (fresh-line *debug-io*) +- (dolist (val /) +- (prin1 val *debug-io*) +- (terpri *debug-io*))) +- nil)))) +- (terpri *debug-io*) +- (break-current)))) ++ (setq +++ ++ ++ + + -) ++ ++ (if *no-prompt* ++ (setq *no-prompt* nil) ++ (format *debug-io* "~&~a~a>~{~*>~}" ++ (if p-e-p "" "dbl:") ++ (if (eq *package* (find-package 'user)) "" (package-name *package*)) ++ *break-level*)) ++ (force-output *error-output*) ++ ++ (setq - (dbl-read *debug-io* nil *top-eof*)) ++ (when (eq - *top-eof*) (bye -1)) ++ (let* ((ev (dbl-eval -)) ++ (break-command (car ev)) ++ (values (cdr ev))) ++ (unless (and break-command (eq (car values) :resume)) ++ (setq /// // // / / values *** ** ** * * (car /)) ++ (fresh-line *debug-io*) ++ (dolist (val /) ++ (prin1 val *debug-io*) ++ (terpri *debug-io*)) ++ (dbl-rpl-loop p-e-p)))) ++ ++(defun do-break-level (at env p-e-p debug-level); break-level ++ ++ (unless ++ (with-simple-restart ++ (abort "Return to debug level ~D." debug-level) ++ ++ (catch-fatal 1) ++ (setq *interrupt-enable* t) ++ (cond (p-e-p ++ (format *debug-io* "~&~A~2%" at) ++ (set-current) ++ (setq *no-prompt* nil) ++ (show-restarts)) ++ ((set-back at env))) ++ ++ (not (catch 'step-continue (dbl-rpl-loop p-e-p)))) ++ ++ (terpri *debug-io*) ++ (break-current) ++ (do-break-level at env p-e-p debug-level))) + + + (defun break-level (at &optional env) +@@ -242,10 +239,10 @@ + (- -) + (* *) (** **) (*** ***) + (/ /) (// //) (/// ///) +- (break-level (if p-e-p (cons t *break-level*) *break-level*)) + (debug-level *debug-level*) + (*quit-tags* (cons (cons *break-level* *quit-tag*) *quit-tags*)) + *quit-tag* ++ (*break-level* (if p-e-p (cons t *break-level*) *break-level*)) + (*ihs-base* (1+ *ihs-top*)) + (*ihs-top* (ihs-top)) + (*frs-base* (or (sch-frs-base *frs-top* *ihs-base*) (1+ (frs-top)))) +@@ -255,9 +252,11 @@ + (*debug-restarts* (compute-restarts)) + (*debug-abort* (find-restart 'abort)) + (*debug-continue* (find-restart 'continue)) +- (*abort-restarts* (remove-if-not (lambda (x) (eq 'abort (restart-name x))) *debug-restarts*))) ++ (*abort-restarts* (remove-if-not (lambda (x) (eq 'abort (restart-name x))) *debug-restarts*)) ++ (*readtable* (or *break-readtable* *readtable*)) ++ *break-env* *read-suppress*) + +- (do-break-level at env p-e-p debug-level break-level))) ++ (do-break-level at env p-e-p debug-level))) + + (putprop 'break-level t 'compiler::cmp-notinline) + +@@ -278,6 +277,6 @@ + (setq message "")))) + (with-simple-restart + (continue "Return from break.") +- (let ((*break-enable* t)) (break-level message))) ++ (break-level message)) + nil) + (putprop 'break t 'compiler::cmp-notinline) +--- gcl-2.6.12.orig/lsp/sys-proclaim.lisp ++++ gcl-2.6.12/lsp/sys-proclaim.lisp +@@ -4,7 +4,7 @@ + '(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::INSPECT-STRUCTURE SYSTEM::PRINT-IHS SYSTEM::DBL-RPL-LOOP + 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 +@@ -268,7 +268,7 @@ + (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-USE-SLOOP-FOR SYSTEM::COERCE-TO-CONDITION SYSTEM::DO-BREAK-LEVEL + SLOOP::FIRST-SLOOP-FOR ANSI-LOOP::LOOP-FOR-ARITHMETIC + SYSTEM::MAYBE-BREAK SYSTEM::SETF-STRUCTURE-ACCESS + SYSTEM::CALL-TEST SYSTEM::FIND-LINE-IN-FUN)) +@@ -334,7 +334,7 @@ + (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-PREDICATE + SYSTEM::MAKE-CONSTRUCTOR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +@@ -519,4 +519,4 @@ + (COMMON-LISP::FUNCTION + (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM) + COMMON-LISP::FIXNUM) +- SYSTEM::ROUND-UP)) +\ No newline at end of file ++ SYSTEM::ROUND-UP)) +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -464,19 +464,12 @@ DEFUN_NEW("EQUAL-TAIL-RECURSION-CHECK",o + int + main(int argc, char **argv, char **envp) { + +-#ifdef CAN_UNRANDOMIZE_SBRK +-#include +-#include +-#include "unrandomize.h" +-#endif +- +- gcl_init_alloc(&argv); +- + #ifdef GET_FULL_PATH_SELF + GET_FULL_PATH_SELF(kcl_self); + #else + kcl_self = argv[0]; + #endif ++ + #ifdef __MINGW32__ + { + char *s=kcl_self; +@@ -485,6 +478,14 @@ main(int argc, char **argv, char **envp) + #endif + *argv=kcl_self; + ++#ifdef CAN_UNRANDOMIZE_SBRK ++#include ++#include ++#include "unrandomize.h" ++#endif ++ ++ gcl_init_alloc(&argv); ++ + setbuf(stdin, stdin_buf); + setbuf(stdout, stdout_buf); + #ifdef _WIN32 diff --git a/patches/Version_2_6_13pre46 b/patches/Version_2_6_13pre46 new file mode 100644 index 00000000..9551eed6 --- /dev/null +++ b/patches/Version_2_6_13pre46 @@ -0,0 +1,237 @@ +Description: + 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-34) unstable; urgency=medium + . + * Version_2_6_13pre45 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-09-30 + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -28,7 +28,7 @@ + + + (export '(*compile-print* *compile-verbose*)) +-(import 'si::*tmp-dir* 'compiler) ++(import 'si::(*tmp-dir* *cc* *ld* *objdump*)) + (import 'si::*error-p* 'compiler) + + ;;; This had been true with Linux 1.2.13 a.out or even older +@@ -85,9 +85,8 @@ + (code result) (system (mysub (ts string) "$" "\\$")) + (unless (and (zerop code) (zerop result)) + (cerror "Continues anyway." +- "(SYSTEM ~S) returned a non-zero value ~D." +- string +- result) ++ "(SYSTEM ~S) returned a non-zero value ~D ~D." ++ string code result) + (setq *error-p* t)) + (values result))) + +@@ -428,8 +427,8 @@ Cannot compile ~a.~%" + (si::copy-stream st *standard-output*)) + (with-open-file (st hn) + (si::copy-stream st *standard-output*)) +- (when (zerop (system "which objdump >/dev/null")) +- (safe-system (si::string-concatenate "objdump --source " (namestring on)))) ++ (when (eql (aref *objdump* 0) #\/);program found at startup in path ++ (safe-system (si::string-concatenate *objdump* (namestring on)))) + (mdelete-file cn) + (mdelete-file dn) + (mdelete-file hn) +@@ -470,8 +469,6 @@ Cannot compile ~a.~%" + (terpri *compiler-output2*))))) + + +-(defvar *cc* "cc") +-(defvar *ld* "ld") + (defvar *ld-libs* "ld-libs") + (defvar *opt-three* "") + (defvar *opt-two* "") +@@ -489,7 +486,7 @@ Cannot compile ~a.~%" + (setq na (namestring + (make-pathname :name name :type (pathname-type(first args))))) + #+(or dos winnt) +- (format nil "~a -I~a ~a ~a -c -w ~s -o ~s" ++ (format nil "~a -I~a ~a ~a -c -w ~a -o ~a" + *cc* + (concatenate 'string si::*system-directory* "../h") + (if (and (boundp '*c-debug*) *c-debug*) " -g " "") +@@ -502,7 +499,7 @@ Cannot compile ~a.~%" + ) + + #-(or dos winnt) +- (format nil "~a -I~a ~a ~a -c ~s -o ~s ~a" ++ (format nil "~a -I~a ~a ~a -c ~a -o ~a ~a" + *cc* + (concatenate 'string si::*system-directory* "../h") + (if (and (boundp '*c-debug*) *c-debug*) " -g " "") +--- gcl-2.6.12.orig/h/elf32_mips_reloc_special.h ++++ gcl-2.6.12/h/elf32_mips_reloc_special.h +@@ -147,3 +147,6 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + (*(a_))->address=p->st_value; \ + break; \ + }}}) ++ ++#undef LOAD_SYM_BY_NAME ++#define LOAD_SYM_BY_NAME(sym,st1) (!strncmp(st1+sym->st_name,"__moddi3",8)) +--- gcl-2.6.12.orig/h/notcomp.h ++++ gcl-2.6.12/h/notcomp.h +@@ -361,7 +361,7 @@ extern bool writable_malloc; + #define prof_block(x) x + #endif + +-#define psystem(x) prof_block(system(x)) ++#define psystem(x) prof_block(vsystem(x)) + #define pfork() prof_block(fork()) + + #include "error.h" +--- gcl-2.6.12.orig/lsp/gcl_top.lsp ++++ gcl-2.6.12/lsp/gcl_top.lsp +@@ -601,9 +601,21 @@ First directory is checked for first nam + :device (pathname-device x) + :directory (append (pathname-directory x) y))))))))) + ++(defun get-path (s &aux (m (string-match "([^/ ]*)( |$)" s))(b (match-beginning 1))(e (match-end 1)) ++ (r (with-open-file (s (concatenate 'string "|which " (subseq s b e))) (read s nil 'eof)))) ++ (if (eq r 'eof) s (concatenate 'string (string-downcase r) (subseq s e)))) ++ ++ ++(defvar *cc* "cc") ++(defvar *ld* "ld") ++(defvar *objdump* "objdump --source ") ++ + (defun set-up-top-level (&aux (i (argc)) tem) + (declare (fixnum i)) +- (setq *tmp-dir* (get-temp-dir)) ++ (setq *tmp-dir* (get-temp-dir) ++ *cc* (get-path *cc*) ++ *ld* (get-path *ld*) ++ *objdump* (get-path *objdump*)) + (dotimes (j i) (push (argv j) tem)) + (setq *command-args* (nreverse tem)) + (setq tem *lib-directory*) +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -613,7 +613,8 @@ BEGIN: + else + fclose(strm->sm.sm_fp); + strm->sm.sm_fp = NULL; +- if (type_of(strm->sm.sm_object0 ) == t_cons && ++ if (strm->sm.sm_object0 && ++ type_of(strm->sm.sm_object0 ) == t_cons && + Mcar(strm->sm.sm_object0 ) == sSAallow_gzipped_fileA) + fLdelete_file(Mcdr(strm->sm.sm_object0)); + break; +--- gcl-2.6.12.orig/o/run_process.c ++++ gcl-2.6.12/o/run_process.c +@@ -502,6 +502,7 @@ make_socket_pair() + stream_in->sm.sm_buffer = 0; + stream_in->sm.sm_int0 = sockets_in[1]; + stream_in->sm.sm_int1 = 0; ++ stream_in->sm.sm_object0=stream_in->sm.sm_object1=OBJNULL; + stream_out = (object) alloc_object(t_stream); + stream_out->sm.sm_mode = smm_output; + stream_out->sm.sm_fp = fp2; +@@ -510,6 +511,7 @@ make_socket_pair() + setup_stream_buffer(stream_out); + stream_out->sm.sm_int0 = sockets_out[1]; + stream_out->sm.sm_int1 = 0; ++ stream_out->sm.sm_object0=stream_out->sm.sm_object1=OBJNULL; + stream = make_two_way_stream(stream_in, stream_out); + return(stream); + } +--- gcl-2.6.12.orig/o/sfaslelf.c ++++ gcl-2.6.12/o/sfaslelf.c +@@ -54,9 +54,10 @@ License for more details. + + #define ulmax(a_,b_) ({ul _a=a_,_b=b_;_a<_b ? _b : _a;}) + #define ALLOC_SEC(sec) (sec->sh_flags&SHF_ALLOC && (sec->sh_type==SHT_PROGBITS || sec->sh_type==SHT_NOBITS)) +-#define LOAD_SEC(sec) (sec->sh_flags&SHF_ALLOC && sec->sh_type==SHT_PROGBITS) +-#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 LOAD_SEC(sec) (sec->sh_flags&SHF_ALLOC && sec->sh_type==SHT_PROGBITS) ++#define LOAD_SYM_BY_BIND(sym) ({ul _b=ELF_ST_BIND(sym->st_info); sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK);}) ++#define LOAD_SYM_BY_NAME(sym,st1) 0 ++#define LOAD_SYM(sym,st1) (LOAD_SYM_BY_BIND(sym)||LOAD_SYM_BY_NAME(sym,st1)) + + #define MASK(n) (~(~0ULL << (n))) + +@@ -410,7 +411,7 @@ calc_space(ul *ns,ul *sl,Sym *sym1,Sym * + + for (sym=sym1;sym + #include + #include +- ++#include + + #include "include.h" + ++int ++vsystem(const char *command) { ++ ++ unsigned j,n=strlen(command); ++ char *z=alloca(n+1),**p1,**pp,*c; ++ int s; ++ pid_t pid; ++ ++ memcpy(z,command,n+1); ++ for (j=0,c=z;strtok(c," \n\t");c=NULL,j++); ++ ++ memcpy(z,command,n+1); ++ p1=alloca((j+1)*sizeof(*p1)); ++ for (pp=p1,c=z;(*pp=strtok(c," \n\t"));c=NULL,pp++); ++ ++ if (!(pid=vfork())) { ++ execvp(*p1,p1); ++ _exit(2); ++ } ++ ++ massert(pid>0); ++ massert(pid==waitpid(pid,&s,0)); ++ ++ return s; ++ ++} ++ ++ + #ifdef ATT3B2 + #include + int diff --git a/patches/Version_2_6_13pre47 b/patches/Version_2_6_13pre47 new file mode 100644 index 00000000..ba92ac2b --- /dev/null +++ b/patches/Version_2_6_13pre47 @@ -0,0 +1,36 @@ +Description: + 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-35) unstable; urgency=medium + . + * Version_2_6_13pre46 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-09-30 + +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -229,7 +229,7 @@ get_gc_environ(void) { + + const char *e; + +- mem_multiple=0.85; ++ mem_multiple=1.0; + if ((e=getenv("GCL_MEM_MULTIPLE"))) { + massert(sscanf(e,"%lf",&mem_multiple)==1); + massert(mem_multiple>=0.0); diff --git a/patches/Version_2_6_13pre48 b/patches/Version_2_6_13pre48 new file mode 100644 index 00000000..e3a07616 --- /dev/null +++ b/patches/Version_2_6_13pre48 @@ -0,0 +1,59 @@ +Description: + 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-35) unstable; urgency=medium + . + * Version_2_6_13pre47 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-01 + +--- gcl-2.6.12.orig/h/elf32_hppa_reloc_special.h ++++ gcl-2.6.12/h/elf32_hppa_reloc_special.h +@@ -39,3 +39,6 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + return 0; + + } ++ ++#undef LOAD_SYM_BY_NAME ++#define LOAD_SYM_BY_NAME(sym,st1) (!strncmp(st1+sym->st_name,"$$dyncall",8)) +--- gcl-2.6.12.orig/o/unixsys.c ++++ gcl-2.6.12/o/unixsys.c +@@ -31,16 +31,16 @@ Foundation, 675 Mass Ave, Cambridge, MA + int + vsystem(const char *command) { + +- unsigned j,n=strlen(command); +- char *z=alloca(n+1),**p1,**pp,*c; ++ unsigned j,n=strlen(command)+1; ++ char *z=alloca(n),**p1,**pp,*c; + int s; + pid_t pid; + +- memcpy(z,command,n+1); +- for (j=0,c=z;strtok(c," \n\t");c=NULL,j++); ++ memcpy(z,command,n); ++ for (j=1,c=z;strtok(c," \n\t");c=NULL,j++); + +- memcpy(z,command,n+1); +- p1=alloca((j+1)*sizeof(*p1)); ++ memcpy(z,command,n); ++ p1=alloca(j*sizeof(*p1)); + for (pp=p1,c=z;(*pp=strtok(c," \n\t"));c=NULL,pp++); + + if (!(pid=vfork())) { diff --git a/patches/Version_2_6_13pre49 b/patches/Version_2_6_13pre49 new file mode 100644 index 00000000..74117076 --- /dev/null +++ b/patches/Version_2_6_13pre49 @@ -0,0 +1,33 @@ +Description: + 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-36) unstable; urgency=medium + . + * Version_2_6_13pre48 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-03 + +--- gcl-2.6.12.orig/h/elf32_hppa_reloc_special.h ++++ gcl-2.6.12/h/elf32_hppa_reloc_special.h +@@ -41,4 +41,4 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + } + + #undef LOAD_SYM_BY_NAME +-#define LOAD_SYM_BY_NAME(sym,st1) (!strncmp(st1+sym->st_name,"$$dyncall",8)) ++#define LOAD_SYM_BY_NAME(sym,st1) (!strncmp(st1+sym->st_name,"$$",2)) diff --git a/patches/Version_2_6_13pre5 b/patches/Version_2_6_13pre5 new file mode 100644 index 00000000..b1643483 --- /dev/null +++ b/patches/Version_2_6_13pre5 @@ -0,0 +1,83 @@ +Description: + 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-5) unstable; urgency=medium + . + * Version_2_6_13pre4 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/page.h ++++ gcl-2.6.12/h/page.h +@@ -85,10 +85,8 @@ extern int sgc_enabled; + + extern long resv_pages; + extern int reserve_pages_for_signal_handler; +-/* #define CONT_MARK_PAGE (((page(heap_end)-first_data_page)*(PAGESIZE/(CPTR_SIZE*CHAR_SIZE))+PAGESIZE-1)/PAGESIZE) */ +-/* #define available_pages ((fixnum)(real_maxpage-page(heap_end)-2*nrbpage-CONT_MARK_PAGE-resv_pages)) */ + +-extern struct pageinfo *cell_list_head,*cell_list_tail/* ,*contblock_list_head,*contblock_list_tail */; ++extern struct pageinfo *cell_list_head,*cell_list_tail; + extern object contblock_array; + + #define PAGE_MAGIC 0x2e +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -506,31 +506,25 @@ rebalance_maxpages(struct typemanager *m + + if (j+d>phys_pages) { + +- ufixnum k=0; ++ ufixnum k,e=j+d-phys_pages; ++ double f; + +- for (i=t_start;ik+phys_pages-j ? k+phys_pages-j : d; +- if (d<=0) ++ e=e>k ? k : e; ++ if (e+phys_pages-j<=0) + return 0; + ++ f=1.0-(double)e/k; ++ + for (i=t_start;i((double)phys_pages/(j+d))*(tm_table+i==my_tm ? z : tm_table[i].tm_maxpage)) */ +- /* return 0; */ +- /* for (i=t_start;itm_maxpage+(phys_pages-sum_maxpages()))/(my_tm->tm_type==t_relocatable ? 2 : 1))); + + return 1; + diff --git a/patches/Version_2_6_13pre50 b/patches/Version_2_6_13pre50 new file mode 100644 index 00000000..e17b6272 --- /dev/null +++ b/patches/Version_2_6_13pre50 @@ -0,0 +1,223 @@ +Description: + 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-37) unstable; urgency=medium + . + * Version_2_6_13pre49 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-04 + +--- gcl-2.6.12.orig/o/array.c ++++ gcl-2.6.12/o/array.c +@@ -850,31 +850,33 @@ raw_aet_ptr(object x, short int typ) + */ + + void +-gset(void *p1, void *val, int n, int typ) +-{ if (val==0) ++gset(void *p1, void *val, int n, int typ) { ++ ++ if (val==0) + val = aet_types[typ].dflt; +- switch (typ){ ++ ++ switch (typ){ + + #define GSET(p,n,typ,val) {typ x = *((typ *) val); GSET1(p,n,typ,x)} +-#define GSET1(p,n,typ,val) while (n-- > 0) \ ++#define GSET1(p,n,typ,val) while (n-- > 0) \ + { *((typ *) p) = val; \ +- p = p + sizeof(typ); \ +- } break; ++ p = p + sizeof(typ); \ ++ } break; + +- case aet_object: GSET(p1,n,object,val); +- case aet_ch: GSET(p1,n,char,val); +- /* Note n is number of fixnum WORDS for bit */ +- case aet_bit: GSET(p1,n,fixnum,val); +- case aet_fix: GSET(p1,n,fixnum,val); +- case aet_sf: GSET(p1,n,shortfloat,val); +- case aet_lf: GSET(p1,n,longfloat,val); +- case aet_char: GSET(p1,n,char,val); +- case aet_uchar: GSET(p1,n,unsigned char,val); +- case aet_short: GSET(p1,n,short,val); +- case aet_ushort: GSET(p1,n,unsigned short,val); +- default: FEerror("bad elttype",0); +- } ++ case aet_object: GSET(p1,n,object,val); ++ case aet_ch: GSET(p1,n,char,val); ++ /* Note n is number of fixnum WORDS for bit */ ++ case aet_bit: GSET(p1,n,fixnum,val); ++ case aet_fix: GSET(p1,n,fixnum,val); ++ case aet_sf: GSET(p1,n,shortfloat,val); ++ case aet_lf: GSET(p1,n,longfloat,val); ++ case aet_char: GSET(p1,n,char,val); ++ case aet_uchar: GSET(p1,n,unsigned char,val); ++ case aet_short: GSET(p1,n,short,val); ++ case aet_ushort: GSET(p1,n,unsigned short,val); ++ default: FEerror("bad elttype",0); + } ++} + + + #define W_SIZE (BV_BITS*sizeof(fixnum)) +@@ -894,38 +896,43 @@ implementation dependent results.") + int n1=fix(n1o),nc; + if (VFUN_NARGS==4) + { n1 = x->v.v_dim - i1;} +- if (typ1==aet_bit) +- {if (i1 % CHAR_SIZE) +- badcopy: +- FEerror("Bit copies only if aligned",0); +- else +- {int rest=n1%CHAR_SIZE; +- if (rest!=0 ) +- {if (typ2!=aet_bit) +- goto badcopy; +- {while(rest> 0) +- { fSaset1(y,i2+n1-rest,(fLrow_major_aref(x,i1+n1-rest))); +- rest--;} +- }} +- i1=i1/CHAR_SIZE ; +- n1=n1/CHAR_SIZE; +- typ1=aet_char; +- }}; +- if (typ2==aet_bit) +- {if (i2 % CHAR_SIZE) +- goto badcopy; +- i2=i2/CHAR_SIZE ;} +- if ((typ1 ==aet_object || +- typ2 ==aet_object) && typ1 != typ2) ++ if (typ1==aet_bit) { ++ if (i1 % CHAR_SIZE) ++ badcopy: ++ FEerror("Bit copies only if aligned",0); ++ else { ++ int rest=n1%CHAR_SIZE; ++ if (rest!=0) { ++ if (typ2!=aet_bit) ++ goto badcopy; ++ while(rest> 0) { ++ fSaset1(y,i2+n1-rest,(fLrow_major_aref(x,i1+n1-rest))); ++ rest--; ++ } ++ } ++ i1=i1/CHAR_SIZE ; ++ n1=n1/CHAR_SIZE; ++ typ1=aet_char; ++ } ++ } ++ ++ if (typ2==aet_bit) { ++ if (i2 % CHAR_SIZE) ++ goto badcopy; ++ i2=i2/CHAR_SIZE ; ++ } ++ ++ if ((typ1 ==aet_object || typ2 ==aet_object) && typ1 != typ2) + FEerror("Can't copy between different array types",0); + nc=n1 * aet_sizes[(int)typ1]; +- if (i1+n1 > x->a.a_dim +- || ((y->a.a_dim - i2) *aet_sizes[(int)typ2]) < nc) ++ if (i1+n1 > x->a.a_dim || ((y->a.a_dim - i2) *aet_sizes[(int)typ2]) < nc) + FEerror("Copy out of bounds",0); + bcopy(x->ust.ust_self + (i1*aet_sizes[(int)typ1]), + y->ust.ust_self + (i2*aet_sizes[(int)typ2]), + nc); ++ + return x; ++ + } + + /* X is the header of an array. This supplies the body which +--- gcl-2.6.12.orig/o/predicate.c ++++ gcl-2.6.12/o/predicate.c +@@ -744,14 +744,13 @@ BEGIN: + if (tx == t_complex) + return(contains_sharp_comma(x->cmp.cmp_real) || + contains_sharp_comma(x->cmp.cmp_imag)); +- if (tx == t_vector) +- { +- int i; +- if (x->v.v_elttype == aet_object) +- for (i = 0; i < x->v.v_fillp; i++) +- if (contains_sharp_comma(x->v.v_self[i])) +- return(TRUE); +- return(FALSE); ++ if (tx == t_vector) { ++ int i; ++ if (x->v.v_elttype == aet_object) ++ for (i = 0; i < x->v.v_fillp; i++) ++ if (contains_sharp_comma(x->v.v_self[i])) ++ return(TRUE); ++ return(FALSE); + } + if (tx == t_cons) { + if (x->c.c_car == siSsharp_comma) +--- gcl-2.6.12.orig/o/unixsys.c ++++ gcl-2.6.12/o/unixsys.c +@@ -32,25 +32,39 @@ int + vsystem(const char *command) { + + unsigned j,n=strlen(command)+1; +- char *z=alloca(n),**p1,**pp,*c; ++ char *z,*c; ++ const char *x1[]={"/bin/sh","-c",NULL,NULL},*spc=" \n\t",**p1,**pp; + int s; + pid_t pid; + +- memcpy(z,command,n); +- for (j=1,c=z;strtok(c," \n\t");c=NULL,j++); ++ if (strpbrk(command,"\"'$<>")) + +- memcpy(z,command,n); +- p1=alloca(j*sizeof(*p1)); +- for (pp=p1,c=z;(*pp=strtok(c," \n\t"));c=NULL,pp++); ++ (p1=x1)[2]=command; ++ ++ else { ++ ++ z=alloca(n); ++ memcpy(z,command,n); ++ for (j=1,c=z;strtok(c,spc);c=NULL,j++); ++ ++ memcpy(z,command,n); ++ p1=alloca(j*sizeof(*p1)); ++ for (pp=p1,c=z;(*pp=strtok(c,spc));c=NULL,pp++); ++ ++ } + + if (!(pid=vfork())) { +- execvp(*p1,p1); +- _exit(2); ++ errno=0; ++ execvp(*p1,(void *)p1); ++ _exit(128|(errno&0x7f)); + } + + massert(pid>0); + massert(pid==waitpid(pid,&s,0)); + ++ if ((s>>8)&128) ++ emsg("execvp failure when executing '%s': %s\n",command,strerror((s>>8)&0x7f)); ++ + return s; + + } diff --git a/patches/Version_2_6_13pre52 b/patches/Version_2_6_13pre52 new file mode 100644 index 00000000..ea69e84b --- /dev/null +++ b/patches/Version_2_6_13pre52 @@ -0,0 +1,36 @@ +Description: + 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-65) unstable; urgency=medium + . + * list_order.25 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-02-22 + +--- gcl-2.6.12.orig/makefile ++++ gcl-2.6.12/makefile +@@ -149,7 +149,7 @@ command: + merge: + $(CC) -o merge merge.c + +-LISP_LIB=cmpnew/gcl_collectfn.o cmpnew/gcl_collectfn.lsp xgcl-2/sysdef.lisp xgcl-2/gcl_dwtest.lsp xgcl-2/gcl_dwtestcases.lsp lsp/gcl_gprof.lsp lsp/gcl_info.o lsp/gcl_profile.lsp lsp/gcl_export.lsp lsp/gcl_autoload.lsp cmpnew/gcl_cmpmain.lsp cmpnew/gcl_cmpopt.lsp cmpnew/gcl_lfun_list.lsp lsp/gcl_auto_new.lsp h/cmpinclude.h unixport/sys_init.lsp unixport/lib$(SYSTEM).a unixport/libgclp.a gcl-tk/tk-package.lsp $(TK_LISP_LIB) $(RL_LIB) $(FIRST_FILE) $(LAST_FILE) $(addsuffix /sys-proclaim.lisp,lsp cmpnew pcl clcs) unixport/gcl.script ++LISP_LIB=cmpnew/gcl_collectfn.o cmpnew/gcl_collectfn.lsp xgcl-2/package.lisp pcl/package.lisp clcs/package.lisp xgcl-2/sysdef.lisp xgcl-2/gcl_dwtest.lsp xgcl-2/gcl_dwtestcases.lsp lsp/gcl_gprof.lsp lsp/gcl_info.o lsp/gcl_profile.lsp lsp/gcl_export.lsp lsp/gcl_autoload.lsp cmpnew/gcl_cmpmain.lsp cmpnew/gcl_cmpopt.lsp cmpnew/gcl_lfun_list.lsp lsp/gcl_auto_new.lsp h/cmpinclude.h unixport/sys_init.lsp unixport/lib$(SYSTEM).a unixport/libgclp.a gcl-tk/tk-package.lsp $(TK_LISP_LIB) $(RL_LIB) $(FIRST_FILE) $(LAST_FILE) $(addsuffix /sys-proclaim.lisp,lsp cmpnew xgcl-2 pcl clcs) unixport/gcl.script + + install-command: + rm -f $(DESTDIR)$(prefix)/bin/gcl diff --git a/patches/Version_2_6_13pre54 b/patches/Version_2_6_13pre54 new file mode 100644 index 00000000..d5d69f71 --- /dev/null +++ b/patches/Version_2_6_13pre54 @@ -0,0 +1,2878 @@ +Description: + 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-65) unstable; urgency=medium + . + * Version_2_6_13pre52 + * Bug fix: "FTBFS on hurd-i386", thanks to svante.signell@gmail.com; + (Closes: #802593). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/802593 + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-02 + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpenv.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpenv.lsp +@@ -49,7 +49,6 @@ + (setq *reservations* nil) + (setq *closures* nil) + (setq *top-level-forms* nil) +- (setq *non-package-operation* nil) + (setq *function-declarations* nil) + (setq *inline-functions* nil) + (setq *inline-blocks* 0) +@@ -71,12 +70,10 @@ + (defun add-symbol (symbol) (add-object symbol)) + + (defun add-object2 (object) +- (let* ((init (when (si::contains-sharp-comma object) +- (if (when (consp object) (eq (car object) 'si::|#,|)) +- (cdr object) (si::string-to-object (wt-to-string object))))) ++ (let* ((init (if (when (consp object) (eq (car object) '|#,|)) (cdr object) `',object)) + (object (if (when (consp init) (eq (car init) 'si::nani)) (si::nani (cadr init)) object))) + (cond ((gethash object *objects*)) +- ((push-data-incf (unless init object)) ++ ((push-data-incf nil) + (when init (add-init `(si::setvv ,*next-vv* ,init))) + (setf (gethash object *objects*) *next-vv*))))) + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -180,7 +180,7 @@ + (*compile-print* (or print *compile-print*)) + (*package* *package*) + (*DEFAULT-PATHNAME-DEFAULTS* #p"") +- (*data* (list (make-array 50 :fill-pointer 0 :adjustable t) nil nil)) ++ (*data* (list nil)) + *init-name* + (*fasd-data* *fasd-data*) + (*error-count* 0)) +@@ -281,10 +281,8 @@ Cannot compile ~a.~%" + (if (consp *split-files*) + (dolist (v (fourth *split-files*)) (t1expr v))) + (unwind-protect +- (do ((form (read *compiler-input* nil eof) +- (read *compiler-input* nil eof)) +- (load-flag (or (eq :defaults *eval-when-defaults*) +- (member 'load *eval-when-defaults*)))) ++ (do ((form (read *compiler-input* nil eof)(read *compiler-input* nil eof)) ++ (load-flag (if *eval-when-defaults* (member 'load *eval-when-defaults*) t))) + (nil) + (cond + ((eq form eof)) +@@ -292,7 +290,7 @@ Cannot compile ~a.~%" + ((maybe-eval nil form))) + (cond + ((and *split-files* (check-end form eof)) +- (setf (fourth *split-files*) (reverse (third *data*))) ++ (setf (fourth *split-files*) nil);(reverse (third *data*)) ;FIXME check this + (return nil)) + ((eq form eof) (return nil)))) + +--- gcl-2.6.12.orig/cmpnew/gcl_cmptop.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmptop.lsp +@@ -72,7 +72,6 @@ + + + (defvar *top-level-forms* nil) +-(defvar *non-package-operation* nil) + + ;;; *top-level-forms* holds ( { top-level-form }* ). + ;;; +@@ -99,18 +98,7 @@ + + ;;; Package operations. + +-(si:putprop 'make-package t 'package-operation) +-(si:putprop 'in-package t 'package-operation) +-(si:putprop 'shadow t 'package-operation) +-(si:putprop 'shadowing-import t 'package-operation) +-(si:putprop 'export t 'package-operation) +-(si:putprop 'unexport t 'package-operation) +-(si:putprop 'use-package t 'package-operation) +-(si:putprop 'unuse-package t 'package-operation) +-(si:putprop 'import t 'package-operation) +-(si:putprop 'provide t 'package-operation) +-(si:putprop 'require t 'package-operation) +-(si:putprop 'defpackage:defpackage t 'package-operation) ++(si:putprop 'in-package t 'eval-at-compile) + + ;;; Pass 1 top-levels. + +@@ -135,6 +123,7 @@ + ;;; Pass 2 initializers. + + (si:putprop 'defun 't2defun 't2) ++(si:putprop 'progn 't2progn 't2) + (si:putprop 'declare 't2declare 't2) + (si:putprop 'defentry 't2defentry 't2) + (si:putprop 'si:putprop 't2putprop 't2) +@@ -142,6 +131,7 @@ + ;;; Pass 2 C function generators. + + (si:putprop 'defun 't3defun 't3) ++(si:putprop 'progn 't3progn 't3) + (si:putprop 'ordinary 't3ordinary 't3) + (si:putprop 'sharp-comma 't3sharp-comma 't3) + (si:putprop 'clines 't3clines 't3) +@@ -242,15 +232,6 @@ + ((symbolp fun) + (cond ((eq fun 'si:|#,|) + (cmperr "Sharp-comma-macro is in a bad place.")) +- ((get fun 'package-operation) +- (when *non-package-operation* +- (cmpwarn "The package operation ~s was in a bad place." +- form)) +- (let ((res (if (setq fd (macro-function fun)) +- (cmp-expand-macro fd fun (copy-list (cdr form))) +- form))) +- (maybe-eval t res) +- (wt-data-package-operation res))) + ((setq fd (get fun 't1)) + (when *compile-print* (print-current-form)) + (funcall fd args)) +@@ -278,11 +259,24 @@ + (defvar *vaddress-list*) ;; hold addresses of C functions, and other data + (defvar *vind*) ;; index in the VV array where the address is. + (defvar *Inits*) ++ ++(defun t23expr (form prop &aux (def (when (consp form) (get (car form) prop))) ++ *local-funs* (*first-error* t) *vcs-used*) ++ (when def ++ (apply def (cdr form))) ++ (when (eq prop 't3) ++ ;;; Local function and closure function definitions. ++ (block ++ nil ++ (loop ++ (when (endp *local-funs*) (return)) ++ (let (*vcs-used*) ++ (apply 't3local-fun (pop *local-funs*))))))) ++ + (defun ctop-write (name &aux +- def +- (*function-links* nil) *c-vars* (*volatile* " VOL ") +- *vaddress-list* (*vind* 0) *inits* +- *current-form* *vcs-used*) ++ (*function-links* nil) *c-vars* (*volatile* " VOL ") ++ *vaddress-list* (*vind* 0) *inits* ++ *current-form* *vcs-used*) + (declare (special *current-form* *vcs-used*)) + + (setq *top-level-forms* (nreverse *top-level-forms*)) +@@ -295,32 +289,19 @@ + + + ;; write all the inits. +- (dolist* (*current-form* *top-level-forms*) +- (setq *first-error* t) +- (setq *vcs-used* nil) +- (when (setq def (get (car *current-form*) 't2)) +- (apply def (cdr *current-form*)))) +- ++ (dolist (*current-form* *top-level-forms*) ++ (t23expr *current-form* 't2)) + + ;;; C function definitions. +- (dolist* (*current-form* *top-level-forms*) +- (setq *first-error* t) +- (setq *vcs-used* nil) +- (when (setq def (get (car *current-form*) 't3)) +- (apply def (cdr *current-form*)))) +- +- ;;; Local function and closure function definitions. +- (let (lf) +- (block local-fun-process +- (loop +- (when (endp *local-funs*) (return-from local-fun-process)) +- (setq lf (car *local-funs*)) +- (pop *local-funs*) +- (setq *vcs-used* nil) +- (apply 't3local-fun lf)))) ++ (dolist (*current-form* *top-level-forms*) ++ (let* ((inits (data-inits))) ++ (t23expr *current-form* 't3) ++ (unless (or (eq (data-inits) inits) (eq (cdr (data-inits)) inits)) ++ (let ((di (data-inits))) ++ (setf (data-inits) inits) ++ (add-init (cons 'progn (nreverse (mapcar 'cdr (ldiff di inits))))))))) + + ;;; Global entries for directly called functions. +- + (dolist* (x *global-entries*) + (setq *vcs-used* nil) + (apply 'wt-global-entry x)) +@@ -400,31 +381,27 @@ + ;; as I can make it. Valid values of *eval-when-defaults* are + ;; a sublist of '(compile eval load) + +-(defvar *eval-when-defaults* :defaults) +- +-(defun maybe-eval (default-action form) +- (or default-action (and (symbolp (car form)) +- (setq default-action (get (car form) 'eval-at-compile)))) +- (cond ((or (and default-action (eq :defaults *eval-when-defaults*)) +- (and (consp *eval-when-defaults*)(member 'compile *eval-when-defaults* ))) +- (if form (cmp-eval form)) +- t))) ++(defvar *eval-when-defaults* nil);:defaults + ++(defun maybe-eval (def form) ++ (when (or def ++ (intersection '(compile :compile-toplevel) *eval-when-defaults*) ++ (let ((c (car form))) (when (symbolp c) (get c 'eval-at-compile)))) ++ (when form ++ (cmp-eval form)) ++ t)) + + (defun t1eval-when (args &aux load-flag compile-flag) + (when (endp args) (too-few-args 'eval-when 1 0)) +- (dolist** (situation (car args)) ++ (dolist (situation (car args)) + (case situation + ((load :load-toplevel) (setq load-flag t)) + ((compile :compile-toplevel) (setq compile-flag t)) + ((eval :execute)) +- (otherwise (cmperr "The EVAL-WHEN situation ~s is illegal." +- situation)))) +- (let ((*eval-when-defaults* (car args))) +- (cond (load-flag +- (t1progn (cdr args))) +- (compile-flag +- (cmp-eval (cons 'progn (cdr args))))))) ++ (otherwise (cmperr "The EVAL-WHEN situation ~s is illegal." situation)))) ++ (let ((*eval-when-defaults* (or *eval-when-defaults* (car args)))) ++ (cond (load-flag (t1progn (cdr args))) ++ (compile-flag (cmp-eval (cons 'progn (cdr args))))))) + + (defun t1macrolet(args &aux (*funs* *funs*)) + (dolist (def (car args)) +@@ -441,7 +418,17 @@ + (let ((*compile-ordinaries* t)) + (t1progn (cdr args)))) + (t +- (dolist** (form args) (t1expr form))))) ++ (let ((f *top-level-forms*)) ++ (dolist (form args) (t1expr form)) ++ (setq *top-level-forms* (cons `(progn ,(nreverse (ldiff *top-level-forms* f))) f)))))) ++ ++(defun t3progn (args) ++ (dolist (arg args) ++ (t23expr arg 't3))) ++ ++(defun t2progn (args) ++ (dolist (arg args) ++ (t23expr arg 't2))) + + ;; (defun foo (x) .. -> (defun foo (g102 &aux (x g102)) ... + (defun cmpfix-args (args bind &aux tem (lam (copy-list (second args)))) +@@ -464,7 +451,6 @@ + (unless (macro-function (car args)) (maybe-eval nil (cons 'defun args))) + (tagbody + top +- (setq *non-package-operation* t) + (setq *local-functions* nil) + (let ((*vars* nil) (*funs* nil) (*blocks* nil) (*tags* nil) lambda-expr + (*special-binding* nil) +@@ -681,8 +667,8 @@ + (push (list a) *vaddress-list*) + (prog1 *vind* (incf *vind*))) + +-(defun t2defun (fname cfun lambda-expr doc sp) +- (declare (ignore cfun lambda-expr doc sp)) ++(defun t2defun (fname cfun lambda-expr doc sp &optional macro-p) ++ (declare (ignore cfun lambda-expr doc sp macro-p)) + (cond ((get fname 'no-global-entry)(return-from t2defun nil))) + (cond ((< *space* 2) + (setf (get fname 'debug-prop) t) +@@ -716,8 +702,7 @@ + (t (wt-h cfun "();") + (add-init `(si::mf ',fname ,(add-address (c-function-name "" cfun fname))))))) + +-(defun t3defun (fname cfun lambda-expr doc sp &aux inline-info +- (macro-p (equal `(mflag ,fname) (cadr (member *current-form* *top-level-forms*)))) ++(defun t3defun (fname cfun lambda-expr doc sp &optional macro-p &aux inline-info + (*current-form* (list 'defun fname)) + (*volatile* (volatile (second lambda-expr))) + *downward-closures*) +@@ -1333,47 +1318,29 @@ + (maybe-eval (not (macro-function n)) (cons 'defmacro w));FIXME? + (t1expr `(defun ,n ,@(if macp args (cddr (caddr (si::defmacro* n (pop args) args)))))) + (setf (symbol-plist n) l) +- (push `(mflag ,n) *top-level-forms*)) ++ (nconc (car *top-level-forms*) '(t))) ++ ++(defvar *compiling-ordinary* nil) + +-(defun t1ordinary (form &aux tem ) +- (setq *non-package-operation* t) +- ;; check for top level functions +- (cond ((or *compile-ordinaries* (when (listp form) (member (car form) '(let let* flet labels)))) ++(defun compile-ordinary-p (form) ++ (when (consp form) ++ (or (member (car form) '(lambda defun defmacro flet labels)) ++ (compile-ordinary-p (car form)) ++ (compile-ordinary-p (cdr form))))) ++ ++(defun t1ordinary (form) ++ (cond ((unless *compiling-ordinary* ++ (or *compile-ordinaries* (compile-ordinary-p form))) + (maybe-eval nil form) +- (let ((gen (gensym "progn 'compile"))) ++ (let ((gen (gensym))(*compiling-ordinary* t)) + (proclaim `(function ,gen nil t)) +- (t1expr `(defun ,gen (), form nil)) +- (push (list 'ordinary `(,gen) ) *top-level-forms*))) +- ;;Hack to things like (setq bil #'(lambda () ...)) or (foo nil #'(lambda () ..)) +- ;; but not (let ((x ..)) (setq bil #'(lambda () ..))) +- ;; for the latter you must use (progn 'compile ...) +- ((and (consp form) +- (symbolp (car form)) +- (or (eq (car form) 'setq) +- (not (special-operator-p (car form)))) +- (do ((v (cdr form) (and (consp v) (cdr v))) +- (i 1 (the fixnum (+ 1 i)))) +- ((or (>= i 1000) +- (not (consp v))) nil) +- (declare (fixnum i)) +- (cond ((and (consp (car v)) +- (eq (caar v) 'function) +- (consp (setq tem (second (car v)))) +- (eq (car tem) 'lambda)) +- (let ((gen (gensym))) +- (t1expr `(defun ,gen ,@ (cdr tem))) +- (return-from t1ordinary +- (t1ordinary (append +- (subseq form 0 i) +- `((symbol-function ', gen)) +- (nthcdr (+ 1 i) form)))))))))) ++ (t1expr `(progn (defun ,gen nil ,form nil) (,gen))))) + (t + (maybe-eval nil form) + (let ((*vars* nil) (*funs* nil) (*blocks* nil) (*tags* nil) + (*sharp-commas* nil)) + (push (list 'ordinary form) *top-level-forms*) +- nil +- )))) ++ nil)))) + + (defun t3ordinary (form) + (cond ((atom form)) +--- gcl-2.6.12.orig/cmpnew/gcl_cmputil.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmputil.lsp +@@ -217,7 +217,7 @@ + (dolist (v '(si::cdefn lfun inline-safe inline-unsafe + inline-always c1conditional c2 c1 c1+ co1 + si::structure-access co1special +- top-level-macro t3 t2 t1 package-operation)) ++ top-level-macro t3 t2 t1)) + (si::putprop v t 'compiler-prop )) + + (defun compiler-def-hook (symbol code) symbol code nil) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpwt.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpwt.lsp +@@ -25,9 +25,7 @@ + (require 'FASDMACROS "../cmpnew/gcl_fasdmacros.lsp") + + +-(defmacro data-vector () `(car *data*)) +-(defmacro data-inits () `(second *data*)) +-(defmacro data-package-ops () `(third *data*)) ++(defmacro data-inits () `(first *data*)) + + ) + +@@ -69,7 +67,7 @@ + (defvar *fasd-data*) + + (defvar *hash-eq* nil) +-(defvar *run-hash-equal-data-checking* nil) ++(defvar *run-hash-equal-data-checking* t) + (defun memoized-hash-equal (x depth);FIXME implement all this in lisp + (declare (fixnum depth)) + (when *run-hash-equal-data-checking* +@@ -85,7 +83,6 @@ + (si::hash-equal x depth))))))) + + (defun push-data-incf (x) +- (vector-push-extend (cons (memoized-hash-equal x -1000) x) (data-vector)) + (incf *next-vv*)) + + (defun wt-data1 (expr) +@@ -105,58 +102,36 @@ + (terpri *compiler-output-data*) + (prin1 expr *compiler-output-data*))) + +-(defun verify-data-vector(vec &aux v) +- (dotimes (i (length vec)) +- (setq v (aref vec i)) +- (let ((has (memoized-hash-equal (cdr v) -1000))) +- (cond ((not (eql (car v) has)) +- (cmpwarn "A form or constant:~% ~s ~%has changed during the eval compile procedure!.~% The changed form will be the one put in the compiled file" (cdr v))))) +- (setf (aref vec i) (cdr v))) +- vec +- ) ++(defun add-init (x &optional endp &aux (tem (cons (memoized-hash-equal x -1000) x))) ++ (if endp ++ (nconc (data-inits) (list tem)) ++ (push tem (data-inits))) ++ x) ++ ++(defun verify-datum (v) ++ (unless (eql (pop v) (memoized-hash-equal v -1000)) ++ (cmpwarn "A form or constant:~% ~s ~%has changed during the eval compile procedure!.~% The changed form will be the one put in the compiled file" v)) ++ v) ++ ++(defun wt-fasd-element (x) ++ (si::find-sharing-top x (fasd-table (car *fasd-data*))) ++ (si::write-fasd-top x (car *fasd-data*))) + +-(defun add-init (x &optional endp) +- (let ((tem (cons (memoized-hash-equal x -1000) x))) +- (setf (data-inits) +- (if endp +- (nconc (data-inits) (list tem)) +- (cons tem (data-inits) ))) +- x)) ++(defun wt-data2 (x) ++ (if *fasd-data* ++ (wt-fasd-element x) ++ (wt-data1 x))) + +-(defun wt-data-file () ++(defun wt-data-file nil + (when *prof-p* (add-init `(si::mark-memory-as-profiling))) +- (verify-data-vector (data-vector)) +- (let* ((vec (coerce (nreverse (data-inits)) 'vector))) +- (verify-data-vector vec) +- (setf (aref (data-vector) (- (length (data-vector)) 1)) +- (cons 'si::%init vec)) +- (setf (data-package-ops) (nreverse (data-package-ops))) +- (cond (*fasd-data* +- (wt-fasd-data-file)) +- (t +- (format *compiler-output-data* " ~%#(") +- (dolist (v (data-package-ops)) +- (format *compiler-output-data* "#! ") +- (wt-data1 v)) +- (wt-data1 (data-vector)) +- (format *compiler-output-data* "~%)~%") +- )))) ++ (wt-data2 (1+ *next-vv*)) ++ (dolist (v (nreverse (data-inits))) ++ (wt-data2 (verify-datum v))) ++ (when *fasd-data* ++ (si::close-fasd (car *fasd-data*)))) + +-(defun wt-fasd-data-file ( &aux (x (data-vector)) tem) +-; (si::find-sharing-top (data-package-ops) (fasd-table (car *fasd-data*))) +- (si::find-sharing-top x (fasd-table (car *fasd-data*))) +- (cond ((setq tem (data-package-ops)) +- (dolist (v tem) +- (put-op d_eval_skip *compiler-output-data*) +- (si::write-fasd-top v (car *fasd-data*))))) +- (si::write-fasd-top x (car *fasd-data*)) +-; (sloop::sloop for (k v) in-table (fasd-table (car *fasd-data*)) +-; when (>= v 0) do (print (list k v))) +- (si::close-fasd (car *fasd-data*))) + (defun wt-data-begin ()) + (defun wt-data-end ()) +-(defun wt-data-package-operation (x) +- (push x (data-package-ops))) + + (defmacro wt (&rest forms &aux (fl nil)) + (dolist** (form forms (cons 'progn (reverse (cons nil fl)))) +--- gcl-2.6.12.orig/cmpnew/sys-proclaim.lisp ++++ gcl-2.6.12/cmpnew/sys-proclaim.lisp +@@ -2,197 +2,163 @@ + (COMMON-LISP::IN-PACKAGE "COMPILER") + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +- COMPILER::TAG-REF-CLB COMPILER::SET-TOP +- COMPILER::C1MULTIPLE-VALUE-BIND COMPILER::C1LIST-NTH +- COMPILER::C1RPLACA-NTHCDR COMPILER::C1DEFINE-STRUCTURE +- COMPILER::BLK-REF-CLB COMPILER::WT-VV COMPILER::C1LENGTH +- COMPILER::C1MAPC COMPILER::C1LOCAL-CLOSURE +- COMPILER::CHECK-VREF COMPILER::WT-VAR-DECL COMPILER::C1TAGBODY +- COMPILER::BLK-REF-CCB COMPILER::C1LOAD-TIME-VALUE +- COMPILER::C1ASH COMPILER::FUN-LEVEL COMPILER::COPY-INFO +- COMPILER::INLINE-POSSIBLE COMPILER::WT-VS-BASE +- COMPILER::T1DEFENTRY COMPILER::CHARACTER-LOC-P +- COMPILER::C2RPLACA COMPILER::RESET-INFO-TYPE +- COMPILER::TYPE-FILTER COMPILER::TAG-SWITCH +- COMPILER::DECL-BODY-SAFETY COMPILER::C1AND +- COMPILER::C1FMLA-CONSTANT COMPILER::C2GO-CLB +- COMPILER::C1FUNCTION COMPILER::C1MAPLIST COMPILER::VAR-TYPE +- COMPILER::CLINK COMPILER::UNWIND-NO-EXIT COMPILER::VAR-LOC +- COMPILER::C2RPLACD COMPILER::VERIFY-DATA-VECTOR +- COMPILER::TAG-REF-CCB COMPILER::C1RETURN-FROM +- COMPILER::T1DEFINE-STRUCTURE COMPILER::MDELETE-FILE +- COMPILER::OBJECT-TYPE COMPILER::WT-CAR COMPILER::TAG-P +- COMPILER::ADD-LOOP-REGISTERS COMPILER::C1MEMQ +- COMPILER::C2FUNCTION COMPILER::CMP-MACRO-FUNCTION +- COMPILER::C1BOOLE-CONDITION COMPILER::REP-TYPE COMPILER::C2GET +- COMPILER::C2VAR COMPILER::C2EXPR* COMPILER::C1ADD-GLOBALS +- COMPILER::WT1 COMPILER::C1BLOCK COMPILER::C1MAPL +- COMPILER::C1MAPCAR COMPILER::FSET-FN-NAME COMPILER::C2GO-CCB +- COMPILER::T1DEFLA COMPILER::C1NTH-CONDITION +- COMPILER::ADD-OBJECT2 COMPILER::VAR-NAME COMPILER::C1EXPR +- COMPILER::FUN-REF COMPILER::SCH-LOCAL-FUN +- COMPILER::FIXNUM-LOC-P COMPILER::BLK-VAR +- COMPILER::C1UNWIND-PROTECT COMPILER::C2BIND +- COMPILER::PARSE-CVSPECS COMPILER::C1NTH +- COMPILER::WT-SWITCH-CASE SYSTEM::UNDEF-COMPILER-MACRO +- COMPILER::SET-UP-VAR-CVS COMPILER::C1ECASE +- COMPILER::C1STRUCTURE-REF COMPILER::FUN-INFO +- COMPILER::C1MEMBER COMPILER::C1GET COMPILER::WT-FUNCTION-LINK +- COMPILER::C1ASH-CONDITION COMPILER::WT-CCB-VS COMPILER::INFO-P +- COMPILER::REGISTER COMPILER::TAG-VAR COMPILER::C1VAR +- COMPILER::C1TERPRI COMPILER::LTVP +- COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::C1MAPCON +- COMPILER::PUSH-ARGS-LISPCALL COMPILER::C1SETQ +- COMPILER::C2DOWNWARD-FUNCTION COMPILER::T3ORDINARY +- COMPILER::C1VREF COMPILER::WT-VS COMPILER::CONSTANT-FOLD-P +- COMPILER::C1MULTIPLE-VALUE-PROG1 COMPILER::BLK-EXIT +- COMPILER::T1DEFUN COMPILER::C1LABELS COMPILER::C1FSET +- COMPILER::T1MACROLET COMPILER::FUN-NAME COMPILER::C1APPLY +- COMPILER::FUN-P COMPILER::WT-DATA-PACKAGE-OPERATION +- COMPILER::C1FUNOB COMPILER::WT-SYMBOL-FUNCTION +- COMPILER::GET-RETURN-TYPE COMPILER::ADD-CONSTANT +- COMPILER::SAFE-SYSTEM COMPILER::BLK-VALUE-TO-GO +- COMPILER::NEED-TO-SET-VS-POINTERS COMPILER::C2TAGBODY-LOCAL +- COMPILER::C1DECLARE COMPILER::C1OR COMPILER::C1ASSOC +- COMPILER::ADD-ADDRESS COMPILER::VAR-KIND +- COMPILER::PROCLAMATION COMPILER::FIX-OPT COMPILER::WT-DATA1 +- COMPILER::INFO-SP-CHANGE COMPILER::ARGS-CAUSE-SIDE-EFFECT +- COMPILER::WRITE-BLOCK-OPEN COMPILER::C2TAGBODY-BODY +- COMPILER::CONS-TO-LISTA COMPILER::SAVE-FUNOB COMPILER::VAR-REF +- COMPILER::C1LOCAL-FUN COMPILER::VAR-REP-LOC +- COMPILER::SET-PUSH-CATCH-FRAME COMPILER::CTOP-WRITE +- COMPILER::C2TAGBODY-CLB COMPILER::T1CLINES +- COMPILER::ADD-OBJECT COMPILER::GET-LOCAL-RETURN-TYPE +- COMPILER::DEFAULT-INIT COMPILER::FUNCTION-ARG-TYPES +- COMPILER::C1STRUCTURE-SET COMPILER::CMP-MACROEXPAND-1 +- COMPILER::INLINE-TYPE COMPILER::VAR-REGISTER +- COMPILER::DECLARATION-TYPE COMPILER::C1CATCH COMPILER::C1LET +- COMPILER::T3CLINES COMPILER::UNDEFINED-VARIABLE COMPILER::C1GO +- COMPILER::TAG-NAME COMPILER::SCH-GLOBAL COMPILER::C1IF +- COMPILER::C1FLET COMPILER::INLINE-BOOLE3-STRING +- COMPILER::INFO-CHANGED-ARRAY COMPILER::C2FUNCALL-AUX +- COMPILER::FUN-REF-CCB COMPILER::WT-CADR COMPILER::FUN-CFUN +- COMPILER::WT-VS* COMPILER::WT-DOWN COMPILER::C2GETHASH +- COMPILER::ADD-REG1 COMPILER::REPLACE-CONSTANT +- COMPILER::C2DM-RESERVE-V COMPILER::RESULT-TYPE +- COMPILER::C1FUNCALL COMPILER::C1THE COMPILER::VARARG-P +- COMPILER::INFO-REFERRED-ARRAY COMPILER::C1PROGV +- COMPILER::T2DECLARE COMPILER::T1DEFCFUN COMPILER::C2VALUES +- COMPILER::C1SWITCH COMPILER::C1MAPCAN +- COMPILER::CMP-MACROEXPAND COMPILER::TAG-LABEL +- COMPILER::TAG-UNWIND-EXIT COMPILER::C1PRINC COMPILER::C1THROW +- COMPILER::SAVE-AVMA COMPILER::VOLATILE COMPILER::FLAGS-POS +- COMPILER::INFO-TYPE COMPILER::C1NTHCDR-CONDITION +- COMPILER::C1MULTIPLE-VALUE-SETQ COMPILER::WT-FUNCALL-C +- COMPILER::PUSH-ARGS COMPILER::C1DM-BAD-KEY +- COMPILER::T1ORDINARY COMPILER::C1PSETQ COMPILER::BLK-REF +- COMPILER::C2DM-RESERVE-VL COMPILER::C1MACROLET +- COMPILER::C1SHARP-COMMA COMPILER::C1RPLACA +- COMMON-LISP::PROCLAIM COMPILER::PUSH-DATA-INCF +- COMPILER::MACRO-DEF-P COMPILER::BLK-NAME COMPILER::C1VALUES +- COMPILER::C1DOWNWARD-FUNCTION COMPILER::T1DEFMACRO +- COMPILER::GET-ARG-TYPES COMPILER::ADD-SYMBOL +- COMPILER::NAME-SD1 COMPILER::C2GO-LOCAL +- COMPILER::C2TAGBODY-CCB COMPILER::WT-LIST +- COMPILER::GET-LOCAL-ARG-TYPES COMPILER::C1BOOLE3 +- COMPILER::C1STACK-LET COMPILER::WT-CDR COMPILER::C1QUOTE +- COMPILER::C1EVAL-WHEN COMPILER::VAR-P COMPILER::CHECK-DOWNWARD +- COMPILER::T1PROGN COMPILER::BLK-P COMPILER::C2LOCATION +- COMPILER::THE-PARAMETER COMPILER::C2VAR-KIND +- COMPILER::C1GETHASH COMPILER::LTVP-EVAL COMPILER::C1RPLACD +- COMPILER::INFO-VOLATILE COMPILER::LONG-FLOAT-LOC-P +- COMPILER::FUNCTION-RETURN-TYPE COMPILER::SHORT-FLOAT-LOC-P +- COMPILER::WT-H1 COMPILER::C1MULTIPLE-VALUE-CALL +- COMPILER::NAME-TO-SD COMPILER::C1PROGN COMPILER::SET-RETURN +- COMPILER::C1LET* COMPILER::AET-C-TYPE COMPILER::C1COMPILER-LET +- COMPILER::MAXARGS COMPILER::VAR-REF-CCB COMPILER::VV-STR +- COMPILER::C1NTHCDR COMPILER::TAG-REF COMPILER::GET-INCLUDED)) +-(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::VECTOR COMMON-LISP::CHARACTER +- COMMON-LISP::*)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- COMPILER::TS COMPILER::DASH-TO-UNDERSCORE)) ++ COMPILER::CMPERR COMPILER::CMPWARN COMPILER::WT-CVAR ++ COMPILER::ADD-INIT COMPILER::INIT-NAME ++ COMPILER::FAST-LINK-PROCLAIMED-TYPE-P COMPILER::C1CASE ++ COMPILER::WT-INTEGER-LOC COMPILER::CMPNOTE ++ COMPILER::UNWIND-EXIT COMPILER::WT-COMMENT ++ COMPILER::C1LAMBDA-EXPR)) + (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::C2CALL-UNKNOWN-GLOBAL COMPILER::WT-IF-PROCLAIMED +- COMPILER::MY-CALL COMPILER::WT-GLOBAL-ENTRY +- COMPILER::T3DEFUN-NORMAL COMPILER::C2STRUCTURE-REF +- COMPILER::C2SWITCH COMPILER::C2CALL-GLOBAL +- COMPILER::T3DEFUN-VARARG COMPILER::C1MAKE-VAR)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ COMPILER::C2RETURN-LOCAL COMPILER::WT-INLINE-LOC ++ COMPILER::C1SYMBOL-FUN COMPILER::C2DECL-BODY ++ COMPILER::COMPILER-BUILD COMPILER::NCONC-FILES ++ COMPILER::C2BLOCK COMPILER::C1BODY COMPILER::C2BLOCK-LOCAL)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::T ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) + COMMON-LISP::T) +- COMPILER::LINK COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL +- COMPILER::INLINE-ARGS)) ++ COMPILER::MEMOIZED-HASH-EQUAL)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::T) +- COMPILER::WT-INLINE-INTEGER COMPILER::ADD-FUNCTION-DECLARATION +- COMPILER::C1STRUCTURE-REF1 COMPILER::ADD-FAST-LINK +- COMPILER::AND-FORM-TYPE COMPILER::C2PRINC COMPILER::C2MAPCAN +- COMPILER::CJT COMPILER::C2CASE COMPILER::WT-INLINE-LONG-FLOAT +- COMPILER::SUBLIS1-INLINE COMPILER::MYSUB +- COMPILER::ADD-FUNCTION-PROCLAMATION COMPILER::FIX-DOWN-ARGS +- COMPILER::TOO-MANY-ARGS COMPILER::CMP-EXPAND-MACRO +- COMPILER::C2MULTIPLE-VALUE-BIND COMPILER::C2GO +- COMPILER::WT-INLINE-FIXNUM COMPILER::WT-INLINE-COND +- COMPILER::C1MAP-FUNCTIONS COMPILER::C1DM +- COMPILER::WT-MAKE-CCLOSURE COMPILER::CAN-BE-REPLACED* +- COMPILER::C-FUNCTION-NAME COMPILER::C2LET* COMPILER::CJF +- COMPILER::TOO-FEW-ARGS COMPILER::BOOLE3 COMPILER::T3DEFCFUN +- COMPILER::C2FUNCALL-SFUN COMPILER::C2MAPC +- COMPILER::CHECK-FORM-TYPE COMPILER::SET-VAR +- COMPILER::C2TAGBODY COMPILER::CHECK-VDECL +- COMPILER::GET-INLINE-INFO COMPILER::ASSIGN-DOWN-VARS +- COMPILER::C2LET COMPILER::INLINE-TYPE-MATCHES +- COMPILER::COMPILER-PASS2 COMPILER::C2PROGV COMPILER::C2MAPCAR +- COMPILER::MAKE-INLINE-STRING COMPILER::WT-INLINE-CHARACTER +- COMPILER::WT-INLINE-SHORT-FLOAT)) ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) ++ COMPILER::MAKE-INIT-STRING)) + (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::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) + COMMON-LISP::T) +- COMPILER::T2DEFENTRY COMPILER::DEFSYSFUN COMPILER::T3DEFENTRY)) ++ COMPILER::MLIN)) + (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::T3DEFUN-LOCAL-ENTRY COMPILER::T3INIT-FUN +- COMPILER::T2DEFUN COMPILER::T3DEFUN COMPILER::C2STRUCTURE-SET +- COMPILER::C1APPLY-OPTIMIZE)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++ COMPILER::PROCLAIMED-ARGD COMPILER::ANALYZE-REGS ++ COMPILER::ANALYZE-REGS1)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) +- COMMON-LISP::T) +- COMPILER::GET-OUTPUT-PATHNAME COMPILER::WT-SIMPLE-CALL)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ COMPILER::DECL-BODY-SAFETY COMPILER::C2FUNCTION ++ COMPILER::C1PROGN COMPILER::C1MAPCAR COMPILER::C1FLET ++ COMPILER::C1EXPR COMPILER::C1LET COMPILER::ADD-OBJECT ++ COMPILER::C1LABELS COMPILER::C1FMLA-CONSTANT COMPILER::C1ECASE ++ COMPILER::C1LENGTH COMPILER::C1APPLY COMPILER::THE-PARAMETER ++ COMPILER::C1TAGBODY COMPILER::T3CLINES ++ COMPILER::VERIFY-DATA-VECTOR COMPILER::VAR-KIND ++ COMPILER::INLINE-TYPE COMPILER::C1MULTIPLE-VALUE-CALL ++ COMPILER::C2GET COMPILER::ADD-CONSTANT COMPILER::T1DEFMACRO ++ COMPILER::C2EXPR* COMPILER::TAG-UNWIND-EXIT ++ COMPILER::CHECK-DOWNWARD COMPILER::WT-CADR ++ COMPILER::CHARACTER-LOC-P COMPILER::C1DECLARE ++ COMPILER::AET-C-TYPE COMPILER::C1QUOTE COMPILER::CHECK-VREF ++ COMPILER::VAR-LOC COMPILER::INLINE-POSSIBLE COMPILER::SET-TOP ++ COMPILER::T1ORDINARY COMPILER::BLK-VAR COMPILER::SAVE-AVMA ++ COMPILER::C1VREF COMPILER::WT-VV COMPILER::C2GO-LOCAL ++ COMPILER::C1MEMBER COMPILER::LTVP-EVAL COMPILER::VV-STR ++ COMPILER::TAG-REF-CLB COMPILER::T2DECLARE ++ COMPILER::CMP-MACROEXPAND-1 COMPILER::T1DEFINE-STRUCTURE ++ COMPILER::T1DEFENTRY COMPILER::ADD-OBJECT2 COMPILER::FUN-LEVEL ++ COMPILER::VAR-P COMPILER::WT-DATA-PACKAGE-OPERATION ++ COMPILER::PUSH-ARGS-LISPCALL COMPILER::C1PSETQ COMPILER::C1OR ++ COMPILER::C1LOCAL-FUN COMPILER::WT-VS-BASE ++ COMPILER::DEFAULT-INIT COMPILER::C1MAPCON COMPILER::C1GO ++ COMPILER::INFO-REFERRED-ARRAY COMPILER::BLK-REF ++ COMPILER::T1DEFLA COMPILER::INFO-CHANGED-ARRAY ++ COMPILER::WT-VAR-DECL COMPILER::UNWIND-NO-EXIT ++ COMPILER::BLK-VALUE-TO-GO COMPILER::C2GO-CLB ++ COMPILER::FUNCTION-ARG-TYPES COMPILER::C1MAPC ++ COMPILER::C2DOWNWARD-FUNCTION COMPILER::CMP-MACRO-FUNCTION ++ COMPILER::C1SHARP-COMMA COMPILER::ADD-ADDRESS ++ COMPILER::GET-LOCAL-RETURN-TYPE COMPILER::T1DEFUN ++ COMPILER::C1ADD-GLOBALS COMPILER::C2DM-RESERVE-V ++ COMPILER::C1ASH COMPILER::C1STACK-LET ++ COMPILER::WT-SYMBOL-FUNCTION COMPILER::C2TAGBODY-CLB ++ COMPILER::C1MAPLIST COMPILER::PUSH-DATA-INCF ++ COMPILER::C2TAGBODY-LOCAL COMPILER::C1FSET COMPILER::WT1 ++ COMPILER::VAR-REF-CCB COMPILER::INFO-P COMPILER::C1ASSOC ++ COMPILER::C2GETHASH COMPILER::C1RPLACD COMPILER::C1EVAL-WHEN ++ COMPILER::REP-TYPE COMPILER::C1FUNOB COMPILER::BLK-REF-CLB ++ COMPILER::WT-VS* COMPILER::C1GET COMPILER::SCH-LOCAL-FUN ++ COMPILER::SET-PUSH-CATCH-FRAME COMPILER::C1BOOLE3 ++ COMPILER::BLK-EXIT COMPILER::T1DEFCFUN COMPILER::GET-ARG-TYPES ++ COMPILER::WRITE-BLOCK-OPEN COMPILER::C1COMPILER-LET ++ COMPILER::ADD-LOOP-REGISTERS COMPILER::INLINE-BOOLE3-STRING ++ COMPILER::C1LOAD-TIME-VALUE COMPILER::VAR-TYPE ++ COMPILER::REGISTER COMPILER::RESET-INFO-TYPE ++ COMPILER::C1UNWIND-PROTECT COMPILER::C1IF ++ COMPILER::SHORT-FLOAT-LOC-P COMPILER::C1VAR ++ COMPILER::WT-FUNCALL-C COMPILER::C1THE COMPILER::FIX-OPT ++ COMPILER::UNDEFINED-VARIABLE COMPILER::C2RPLACD ++ COMPILER::C1BOOLE-CONDITION COMPILER::C1NTH COMPILER::VARARG-P ++ COMPILER::OBJECT-TYPE COMPILER::VOLATILE COMPILER::FUN-P ++ COMPILER::VAR-REF COMPILER::C1DEFINE-STRUCTURE ++ COMPILER::MAXARGS COMPILER::LONG-FLOAT-LOC-P ++ COMPILER::REPLACE-CONSTANT COMPILER::C2TAGBODY-BODY ++ COMPILER::TAG-P COMPILER::C1RETURN-FROM COMPILER::WT-VS ++ COMPILER::ARGS-CAUSE-SIDE-EFFECT COMPILER::C1LIST-NTH ++ COMPILER::FSET-FN-NAME COMPILER::SAVE-FUNOB COMPILER::C1BLOCK ++ COMPILER::C1AND COMPILER::C2TAGBODY-CCB COMPILER::GET-INCLUDED ++ COMPILER::TAG-REF COMPILER::NEED-TO-SET-VS-POINTERS ++ COMPILER::C1VALUES COMPILER::BLK-P COMPILER::COPY-INFO ++ COMPILER::WT-CAR COMPILER::FUN-CFUN ++ COMPILER::C1MULTIPLE-VALUE-PROG1 SYSTEM::UNDEF-COMPILER-MACRO ++ COMPILER::C1DM-BAD-KEY COMPILER::FUN-REF COMPILER::NAME-SD1 ++ COMPILER::MDELETE-FILE COMPILER::SAFE-SYSTEM ++ COMPILER::WT-DATA2 COMPILER::WT-CDR COMPILER::C2GO-CCB ++ COMPILER::C1ASH-CONDITION COMPILER::C1RPLACA ++ COMPILER::WT-DATA1 COMPILER::C1RPLACA-NTHCDR ++ COMPILER::NAME-TO-SD COMPILER::WT-LIST ++ COMPILER::CMP-MACROEXPAND COMPILER::WT-SWITCH-CASE ++ COMPILER::GET-LOCAL-ARG-TYPES COMPILER::SET-UP-VAR-CVS ++ COMPILER::WT-FASD-ELEMENT COMPILER::RESULT-TYPE ++ COMPILER::C1SWITCH COMPILER::FIXNUM-LOC-P ++ COMPILER::C1NTHCDR-CONDITION COMPILER::TAG-VAR ++ COMPILER::C1NTHCDR COMPILER::CLINK COMPILER::LTVP ++ COMPILER::C1LET* COMPILER::TAG-NAME COMPILER::C1FUNCALL ++ COMPILER::C2RPLACA COMPILER::MACRO-DEF-P ++ COMPILER::C1STRUCTURE-REF COMPILER::GET-RETURN-TYPE ++ COMPILER::C1DOWNWARD-FUNCTION COMPILER::T1CLINES ++ COMPILER::TYPE-FILTER COMPILER::C1FUNCTION ++ COMPILER::CONS-TO-LISTA COMPILER::C1NTH-CONDITION ++ COMPILER::FUN-NAME COMPILER::PROCLAMATION COMPILER::VAR-NAME ++ COMPILER::WT-CCB-VS COMPILER::FLAGS-POS COMPILER::C1CATCH ++ COMPILER::CTOP-WRITE COMPILER::TAG-LABEL COMPILER::C1MEMQ ++ COMPILER::C1GETHASH COMPILER::TAG-REF-CCB COMPILER::TAG-SWITCH ++ COMPILER::C2BIND COMPILER::VERIFY-DATUM COMPILER::C1MAPCAN ++ COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::C1TERPRI ++ COMPILER::FUN-REF-CCB COMMON-LISP::PROCLAIM ++ COMPILER::INFO-VOLATILE COMPILER::T3ORDINARY ++ COMPILER::C2LOCATION COMPILER::BLK-NAME ++ COMPILER::C1STRUCTURE-SET COMPILER::C2VAR ++ COMPILER::C1LOCAL-CLOSURE COMPILER::C1MACROLET ++ COMPILER::WT-FUNCTION-LINK COMPILER::C2VALUES ++ COMPILER::T1MACROLET COMPILER::C1MULTIPLE-VALUE-BIND ++ COMPILER::C2FUNCALL-AUX COMPILER::C1MULTIPLE-VALUE-SETQ ++ COMPILER::PUSH-ARGS COMPILER::BLK-REF-CCB COMPILER::C1SETQ ++ COMPILER::ADD-SYMBOL COMPILER::C2VAR-KIND COMPILER::C1THROW ++ COMPILER::DECLARATION-TYPE COMPILER::C1PROGV ++ COMPILER::INFO-TYPE COMPILER::CONSTANT-FOLD-P ++ COMPILER::C1PRINC COMPILER::WT-DOWN COMPILER::SCH-GLOBAL ++ COMPILER::T1PROGN COMPILER::INFO-SP-CHANGE ++ COMPILER::C2DM-RESERVE-VL COMPILER::C1MAPL ++ COMPILER::FUNCTION-RETURN-TYPE COMPILER::ADD-REG1 ++ COMPILER::PARSE-CVSPECS COMPILER::FUN-INFO ++ COMPILER::VAR-REGISTER COMPILER::SET-RETURN COMPILER::WT-H1 ++ COMPILER::VAR-REP-LOC)) + (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-DCFUN COMPILER::T3LOCAL-FUN)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++ COMPILER::INLINE-BOOLE3)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -206,8 +172,8 @@ + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T) + COMMON-LISP::*) +- COMPILER::C2RETURN-FROM COMPILER::C2DM COMPILER::C1DM-VL +- COMPILER::C2APPLY-OPTIMIZE COMPILER::C1DM-V)) ++ COMPILER::C1DM-V COMPILER::C1DM-VL COMPILER::C2APPLY-OPTIMIZE ++ COMPILER::C2RETURN-FROM COMPILER::C2DM)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -216,40 +182,85 @@ + COMPILER::T3DEFUN-AUX)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) +- COMPILER::C2PROGN COMPILER::WT-LONG-FLOAT-LOC +- COMPILER::WT-CHARACTER-LOC COMPILER::WT-TO-STRING +- COMPILER::WT-LOC COMPILER::MEXPAND-DEFTYPE +- COMPILER::CMP-TOPLEVEL-EVAL COMPILER::T1EVAL-WHEN +- COMPILER::T1EXPR COMPILER::C2OR COMPILER::WT-FIXNUM-LOC +- COMPILER::C2EXPR COMPILER::C2AND COMPILER::CMP-EVAL +- COMPILER::SET-LOC COMPILER::WT-SHORT-FLOAT-LOC)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +- COMPILER::MAKE-INFO COMPILER::FCALLN-INLINE +- COMPILER::LIST-INLINE COMPILER::LIST*-INLINE +- COMPILER::COMPILER-COMMAND COMPILER::MAKE-BLK +- COMPILER::MAKE-FUN COMPILER::WT-CLINK COMPILER::C2FSET +- COMPILER::MAKE-TAG COMPILER::CS-PUSH COMPILER::MAKE-VAR +- COMMON-LISP::COMPILE-FILE)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) + COMPILER::F-TYPE)) +-(COMMON-LISP::MAPC +- (COMMON-LISP::LAMBDA (COMPILER::X) +- (COMMON-LISP::SETF +- (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) +- COMMON-LISP::T)) +- '(COMMON-LISP::DISASSEMBLE COMPILER::CMP-TMP-MACRO +- COMPILER::CMP-ANON COMMON-LISP::COMPILE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- ((COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*))) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- COMPILER::COPY-ARRAY)) ++ COMPILER::C2RETURN-CCB ++ COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES ++ COMPILER::DO-CHANGED COMPILER::CO1STRUCTURE-PREDICATE ++ COMPILER::RESULT-TYPE-FROM-ARGS COMPILER::CMPFIX-ARGS ++ COMPILER::T3SHARP-COMMA COMPILER::FLAGS ++ COMPILER::CO1WRITE-BYTE COMPILER::CHECK-FNAME-ARGS ++ COMPILER::C2ASSOC!2 COMPILER::CK-SPEC ++ COMPILER::COERCE-LOC-STRUCTURE-REF COMPILER::ADD-DEBUG-INFO ++ COMPILER::C2LAMBDA-EXPR-WITH-KEY COMPILER::PRIN1-CMP ++ COMPILER::PUSH-CHANGED-VARS COMPILER::SHIFT>> ++ COMPILER::ARGS-INFO-REFERRED-VARS ++ COMPILER::C2MULTIPLE-VALUE-CALL ++ COMPILER::ARGS-INFO-CHANGED-VARS COMPILER::CO1SCHAR ++ COMPILER::NEXT-CVAR COMPILER::C2RETURN-CLB ++ COMPILER::CO1WRITE-CHAR COMPILER::SET-VS SYSTEM::SWITCH ++ COMPILER::FLAG-P COMPILER::DO-ARRAY COMPILER::INLINE-PROC ++ COMPILER::CO1CONS COMPILER::C2EXPR-TOP ++ COMPILER::CHANGED-LENGTH COMPILER::C2MULTIPLE-VALUE-PROG1 ++ COMPILER::REMOVE-FLAG COMPILER::CO1SUBLIS COMPILER::ADD-INFO ++ COMPILER::C2BIND-INIT COMPILER::C2DM-BIND-VL COMPILER::C1FMLA ++ COMPILER::C2CATCH COMPILER::WT-MAKE-DCLOSURE ++ COMPILER::UNWIND-BDS COMPILER::IS-REP-REFERRED ++ COMPILER::WT-LONG-FLOAT-VALUE COMPILER::WT-GO ++ COMPILER::FAST-READ COMPILER::WT COMPILER::SAFE-COMPILE ++ COMPILER::WT-H COMPILER::STRUCT-TYPE-OPT ++ COMPILER::REFERRED-LENGTH COMPILER::TYPE-AND COMPILER::C2THROW ++ COMPILER::NEED-TO-PROTECT COMPILER::COERCE-LOC ++ COMPILER::TYPE>= COMPILER::WT-NL1 COMPILER::CHECK-END ++ COMPILER::C2BLOCK-CCB COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY ++ COMPILER::SET-BDS-BIND COMPILER::C2DM-BIND-INIT ++ COMPILER::CAN-BE-REPLACED COMPILER::MAYBE-EVAL ++ COMPILER::WT-VAR COMPILER::WT-REQUIREDS ++ COMPILER::CONVERT-CASE-TO-SWITCH COMPILER::CO1TYPEP ++ COMPILER::C1DECL-BODY COMPILER::DOWNWARD-FUNCTION ++ COMPILER::MULTIPLE-VALUE-CHECK COMPILER::NEXT-CFUN ++ SYSTEM::SWITCH-FINISH COMPILER::CO1READ-CHAR ++ COMPILER::COMPILER-CC COMPILER::C1PROGN* ++ COMPILER::C1LAMBDA-FUN COMPILER::MAKE-USER-INIT ++ COMPILER::SHIFT<< COMPILER::C1ARGS COMPILER::CK-VL ++ COMPILER::T23EXPR COMPILER::IS-CHANGED COMPILER::PUSH-REFERRED ++ COMPILER::WT-CHARACTER-VALUE ++ COMPILER::PUSH-REFERRED-WITH-START COMPILER::NEXT-LABEL* ++ COMPILER::CMPCK COMPILER::C2DM-BIND-LOC ++ COMPILER::WT-SHORT-FLOAT-VALUE ++ COMPILER::PUSH-CHANGED-WITH-START COMPILER::C2EXPR-TOP* ++ COMPILER::DOLIST* COMPILER::WT-LABEL COMPILER::PUSH-CHANGED ++ COMPILER::BASE-USED COMPILER::CO1VECTOR-PUSH ++ COMPILER::WT-V*-MACROS COMPILER::CO1CONSTANT-FOLD ++ COMPILER::WT-FIXNUM-VALUE COMPILER::C2BLOCK-CLB ++ SYSTEM::DEFINE-INLINE-FUNCTION COMPILER::SET-JUMP-TRUE ++ COMPILER::C2BIND-LOC COMPILER::IN-ARRAY ++ COMPILER::SET-JUMP-FALSE COMPILER::PROCLAIM-VAR ++ COMMON-LISP::DEFINE-COMPILER-MACRO COMPILER::C1CONSTANT-VALUE ++ COMPILER::COMPILER-DEF-HOOK COMPILER::CO1READ-BYTE ++ COMPILER::MAYBE-WT-C2DM-BIND-VL COMPILER::IS-REFERRED ++ COMPILER::DOTIMES** SYSTEM::ADD-DEBUG COMPILER::DO-REFERRED ++ COMPILER::NEXT-LABEL COMPILER::C2CALL-LAMBDA COMPILER::C2APPLY ++ COMPILER::C1EXPR* COMPILER::C2SETQ COMPILER::MIA ++ COMPILER::C2PSETQ COMPILER::C1SETQ1 ++ COMPILER::C2LIST-NTH-IMMEDIATE COMPILER::WT-NL ++ COMPILER::CO1EQL COMPILER::CFAST-WRITE COMPILER::CO1LDB ++ COMPILER::EQL-NOT-NIL COMPILER::JUMPS-TO-P ++ COMPILER::C2CALL-LOCAL COMPILER::BIGNUM-EXPANSION-STORAGE ++ COMPILER::STACK-LET COMPILER::C2MULTIPLE-VALUE-SETQ ++ COMPILER::C2MEMBER!2 COMPILER::C2UNWIND-PROTECT ++ COMPILER::DOLIST** COMPILER::SET-DBIND COMPILER::DOTIMES* ++ COMPILER::NEXT-CMACRO COMPILER::GET-INLINE-LOC ++ COMPILER::C2STACK-LET)) ++(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 +@@ -257,9 +268,11 @@ + (COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*)) + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) + COMMON-LISP::T) + COMMON-LISP::FIXNUM) +- COMPILER::PUSH-ARRAY)) ++ COMPILER::BSEARCHLEQ)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -267,11 +280,16 @@ + (COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*)) + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807) +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807) + COMMON-LISP::T) + COMMON-LISP::FIXNUM) +- COMPILER::BSEARCHLEQ)) ++ COMPILER::PUSH-ARRAY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++ COMMON-LISP::*)) ++ COMMON-LISP::T) ++ COMPILER::TS COMPILER::DASH-TO-UNDERSCORE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -285,130 +303,121 @@ + COMPILER::DASH-TO-UNDERSCORE-INT)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++ COMPILER::VS-PUSH COMPILER::WFS-ERROR COMPILER::MACRO-ENV ++ COMPILER::C1T COMPILER::WT-CVARS COMPILER::WT-DATA-END ++ COMPILER::GAZONK-NAME COMPILER::INIT-ENV ++ COMPILER::ADD-LOAD-TIME-SHARP-COMMA COMPILER::CCB-VS-PUSH ++ COMPILER::WT-DATA-FILE COMPILER::WT-FASD-DATA-FILE ++ COMPILER::INC-INLINE-BLOCKS COMPILER::PRINT-CURRENT-FORM ++ COMPILER::CLOSE-INLINE-BLOCKS COMPILER::WT-DATA-BEGIN ++ COMPILER::BABOON COMPILER::WT-C-PUSH COMPILER::WT-NEXT-VAR-ARG ++ COMPILER::WT-FIRST-VAR-ARG COMPILER::CVS-PUSH ++ COMPILER::TAIL-RECURSION-POSSIBLE COMPILER::RESET-TOP ++ COMPILER::C1NIL COMPILER::PRINT-COMPILER-INFO)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- ((COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807) +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807)) ++ ((COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*))) + COMMON-LISP::T) +- COMPILER::MLIN)) ++ COMPILER::COPY-ARRAY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++ COMPILER::T1EXPR COMPILER::WT-TO-STRING COMPILER::C2OR ++ COMPILER::WT-LOC COMPILER::SET-LOC COMPILER::MEXPAND-DEFTYPE ++ COMPILER::C2EXPR COMPILER::C2PROGN COMPILER::C2AND ++ COMPILER::WT-SHORT-FLOAT-LOC COMPILER::WT-CHARACTER-LOC ++ COMPILER::CMP-EVAL COMPILER::T1EVAL-WHEN ++ COMPILER::WT-LONG-FLOAT-LOC COMPILER::CMP-TOPLEVEL-EVAL ++ COMPILER::WT-FIXNUM-LOC)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++ COMPILER::FCALLN-INLINE COMPILER::CS-PUSH COMPILER::WT-CLINK ++ COMPILER::COMPILER-COMMAND COMPILER::MAKE-INFO ++ COMPILER::T2PROGN COMPILER::MAKE-TAG COMPILER::C2FSET ++ COMPILER::MAKE-BLK COMPILER::LIST-INLINE ++ COMMON-LISP::COMPILE-FILE COMPILER::MAKE-FUN ++ COMPILER::MAKE-VAR COMPILER::T3PROGN COMPILER::LIST*-INLINE)) ++(COMMON-LISP::MAPC ++ (COMMON-LISP::LAMBDA (COMPILER::X) ++ (COMMON-LISP::SETF ++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) ++ COMMON-LISP::T)) ++ '(COMMON-LISP::COMPILE COMMON-LISP::DISASSEMBLE COMPILER::CMP-ANON ++ COMPILER::CMP-TMP-MACRO)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807)) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) + COMMON-LISP::T) +- COMPILER::MEMOIZED-HASH-EQUAL)) ++ COMPILER::T3DEFUN-VARARG COMPILER::T3DEFUN-NORMAL ++ COMPILER::C2CALL-GLOBAL COMPILER::C2SWITCH COMPILER::MY-CALL ++ COMPILER::C1MAKE-VAR COMPILER::WT-IF-PROCLAIMED ++ COMPILER::C2STRUCTURE-REF COMPILER::C2CALL-UNKNOWN-GLOBAL ++ COMPILER::WT-GLOBAL-ENTRY)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +- COMPILER::MACRO-ENV COMPILER::C1T COMPILER::PRINT-CURRENT-FORM +- COMPILER::CCB-VS-PUSH COMPILER::C1NIL +- COMPILER::WT-FASD-DATA-FILE COMPILER::INIT-ENV +- COMPILER::WT-CVARS COMPILER::CVS-PUSH +- COMPILER::WT-FIRST-VAR-ARG COMPILER::WT-NEXT-VAR-ARG +- COMPILER::WT-DATA-FILE COMPILER::WT-C-PUSH +- COMPILER::GAZONK-NAME COMPILER::WT-DATA-END +- COMPILER::INC-INLINE-BLOCKS COMPILER::TAIL-RECURSION-POSSIBLE +- COMPILER::RESET-TOP COMPILER::CLOSE-INLINE-BLOCKS +- COMPILER::PRINT-COMPILER-INFO COMPILER::WFS-ERROR +- COMPILER::VS-PUSH COMPILER::BABOON COMPILER::WT-DATA-BEGIN +- COMPILER::ADD-LOAD-TIME-SHARP-COMMA)) ++ (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::T2DEFENTRY COMPILER::T3DEFENTRY COMPILER::DEFSYSFUN)) + (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::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ COMPILER::C2PROGV COMPILER::WT-INLINE-COND COMPILER::C2TAGBODY ++ COMPILER::CAN-BE-REPLACED* COMPILER::WT-INLINE-FIXNUM ++ COMPILER::MAKE-INLINE-STRING COMPILER::WT-INLINE-SHORT-FLOAT ++ COMPILER::C2LET* COMPILER::ADD-FAST-LINK ++ COMPILER::C1STRUCTURE-REF1 COMPILER::GET-INLINE-INFO ++ COMPILER::CHECK-FORM-TYPE COMPILER::C2MAPCAN ++ COMPILER::FIX-DOWN-ARGS COMPILER::CMP-EXPAND-MACRO ++ COMPILER::SUBLIS1-INLINE COMPILER::ADD-FUNCTION-PROCLAMATION ++ COMPILER::ADD-FUNCTION-DECLARATION COMPILER::SET-VAR ++ COMPILER::BOOLE3 COMPILER::CJF COMPILER::C2PRINC ++ COMPILER::INLINE-TYPE-MATCHES COMPILER::C1MAP-FUNCTIONS ++ COMPILER::C1DM COMPILER::WT-INLINE-CHARACTER ++ COMPILER::WT-MAKE-CCLOSURE COMPILER::TOO-MANY-ARGS ++ COMPILER::COMPILER-PASS2 COMPILER::WT-INLINE-INTEGER ++ COMPILER::T3DEFCFUN COMPILER::MYSUB ++ COMPILER::WT-INLINE-LONG-FLOAT COMPILER::TOO-FEW-ARGS ++ COMPILER::CHECK-VDECL COMPILER::C2GO COMPILER::C2LET ++ COMPILER::ASSIGN-DOWN-VARS COMPILER::C2CASE ++ COMPILER::C2FUNCALL-SFUN COMPILER::AND-FORM-TYPE ++ COMPILER::C-FUNCTION-NAME COMPILER::C2MAPCAR COMPILER::CJT ++ COMPILER::C2MULTIPLE-VALUE-BIND COMPILER::C2MAPC)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- COMPILER::UNWIND-EXIT COMPILER::WT-COMMENT COMPILER::CMPERR +- COMPILER::WT-CVAR COMPILER::FAST-LINK-PROCLAIMED-TYPE-P +- COMPILER::C1CASE COMPILER::CMPWARN COMPILER::ADD-INIT +- COMPILER::INIT-NAME COMPILER::WT-INTEGER-LOC COMPILER::CMPNOTE +- COMPILER::C1LAMBDA-EXPR)) ++ COMPILER::C1APPLY-OPTIMIZE COMPILER::T3DEFUN-LOCAL-ENTRY ++ COMPILER::T3INIT-FUN COMPILER::C2STRUCTURE-SET)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::*) +- COMPILER::C2BLOCK COMPILER::C1SYMBOL-FUN +- COMPILER::C2BLOCK-LOCAL COMPILER::C2DECL-BODY +- COMPILER::COMPILER-BUILD COMPILER::NCONC-FILES +- COMPILER::WT-INLINE-LOC COMPILER::C2RETURN-LOCAL +- COMPILER::C1BODY)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ COMPILER::T3DEFUN COMPILER::T2DEFUN COMPILER::T3LOCAL-FUN ++ COMPILER::T3LOCAL-DCFUN)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- COMPILER::WT-FIXNUM-VALUE COMPILER::DOLIST** COMPILER::CO1LDB +- COMPILER::PUSH-REFERRED-WITH-START COMPILER::C2ASSOC!2 +- COMPILER::ADD-DEBUG-INFO COMPILER::WT-CHARACTER-VALUE +- COMPILER::MAYBE-WT-C2DM-BIND-VL COMPILER::C2BIND-LOC +- COMPILER::C2CATCH COMPILER::DO-REFERRED COMPILER::C2BLOCK-CLB +- COMPILER::CO1CONSTANT-FOLD COMPILER::C2CALL-LOCAL +- COMPILER::SHIFT<< COMPILER::C2UNWIND-PROTECT +- COMPILER::C2MULTIPLE-VALUE-SETQ COMPILER::C2DM-BIND-VL +- COMPILER::DOTIMES* COMPILER::REFERRED-LENGTH COMPILER::C1ARGS +- COMPILER::CK-SPEC COMPILER::C2MULTIPLE-VALUE-CALL +- COMPILER::C2CALL-LAMBDA COMPILER::CO1READ-BYTE +- COMPILER::CO1VECTOR-PUSH COMPILER::STACK-LET COMPILER::CMPCK +- COMPILER::MAYBE-EVAL COMPILER::COERCE-LOC COMPILER::C2PSETQ +- SYSTEM::DEFINE-INLINE-FUNCTION COMPILER::WT-MAKE-DCLOSURE +- COMPILER::COMPILER-CC COMPILER::WT-GO COMPILER::C1LAMBDA-FUN +- COMPILER::C2RETURN-CLB COMPILER::C1DECL-BODY +- COMPILER::PUSH-CHANGED-VARS COMPILER::GET-INLINE-LOC +- COMPILER::CO1SUBLIS COMPILER::CHANGED-LENGTH COMPILER::CO1CONS +- COMPILER::ARGS-INFO-REFERRED-VARS COMPILER::SET-JUMP-FALSE +- COMPILER::MAKE-USER-INIT COMPILER::NEXT-CVAR +- COMPILER::CAN-BE-REPLACED COMPILER::WT-V*-MACROS +- COMPILER::NEXT-CMACRO COMPILER::C2RETURN-CCB +- COMPILER::CO1SCHAR COMPILER::IS-CHANGED +- COMMON-LISP::DEFINE-COMPILER-MACRO COMPILER::SET-DBIND +- COMPILER::WT-H COMPILER::COERCE-LOC-STRUCTURE-REF +- COMPILER::C1EXPR* COMPILER::IS-REFERRED COMPILER::SHIFT>> +- COMPILER::WT COMPILER::TYPE-AND COMPILER::PRIN1-CMP +- COMPILER::C2BIND-INIT COMPILER::RESULT-TYPE-FROM-ARGS +- COMPILER::EQL-NOT-NIL COMPILER::C2APPLY COMPILER::C2BLOCK-CCB +- COMPILER::WT-NL1 COMPILER::CO1WRITE-CHAR COMPILER::CFAST-WRITE +- COMPILER::NEED-TO-PROTECT COMPILER::T3SHARP-COMMA +- SYSTEM::ADD-DEBUG COMPILER::BIGNUM-EXPANSION-STORAGE +- COMPILER::C2SETQ COMPILER::FLAG-P +- COMPILER::PUSH-CHANGED-WITH-START COMPILER::CMPFIX-ARGS +- COMPILER::CO1STRUCTURE-PREDICATE COMPILER::FAST-READ +- COMPILER::C1CONSTANT-VALUE COMPILER::BASE-USED +- COMPILER::PROCLAIM-VAR COMPILER::CO1TYPEP +- COMPILER::SET-JUMP-TRUE COMPILER::TYPE>= COMPILER::DOTIMES** +- COMPILER::CONVERT-CASE-TO-SWITCH COMPILER::C2MEMBER!2 +- COMPILER::DO-CHANGED COMPILER::ADD-INFO COMPILER::SET-VS +- COMPILER::CHECK-FNAME-ARGS +- COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES +- COMPILER::C2MULTIPLE-VALUE-PROG1 COMPILER::NEXT-LABEL* +- COMPILER::WT-VAR COMPILER::C2THROW COMPILER::INLINE-PROC +- COMPILER::PUSH-REFERRED COMPILER::C2LIST-NTH-IMMEDIATE +- COMPILER::C1FMLA COMPILER::PUSH-CHANGED +- COMPILER::MULTIPLE-VALUE-CHECK COMPILER::MIA +- COMPILER::WT-LABEL COMPILER::WT-NL +- COMPILER::WT-SHORT-FLOAT-VALUE COMPILER::SET-BDS-BIND +- COMPILER::DO-ARRAY COMPILER::WT-REQUIREDS +- COMPILER::C2EXPR-TOP* COMPILER::C2DM-BIND-LOC +- COMPILER::DOLIST* SYSTEM::SWITCH-FINISH +- COMPILER::IS-REP-REFERRED COMPILER::WT-LONG-FLOAT-VALUE +- COMPILER::C1SETQ1 COMPILER::FLAGS COMPILER::CO1EQL +- COMPILER::CHECK-END COMPILER::NEXT-LABEL COMPILER::CK-VL +- COMPILER::ARGS-INFO-CHANGED-VARS COMPILER::C1PROGN* +- COMPILER::C2DM-BIND-INIT COMPILER::STRUCT-TYPE-OPT +- COMPILER::UNWIND-BDS COMPILER::SAFE-COMPILE +- COMPILER::CO1READ-CHAR COMPILER::JUMPS-TO-P SYSTEM::SWITCH +- COMPILER::NEXT-CFUN COMPILER::CO1WRITE-BYTE +- COMPILER::DOWNWARD-FUNCTION COMPILER::COMPILER-DEF-HOOK +- COMPILER::C2STACK-LET COMPILER::C2EXPR-TOP +- COMPILER::C2LAMBDA-EXPR-WITH-KEY COMPILER::IN-ARRAY +- COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY)) ++ COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL COMPILER::LINK ++ COMPILER::INLINE-ARGS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::*) +- COMPILER::COMPILE-FILE1)) +\ No newline at end of file ++ (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)) +\ No newline at end of file +--- gcl-2.6.12.orig/h/object.h ++++ gcl-2.6.12/h/object.h +@@ -255,6 +255,21 @@ struct freelist { + + #define FREE (-1) /* free object */ + ++struct fasd { ++ object stream; /* lisp object of type stream */ ++ object table; /* hash table used in dumping or vector on input*/ ++ object eof; /* lisp object to be returned on coming to eof mark */ ++ object direction; /* holds Cnil or sKinput or sKoutput */ ++ object package; /* the package symbols are in by default */ ++ object index; /* integer. The current_dump index on write */ ++ object filepos; /* nil or the position of the start */ ++ object table_length; /* On read it is set to the size dump array needed ++ or 0 ++ */ ++ object evald_items; /* a list of items which have been eval'd and must ++ not be walked by fasd_patch_sharp */ ++}; ++ + /* + Storage manager for each type. + */ +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -144,7 +144,7 @@ struct key {short n,allow_other_keys; + /* cmpaux.c:185:OF */ extern fixnum object_to_fixnum (object x); /* (x) object x; */ + /* cmpaux.c:263:OF */ extern char *object_to_string (object x); /* (x) object x; */ + typedef int (*FUNC)(); +-/* cmpaux.c:294:OF */ extern void call_init (int init_address, object memory, object fasl_vec, FUNC fptr); /* (init_address, memory, fasl_vec, fptr) int init_address; object memory; object fasl_vec; FUNC fptr; */ ++/* cmpaux.c:294:OF */ extern void call_init (int init_address,object memory,object faslfile); /* (init_address, memory, fasl_vec, fptr) int init_address; object memory; object fasl_vec; FUNC fptr; */ + /* cmpaux.c:339:OF */ extern void do_init (object *statVV); /* (statVV) object *statVV; */ + /* cmpaux.c:416:OF */ extern void gcl_init_or_load1 (void (*fn) (void), const char *file); /* (fn, file) int (*fn)(); char *file; */ + /* conditional.c:200:OF */ extern void gcl_init_conditional (void); /* () */ +--- gcl-2.6.12.orig/o/cmpaux.c ++++ gcl-2.6.12/o/cmpaux.c +@@ -324,63 +324,18 @@ object_to_string(object x) { + /* } */ + /* #endif */ + ++ + void +-call_init(int init_address, object memory, object fasl_vec, FUNC fptr) +-{object form; +- FUNC at; +-/* #ifdef CLEAR_CACHE */ +-/* static int n; */ +-/* static sigset_t ss; */ +- +-/* if (!n) { */ +-/* struct sigaction sa={{(void *)sigh},{{0}},SA_RESTART|SA_SIGINFO,NULL}; */ +- +-/* sigaction(SIGILL,&sa,NULL); */ +-/* sigemptyset(&ss); */ +-/* sigaddset(&ss,SIGILL); */ +-/* sigprocmask(SIG_BLOCK,&ss,NULL); */ +-/* n=1; */ +-/* } */ +-/* #endif */ ++call_init(int init_address,object memory,object faslfile) { + ++ bds_bind(sSPmemory,memory); ++ bds_bind(sSPinit,faslfile); ++ ((FUNC)(memory->cfd.cfd_start+init_address))(); ++ bds_unwind1; ++ bds_unwind1; + +- check_type(fasl_vec,t_vector); +- form=(fasl_vec->v.v_self[fasl_vec->v.v_fillp -1]); ++} + +- if (fptr) at = fptr; +- else +- at=(FUNC)(memory->cfd.cfd_start+ init_address ); +- +-#ifdef VERIFY_INIT +- VERIFY_INIT +-#endif +- +- if (type_of(form)==t_cons && +- form->c.c_car == sSPinit) +- {bds_bind(sSPinit,fasl_vec); +- bds_bind(sSPmemory,memory); +-/* #ifdef CLEAR_CACHE */ +-/* sigprocmask(SIG_UNBLOCK,&ss,NULL); */ +-/* #endif */ +- (*at)(); +-/* #ifdef CLEAR_CACHE */ +-/* sigprocmask(SIG_BLOCK,&ss,NULL); */ +-/* #endif */ +- bds_unwind1; +- bds_unwind1; +- } +- else +- /* old style three arg init, with all init being done by C code. */ +- {memory->cfd.cfd_self = fasl_vec->v.v_self; +- memory->cfd.cfd_fillp = fasl_vec->v.v_fillp; +-/* #ifdef CLEAR_CACHE */ +-/* sigprocmask(SIG_UNBLOCK,&ss,NULL); */ +-/* #endif */ +- (*at)(memory->cfd.cfd_start, memory->cfd.cfd_size, memory); +-/* #ifdef CLEAR_CACHE */ +-/* sigprocmask(SIG_BLOCK,&ss,NULL); */ +-/* #endif */ +-}} + + /* statVV is the address of some static storage, which is used by the + cfunctions to refer to global variables,.. +@@ -393,48 +348,46 @@ call_init(int init_address, object memor + + */ + +-DEFUN_NEW("MARK-MEMORY-AS-PROFILING",object,fSmark_memory_as_profiling,SI,0,0, +- NONE,OO,OO,OO,OO,(void),"") { +- +- sSPmemory->s.s_dbind->cfd.cfd_prof=1; +- +- return Cnil; +- +-} +- + void +-do_init(object *statVV) +-{object fasl_vec=sSPinit->s.s_dbind; +- object data = sSPmemory->s.s_dbind; +- {object *p,*q,y; +- int n=fasl_vec->v.v_fillp -1; +- int i; +- object form; +- check_type(fasl_vec,t_vector); +- form = fasl_vec->v.v_self[n]; +- dcheck_type(form,t_cons); ++do_init(object *statVV) { ++ ++ object faslfile=sSPinit->s.s_dbind; ++ object data=sSPmemory->s.s_dbind; ++ object *p,*q,y; ++ int i,n; ++ object fasl_vec; ++ char ch; ++ ++ ch=readc_stream(faslfile); ++ unreadc_stream(ch,faslfile); ++ ++ if (ch!='\n') { ++ struct fasd * fd; ++ faslfile=FFN(fSopen_fasd)(faslfile,sKinput,OBJNULL,Cnil); ++ fd=(struct fasd *)faslfile->v.v_self; ++ n=fix(fd->table_length); ++ fd->table->v.v_self=alloca(n*sizeof(object)); ++ memset(fd->table->v.v_self,0,n*sizeof(object)); ++ fd->table->v.v_dim=faslfile->v.v_self[1]->v.v_fillp=n; ++ } + ++ n=fix(type_of(faslfile)==t_stream ? read_object(faslfile) : FFN(fSread_fasd_top)(faslfile)); ++ sSPinit->s.s_dbind=fasl_vec=fSmake_vector1_1(n,aet_object,Cnil); + + /* switch SPinit to point to a vector of function addresses */ +- ++ + fasl_vec->v.v_elttype = aet_fix; +- fasl_vec->v.v_dim *= (sizeof(object)/sizeof(fixnum)); +- fasl_vec->v.v_fillp *= (sizeof(object)/sizeof(fixnum)); +- ++ + /* swap the entries */ +- p = fasl_vec->v.v_self; ++ for (i=0,p=fasl_vec->v.v_self,q=statVV;icfd.cfd_self = statVV; +- data->cfd.cfd_fillp= n+1; +- statVV[n] = data; +- ++ data->cfd.cfd_fillp= n; ++ statVV[n-1] = data; + + /* So now the fasl_vec is a fixnum array, containing random addresses of c + functions and other stuff from the compiled code. +@@ -442,16 +395,20 @@ do_init(object *statVV) + */ + /* Now we can run the forms f1 f2 in form= (%init f1 f2 ...) */ + +- form=form->c.c_cdr; +- {object *top=vs_top; +- +- for(i=0 ; i< form->v.v_fillp; i++) +- { +- eval(form->v.v_self[i]); +- vs_top=top; +- } +- } +-}} ++ FFN(fSload_stream)(faslfile,Cnil); ++ if (type_of(faslfile)!=t_stream) ++ FFN(fSclose_fasd)(faslfile); ++ ++} ++ ++DEFUN_NEW("MARK-MEMORY-AS-PROFILING",object,fSmark_memory_as_profiling,SI,0,0, ++ NONE,OO,OO,OO,OO,(void),"") { ++ ++ sSPmemory->s.s_dbind->cfd.cfd_prof=1; ++ ++ return Cnil; ++ ++} + + #ifdef DOS + #define PATH_LIM 8 +@@ -498,14 +455,15 @@ gcl_init_or_load1(void (*fn)(void),const + if (file[strlen(file)-1]=='o') { + + object memory; +- object fasl_data; ++ object faslfile; + file=FIX_PATH_STRING(file); + + memory=new_cfdata(); + memory->cfd.cfd_start= (char *)fn; + printf("Initializing %s\n",file); fflush(stdout); +- fasl_data = read_fasl_data(file); +- call_init(0,memory,fasl_data,0); ++ faslfile=open_stream(make_simple_string(file),smm_input,Cnil,sKerror); ++ SEEK_TO_END_OFILE(faslfile->sm.sm_fp); ++ call_init(0,memory,faslfile); + + } else { + printf("loading %s\n",file); +--- gcl-2.6.12.orig/o/fasdump.c ++++ gcl-2.6.12/o/fasdump.c +@@ -35,22 +35,6 @@ object make_pathname (); + + static int needs_patching; + +- +-struct fasd { +- object stream; /* lisp object of type stream */ +- object table; /* hash table used in dumping or vector on input*/ +- object eof; /* lisp object to be returned on coming to eof mark */ +- object direction; /* holds Cnil or sKinput or sKoutput */ +- object package; /* the package symbols are in by default */ +- object index; /* integer. The current_dump index on write */ +- object filepos; /* nil or the position of the start */ +- object table_length; /* On read it is set to the size dump array needed +- or 0 +- */ +- object evald_items; /* a list of items which have been eval'd and must +- not be walked by fasd_patch_sharp */ +-}; +- + struct fasd current_fasd; + + +@@ -599,7 +583,7 @@ DEFUN_NEW("OPEN-FASD",object,fSopen_fasd + else + check_type(tabl,t_hashtable);} + massert(str==stream); +- result=alloc_simple_vector(sizeof(struct fasd)/sizeof(int),aet_object); ++ result=alloc_simple_vector(sizeof(struct fasd)/sizeof(object),aet_object); + array_allocself(result,1,Cnil); + {struct fasd *fd= (struct fasd *)result->v.v_self; + fd->table=tabl; +@@ -631,6 +615,7 @@ DEFUN_NEW("OPEN-FASD",object,fSopen_fasd + fd->index=make_fixnum(dump_index); + fd->filepos=current_fasd.filepos; + fd->package=current_fasd.package; ++ fd->table_length=current_fasd.table_length; + return result; + }} + +@@ -642,7 +627,7 @@ DEFUN_NEW("CLOSE-FASD",object,fSclose_fa + if (type_of(fd->table)==t_vector) + /* input uses a vector */ + {if (fd->table->v.v_self) +- gset(fd->table->v.v_self,0,fix(fd->index),aet_object); ++ fd->table->v.v_dim=0;/*self can be on the stack, and others write there*/ + } + else + if(fd->direction==sKoutput) +@@ -1402,66 +1387,6 @@ clrhash(object table) + table->ht.ht_self[i].hte_value = OBJNULL;} + table->ht.ht_nent =0;} + +- +- +-object read_fasl_vector1(); +-object +-read_fasl_vector(object in) +-{char ch; +- object orig = in; +- object d; +- int tem; +- if (((tem=getc(((FILE *)in->sm.sm_fp))) == EOF) && feof(((FILE *)in->sm.sm_fp))) +- { char *pf; +- coerce_to_filename(in,FN1); +- for (pf=FN1+strlen(FN1);pf>FN1 && pf[-1]!='.';pf--); +- if (pf==FN1) {pf=FN1+strlen(FN1);*pf++='.';} +- snprintf(pf,sizeof(FN1)-(pf-FN1),"data"); +- d=make_simple_string(FN1); +- in = open_stream(d,smm_input,Cnil,Cnil); +- if (in == Cnil) +- FEerror("Can't open file ~s",1,d); +- } +- else if (tem != EOF) +- { ungetc(tem,in->sm.sm_fp);} +- while (1) +- { ch=readc_stream(in); +- if (ch=='#') +- {unreadc_stream(ch,in); +- return read_fasl_vector1(in);} +- if (ch== d_begin_dump){ +- unreadc_stream(ch,in); +- break;}} +- {object ar=FFN(fSopen_fasd)(in,sKinput,0,Cnil); +- int n=fix(current_fasd.table_length); +- object result,last; +- { BEGIN_NO_INTERRUPT; +-#ifdef HAVE_ALLOCA +- current_fasd.table->v.v_self +- = (object *)alloca(n*sizeof(object)); +-#else +- current_fasd.table->v.v_self +- = (object *)alloc_relblock(n*sizeof(object)); +-#endif +- current_fasd.table->v.v_dim=n; +- current_fasd.table->v.v_fillp=n; +- gset( current_fasd.table->v.v_self,0,n,aet_object); +- END_NO_INTERRUPT; +- } +- result=FFN(fSread_fasd_top)(ar); +- if (type_of(result) !=t_vector) goto ERROR; +- last=result->v.v_self[result->v.v_fillp-1]; +- if(type_of(last)!=t_cons || last->c.c_car !=sSPinit) +- goto ERROR; +- current_fasd.table->v.v_self = 0; +- FFN(fSclose_fasd)(ar); +- if (orig != in) +- close_stream(in); +- return result; +- ERROR: FEerror("Bad fasd stream ~a",1,in); +- return Cnil; +-}} +- + object IfaslInStream; + /* static void */ + /* IreadFasdData(void) */ +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -1645,7 +1645,7 @@ DEFUN_NEW("LOAD-STREAM",object,fSload_st + for (;;) { + preserving_whitespace_flag = FALSE; + detect_eos_flag = TRUE; +- x = read_object_non_recursive(strm); ++ x = type_of(strm)==t_stream ? read_object_non_recursive(strm) : FFN(fSread_fasd_top)(strm); + if (x == OBJNULL) + break; + { +@@ -2371,75 +2371,3 @@ gcl_init_file_function() + gcl_init_readline_function(); + #endif + } +- +- +-object +-read_fasl_data(const char *str) { +- +- object faslfile, data; +-#ifndef SEEK_TO_END_OFILE +-#if defined(BSD) && defined(UNIX) +- FILE *fp; +- int i; +-#ifdef HAVE_AOUT +- struct exec header; +-#endif +-#endif +-#ifdef HAVE_FILEHDR +- struct filehdr fileheader; +-#endif +-#ifdef E15 +- struct exec header; +-#endif +-#endif +- vs_mark; +- +- faslfile = make_simple_string(str); +- vs_push(faslfile); +- faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); +- vs_push(faslfile); +- +-#ifdef SEEK_TO_END_OFILE +- SEEK_TO_END_OFILE(faslfile->sm.sm_fp); +-#else +- +-#ifdef BSD +- fp = faslfile->sm.sm_fp; +- fread(&header, sizeof(header), 1, fp); +- fseek(fp, +- header.a_text+header.a_data+ +- header.a_syms+header.a_trsize+header.a_drsize, +- 1); +- fread(&i, sizeof(i), 1, fp); +- fseek(fp, i - sizeof(i), 1); +-#endif +- +-#ifdef HAVE_FILEHDR +- fp = faslfile->sm.sm_fp; +- fread(&fileheader, sizeof(fileheader), 1, fp); +- fseek(fp, +- fileheader.f_symptr+fileheader.f_nsyms*SYMESZ, +- 0); +- fread(&i, sizeof(i), 1, fp); +- fseek(fp, i - sizeof(i), 1); +- while ((i = getc(fp)) == 0) +- ; +- ungetc(i, fp); +-#endif +- +-#ifdef E15 +- fp = faslfile->sm.sm_fp; +- fread(&header, sizeof(header), 1, fp); +- fseek(fp, +- header.a_text+header.a_data+ +- header.a_syms+header.a_trsize+header.a_drsize, +- 1); +-#endif +-#endif +- data = read_fasl_vector(faslfile); +- +- vs_push(data); +- close_stream(faslfile); +- vs_reset; +- return(data); +-} +--- gcl-2.6.12.orig/o/gprof.c ++++ gcl-2.6.12/o/gprof.c +@@ -5,6 +5,10 @@ + + static unsigned long gprof_on; + ++#ifdef DARWIN ++void _mcleanup() {} ++#endif ++ + DEFUN_NEW("MCLEANUP",object,fSmcleanup,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { + + extern void _mcleanup(void); +--- gcl-2.6.12.orig/o/read.d ++++ gcl-2.6.12/o/read.d +@@ -333,16 +333,16 @@ setup_READ() + backq_level = 0; + } + +-static void +-setup_standard_READ() +-{ +- READtable = standard_readtable; +- READdefault_float_format = 'F'; +- READbase = 10; +- READsuppress = FALSE; +- sSAsharp_eq_contextA->s.s_dbind=Cnil; +- backq_level = 0; +-} ++/* static void */ ++/* setup_standard_READ() */ ++/* { */ ++/* READtable = standard_readtable; */ ++/* READdefault_float_format = 'F'; */ ++/* READbase = 10; */ ++/* READsuppress = FALSE; */ ++/* sSAsharp_eq_contextA->s.s_dbind=Cnil; */ ++/* backq_level = 0; */ ++/* } */ + + object + read_char(in) +@@ -1393,28 +1393,6 @@ FFN(siLsharp_comma_reader_for_compiler)( + vs_base[0] = make_cons(siSsharp_comma, vs_base[0]); + } + +-/* +- For fasload. +-*/ +-static void +-Lsharp_exclamation_reader() +-{ +- check_arg(3); +- if(vs_base[2] != Cnil && !READsuppress) +- extra_argument('!'); +- vs_popp; +- vs_popp; +- if (READsuppress) { +- vs_base[0] = Cnil; +- return; +- } +- vs_base[0] = read_object(vs_base[0]); +- if (sSAsharp_eq_contextA->s.s_dbind!=Cnil) +- vs_base[0]=patch_sharp(vs_base[0]); +- ieval(vs_base[0]); +- vs_popp; +-} +- + static void + Lsharp_B_reader() + { +@@ -2327,8 +2305,6 @@ gcl_init_read() + dtab['*'] = make_cf(Lsharp_asterisk_reader); + dtab[':'] = make_cf(Lsharp_colon_reader); + dtab['.'] = make_cf(Lsharp_dot_reader); +- dtab['!'] = make_cf(Lsharp_exclamation_reader); +- /* Used for fasload only. */ + dtab[','] = make_cf(Lsharp_comma_reader); + dtab['B'] = dtab['b'] = make_cf(Lsharp_B_reader); + dtab['O'] = dtab['o'] = make_cf(Lsharp_O_reader); +@@ -2441,96 +2417,96 @@ gcl_init_read_function() + + object sSPinit; + +-object +-read_fasl_vector1(in) +-object in; +-{ +- int dimcount, dim; +- VOL object *vsp; +- object vspo; +- VOL object x; +- long i; +- bool e; +- object old_READtable; +- int old_READdefault_float_format; +- int old_READbase; +- int old_READsuppress; +- volatile object old_READcontext; +- int old_backq_level; +- +- /* to prevent longjmp clobber */ +- i=(long)&vsp; +- i+=i; +- vsp=&vspo; +- old_READtable = READtable; +- old_READdefault_float_format = READdefault_float_format; +- old_READbase = READbase; +- old_READsuppress = READsuppress; +- old_READcontext=sSAsharp_eq_contextA->s.s_dbind; +- /* BUG FIX by Toshiba */ +- vs_push(old_READtable); +- old_backq_level = backq_level; +- +- setup_standard_READ(); +- +- frs_push(FRS_PROTECT, Cnil); +- if (nlj_active) { +- e = TRUE; +- goto L; +- } +- +- while (readc_stream(in) != '#') +- ; +- while (readc_stream(in) != '(') +- ; +- vsp = vs_top; +- dimcount = 0; +- for (;;) { +- sSAsharp_eq_contextA->s.s_dbind=Cnil; +- backq_level = 0; +- delimiting_char = code_char(')'); +- preserving_whitespace_flag = FALSE; +- detect_eos_flag = FALSE; +- x = read_object(in); +- if (x == OBJNULL) +- break; +- vs_check_push(x); +- if (sSAsharp_eq_contextA->s.s_dbind!=Cnil) +- x = vs_head = patch_sharp(x); +- dimcount++; +- } +- if(dimcount==1 && type_of(vs_head)==t_vector) +- {/* new style where all read at once */ +- x=vs_head; +- goto DONE;} +- /* old style separately sharped, and no %init */ +- {BEGIN_NO_INTERRUPT; +- x=alloc_simple_vector(dimcount,aet_object); +- vs_push(x); +- x->v.v_self +- = (object *)alloc_relblock(dimcount * sizeof(object)); +- END_NO_INTERRUPT;} +- for (dim = 0; dim < dimcount; dim++) +- {SGC_TOUCH(x); +- x->cfd.cfd_self[dim] = vsp[dim];} ++/* object */ ++/* read_fasl_vector1(in) */ ++/* object in; */ ++/* { */ ++/* int dimcount, dim; */ ++/* VOL object *vsp; */ ++/* object vspo; */ ++/* VOL object x; */ ++/* long i; */ ++/* bool e; */ ++/* object old_READtable; */ ++/* int old_READdefault_float_format; */ ++/* int old_READbase; */ ++/* int old_READsuppress; */ ++/* volatile object old_READcontext; */ ++/* int old_backq_level; */ ++ ++/* /\* to prevent longjmp clobber *\/ */ ++/* i=(long)&vsp; */ ++/* i+=i; */ ++/* vsp=&vspo; */ ++/* old_READtable = READtable; */ ++/* old_READdefault_float_format = READdefault_float_format; */ ++/* old_READbase = READbase; */ ++/* old_READsuppress = READsuppress; */ ++/* old_READcontext=sSAsharp_eq_contextA->s.s_dbind; */ ++/* /\* BUG FIX by Toshiba *\/ */ ++/* vs_push(old_READtable); */ ++/* old_backq_level = backq_level; */ ++ ++/* setup_standard_READ(); */ ++ ++/* frs_push(FRS_PROTECT, Cnil); */ ++/* if (nlj_active) { */ ++/* e = TRUE; */ ++/* goto L; */ ++/* } */ ++ ++/* while (readc_stream(in) != '#') */ ++/* ; */ ++/* while (readc_stream(in) != '(') */ ++/* ; */ ++/* vsp = vs_top; */ ++/* dimcount = 0; */ ++/* for (;;) { */ ++/* sSAsharp_eq_contextA->s.s_dbind=Cnil; */ ++/* backq_level = 0; */ ++/* delimiting_char = code_char(')'); */ ++/* preserving_whitespace_flag = FALSE; */ ++/* detect_eos_flag = FALSE; */ ++/* x = read_object(in); */ ++/* if (x == OBJNULL) */ ++/* break; */ ++/* vs_check_push(x); */ ++/* if (sSAsharp_eq_contextA->s.s_dbind!=Cnil) */ ++/* x = vs_head = patch_sharp(x); */ ++/* dimcount++; */ ++/* } */ ++/* if(dimcount==1 && type_of(vs_head)==t_vector) */ ++/* {/\* new style where all read at once *\/ */ ++/* x=vs_head; */ ++/* goto DONE;} */ ++/* /\* old style separately sharped, and no %init *\/ */ ++/* {BEGIN_NO_INTERRUPT; */ ++/* x=alloc_simple_vector(dimcount,aet_object); */ ++/* vs_push(x); */ ++/* x->v.v_self */ ++/* = (object *)alloc_relblock(dimcount * sizeof(object)); */ ++/* END_NO_INTERRUPT;} */ ++/* for (dim = 0; dim < dimcount; dim++) */ ++/* {SGC_TOUCH(x); */ ++/* x->cfd.cfd_self[dim] = vsp[dim];} */ + + +- DONE: +- e = FALSE; ++/* DONE: */ ++/* e = FALSE; */ + +-L: +- frs_pop(); ++/* L: */ ++/* frs_pop(); */ + +- READtable = old_READtable; +- READdefault_float_format = old_READdefault_float_format; +- READbase = old_READbase; +- READsuppress = old_READsuppress; +- sSAsharp_eq_contextA->s.s_dbind=old_READcontext; +- backq_level = old_backq_level; +- if (e) { +- nlj_active = FALSE; +- unwind(nlj_fr, nlj_tag); +- } +- vs_top = (object *)vsp; +- return(x); +-} ++/* READtable = old_READtable; */ ++/* READdefault_float_format = old_READdefault_float_format; */ ++/* READbase = old_READbase; */ ++/* READsuppress = old_READsuppress; */ ++/* sSAsharp_eq_contextA->s.s_dbind=old_READcontext; */ ++/* backq_level = old_backq_level; */ ++/* if (e) { */ ++/* nlj_active = FALSE; */ ++/* unwind(nlj_fr, nlj_tag); */ ++/* } */ ++/* vs_top = (object *)vsp; */ ++/* return(x); */ ++/* } */ +--- gcl-2.6.12.orig/o/sfasl.c ++++ gcl-2.6.12/o/sfasl.c +@@ -80,619 +80,5 @@ DEFUN_NEW("FIND-SYM-PTABLE",object,fSfin + #ifdef SEPARATE_SFASL_FILE + #include SEPARATE_SFASL_FILE + #else +- +-#include "ext_sym.h" +-struct node * find_sym(); +-int node_compare(); +-#ifndef _WIN32 +-void *malloc(); +-void *bsearch(); +-#endif +- +-struct reloc relocation_info; +-/* next 5 static after debug */ +- +-int debug; +- +-#ifdef DEBUG +-#define debug sfasldebug +-int sfasldebug=0; +-#define dprintf(s,ar) if(debug) { printf(" ( s )",ar) ; fflush(stdout);} +-#define STAT +- +-#else /* end debug */ +-#define dprintf(s,ar) +-#define STAT static +-#endif +- +-#ifndef MAXPATHLEN +-#define MAXPATHLEN 256 +-#endif +-#define PTABLE_EXTRA 20 +- +-struct sfasl_info { +- struct syment *s_symbol_table; +- char *s_start_address; +- char *s_start_data; +- char *s_start_bss; +- char *s_my_string_table; +- int s_extra_bss; +- char *s_the_start; +- +-}; +-struct sfasl_info *sfaslp; +- +-#define symbol_table sfaslp->s_symbol_table +-#define start_address sfaslp->s_start_address +-#define my_string_table sfaslp->s_my_string_table +-#define extra_bss sfaslp->s_extra_bss +-#define the_start sfaslp->s_the_start +- +- +-#ifndef describe_sym +-#define describe_sym(a) +-#endif +- +-#ifdef STAND +-#include "rel_stand.c" +-#endif +- +-/* begin reloc_file */ +-#include RELOC_FILE +- +-/* end reloc_file */ +-int get_extra_bss ( struct syment *sym_table, int length, int start, int *ptr, int bsssize); +-void relocate_symbols ( unsigned int length ); +-void set_symbol_address ( struct syment *sym, char *string ); +- +-int +-fasload(faslfile) +-object faslfile; +-{ long fasl_vector_start; +- struct filehdr fileheader; +- struct sfasl_info sfasl_info_buf; +-#ifdef COFF +- struct scnhdr section[10]; +- struct aouthdr header; +-#endif +- int textsize, datasize, bsssize,nsyms; +-#if defined ( READ_IN_STRING_TABLE ) || defined ( HPUX ) +- int string_size=0; +-#endif +- +- object memory, data; +- FILE *fp; +- char filename[MAXPATHLEN]; +- int i; +- int init_address=0; +-#ifndef STAND +- object *old_vs_base = vs_base; +- object *old_vs_top = vs_top; +-#endif +- sfaslp = &sfasl_info_buf; +- +- extra_bss=0; +-#ifdef STAND +- strcpy(filename,faslfile); +- fp=fopen(filename,"r"); +-#else +- coerce_to_filename(faslfile, filename); +- faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); +- vs_push(faslfile); +- fp = faslfile->sm.sm_fp; +-#endif +- +- HEADER_SEEK(fp); +- if(!fread((char *)&fileheader, sizeof(struct filehdr), 1, fp)) +- FEerror("Could not get the header",0,0); +- nsyms = NSYMS(fileheader); +-#ifdef COFF +- +-#ifdef AIX3 +- setup_for_aix_load(); +-#endif +- +- fread(&header,1,fileheader.f_opthdr,fp); +- +- fread(§ion[1],fileheader.f_nscns,sizeof (struct scnhdr),fp); +- textsize = section[TEXT_NSCN].s_size; +- datasize = section[DATA_NSCN].s_size; +- if (strcmp(section[BSS_NSCN].s_name, ".bss") == 0) +- bsssize=section[BSS_NSCN].s_size; +- else bsssize=section[BSS_NSCN].s_size = 0; +-#endif +- +-#ifdef BSD +- textsize=fileheader.a_text; +- datasize=fileheader.a_data; +- bsssize=fileheader.a_bss; +-#endif +- symbol_table = +- (struct syment *) OUR_ALLOCA(sizeof(struct syment)* +- (unsigned int)nsyms); +- fseek(fp,(int)( N_SYMOFF(fileheader)), 0); +- { +- for (i = 0; i < nsyms; i++) +- { fread((char *)&symbol_table[i], SYMESZ, 1, fp); +- dprintf( symbol table %d , i); +- if (debug) describe_sym(i); +- dprintf( at %d , &symbol_table[i]); +-#ifdef HPUX +- symbol_table[i].n_un.n_strx = string_size; +- dprintf(string_size %d, string_size); +- string_size += symbol_table[i].n_length + 1; +- fseek(fp,(int)symbol_table[i].n_length,1); +-#endif +- } +- } +-/* +-on MP386 +-The sizeof(struct syment) = 20, while only SYMESZ =18. So we had to read +-one at a time. +-fread((char *)symbol_table, SYMESZ*fileheader.f_nsyms,1,fp); +-*/ +- +-#ifdef READ_IN_STRING_TABLE +- +-my_string_table=READ_IN_STRING_TABLE(fp,string_size); +- +-#else +-#ifdef MUST_SEEK_TO_STROFF +- fseek(fp,N_STROFF(fileheader),0); +-#endif +- {int ii=0; +- if (!fread((char *)&ii,sizeof(int),1,fp)) +- {FEerror("The string table of this file did not have any length",0, +- 0);} +- fseek(fp,-4,1); +- /* at present the string table is located just after the symbols */ +- my_string_table=OUR_ALLOCA((unsigned int)ii); +- dprintf( string table leng = %d, ii); +- +- if(ii!=fread(my_string_table,1,ii,fp)) +- FEerror("Could not read whole string table",0,0) ; +- } +-#endif +-#ifdef SEEK_TO_END_OFILE +-SEEK_TO_END_OFILE(fp); +-#else +- while ((i = getc(fp)) == 0) +- ; +- ungetc(i, fp); +-#endif +- +- fasl_vector_start=ftell(fp); +- +- if (!((c_table.ptable) && *(c_table.ptable))) +- build_symbol_table(); +- +-/* figure out if there is more bss space needed */ +- extra_bss=get_extra_bss(symbol_table,nsyms,datasize+textsize+bsssize, +- &init_address,bsssize); +- +-/* allocate some memory */ +-#ifndef STAND +- {BEGIN_NO_INTERRUPT; +- memory=new_cfdata(); +- memory->cfd.cfd_size = datasize+textsize+bsssize + extra_bss; +- vs_push(memory); +- the_start=start_address= +- memory->cfd.cfd_start= +- alloc_contblock(memory->cfd.cfd_size); +- sfaslp->s_start_data = start_address + textsize; +- sfaslp->s_start_bss = start_address + textsize + datasize; +- END_NO_INTERRUPT; +- } +-#else +- the_start = start_address +- = malloc ( datasize + textsize + bsssize + extra_bss ); +- sfaslp->s_start_data = start_address + textsize; +- sfaslp->s_start_bss = start_address + textsize + datasize; +-#endif +- +- dprintf( code size %d , datasize+textsize+bsssize + extra_bss); +- if (fseek(fp,N_TXTOFF(fileheader) ,0) < 0) +- FEerror("file seek error",0,0); +- SAFE_FREAD(the_start, textsize + datasize, 1, fp); +- dprintf(read into memory text +data %d bytes, textsize + datasize); +-/* relocate the actual loaded text */ +- +- dprintf( the_start %x, the_start); +- +- /* record which symbols are used */ +- +-#ifdef SYM_USED +- {int j=0; +- for(j=1; j< BSS_NSCN ; j++) +- { dprintf( relocating section %d \n,j); +- if (section[j].s_nreloc) fseek(fp,section[j].s_relptr,0); +- for(i=0; i < section[j].s_nreloc; i++) +- { struct syment *sym; +- fread(&relocation_info, RELSZ, 1, fp); +- sym = & symbol_table[relocation_info.r_symndx]; +- if (TC_SYMBOL_P(sym)) +- SYM_USED(sym) = 1; +- }}} +-#endif +- +- +- /* this looks up symbols in c.ptable and also adds new externals to +- that c.table */ +- relocate_symbols(NSYMS(fileheader)); +- +-#ifdef COFF +- {int j=0; +- for(j=1; j< BSS_NSCN ; j++) +- { dprintf( relocating section %d \n,j); +- if (section[j].s_nreloc) fseek(fp,section[j].s_relptr,0); +-#ifdef ADJUST_RELOC_START +-ADJUST_RELOC_START(j) +-#endif +- for(i=0; i < section[j].s_nreloc; i++) +- /* RELSZ = sizeof(relocation_info) */ +- {fread(&relocation_info, RELSZ, 1, fp); +- dprintf(relocating %d,i); +- relocate();}; +- }}; +-#endif +-#ifdef BSD +- fseek(fp,N_RELOFF(fileheader),0); +- {int nrel = (fileheader.a_trsize/sizeof(struct reloc)); +- for (i=0; i < nrel; i++) +- {fread((char *)&relocation_info, sizeof(struct reloc), +- 1, fp); +- dprintf(relocating %d,i); +- relocate(); +- } +- } +-#ifdef N_DRELOFF +- fseek (fp, N_DRELOFF(fileheader), 0); +-#endif +- {int nrel = (fileheader.a_drsize/sizeof(struct reloc)); +- the_start += fileheader.a_text; +- for (i=0; i < nrel; i++) +- +- {fread((char *)&relocation_info, sizeof(struct reloc), +- 1, fp); +- dprintf(relocating %d,i); +- relocate(); +- } +- } +-#endif +- +-/* end of relocation */ +- dprintf( END OF RELOCATION \n,0); +- dprintf( invoking init function at %x, start_address) +- dprintf( textsize is %x,textsize); +- dprintf( datasize is %x,datasize); +- +-/* read in the fasl vector */ +- fseek(fp,fasl_vector_start,0); +- if (feof(fp)) +- {data=0;} +- else{ +- data = read_fasl_vector(faslfile); +- vs_push(data); +-#ifdef COFF +- dprintf( read fasl now symbols %d , fileheader.f_nsyms); +-#endif +- } +- close_stream(faslfile); +- +-/* +- { +- int fd; +- +- fd = creat ("xsgcl.bits", 0777); +- write (fd, memory->cfd.cfd_start, textsize + datasize); +- close (fd); +- +- fd = open ("xsl2.bits", 0); +- read (fd, memory->cfd.cfd_start, memory->cfd.cfd_size); +- close (fd); +- } +-*/ +- +-#ifndef STAND +- ALLOCA_FREE(my_string_table); +- ALLOCA_FREE(symbol_table); +- +- +-#ifdef CLEAR_CACHE +- CLEAR_CACHE; +-#endif +- call_init(init_address,memory,data,0); +- +- vs_base = old_vs_base; +- vs_top = old_vs_top; +- if(symbol_value(sLAload_verboseA)!=Cnil) +- printf("start address -T %x ", memory->cfd.cfd_start); +- return(memory->cfd.cfd_size); +-#endif +- {FILE *out; +- out=fopen("/tmp/sfasltest","w"); +- fwrite((char *)&fileheader, sizeof(struct filehdr), 1, out); +- fwrite(start_address,sizeof(char),datasize+textsize,out); +- fclose(out);} +- printf("\n(start %x)\n",start_address); +- +-} +- +-int get_extra_bss(sym_table,length,start,ptr,bsssize) +- int length,bsssize; +- struct syment *sym_table; +- int *ptr; /* store init address offset here */ +-{ +- int result = start; +- +-#ifdef AIX3 +- int next_bss = start - bsssize; +-#endif +- +- struct syment *end,*sym; +- +-#ifdef BSD +- char tem[SYMNMLEN +1]; +-#endif +- +- end =sym_table + length; +- for(sym=sym_table; sym < end; sym++) +- { +- +-#ifdef FIND_INIT +- FIND_INIT +-#endif +- +-#ifdef AIX3 +- /* we later go through the relocation entries making this 1 +- for symbols used */ +-#ifdef SYM_USED +- if(TC_SYMBOL_P(sym)) +- {SYM_USED(sym) = 0;} +-#endif +- +- /* fix up the external refer to _ptrgl to be local ref */ +- if (sym->n_scnum == 0 && +- strcmp(sym->n_name,"_ptrgl")==0) +- {struct syment* s = +- get_symbol("._ptrgl",TEXT_NSCN,sym_table,length); +- if (s ==0) FEerror("bad glue",0,0); +- sym->n_value = next_bss ; +- ptrgl_offset = next_bss; +- ptrgl_text = s->n_value; +- next_bss += 0xc; +- sym->n_scnum = DATA_NSCN; +- ((union auxent *)(sym+1))->x_csect.x_scnlen = 0xc; +- +- } +- +- if(sym->n_scnum != BSS_NSCN) goto NEXT; +- if(SYM_EXTERNAL_P(sym)) +- {int val=sym->n_value; +- struct node joe; +- if (val && c_table.ptable) +- {struct node *answ; +- answ= find_sym(sym,0); +- if(answ) +- {sym->n_value = answ->address ; +- sym->n_scnum = N_UNDEF; +- val= ((union auxent *)(sym+1))->x_csect.x_scnlen; +- result -= val; +- goto NEXT; +- }} +- } +- /* reallocate the bss space */ +- if (sym->n_value == 0) +- {result += ((union auxent *)(sym+1))->x_csect.x_scnlen;} +- sym->n_value = next_bss; +- next_bss += ((union auxent *)(sym+1))->x_csect.x_scnlen; +- NEXT: +- ; +- /* end aix3 */ +-#endif +- +- +- +-#ifdef BSD +- tem; /* ignored */ +- if(SYM_EXTERNAL_P(sym) && SYM_UNDEF_P(sym)) +-#endif +-#ifdef COFF +- if(0) +- /* what we really want is +- if (sym->n_scnum==0 && sym->n_sclass == C_EXT +- && !(bsearch(..in ptable for this symbol))) +- Since this won't allow loading in of a new external array +- char foo[10] not ok +- static foo[10] ok. +- for the moment we give undefined symbol warning.. +- Should really go through the symbols, recording the external addr +- for ones found in ptable, and for the ones not in ptable +- set some flag, and add up the extra_bss required. Then +- when you have the new memory chunk in hand, +- you could make the pass setting the relative addresses. +- for the ones you flagged last time. +- */ +-#endif +- /* external bss so not included in size of bss for file */ +- {int val=sym->n_value; +- if (val && c_table.ptable +- && (0== find_sym(sym,0))) +- { sym->n_value=result; +- result += val;}} +- +- sym += NUM_AUX(sym); +- +- } +- return (result-start); +-} +- +- +- +-/* go through the symbol table changing the addresses of the symbols +-to reflect the current cfd_start */ +- +- +-void +-relocate_symbols(length) +-unsigned int length; +-{struct syment *end,*sym; +- unsigned int typ; +- char *str; +- char tem[SYMNMLEN +1]; +- tem[SYMNMLEN]=0; +- int n_value=(int)start_address; +- +- end =symbol_table + length; +- for(sym=symbol_table; sym < end; sym++) { +- typ=NTYPE(sym); +-#ifdef BSD +-#ifdef N_STAB +- if (N_STAB & sym->n_type) continue;/* skip: It is for dbx only */ +-#endif +- typ=N_SECTION(sym); +-/* if(sym->n_type & N_EXT) should add the symbol name, +- so it would be accessible by future loads */ +-#endif +- switch (typ) { +-#ifdef BSD +- case N_ABS : case N_TEXT: case N_DATA: case N_BSS: +-#endif +-#ifdef COFF +- case TEXT_NSCN : case DATA_NSCN: case BSS_NSCN : +-#ifdef _WIN32 +- if (typ==DATA_NSCN) +- n_value = (int)sfaslp->s_start_data; +- if (typ==BSS_NSCN) +- n_value = (int)sfaslp->s_start_bss; +- if (typ==TEXT_NSCN) +- n_value = (int)start_address; +-#endif /* _WIN32 */ +-#endif /* COFF */ +- str=SYM_NAME(sym); +- dprintf( for sym %s ,str) +- dprintf( new value will be start %x, start_address); +- +-#ifdef AIX3 +- if(N_SECTION(sym) == DATA_NSCN +- && NUM_AUX(sym) +- && allocate_toc(sym)) +- break; +-#endif +- sym->n_value = n_value; +- break; +- case N_UNDEF: +- str=SYM_NAME(sym); +- dprintf( undef symbol %s ,str); +- dprintf( symbol diff %d , sym - symbol_table); +- describe_sym(sym-symbol_table); +- set_symbol_address(sym,str); +- describe_sym(sym-symbol_table); +- break; +- default: +-#ifdef COFF +- dprintf(am ignoring a scnum %d,(sym->n_scnum)); +-#endif +- break; +- } +- sym += NUM_AUX(sym); +- } +-} +- +-/* +-STEPS: +-1) read in the symbol table from the file, +-2) go through the symbol table, relocating external entries. +-3) for i <=2 go thru the relocation information for this section +- relocating the text. +-4) done. +-*/ +- +-struct node * +-find_sym(sym,name) +- struct syment *sym; +- char *name; +-{ char tem[SYMNMLEN +1]; +- tem [SYMNMLEN] = 0; +- if (name==0) name = SYM_NAME(sym); +- return find_sym_ptable(name);} +- +-void +-set_symbol_address(sym,string) +-struct syment *sym; +-char *string; +-{struct node *answ; +- if (c_table.ptable) +- { +- dprintf(string %s, string); +- answ = find_sym(sym,string); +- dprintf(answ %d , (answ ? answ->address : -1)); +- if(answ) +- { +-#ifdef COFF +-#ifdef _AIX370 +- if (NTYPE(sym) == N_UNDEF) +- sym->n_value = answ->address; +- else +-#endif +- sym->n_value = answ->address -sym->n_value; +- /* for symbols in the local data,text and bss this gets added +- on when we add the current value */ +-#endif +-#ifdef BSD +- /* the old value of sym->n_value is the length of the common area +- starting at this address */ +- sym->n_value = answ->address; +-#endif +-#ifdef AIX3 +- fix_undef_toc_address(answ,sym,string); +-#endif +- +-} +- else +- { +-/* +-#ifdef BSD +- {char *name; +- name=malloc(1+strlen(string)); +- strcpy(name,string); +- sym->n_value = sym->n_value + (unsigned int) the_start; +- add_symbol(name,sym->n_value,NULL); +- } +-#endif +-*/ +- fprintf(stdout,"undefined %s symbol",string) +- ;fflush(stdout); +- +- }} +- +- else{FEerror("symbol table not loaded",0,0);}} +- +-/* include the machine independent stuff */ +-#include "sfasli.c" +- +- +-#ifdef DEBUG +-print_name(p) +- struct syment *p; +-{char tem[10],*name; +- name=SYM_NAME(p); +- name= (((p)->_n._n_n._n_zeroes == 0) ? +- &my_string_table[(p)->_n._n_n._n_offset] : +- ((p)->_n._n_name[SYMNMLEN -1] ? +- (strncpy(tem,(p)->_n._n_name, +- SYMNMLEN), +- (char *)tem) : +- (p)->_n._n_name )); +- +- printf("(name:|%s|)",name); +- printf("(sclass 0x%x)",p->n_sclass); +- printf("(external_p 0x%x)",SYM_EXTERNAL_P(p)); +- printf("(n_type 0x%x)",p->n_type); +- printf("(n_value 0x%x)",p->n_value); +- printf("(numaux 0x%x)\n",NUM_AUX(p)); +- fflush(stdout); +-} +-#endif +- ++#error must define SEPARATE_SFASL_FILE + #endif /* SEPARATE_SFASL_FILE */ +--- gcl-2.6.12.orig/o/sfaslcoff.c ++++ gcl-2.6.12/o/sfaslcoff.c +@@ -443,7 +443,6 @@ fasload(object faslfile) { + fseek(fp,(void *)ste-st,0); + while ((i = getc(fp)) == 0); + ungetc(i, fp); +- data = read_fasl_vector(faslfile); + + massert(!un_mmap(st,est)); + +@@ -451,7 +450,7 @@ fasload(object faslfile) { + CLEAR_CACHE; + #endif + +- call_init(init_address,memory,data,0); ++ call_init(init_address,memory,faslfile); + + if(symbol_value(sLAload_verboseA)!=Cnil) + printf("start address -T %p ", memory->cfd.cfd_start); +--- gcl-2.6.12.orig/o/sfaslelf.c ++++ gcl-2.6.12/o/sfaslelf.c +@@ -550,7 +550,7 @@ fasload(object faslfile) { + FILE *fp; + char *sn,*st1,*dst1; + ul init_address=0,end,gs=0,*got=&gs,*gote=got+1; +- object memory,data; ++ object memory; + Shdr *sec1,*sece; + Sym *sym1,*syme,*dsym1,*dsyme; + void *v1,*ve; +@@ -574,7 +574,6 @@ fasload(object faslfile) { + massert(!relocate_code(v1,sec1,sece,sym1,got,gote)); + + massert(!fseek(fp,end,SEEK_SET)); +- data=feof(fp) ? 0 : read_fasl_vector(faslfile); + + massert(!un_mmap(v1,ve)); + +@@ -587,7 +586,7 @@ fasload(object faslfile) { + #endif + + init_address-=(ul)memory->cfd.cfd_start; +- call_init(init_address,memory,data,0); ++ call_init(init_address,memory,faslfile); + + if(symbol_value(sLAload_verboseA)!=Cnil) + printf("start address -T %p ",memory->cfd.cfd_start); +--- gcl-2.6.12.orig/o/sfaslmacho.c ++++ gcl-2.6.12/o/sfaslmacho.c +@@ -421,7 +421,7 @@ load_self_symbols() { + + for (a=c_table.ptable,sym=sym1;symn_type & N_STAB || !(sym->n_type & N_EXT)) ++ if ((sym->n_type & N_STAB) || !(sym->n_type & N_EXT)) + continue; + + a->address=sym->n_value; +@@ -435,10 +435,9 @@ load_self_symbols() { + c_table.length=a-c_table.ptable; + qsort(c_table.ptable,c_table.length,sizeof(*c_table.ptable),node_compare); + +- c_table.local_ptable=a; +- for (a=c_table.ptable,sym=sym1;symn_type & N_STAB || sym->n_type & N_EXT) ++ if ((sym->n_type & N_STAB) || sym->n_type & N_EXT) + continue; + + a->address=sym->n_value; +@@ -536,7 +535,6 @@ int + fasload(object faslfile) { + + FILE *fp; +- object data; + ul init_address=-1; + object memory; + void *v1,*ve,*p; +@@ -564,7 +562,6 @@ fasload(object faslfile) { + relocate_code(v1,sec1,sece,&p,io1,n1,got,gote,start); + + fseek(fp,(void *)ste-v1,SEEK_SET); +- data = feof(fp) ? 0 : read_fasl_vector(faslfile); + + massert(!clear_protect_memory(memory)); + +@@ -575,7 +572,7 @@ fasload(object faslfile) { + massert(!un_mmap(v1,ve)); + + init_address-=(ul)memory->cfd.cfd_start; +- call_init(init_address,memory,data,0); ++ call_init(init_address,memory,faslfile); + + if(symbol_value(sLAload_verboseA)!=Cnil) + printf("start address -T %p ",memory->cfd.cfd_start); +--- gcl-2.6.12.orig/o/sfaslmacosx.c ++++ gcl-2.6.12/o/sfaslmacosx.c +@@ -228,8 +228,6 @@ int fasload (object faslfile) + sfasl_error ("error seeking to end of object file"); + } + +- data = read_fasl_vector (faslstream); +- + close_stream (faslstream); + + memory=new_cfdata(); +@@ -237,7 +235,7 @@ int fasload (object faslfile) + if (symbol_value (sLAload_verboseA) != Cnil) + printf (" start address (dynamic) %p ", fptr); + +- call_init (0, memory, data, fptr); ++ call_init (0,memory,faslstream); + + unlink (tmpfile); + +--- gcl-2.6.12.orig/o/unixfasl.c ++++ gcl-2.6.12/o/unixfasl.c +@@ -78,197 +78,7 @@ Foundation, 675 Mass Ave, Cambridge, MA + #endif + + #ifndef SFASL +-int +-fasload(faslfile) +-object faslfile; +-{ +- +-#ifdef BSD +- struct exec header, newheader; +-#endif +- +-#ifdef ATT +- struct filehdr fileheader; +- struct scnhdr sectionheader; +- int textsize, datasize, bsssize; +- int textstart; +-#endif +- +-#ifdef E15 +- struct exec header; +-#define textsize header.a_text +-#define datasize header.a_data +-#define bsssize header.a_bss +-#define textstart sizeof(header) +-#endif +- +- object memory, data, tempfile; +- FILE *fp; +- char filename[MAXPATHLEN]; +- char tempfilename[32]; +- char command[MAXPATHLEN * 2]; +- int i; +- object *old_vs_base = vs_base; +- object *old_vs_top = vs_top; +-#ifdef IBMRT +- +-#endif +- +- coerce_to_filename(faslfile, filename); +- +- faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); +- vs_push(faslfile); +- fp = faslfile->sm.sm_fp; +- /* seek to beginning of the header */ +- +- HEADER_SEEK(fp); +- +-#ifdef BSD +- fread(&header, sizeof(header), 1, fp); +-#endif +-#ifdef ATT +- fread(&fileheader, sizeof(fileheader), 1, fp); +-#ifdef S3000 +- if(fileheader.f_opthdr != 0) fseek(fp,fileheader.f_opthdr,1); +-#endif +- fread(§ionheader, sizeof(sectionheader), 1, fp); +- textsize = sectionheader.s_size; +- textstart = sectionheader.s_scnptr; +- fread(§ionheader, sizeof(sectionheader), 1, fp); +- datasize = sectionheader.s_size; +- fread(§ionheader, sizeof(sectionheader), 1, fp); +- if (strcmp(sectionheader.s_name, ".bss") == 0) +- bsssize = sectionheader.s_size; +- else +- bsssize = 0; +-#endif +-#ifdef E15 +- fread(&header, sizeof(header), 1, fp); +-#endif +- +- memory=new_cfdata(); +- memory->cfd.cfd_size = textsize + datasize + bsssize; +- vs_push(memory); +- /* If the file is smaller than the space asked for, typically the file +- is an invalid object file */ +- if (file_len(fp)*4 < memory->cfd.cfd_size) +- FEerror("Invalid object file stream: ~a",1,faslfile); +- memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock, +- memory->cfd.cfd_size,sizeof(double)); +- +-#ifdef SEEK_TO_END_OFILE +-SEEK_TO_END_OFILE(fp); +-#else +-#ifdef BSD +- fseek(fp, +- header.a_text+header.a_data+ +- header.a_syms+header.a_trsize+header.a_drsize, +- 1); +- fread(&i, sizeof(i), 1, fp); +- fseek(fp, i - sizeof(i), 1); +-#endif +- +-#ifdef ATT +- fseek(fp, +- fileheader.f_symptr + SYMESZ*fileheader.f_nsyms, +- 0); +- fread(&i, sizeof(i), 1, fp); +- fseek(fp, i - sizeof(i), 1); +- while ((i = getc(fp)) == 0) +- ; +- ungetc(i, fp); +-#endif +- +-#ifdef E15 +- fseek(fp, +- header.a_text+header.a_data+ +- header.a_syms+header.a_trsize+header.a_drsize, +- 1); +-#endif +-#endif +- data = read_fasl_vector(faslfile); +- vs_push(data); +- close_stream(faslfile); +- +- sprintf(tempfilename, "/tmp/fasltemp%d", getpid()); +- +-AGAIN: +- +-#ifdef BSD +- LD_COMMAND(command, +- kcl_self, +- memory->cfd.cfd_start, +- filename, +- " ", +- tempfilename); +- if(symbol_value(sLAload_verboseA)!=Cnil) +- printf("start address -T %x ",memory->cfd.cfd_start); +-#endif +-#ifdef ATT +- coerce_to_filename(symbol_value(sSAsystem_directoryA), +- system_directory); +- sprintf(command, +- "%sild %s %d %s %s", +- system_directory, +- kcl_self, +- memory->cfd.cfd_start, +- filename, +- tempfilename); +-#endif +-#ifdef E15 +- coerce_to_filename(symbol_value(sSAsystem_directoryA), +- system_directory); +- sprintf(command, +- "%sild %s %d %s %s", +- system_directory, +- kcl_self, +- memory->cfd.cfd_start, +- filename, +- tempfilename); +-#endif +- +- if (system(command) != 0) +- FEerror("The linkage editor failed.", 0); +- +- tempfile = make_simple_string(tempfilename); +- vs_push(tempfile); +- tempfile = open_stream(tempfile, smm_input, Cnil, sKerror); +- vs_push(tempfile); +- fp = tempfile->sm.sm_fp; +- +- HEADER_SEEK(fp); +- +-#ifdef BSD +- fread(&newheader, sizeof(header), 1, fp); +- if (newbsssize != bsssize) { +- insert_contblock(memory->cfd.cfd_start, memory->cfd.cfd_size); +- bsssize = newbsssize; +- memory->cfd.cfd_start = NULL; +- memory->cfd.cfd_size = textsize + datasize + bsssize; +- memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock,memory->cfd.cfd_size, +- sizeof( double)); +- close_stream(tempfile); +- unlink(tempfilename); +- goto AGAIN; +- } +-#endif +- +- if (fseek(fp, textstart, 0) < 0) +- error("file seek error"); +- +- fread(memory->cfd.cfd_start, textsize + datasize, 1, fp); +- +- close_stream(tempfile); +- +- unlink(tempfilename); +- +- call_init(0,memory,data,0); +- +- vs_base = old_vs_base; +- vs_top = old_vs_top; +- +- return(memory->cfd.cfd_size); +-} ++#error must define SFASL + #endif /* ifndef SFASL */ + + #ifndef __svr4__ diff --git a/patches/Version_2_6_13pre55 b/patches/Version_2_6_13pre55 new file mode 100644 index 00000000..6b4b7828 --- /dev/null +++ b/patches/Version_2_6_13pre55 @@ -0,0 +1,132 @@ +Description: + 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-67) unstable; urgency=medium + . + * Version_2_6_13pre55 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-03 + +--- gcl-2.6.12.orig/h/notcomp.h ++++ gcl-2.6.12/h/notcomp.h +@@ -374,3 +374,5 @@ EXTER gmp_randfnptr_t Mersenne_Twister_G + #endif + + #define collect(p_,f_) (p_)=&(*(p_)=(f_))->c.c_cdr ++#define READ_STREAM_OR_FASD(strm_) \ ++ type_of(strm_)==t_stream ? read_object_non_recursive(strm_) : fSread_fasd_top(strm_) +--- gcl-2.6.12.orig/o/cmpaux.c ++++ gcl-2.6.12/o/cmpaux.c +@@ -363,7 +363,7 @@ do_init(object *statVV) { + + if (ch!='\n') { + struct fasd * fd; +- faslfile=FFN(fSopen_fasd)(faslfile,sKinput,OBJNULL,Cnil); ++ faslfile=fSopen_fasd(faslfile,sKinput,OBJNULL,Cnil); + fd=(struct fasd *)faslfile->v.v_self; + n=fix(fd->table_length); + fd->table->v.v_self=alloca(n*sizeof(object)); +@@ -371,7 +371,7 @@ do_init(object *statVV) { + fd->table->v.v_dim=faslfile->v.v_self[1]->v.v_fillp=n; + } + +- n=fix(type_of(faslfile)==t_stream ? read_object(faslfile) : FFN(fSread_fasd_top)(faslfile)); ++ n=fix(READ_STREAM_OR_FASD(faslfile)); + sSPinit->s.s_dbind=fasl_vec=fSmake_vector1_1(n,aet_object,Cnil); + + /* switch SPinit to point to a vector of function addresses */ +@@ -395,9 +395,9 @@ do_init(object *statVV) { + */ + /* Now we can run the forms f1 f2 in form= (%init f1 f2 ...) */ + +- FFN(fSload_stream)(faslfile,Cnil); ++ fSload_stream(faslfile,Cnil); + if (type_of(faslfile)!=t_stream) +- FFN(fSclose_fasd)(faslfile); ++ fSclose_fasd(faslfile); + + } + +--- gcl-2.6.12.orig/o/fasdump.c ++++ gcl-2.6.12/o/fasdump.c +@@ -561,6 +561,13 @@ DEFUN_NEW("READ-FASD-TOP",object,fSread_ + { RESTORE_FASD; + return result;} + } ++#ifdef STATIC_FUNCTION_POINTERS ++object ++fSread_fasd_top(object x) { ++ return FFN(fSread_fasd_top)(x); ++} ++#endif ++ + + object sLeq; + object sSPinit; +@@ -618,6 +625,12 @@ DEFUN_NEW("OPEN-FASD",object,fSopen_fasd + fd->table_length=current_fasd.table_length; + return result; + }} ++#ifdef STATIC_FUNCTION_POINTERS ++object ++fSopen_fasd(object stream, object direction, object eof, object tabl) { ++ return FFN(fSopen_fasd)(stream,direction,eof,tabl); ++} ++#endif + + DEFUN_NEW("CLOSE-FASD",object,fSclose_fasd,SI,1,1,NONE,OO,OO,OO,OO,(object ar),"") + /* static object */ +@@ -649,6 +662,12 @@ DEFUN_NEW("CLOSE-FASD",object,fSclose_fa + return ar; + + } ++#ifdef STATIC_FUNCTION_POINTERS ++object ++fSclose_fasd(object ar) { ++ return FFN(fSclose_fasd)(ar); ++} ++#endif + + + #define HASHP(x) 1 +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -1645,8 +1645,7 @@ DEFUN_NEW("LOAD-STREAM",object,fSload_st + for (;;) { + preserving_whitespace_flag = FALSE; + detect_eos_flag = TRUE; +- x = type_of(strm)==t_stream ? read_object_non_recursive(strm) : FFN(fSread_fasd_top)(strm); +- if (x == OBJNULL) ++ if ((x = READ_STREAM_OR_FASD(strm))==OBJNULL) + break; + { + object *base = vs_base, *top = vs_top, *lex = lex_env; +@@ -1672,6 +1671,12 @@ DEFUN_NEW("LOAD-STREAM",object,fSload_st + RETURN1(Ct); + + } ++#ifdef STATIC_FUNCTION_POINTERS ++object ++fSload_stream(object strm,object print) { ++ return FFN(fSload_stream)(strm,print); ++} ++#endif + + DEFUN_NEW("LOAD-FASL",object,fSload_fasl,SI,2,2,NONE,OO,OO,OO,OO,(object fasl_filename,object print),"") { + diff --git a/patches/Version_2_6_13pre56 b/patches/Version_2_6_13pre56 new file mode 100644 index 00000000..94a7be89 --- /dev/null +++ b/patches/Version_2_6_13pre56 @@ -0,0 +1,107 @@ +Description: + 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-67) unstable; urgency=medium + . + * Version_2_6_13pre55 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-04 + +--- gcl-2.6.12.orig/h/elf64_alpha_reloc.h ++++ gcl-2.6.12/h/elf64_alpha_reloc.h +@@ -22,16 +22,14 @@ + store_val(where,MASK(32),s+a); + break; + case R_ALPHA_LITERAL: +- s+=a; +- if (a || !(sym->st_other&0x1)) {gotp+=1+(sym->st_other>>1);sym->st_other|=1;} +- gote=got+(a ? gotp : sym->st_size)-1; +- massert(s); ++ gote=got+(a>>32)-1; ++ a&=MASK(32); + if (s>=ggot1 && sst_other=sym->st_size=0; + ++ for (sec=sec1;secsh_type==SHT_RELA) ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++ if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { ++ ++ sym=sym1+ELF_R_SYM(r->r_info); ++ ++ /*unlikely to save got space by recording possible holes in addend range*/ ++ if ((a=r->r_addend+1)>sym->st_other) ++ sym->st_other=a; ++ ++ } ++ + for (*gs=0,sec=sec1;secsh_type==SHT_RELA) + for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) +@@ -78,13 +90,19 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + + sym=sym1+ELF_R_SYM(r->r_info); + +- if (!sym->st_size || r->r_addend) { +- q=++*gs; +- if (!sym->st_size) sym->st_size=q; ++ if (sym->st_other) { ++ sym->st_size=++*gs; + massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); +- sym->st_other=(*gs-q)<<1; ++ massert((*gs-sym->st_size) || !r->r_addend); ++ if (sym->st_other>1) ++ (*gs)+=sym->st_other-1; ++ sym->st_other=0; + } + ++ b=sizeof(r->r_addend)*4; ++ massert(!(r->r_addend>>b)); ++ r->r_addend|=((sym->st_size+r->r_addend)< + 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-68) unstable; urgency=medium + . + * Version_2_6_13pre57 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-04 + +--- gcl-2.6.12.orig/h/elf64_alpha_reloc_special.h ++++ gcl-2.6.12/h/elf64_alpha_reloc_special.h +@@ -93,7 +93,7 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + if (sym->st_other) { + sym->st_size=++*gs; + massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); +- massert((*gs-sym->st_size) || !r->r_addend); ++ massert(!(*gs-sym->st_size) || !r->r_addend); + if (sym->st_other>1) + (*gs)+=sym->st_other-1; + sym->st_other=0; diff --git a/patches/Version_2_6_13pre58 b/patches/Version_2_6_13pre58 new file mode 100644 index 00000000..ec37b831 --- /dev/null +++ b/patches/Version_2_6_13pre58 @@ -0,0 +1,86 @@ +Description: + 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-68) unstable; urgency=medium + . + * Version_2_6_13pre57 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-09 + +--- gcl-2.6.12.orig/h/elf64_alpha_reloc_special.h ++++ gcl-2.6.12/h/elf64_alpha_reloc_special.h +@@ -65,7 +65,7 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + Sym *sym; + Shdr *sec; + void *v,*ve; +- ul q=0,a; ++ ul a,b; + + for (sym=sym1;symst_other=sym->st_size=0; +--- gcl-2.6.12.orig/o/cmpaux.c ++++ gcl-2.6.12/o/cmpaux.c +@@ -348,6 +348,8 @@ call_init(int init_address,object memory + + */ + ++object *min_cfd_self=NULL; ++ + void + do_init(object *statVV) { + +@@ -386,6 +388,8 @@ do_init(object *statVV) { + } + + data->cfd.cfd_self = statVV; ++ if (!min_cfd_self || data->cfd.cfd_selfcfd.cfd_self; + data->cfd.cfd_fillp= n; + statVV[n-1] = data; + +--- gcl-2.6.12.orig/o/fasdump.c ++++ gcl-2.6.12/o/fasdump.c +@@ -640,7 +640,7 @@ DEFUN_NEW("CLOSE-FASD",object,fSclose_fa + if (type_of(fd->table)==t_vector) + /* input uses a vector */ + {if (fd->table->v.v_self) +- fd->table->v.v_dim=0;/*self can be on the stack, and others write there*/ ++ gset(fd->table->v.v_self,0,fix(fd->index),aet_object); + } + else + if(fd->direction==sKoutput) +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -446,6 +446,7 @@ mark_object_address(object *o,int f) { + + static ufixnum lp; + static ufixnum lr; ++ extern object *min_cfd_self; + + ufixnum p=page(o); + +@@ -455,7 +456,7 @@ mark_object_address(object *o,int f) { + #ifdef SGC + sgc_enabled ? WRITABLE_PAGE_P(lp) : + #endif +- 1; ++ (o>=min_cfd_self && o<((object *)core_end)); + } + + if (lr) diff --git a/patches/Version_2_6_13pre59 b/patches/Version_2_6_13pre59 new file mode 100644 index 00000000..a5e7a2d9 --- /dev/null +++ b/patches/Version_2_6_13pre59 @@ -0,0 +1,88 @@ +Description: + 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-69) unstable; urgency=medium + . + * Version_2_6_13pre58 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-12 + +--- gcl-2.6.12.orig/h/elf64_alpha_reloc_special.h ++++ gcl-2.6.12/h/elf64_alpha_reloc_special.h +@@ -61,47 +61,30 @@ find_special_params(void *v,Shdr *sec1,S + static int + label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,const char *sn,ul *gs) { + +- Rela *r; ++ Rela *r,*rr; + Sym *sym; + Shdr *sec; +- void *v,*ve; +- ul a,b; +- +- for (sym=sym1;symst_other=sym->st_size=0; +- +- for (sec=sec1;secsh_type==SHT_RELA) +- for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) +- if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { +- +- sym=sym1+ELF_R_SYM(r->r_info); +- +- /*unlikely to save got space by recording possible holes in addend range*/ +- if ((a=r->r_addend+1)>sym->st_other) +- sym->st_other=a; +- +- } ++ void *v,*ve,*vv; ++ ul b,q; + + for (*gs=0,sec=sec1;secsh_type==SHT_RELA) + for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) + if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { + +- sym=sym1+ELF_R_SYM(r->r_info); +- +- if (sym->st_other) { +- sym->st_size=++*gs; +- massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); +- massert(!(*gs-sym->st_size) || !r->r_addend); +- if (sym->st_other>1) +- (*gs)+=sym->st_other-1; +- sym->st_other=0; +- } ++ for (rr=vv=v-sec->sh_entsize; ++ vv>=v1 && ++ (ELF_R_TYPE(rr->r_info)!=ELF_R_TYPE(r->r_info) || ++ ELF_R_SYM(rr->r_info)!=ELF_R_SYM(r->r_info) || ++ rr->r_addend!=r->r_addend); ++ vv-=sec->sh_entsize,rr=vv); + + b=sizeof(r->r_addend)*4; ++ q=vv>=v1 ? (rr->r_addend>>b) : ++*gs; ++ massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); ++ massert(*gs==q || !r->r_addend); + massert(!(r->r_addend>>b)); +- r->r_addend|=((sym->st_size+r->r_addend)<r_addend|=(q< + 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-6) unstable; urgency=medium + . + * Version_2_6_13pre5 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -254,8 +254,10 @@ 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;) ++ for (;rb_pointer!=rb_start&&rb_pointer!=rb_end;) { ++ tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); ++ } + sSAleaf_collection_thresholdA->s.s_dbind=o; + + } +@@ -498,10 +500,10 @@ static int + rebalance_maxpages(struct typemanager *my_tm,fixnum z) { + + fixnum d; +- ufixnum i,j; ++ ufixnum i,j,r=(my_tm->tm_type==t_relocatable ? 2 : 1); + + +- d=(z-my_tm->tm_maxpage)*(my_tm->tm_type==t_relocatable ? 2 : 1); ++ d=(z-my_tm->tm_maxpage)*r; + j=sum_maxpages(); + + if (j+d>phys_pages) { +@@ -517,14 +519,14 @@ rebalance_maxpages(struct typemanager *m + if (e+phys_pages-j<=0) + return 0; + +- f=1.0-(double)e/k; ++ f=k ? 1.0-(double)e/k : 1.0; + + for (i=t_start;itm_maxpage+(phys_pages-sum_maxpages()))/(my_tm->tm_type==t_relocatable ? 2 : 1))); ++ massert(set_tm_maxpage(my_tm,(my_tm->tm_maxpage*r+(phys_pages-sum_maxpages()))/r)); + + return 1; + +@@ -624,7 +626,12 @@ expand_contblock_index_space(void) { + + if (cbv->v.v_fillp+1==cbv->v.v_dim) { + +- void *v=alloc_relblock(2*cbv->v.v_dim*sizeof(fixnum)); ++ void *v; ++ object o=sSAleaf_collection_thresholdA->s.s_dbind; ++ ++ sSAleaf_collection_thresholdA->s.s_dbind=make_fixnum(-1); ++ v=alloc_relblock(2*cbv->v.v_dim*sizeof(fixnum)); ++ sSAleaf_collection_thresholdA->s.s_dbind=o; + + memcpy(v,cbv->v.v_self,cbv->v.v_dim*sizeof(fixnum)); + cbv->v.v_self=v; +@@ -731,13 +738,14 @@ insert_contblock(void *p,ufixnum s) { + + 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; + } + ++ *cbpp=cbp; ++ + } + + static inline void +@@ -890,6 +898,7 @@ add_pages(struct typemanager *tm,fixnum + if (rb_pointer>rb_end) { + fprintf(stderr,"Moving relblock low before expanding relblock pages\n"); + fflush(stderr); ++ tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + } + nrbpage+=m; +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -1042,14 +1042,10 @@ contblock_sweep_phase(void) { + + struct pageinfo *v; + STATIC char *s, *e, *p, *q; +- object o; + ufixnum i; + + reset_contblock_freelist(); + +- o=sSAleaf_collection_thresholdA->s.s_dbind; +- sSAleaf_collection_thresholdA->s.s_dbind=make_fixnum(-1); +- + for (i=0;iv.v_fillp && (v=(void *)contblock_array->v.v_self[i]);i++) { + + bool z; +@@ -1074,8 +1070,6 @@ contblock_sweep_phase(void) { + + } + +- sSAleaf_collection_thresholdA->s.s_dbind=o; +- + sweep_link_array(); + + } +@@ -1646,14 +1640,18 @@ DEFUN_NEW("GBC",object,fSgbc,SI,1,1,NONE + + /* 1 args */ + +- if (x0 == Ct) ++ if (x0 == Ct) { ++ tm_table[t_contiguous].tm_adjgbccnt--; + GBC(t_other); +- else if (x0 == Cnil) ++ } else if (x0 == Cnil) { ++ tm_table[t_cons].tm_adjgbccnt--; + GBC(t_cons); +- else if (eql(small_fixnum(0),x0)) ++ } else if (eql(small_fixnum(0),x0)) { ++ tm_table[t_contiguous].tm_adjgbccnt--; + GBC(t_contiguous); +- else { ++ } else { + x0 = small_fixnum(1); ++ tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + } + RETURN1(x0); diff --git a/patches/Version_2_6_13pre60 b/patches/Version_2_6_13pre60 new file mode 100644 index 00000000..e5808329 --- /dev/null +++ b/patches/Version_2_6_13pre60 @@ -0,0 +1,61 @@ +Description: + 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-70) unstable; urgency=medium + . + * Version_2_6_13pre59 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-12 + +--- gcl-2.6.12.orig/h/elf64_alpha_reloc.h ++++ gcl-2.6.12/h/elf64_alpha_reloc.h +@@ -29,7 +29,7 @@ + } else + *gote=s+a; + s=(gote-got)*sizeof(*got); +- massert(!(s&~MASK(16))); ++ massert(!(s&~MASK(15))); + store_val(where,MASK(16),s); + break; + case R_ALPHA_GPRELHIGH: +--- gcl-2.6.12.orig/h/elf64_alpha_reloc_special.h ++++ gcl-2.6.12/h/elf64_alpha_reloc_special.h +@@ -62,7 +62,6 @@ static int + label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,const char *sn,ul *gs) { + + Rela *r,*rr; +- Sym *sym; + Shdr *sec; + void *v,*ve,*vv; + ul b,q; +@@ -80,8 +79,12 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + vv-=sec->sh_entsize,rr=vv); + + b=sizeof(r->r_addend)*4; +- q=vv>=v1 ? (rr->r_addend>>b) : ++*gs; +- massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); ++ if (vv>=v1) ++ q=rr->r_addend>>b; ++ else { ++ q=++*gs; ++ massert(!make_got_room_for_stub(sec1,sece,sym1+ELF_R_SYM(r->r_info),st1,gs)); ++ } + massert(*gs==q || !r->r_addend); + massert(!(r->r_addend>>b)); + r->r_addend|=(q< + 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-71) unstable; urgency=medium + . + * Version_2_6_13pre60 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-13 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4118,6 +4118,7 @@ if test "${enable_gprof+set}" = set; the + $as_echo_n "checking working gprof... " >&6; } + case $use in + powerpc*) if test "$host_cpu" = "powerpc64le" ; then enableval="no"; fi;; ++ s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 + sh4*) enableval="no";; + ia64*) enableval="no";; + hppa*) enableval="no";; +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -331,6 +331,7 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof + AC_MSG_CHECKING([working gprof]) + case $use in + powerpc*) if test "$host_cpu" = "powerpc64le" ; then enableval="no"; fi;; ++ s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 + sh4*) enableval="no";; + ia64*) enableval="no";; + hppa*) enableval="no";; diff --git a/patches/Version_2_6_13pre62 b/patches/Version_2_6_13pre62 new file mode 100644 index 00000000..c7d4c3c9 --- /dev/null +++ b/patches/Version_2_6_13pre62 @@ -0,0 +1,113 @@ +Description: + 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-72) unstable; urgency=medium + . + * Version_2_6_13pre61 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-14 + +--- gcl-2.6.12.orig/h/elf64_alpha_reloc.h ++++ gcl-2.6.12/h/elf64_alpha_reloc.h +@@ -22,12 +22,12 @@ + store_val(where,MASK(32),s+a); + break; + case R_ALPHA_LITERAL: +- gote=got+(a>>32)-1; +- a&=MASK(32); ++ massert(a || sym->st_size); ++ gote=got+(a ? (a>>32) : sym->st_size)-1; + if (s>=ggot1 && sst_size=0; + + for (*gs=0,sec=sec1;secsh_type==SHT_RELA) +- for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) +- if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { +- +- for (rr=vv=v-sec->sh_entsize; +- vv>=v1 && +- (ELF_R_TYPE(rr->r_info)!=ELF_R_TYPE(r->r_info) || +- ELF_R_SYM(rr->r_info)!=ELF_R_SYM(r->r_info) || +- rr->r_addend!=r->r_addend); +- vv-=sec->sh_entsize,rr=vv); +- +- b=sizeof(r->r_addend)*4; +- if (vv>=v1) +- q=rr->r_addend>>b; +- else { +- q=++*gs; +- massert(!make_got_room_for_stub(sec1,sece,sym1+ELF_R_SYM(r->r_info),st1,gs)); ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++ ++ if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { ++ ++ if (sec->sh_type!=SHT_RELA || !r->r_addend) { ++ ++ sym=sym1+ELF_R_SYM(r->r_info); ++ ++ if (!sym->st_size) { ++ sym->st_size=++*gs; ++ massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); + } +- massert(*gs==q || !r->r_addend); +- massert(!(r->r_addend>>b)); +- r->r_addend|=(q<sh_entsize; ++ vv>=v1 && (ELF_R_TYPE(rr->r_info)!=ELF_R_TYPE(r->r_info) || ++ ELF_R_SYM(rr->r_info)!=ELF_R_SYM(r->r_info) || ++ rr->r_addend!=r->r_addend); ++ vv-=sec->sh_entsize,rr=vv); ++ ++ q=vvr_addend>>32; ++ massert(!(r->r_addend>>32)); ++ r->r_addend|=(q<<32); + + } +- ++ ++ } ++ + return 0; + + } diff --git a/patches/Version_2_6_13pre63 b/patches/Version_2_6_13pre63 new file mode 100644 index 00000000..ee53ae96 --- /dev/null +++ b/patches/Version_2_6_13pre63 @@ -0,0 +1,78 @@ +Description: + 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-73) unstable; urgency=medium + . + * Version_2_6_13pre62 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-17 + +--- gcl-2.6.12.orig/h/elf64_alpha_reloc_special.h ++++ gcl-2.6.12/h/elf64_alpha_reloc_special.h +@@ -71,20 +71,21 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + sym->st_size=0; + + for (*gs=0,sec=sec1;secsh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++ if (sec->sh_type==SHT_RELA || sec->sh_type==SHT_REL) ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) + +- if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { ++ if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { + +- if (sec->sh_type!=SHT_RELA || !r->r_addend) { ++ if (sec->sh_type!=SHT_RELA || !r->r_addend) { + +- sym=sym1+ELF_R_SYM(r->r_info); ++ sym=sym1+ELF_R_SYM(r->r_info); + +- if (!sym->st_size) { +- sym->st_size=++*gs; +- massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); +- } ++ if (!sym->st_size) { ++ sym->st_size=++*gs; ++ massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); ++ } + +- } else { ++ } else { + + for (rr=vv=v-sec->sh_entsize; + vv>=v1 && (ELF_R_TYPE(rr->r_info)!=ELF_R_TYPE(r->r_info) || +@@ -96,9 +97,9 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + massert(!(r->r_addend>>32)); + r->r_addend|=(q<<32); + +- } ++ } + +- } ++ } + + return 0; + +--- gcl-2.6.12.orig/o/gprof.c ++++ gcl-2.6.12/o/gprof.c +@@ -1,3 +1,5 @@ ++#include ++ + #include "include.h" + #include "page.h" + #include "ptable.h" diff --git a/patches/Version_2_6_13pre64 b/patches/Version_2_6_13pre64 new file mode 100644 index 00000000..e0a6ae0c --- /dev/null +++ b/patches/Version_2_6_13pre64 @@ -0,0 +1,169 @@ +Description: + 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-74) unstable; urgency=medium + . + * Version_2_6_13pre63 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-21 + +--- gcl-2.6.12.orig/h/elf64_alpha_reloc.h ++++ gcl-2.6.12/h/elf64_alpha_reloc.h +@@ -1,16 +1,14 @@ + case R_ALPHA_GPDISP: +- s=(ul)got; +- s-=p; +- s+=(s&0x8000)<<1; +- store_val(where,MASK(16),s>>16); +- where=(void *)where+a; +- store_val(where,MASK(16),s); ++ gotoff=(ul)(got+(a>>32)); ++ s=gotoff-p; ++ store_val(where,MASK(16),(s-(short)s)>>16); ++ store_val((void *)where+(a&MASK(32)),MASK(16),s); + break; + case R_ALPHA_SREL32: + store_val(where,MASK(32),s+a-p); + break; + case R_ALPHA_GPREL32: +- store_val(where,MASK(32),s+a-(ul)got); ++ store_val(where,MASK(32),s+a-gotoff); + break; + case R_ALPHA_LITUSE: + case R_ALPHA_HINT: +@@ -22,23 +20,20 @@ + store_val(where,MASK(32),s+a); + break; + case R_ALPHA_LITERAL: +- massert(a || sym->st_size); +- gote=got+(a ? (a>>32) : sym->st_size)-1; ++ s+=a&MASK(32); ++ a=(a>>32)-1; + if (s>=ggot1 && s>16); ++ s+=a-gotoff; ++ store_val(where,MASK(16),(s-(short)s)>>16); + break; + case R_ALPHA_GPRELLOW: +- store_val(where,MASK(16),s+a-(ul)got); ++ store_val(where,MASK(16),s+a-gotoff); + break; + case R_ALPHA_TLS_GD_HI: + store_vals(where,MASK(21),((long)(s+a-(p+4)))>>2); +--- gcl-2.6.12.orig/h/elf64_alpha_reloc_special.h ++++ gcl-2.6.12/h/elf64_alpha_reloc_special.h +@@ -1,4 +1,4 @@ +-static ul ggot1,ggote; ++static ul ggot1,ggote,gotoff; + + static int + write_stub(ul s,ul *got,ul *gote) { +@@ -61,44 +61,60 @@ find_special_params(void *v,Shdr *sec1,S + static int + label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,const char *sn,ul *gs) { + +- Sym *sym; +- Rela *r,*rr; ++ Sym *sym,*fsym=sym1; ++ Rela *r; + Shdr *sec; +- void *v,*ve,*vv; +- ul q; ++ void *v,*ve; ++ ul q,gotp; + + for (sym=sym1;symst_size=0; + +- for (*gs=0,sec=sec1;secsh_type==SHT_RELA || sec->sh_type==SHT_REL) ++ for (*gs=gotp=0,sec=sec1;secsh_type==SHT_RELA) + for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) + +- if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { ++ switch(ELF_R_TYPE(r->r_info)) { ++ ++ case R_ALPHA_LITERAL: + +- if (sec->sh_type!=SHT_RELA || !r->r_addend) { ++ if (!r->r_addend) { + + sym=sym1+ELF_R_SYM(r->r_info); ++ q=(gotp-sym->st_size)*sizeof(*gs); + +- if (!sym->st_size) { ++ if (!sym->st_size || q!=(short)q) { + sym->st_size=++*gs; + massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); + } + +- } else { ++ q=sym->st_size; ++ ++ } else ++ ++ q=++*gs; ++ ++ massert(!(r->r_addend>>32)); ++ r->r_addend|=(q<<32); + +- for (rr=vv=v-sec->sh_entsize; +- vv>=v1 && (ELF_R_TYPE(rr->r_info)!=ELF_R_TYPE(r->r_info) || +- ELF_R_SYM(rr->r_info)!=ELF_R_SYM(r->r_info) || +- rr->r_addend!=r->r_addend); +- vv-=sec->sh_entsize,rr=vv); +- +- q=vvr_addend>>32; +- massert(!(r->r_addend>>32)); +- r->r_addend|=(q<<32); ++ q=(q-gotp)*sizeof(*gs); ++ massert(q==(short)q); + ++ break; ++ ++ case R_ALPHA_GPDISP: ++ ++ for (sym=fsym;symst_shndx!=1 || sym->st_value!=r->r_offset);sym++); ++ ++ if (symr_addend|=(gotp<<32); ++ ++ break; ++ + } + + return 0; diff --git a/patches/Version_2_6_13pre65 b/patches/Version_2_6_13pre65 new file mode 100644 index 00000000..dbaef5d7 --- /dev/null +++ b/patches/Version_2_6_13pre65 @@ -0,0 +1,212 @@ +Description: + 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-75) unstable; urgency=medium + . + * Version_2_6_13pre64 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-22 + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpif.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpif.lsp +@@ -428,9 +428,8 @@ + (wt-label label)))) + + (if (eq default 't) +- (progn (wt-nl "FEerror(\"The ECASE key value ~s is illegal.\",1,V" cvar ");") +- (unwind-exit nil 'jump)) +- (c2expr default)) ++ (wt-nl "FEerror(\"The ECASE key value ~s is illegal.\",1,V" cvar ");") ++ (c2expr default)) + + (wt "}") + (close-inline-blocks)) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmulti.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmulti.lsp +@@ -221,56 +221,36 @@ + + + (defun c2multiple-value-bind (vars init-form body +- &aux (block-p nil) (labels nil) +- (*unwind-exit* *unwind-exit*) +- (*vs* *vs*) (*clink* *clink*) (*ccb-vs* *ccb-vs*) +- top-data) +- (declare (object block-p)) +- (multiple-value-check vars init-form) ++ &aux (block-p nil) ++ (*unwind-exit* *unwind-exit*) ++ (*vs* *vs*) (*clink* *clink*) (*ccb-vs* *ccb-vs*) ++ top-data) + +- (dolist** (var vars) ++ (multiple-value-check vars init-form) ++ ++ (dolist (var vars) + (let ((kind (c2var-kind var))) +- (declare (object kind)) + (if kind + (let ((cvar (next-cvar))) + (setf (var-kind var) kind) + (setf (var-loc var) cvar) + (wt-nl) + (unless block-p (wt "{") (setq block-p t)) +- (wt-var-decl var) +- ) +- (setf (var-ref var) (vs-push))))) ++ (wt-var-decl var)) ++ (setf (var-ref var) (vs-push))))) + + (let ((*value-to-go* 'top) *top-data*) + (c2expr* init-form) (setq top-data *top-data*)) ++ + (and *record-call-info* (record-call-info nil (car top-data))) +- (let ((*clink* *clink*) +- (*unwind-exit* *unwind-exit*) +- (*ccb-vs* *ccb-vs*)) +- (do ((vs vars (cdr vs))) +- ((endp vs)) +- (declare (object vs)) +- (push (next-label) labels) +- (wt-nl "if(vs_base>=vs_top){") +- (reset-top) +- (wt-go (car labels)) (wt "}") ++ ++ (wt-nl "if(vs_base>vs_top) vs_top=vs_base;*vs_top=Cnil;") ++ (do ((vs vars (cdr vs))) ++ ((endp vs)) + (c2bind-loc (car vs) '(vs-base 0)) +- (unless (endp (cdr vs)) (wt-nl "vs_base++;")))) ++ (unless (endp (cdr vs)) (wt-nl "if (vs_base>32)); ++ gotoff=(ul)(got+(a>>32)-1); + s=gotoff-p; + store_val(where,MASK(16),(s-(short)s)>>16); + store_val((void *)where+(a&MASK(32)),MASK(16),s); +@@ -23,7 +23,7 @@ + s+=a&MASK(32); + a=(a>>32)-1; + if (s>=ggot1 && sr_addend>>32)); ++ if (r->r_addend>>32) ++ fprintf(stderr,"zeroing high addend %lx\n",r->r_addend>>32); ++ r->r_addend&=0xffffffff; ++ massert((q&0xffffffff)==q); + r->r_addend|=(q<<32); + + q=(q-gotp)*sizeof(*gs); +@@ -111,6 +114,10 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + gotp=*gs+1; + } + ++ if (r->r_addend>>32) ++ fprintf(stderr,"zeroing high addend %lx\n",r->r_addend>>32); ++ r->r_addend&=0xffffffff; ++ massert((gotp&0xffffffff)==gotp); + r->r_addend|=(gotp<<32); + + break; diff --git a/patches/Version_2_6_13pre66 b/patches/Version_2_6_13pre66 new file mode 100644 index 00000000..667cee3c --- /dev/null +++ b/patches/Version_2_6_13pre66 @@ -0,0 +1,132 @@ +Description: + 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-75) unstable; urgency=medium + . + * Version_2_6_13pre65 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-23 + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmulti.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmulti.lsp +@@ -164,27 +164,21 @@ + (cmpwarn "~A was proclaimed to have only one return value. ~%;But you appear to want multiple values." fname)))))) + + (defun c2multiple-value-setq (vrefs form &aux top-data) +- (multiple-value-check vrefs form) ++ (multiple-value-check vrefs form) + (let ((*value-to-go* 'top)*top-data*) + (c2expr* form) (setq top-data *top-data*)) + (and *record-call-info* (record-call-info nil (car top-data))) ++ (wt-nl "if(vs_base>vs_top) vs_top=vs_base;*vs_top=Cnil;") + (do ((vs vrefs (cdr vs))) + ((endp vs)) +- (declare (object vs)) + (let ((vref (car vs))) +- (declare (object vref)) +- (wt-nl "if(vs_base&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5 + $as_echo "ok" >&6; } +- assert_arg_to_cflags -pg ++ OLD_CFLAGS=$CFLAGS # Do not run configure tests with -pg ++ assert_arg_to_cflags -pg ++ CFLAGS=$OLD_CFLAGS + TFPFLAG="" + + $as_echo "#define GCL_GPROF 1" >>confdefs.h +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -334,6 +334,7 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof + s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 + sh4*) enableval="no";; + ia64*) enableval="no";; ++ alpha*) enableval="no";;#write_stub currently depends on t12 set in call + hppa*) enableval="no";; + arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible + aarch64*) enableval="no";;#unreproducible buildd bug 20170824 +@@ -343,25 +344,11 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof + AC_MSG_RESULT([disabled]) + else + AC_MSG_RESULT([ok]) +- assert_arg_to_cflags -pg ++ OLD_CFLAGS=$CFLAGS # Do not run configure tests with -pg ++ assert_arg_to_cflags -pg ++ CFLAGS=$OLD_CFLAGS + TFPFLAG="" + AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) +-dnl AC_MSG_CHECKING([for text start]) +-dnl echo 'int main () {return(0);}' >foo.c +-dnl $CC foo.c -o foo +-dnl GCL_GPROF_START=`nm foo | $AWK '/ *[[TD]] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc +-dnl rm -f foo.c foo +-dnl if test "$GCL_GPROF_START" != "" ; then +-dnl AC_MSG_RESULT($GCL_GPROF_START) +-dnl AC_DEFINE_UNQUOTED(GCL_GPROF_START,$GCL_GPROF_START,[starting address for gprof]) +-dnl assert_arg_to_cflags -pg +-dnl # case $use in +-dnl # s390*) ;; # relocation truncation bug in gcc +-dnl # *) TLIBS="$TLIBS -pg";; +-dnl # esac +-dnl TFPFLAG="" +-dnl AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) +-dnl fi + fi + fi]) + +--- gcl-2.6.12.orig/o/usig.c ++++ gcl-2.6.12/o/usig.c +@@ -150,7 +150,7 @@ DEFUN_NEW("FLD",object,fSfld,SI,1,1,NONE + + /* For now ignore last three args governing offsets and data modification, just to + support fpe sync with master*/ +-DEFUN_NEW("*FIXNUM",object,fSAfixnum,SI,4,4,NONE,OI,OO,OO,OO,(fixnum addr,object x,object y,object z),"") { ++DEFUN_NEW("*FIXNUM",object,fSAfixnum,SI,4,4,NONE,II,OO,OO,OO,(fixnum addr,object x,object y,object z),"") { + RETURN1((object)*(fixnum *)addr); + } + DEFUN_NEW("*FLOAT",object,fSAfloat,SI,4,4,NONE,OI,OO,OO,OO,(fixnum addr,object x,object y,object z),"") { diff --git a/patches/Version_2_6_13pre67 b/patches/Version_2_6_13pre67 new file mode 100644 index 00000000..274a39e0 --- /dev/null +++ b/patches/Version_2_6_13pre67 @@ -0,0 +1,256 @@ +Description: + 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-76) unstable; urgency=medium + . + * Version_2_6_13pre66 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-26 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4121,7 +4121,6 @@ $as_echo_n "checking working gprof... " + s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 + sh4*) enableval="no";; + ia64*) enableval="no";; +- alpha*) enableval="no";;#write_stub currently depends on t12 set in call + hppa*) enableval="no";; + arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible + aarch64*) enableval="no";;#unreproducible buildd bug 20170824 +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -334,7 +334,6 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof + s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 + sh4*) enableval="no";; + ia64*) enableval="no";; +- alpha*) enableval="no";;#write_stub currently depends on t12 set in call + hppa*) enableval="no";; + arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible + aarch64*) enableval="no";;#unreproducible buildd bug 20170824 +--- gcl-2.6.12.orig/h/elf64_alpha_reloc.h ++++ gcl-2.6.12/h/elf64_alpha_reloc.h +@@ -1,14 +1,14 @@ + case R_ALPHA_GPDISP: +- gotoff=(ul)(got+(a>>32)-1); ++ gotoff=(ul)(got+HIGH(a)-1); + s=gotoff-p; + store_val(where,MASK(16),(s-(short)s)>>16); +- store_val((void *)where+(a&MASK(32)),MASK(16),s); ++ store_val((void *)where+LOW(a),MASK(16),s); + break; + case R_ALPHA_SREL32: + store_val(where,MASK(32),s+a-p); + break; + case R_ALPHA_GPREL32: +- store_val(where,MASK(32),s+a-gotoff); ++ store_val(where,MASK(32),s+LOW(a)-(ul)(got+HIGH(a)-1)); + break; + case R_ALPHA_LITUSE: + case R_ALPHA_HINT: +@@ -20,8 +20,8 @@ + store_val(where,MASK(32),s+a); + break; + case R_ALPHA_LITERAL: +- s+=a&MASK(32); +- a=(a>>32)-1; ++ s+=LOW(a); ++ a=HIGH(a)-1; + if (s>=ggot1 && s>16); /*ldah t12,(symhigh)(zero)*/ ++ *goti++=(0x8<<26)|(0x1b<<21)|(0x1b<<16)|(s&MASK(16)); /*lda t12,(symlow)(t12)*/ ++ *goti++=(0x29<<26)|(0x1b<<21)|(0x1b<<16)|0; /*ldq t12,0(t12)*/ ++ *goti++=(0x1a<<26)|(0x1f<<21)|(0x1b<<16)|0x4000; /*jsr zero,(t12),$pc+4*/ ++ *goti++=0; /*halt*/ ++ *goti++=0; /*halt*/ ++ ++ return 0; ++ ++} + + static int + write_stub(ul s,ul *gote) { + + unsigned int *goti; + ++ if (s==mcount) ++ return write_stub_mcount(mcount,gote); ++ + *gote=(ul)(goti=(void *)(gote+2)); + *++gote=s; + *goti++=(0x29<<26)|(0x1b<<21)|(0x1b<<16)|0xfff8; /*ldq t12,-8(t12)*/ +@@ -35,15 +57,19 @@ static int + find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, + const char *st1,Sym *ds1,Sym *dse,Sym *sym1,Sym *syme) { + ++ Sym *sym; + Shdr *sec; + Rela *r; +- void *ve; ++ void *ve,*dst1; + + massert((sec=get_section(".got",sec1,sece,sn))); + + ggot1=sec->sh_addr; + ggote=ggot1+sec->sh_size; + ++ massert(sec=get_section(".dynstr",sec1,sece,sn));/*FIXME pass as parameter*/ ++ dst1=v+sec->sh_offset; ++ + massert((sec=get_section(".rel.dyn",sec1,sece,sn))|| + (sec=get_section(".rela.dyn",sec1,sece,sn))); + +@@ -51,13 +77,20 @@ find_special_params(void *v,Shdr *sec1,S + ve=v+sec->sh_size; + + for (r=v;vsh_entsize,r=v) +- if (ELF_R_TYPE(r->r_info) && !ds1[ELF_R_SYM(r->r_info)].st_value) +- ds1[ELF_R_SYM(r->r_info)].st_value=r->r_offset; ++ if (ELF_R_TYPE(r->r_info) && !(sym=ds1+ELF_R_SYM(r->r_info))->st_value) { ++ sym->st_value=r->r_offset; ++ if (!strncmp("_mcount",dst1+sym->st_name,7)) ++ mcount=sym->st_value; ++ } + + return 0; + + } + ++#define HIGH(a_) ((a_)>>32) ++#define LOW(a_) ((a_)&MASK(32)) ++#define SET_HIGH(a_,b_) ({ul _a=(a_);(a_)=((b_)<<32)|LOW(_a);}) ++ + static int + label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,const char *sn,ul *gs) { + +@@ -67,12 +100,18 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + void *v,*ve; + ul q,gotp; + +- for (sym=sym1;symst_size=0; ++ for (sym=sym1;symst_value)); ++ massert(!HIGH(sym->st_size)); ++ } + + for (*gs=gotp=0,sec=sec1;secsh_type==SHT_RELA) +- for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) { ++ ++ if (HIGH(r->r_addend)) ++ fprintf(stderr,"zeroing high addend %lx\n",HIGH(r->r_addend));/*never reached fix(Cnil) code, to be eliminated*/ ++ SET_HIGH(r->r_addend,0UL); + + switch(ELF_R_TYPE(r->r_info)) { + +@@ -81,49 +120,60 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + if (!r->r_addend) { + + sym=sym1+ELF_R_SYM(r->r_info); +- q=(gotp-sym->st_size)*sizeof(*gs); ++ q=(HIGH(sym->st_size)-gotp)*sizeof(*gs); + +- if (!sym->st_size || q!=(short)q) { +- sym->st_size=++*gs; ++ if (!HIGH(sym->st_size) || q!=(short)q) {/*new cached got entry if first or out of range*/ ++ SET_HIGH(sym->st_size,++*gs); + massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); + } + +- q=sym->st_size; ++ q=HIGH(sym->st_size); + + } else + + q=++*gs; + +- if (r->r_addend>>32) +- fprintf(stderr,"zeroing high addend %lx\n",r->r_addend>>32); +- r->r_addend&=0xffffffff; +- massert((q&0xffffffff)==q); +- r->r_addend|=(q<<32); ++ SET_HIGH(r->r_addend,q); + +- q=(q-gotp)*sizeof(*gs); ++ q=(q-gotp)*sizeof(*gs);/*check 16bit range gprel address in range*/ + massert(q==(short)q); + + break; + + case R_ALPHA_GPDISP: + +- for (sym=fsym;symst_shndx!=1 || sym->st_value!=r->r_offset);sym++); ++ for (sym=fsym;symst_shndx!=1 || LOW(sym->st_value)!=r->r_offset);sym++);/*ordered search*/ + + if (symst_value,gotp=*gs+1); + } + +- if (r->r_addend>>32) +- fprintf(stderr,"zeroing high addend %lx\n",r->r_addend>>32); +- r->r_addend&=0xffffffff; +- massert((gotp&0xffffffff)==gotp); +- r->r_addend|=(gotp<<32); ++ SET_HIGH(r->r_addend,gotp); ++ ++ break; ++ ++ case R_ALPHA_GPREL32: ++ ++ q=LOW(sym1[ELF_R_SYM(r->r_info)].st_value)+r->r_addend; ++ ++ /*unordered search*/ ++ for (sym=sym1;symst_shndx!=1 || LOW(sym->st_value)>q || LOW(sym->st_value)+LOW(sym->st_size)r_addend,HIGH(sym->st_value)); + + break; + + } + ++ } ++ ++ for (sym=sym1;symst_value,0UL); ++ SET_HIGH(sym->st_size,0UL); ++ } ++ + return 0; + + } diff --git a/patches/Version_2_6_13pre68 b/patches/Version_2_6_13pre68 new file mode 100644 index 00000000..3c62bd07 --- /dev/null +++ b/patches/Version_2_6_13pre68 @@ -0,0 +1,35 @@ +Description: + 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-76) unstable; urgency=medium + . + * Version_2_6_13pre67 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-07-24 + +--- gcl-2.6.12.orig/h/elf64_i386_reloc.h ++++ gcl-2.6.12/h/elf64_i386_reloc.h +@@ -8,6 +8,7 @@ + add_val(where,~0L,s+a); + break; + case R_X86_64_PC32: ++ case R_X86_64_PLT32: + massert(ovchks(s+a-p,~MASK(32))); + add_val(where,MASK(32),s+a-p); + break; diff --git a/patches/Version_2_6_13pre69 b/patches/Version_2_6_13pre69 new file mode 100644 index 00000000..37f5f682 --- /dev/null +++ b/patches/Version_2_6_13pre69 @@ -0,0 +1,32 @@ +Description: + 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-78) unstable; urgency=medium + . + * rebuild against latest compilers and tools +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-10-11 + +--- gcl-2.6.12.orig/h/386-gnu.h ++++ gcl-2.6.12/h/386-gnu.h +@@ -61,3 +61,4 @@ + #define NEED_STACK_CHK_GUARD + + #undef HAVE_D_TYPE /*FIXME defined, but not implemented in readdir*/ ++#define NO_FILE_LOCKING /*FIXME*/ diff --git a/patches/Version_2_6_13pre7 b/patches/Version_2_6_13pre7 new file mode 100644 index 00000000..ccbd1e45 --- /dev/null +++ b/patches/Version_2_6_13pre7 @@ -0,0 +1,163 @@ +Description: + 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-7) unstable; urgency=medium + . + * Version_2_6_13pre6 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/att_ext.h ++++ gcl-2.6.12/h/att_ext.h +@@ -29,7 +29,7 @@ void *malloc(size_t); + void *realloc(void *,size_t); + /* void * memalign(size_t,size_t); */ + void *alloc_contblock(size_t); +-void *alloc_relblock(size_t); ++inline void *alloc_relblock(size_t); + /* object fSallocate_contiguous_pages(); */ + /* object fSallocate_relocatable_pages(); */ + +--- 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 (void *p, ufixnum s); /* (p, s) char *p; int s; */ ++/* alloc.c:480:OF */ extern inline 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 *); /* () */ +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -422,7 +422,11 @@ DEFVAR("*LEAF-COLLECTION-THRESHOLD*",sSA + + static inline bool + marking(void *p) { +- return (sgc_enabled ? ON_WRITABLE_PAGE_CACHED(p) : !NULL_OR_ON_C_STACK(p)); ++ return ( ++#ifdef SGC ++ sgc_enabled ? ON_WRITABLE_PAGE_CACHED(p) : ++#endif ++ !NULL_OR_ON_C_STACK(p)); + } + + static inline bool +@@ -483,7 +487,11 @@ mark_object_address(object *o,int f) { + + if (lp!=p || !f) { + lp=p; +- lr=sgc_enabled ? WRITABLE_PAGE_P(lp) : 1; ++ lr= ++#ifdef SGC ++ sgc_enabled ? WRITABLE_PAGE_P(lp) : ++#endif ++ 1; + } + + if (lr) +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -147,8 +147,8 @@ mbrk(void *v) { + + #include + +-ufixnum +-get_phys_pages_no_malloc(void) { ++static ufixnum ++get_phys_pages_no_malloc(char n) { + MEMORYSTATUS m; + + m.dwLength=sizeof(m); +@@ -161,8 +161,8 @@ get_phys_pages_no_malloc(void) { + + #include + +-ufixnum +-get_phys_pages_no_malloc(void) { ++static ufixnum ++get_phys_pages_no_malloc(char n) { + uint64_t s; + size_t z=sizeof(s); + int m[2]={CTL_HW,HW_MEMSIZE}; +@@ -176,8 +176,8 @@ get_phys_pages_no_malloc(void) { + + #elif defined(__sun__) + +-ufixnum +-get_phys_pages_no_malloc(void) { ++static ufixnum ++get_phys_pages_no_malloc(char n) { + + return sysconf(_SC_PHYS_PAGES); + +@@ -202,7 +202,7 @@ get_proc_meminfo_value_in_pages(const ch + return n>>(PAGEWIDTH-10); + } + +-ufixnum ++static ufixnum + get_phys_pages_no_malloc(char freep) { + return freep ? + get_proc_meminfo_value_in_pages("MemFree:")+ +--- gcl-2.6.12.orig/o/sfaslcoff.c ++++ gcl-2.6.12/o/sfaslcoff.c +@@ -205,9 +205,7 @@ load_memory(struct scnhdr *sec1,struct s + 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_code_space(sz); + + for (sec=sec1;secs_paddr+=(ul)memory->cfd.cfd_start; +--- gcl-2.6.12.orig/o/sfaslmacho.c ++++ gcl-2.6.12/o/sfaslmacho.c +@@ -207,9 +207,7 @@ load_memory(struct section *sec1,struct + 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_code_space(sz); + + a=(ul)memory->cfd.cfd_start; + a=(a+ma)&~ma; +--- gcl-2.6.12.orig/unixport/sys_init.lsp.in ++++ gcl-2.6.12/unixport/sys_init.lsp.in +@@ -28,7 +28,7 @@ + (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)) ++ (dolist (d (list lsp cmpnew #+(and xgcl (not pre-gcl)) xgcl-2 #+(or pcl ansi-cl) pcl #+ansi-cl clcs)) + (load (make-pathname :name "sys-proclaim" :type "lisp" :directory d))) + (load (make-pathname :name "tk-package" :type "lsp" :directory gtk)) + (load (make-pathname :name "gcl_lfun_list" :type "lsp" :directory cmpnew)) +@@ -77,6 +77,5 @@ + + #-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) diff --git a/patches/Version_2_6_13pre70 b/patches/Version_2_6_13pre70 new file mode 100644 index 00000000..cbcbe0a8 --- /dev/null +++ b/patches/Version_2_6_13pre70 @@ -0,0 +1,108 @@ +Description: + 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-78) unstable; urgency=medium + . + * rebuild against latest compilers and tools + * Version_2_6_13pre69 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-10-29 + +--- gcl-2.6.12.orig/h/linux.h ++++ gcl-2.6.12/h/linux.h +@@ -132,17 +132,10 @@ do { int c = 0; \ + + #include + #include +-#define GET_FULL_PATH_SELF(a_) do { \ +- static char q[PATH_MAX]; \ +- const char *s="/proc/self/exe"; \ +- struct stat ss; \ +- if (stat(s,&ss)) \ +- (a_)=argv[0]; \ +- else { \ +- if (!realpath(s,q)) \ +- error("realpath error"); \ +- (a_)=q; \ +- } \ ++#define GET_FULL_PATH_SELF(a_) do { \ ++ static char q[PATH_MAX]; \ ++ massert(which("/proc/self/exe",q) || which(argv[0],q)); \ ++ (a_)=q; \ + } while(0) + + +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -460,18 +460,49 @@ DEFUN_NEW("EQUAL-TAIL-RECURSION-CHECK",o + RETURN1((object)(w-u)); + } + ++static int ++mbin(const char *s,char *o) { ++ ++ struct stat ss; ++ ++ if (!stat(s,&ss) && (ss.st_mode&S_IFMT)==S_IFREG && !access(s,R_OK|X_OK)) { ++ massert(realpath(s,o)); ++ return 1; ++ } ++ ++ return 0; ++ ++} ++ ++static int ++which(const char *n,char *o) { ++ ++ char *s; ++ ++ if (strchr(n,'/')) ++ return mbin(n,o); ++ ++ massert(snprintf(FN1,sizeof(FN1),"%s",getenv("PATH"))>1); ++ for (s=NULL;(s=strtok(s ? NULL : FN1,":"));) { ++ ++ massert(snprintf(FN2,sizeof(FN2),"%s/%s",s,n)); ++ if (mbin(FN2,o)) ++ return 1; ++ ++ } ++ ++ return 0; ++ ++} ++ ++ + + int + main(int argc, char **argv, char **envp) { + +-#ifdef GET_FULL_PATH_SELF + GET_FULL_PATH_SELF(kcl_self); +-#else +- kcl_self = argv[0]; +-#endif +- + *argv=kcl_self; +- ++ + #ifdef CAN_UNRANDOMIZE_SBRK + #include + #include diff --git a/patches/Version_2_6_13pre71 b/patches/Version_2_6_13pre71 new file mode 100644 index 00000000..f0013e6f --- /dev/null +++ b/patches/Version_2_6_13pre71 @@ -0,0 +1,59 @@ +Description: + 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-79) unstable; urgency=medium + . + * Version_2_6_13pre70 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-10-30 + +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -879,9 +879,9 @@ void hppa_save_regs(struct regs); + + asm(".code"); + asm(".export hppa_save_regs, entry"); ++ asm(".label hppa_save_regs"); + asm(".proc"); + asm(".callinfo"); +- asm(".label hppa_save_regs"); + asm(".entry"); + + asm("stw %r3,0(%arg0)"); +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -242,7 +242,7 @@ get_gc_environ(void) { + } + + gc_page_min=0.5; +- if ((e=getenv("GCL_GC_PAGE_MIN"))) { ++ if ((e=getenv("GCL_GC_PAGE_MIN"))||(e=getenv("GCL_GC_PAGE_THRESH"))) {/*legacy support*/ + massert(sscanf(e,"%lf",&gc_page_min)==1); + massert(gc_page_min>=0.0); + } +@@ -253,7 +253,8 @@ get_gc_environ(void) { + massert(gc_page_max>=0.0); + } + +- multiprocess_memory_pool=(e=getenv("GCL_MULTIPROCESS_MEMORY_POOL")) && *e; ++ multiprocess_memory_pool= ++ (e=getenv("GCL_MULTIPROCESS_MEMORY_POOL")) && (*e=='t' || *e=='T'); + + wait_on_abort=0; + if ((e=getenv("GCL_WAIT_ON_ABORT"))) diff --git a/patches/Version_2_6_13pre72 b/patches/Version_2_6_13pre72 new file mode 100644 index 00000000..136954bb --- /dev/null +++ b/patches/Version_2_6_13pre72 @@ -0,0 +1,103 @@ +Description: + 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-81) unstable; urgency=high + . + * Version_2_6_13pre72 + * Fix to ppc64el for acl2 FTBFS bug +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-01-21 + +--- gcl-2.6.12.orig/h/elf64_ppcle_reloc_special.h ++++ gcl-2.6.12/h/elf64_ppcle_reloc_special.h +@@ -1,12 +1,12 @@ + static Sym *toc; + +-/* static int tramp[]={0,0, */ +-/* (((0x3a<<10)|(0x9<<5)|0xc)<<16)|0xfff8,/\*ld r9,-8(r12)*\/ */ +-/* ((0x3a<<10)|(0x9<<5)|0x9)<<16, /\*ld r9,0(r9)*\/ */ +-/* 0x7d2c4b78, /\*mr r12,r9 *\/ */ +-/* 0x7d8903a6, /\*mtctr r12*\/ */ +-/* 0x4e800420 /\*bctrl*\/ */ +-/* }; */ ++static int tramp[]={0,0, ++ (((0x3a<<10)|(0x9<<5)|0xc)<<16)|0xfff8,/*ld r9,-8(r12)*/ ++ ((0x3a<<10)|(0x9<<5)|0x9)<<16, /*ld r9,0(r9)*/ ++ 0x7d2c4b78, /*mr r12,r9 */ ++ 0x7d8903a6, /*mtctr r12*/ ++ 0x4e800420 /*bctrl*/ ++}; + + static int + find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, +@@ -15,41 +15,29 @@ find_special_params(void *v,Shdr *sec1,S + Shdr *sec; + Rela *r; + void *ve; ++ ul *u,j; + + massert((sec=get_section(".rela.dyn",sec1,sece,sn))); + + v+=sec->sh_offset; + ve=v+sec->sh_size; + +- for (r=v;vsh_entsize,r=v) ++ for (j=0,r=v;vsh_entsize,r=v) + if (ELF_R_TYPE(r->r_info) && !ds1[ELF_R_SYM(r->r_info)].st_value) +- ds1[ELF_R_SYM(r->r_info)].st_value=*(ul *)r->r_offset; ++ j++; + +- return 0; +- +- +- /* massert((sec=get_section(".rel.dyn",sec1,sece,sn))|| */ +- /* (sec=get_section(".rela.dyn",sec1,sece,sn))); */ ++ massert(u=malloc(j*sizeof(tramp))); + +- /* v+=sec->sh_offset; */ +- /* ve=v+sec->sh_size; */ ++ v=ve-sec->sh_size; ++ for (r=v;vsh_entsize,r=v) ++ if (ELF_R_TYPE(r->r_info) && !ds1[ELF_R_SYM(r->r_info)].st_value) { ++ memcpy(u,tramp,sizeof(tramp)); ++ *u++=r->r_offset; ++ ds1[ELF_R_SYM(r->r_info)].st_value=(ul)u; ++ u=((void *)(u-1)+sizeof(tramp)); ++ } + +- /* for (j=0,r=v;vsh_entsize,r=v) */ +- /* if (ELF_R_TYPE(r->r_info) && !ds1[ELF_R_SYM(r->r_info)].st_value) */ +- /* j++; */ +- +- /* massert(u=malloc(j*sizeof(tramp))); */ +- +- /* v=ve-sec->sh_size; */ +- /* for (r=v;vsh_entsize,r=v) */ +- /* if (ELF_R_TYPE(r->r_info) && !ds1[ELF_R_SYM(r->r_info)].st_value) { */ +- /* memcpy(u,tramp,sizeof(tramp)); */ +- /* *u++=r->r_offset; */ +- /* ds1[ELF_R_SYM(r->r_info)].st_value=(ul)u; */ +- /* u=((void *)(u-1)+sizeof(tramp)); */ +- /* } */ +- +- /* return 0; */ ++ return 0; + + } + diff --git a/patches/Version_2_6_13pre73 b/patches/Version_2_6_13pre73 new file mode 100644 index 00000000..c64ecc45 --- /dev/null +++ b/patches/Version_2_6_13pre73 @@ -0,0 +1,130 @@ +Description: + 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-81) unstable; urgency=high + . + * Version_2_6_13pre72 + * Fix to ppc64el for acl2 FTBFS bug +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-02-02 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4181,7 +4181,7 @@ case $use in + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 + ;; + arm*) +- assert_arg_to_cflags -mlong-calls ++# assert_arg_to_cflags -mlong-calls + assert_arg_to_cflags -fdollars-in-identifiers + assert_arg_to_cflags -g #? + ;; +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -388,7 +388,7 @@ case $use in + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 + ;; + arm*) +- assert_arg_to_cflags -mlong-calls ++# assert_arg_to_cflags -mlong-calls + assert_arg_to_cflags -fdollars-in-identifiers + assert_arg_to_cflags -g #? + ;; +--- gcl-2.6.12.orig/h/arm-linux.h ++++ gcl-2.6.12/h/arm-linux.h +@@ -12,5 +12,6 @@ + #define SGC + + #define RELOC_H "elf32_arm_reloc.h" ++#define SPECIAL_RELOC_H "elf32_arm_reloc_special.h" + + #define NEED_STACK_CHK_GUARD +--- gcl-2.6.12.orig/h/elf32_arm_reloc.h ++++ gcl-2.6.12/h/elf32_arm_reloc.h +@@ -53,11 +53,21 @@ + break; + case R_ARM_CALL: + case R_ARM_JUMP24: +- add_vals(where,MASK(24),((long)(s+a-p))>>2); ++ massert(!a); ++ { ++ long x=((long)(s-p))/4; ++ if (abs(x)&(~MASK(23))) { ++ got+=(sym->st_size-1)*tz; ++ memcpy(got,tramp,sizeof(tramp)); ++ got[sizeof(tramp)/sizeof(*got)]=s; ++ x=((long)got-p)/4; ++ } ++ add_vals(where,MASK(24),x); ++ } + break; + case R_ARM_ABS32: +- add_val(where,~0L,s+a); ++ add_vals(where,~0L,s+a); + break; + case R_ARM_V4BX: +- add_val(where,~0L,s+a); ++ add_vals(where,~0L,s+a); + break; +--- /dev/null ++++ gcl-2.6.12/h/elf32_arm_reloc_special.h +@@ -0,0 +1,43 @@ ++/* #define R_AARCH64_TRAMP 1 */ ++static int tramp[]={0xe59fc000, /*ldr r12, [pc]*/ /*FIXME? Can this refer to an earlier address?*/ ++ 0xe12fff1c}; /*br r12*/ ++static ul tz=1+sizeof(tramp)/sizeof(ul); ++ ++ ++static int ++find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, ++ const char *st1,Sym *ds1,Sym *dse,Sym *sym,Sym *syme) { ++ ++ return 0; ++ ++} ++ ++static int ++label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,const char *sn,ul *gs) { ++ ++ Rel *r; ++ Sym *sym; ++ Shdr *sec; ++ void *v,*ve; ++ ++ for (sym=sym1;symst_size=0; ++ ++ for (*gs=0,sec=sec1;secsh_type==SHT_REL) ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++ if (ELF_R_TYPE(r->r_info)==R_ARM_CALL || ++ ELF_R_TYPE(r->r_info)==R_ARM_JUMP24) { ++ ++ sym=sym1+ELF_R_SYM(r->r_info); ++ ++ if (!sym->st_size) ++ sym->st_size=++*gs; ++ ++ } ++ ++ (*gs)*=tz; ++ ++ return 0; ++ ++} diff --git a/patches/Version_2_6_13pre74 b/patches/Version_2_6_13pre74 new file mode 100644 index 00000000..e8e364fb --- /dev/null +++ b/patches/Version_2_6_13pre74 @@ -0,0 +1,47 @@ +Description: + 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-82) unstable; urgency=high + . + * Version_2_6_13pre73 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-02-02 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4122,7 +4122,7 @@ $as_echo_n "checking working gprof... " + sh4*) enableval="no";; + ia64*) enableval="no";; + hppa*) enableval="no";; +- arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++# arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible + aarch64*) enableval="no";;#unreproducible buildd bug 20170824 + *gnu) enableval="no";; + esac +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -335,7 +335,7 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof + sh4*) enableval="no";; + ia64*) enableval="no";; + hppa*) enableval="no";; +- arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++# arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible + aarch64*) enableval="no";;#unreproducible buildd bug 20170824 + *gnu) enableval="no";; + esac diff --git a/patches/Version_2_6_13pre76 b/patches/Version_2_6_13pre76 new file mode 100644 index 00000000..bac042b4 --- /dev/null +++ b/patches/Version_2_6_13pre76 @@ -0,0 +1,446 @@ +Description: + 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-83) unstable; urgency=high + . + * Version_2_6_13pre75 + * FIx acl2 arm builds (Closes: #919477). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/919477 + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-02-05 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -2679,6 +2679,7 @@ case $canonical in + mipsel*linux*) use=mipsel-linux;; + sparc*linux*) use=sparc-linux;; + aarch64*linux*) use=aarch64-linux;; ++ arm*linux*hf) use=armhf-linux;; + arm*linux*) use=arm-linux;; + s390*linux*) use=s390-linux;; + ia64*linux*) use=ia64-linux;; +@@ -4122,11 +4123,12 @@ $as_echo_n "checking working gprof... " + sh4*) enableval="no";; + ia64*) enableval="no";; + hppa*) enableval="no";; +-# arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++# arm*) if echo $canonical |grep -q hf$; then enableval="no"; fi;;#FIXME CALL and JUMP24 veneers needed for thumb 20190201 #FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible + aarch64*) enableval="no";;#unreproducible buildd bug 20170824 + *gnu) enableval="no";; + esac +- if test "$enableval" != "yes" ; then ++ GP_FLAG="" ++ if test "$enableval" != "yes" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: disabled" >&5 + $as_echo "disabled" >&6; } + else +@@ -4134,7 +4136,8 @@ $as_echo "disabled" >&6; } + $as_echo "ok" >&6; } + OLD_CFLAGS=$CFLAGS # Do not run configure tests with -pg + assert_arg_to_cflags -pg +- CFLAGS=$OLD_CFLAGS ++ GP_FLAG="-pg" ++ CFLAGS=$OLD_CFLAGS + TFPFLAG="" + + $as_echo "#define GCL_GPROF 1" >>confdefs.h +@@ -4180,8 +4183,11 @@ case $use in + ia64*) + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 + ;; ++ armhf*) ++ assert_arg_to_cflags -fdollars-in-identifiers ++ assert_arg_to_cflags -g #? ++ ;; + arm*) +-# assert_arg_to_cflags -mlong-calls + assert_arg_to_cflags -fdollars-in-identifiers + assert_arg_to_cflags -g #? + ;; +@@ -9051,6 +9057,7 @@ LDFLAGS="`echo $LDFLAGS | sed 's,gcl.scr + + LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $LIBS $TLIBS" + ++CFLAGS="$CFLAGS $GP_FLAG" + FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS" + + # Work around bug with gcc on ppc -- CM +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -37,6 +37,7 @@ case $canonical in + mipsel*linux*) use=mipsel-linux;; + sparc*linux*) use=sparc-linux;; + aarch64*linux*) use=aarch64-linux;; ++ arm*linux*hf) use=armhf-linux;; + arm*linux*) use=arm-linux;; + s390*linux*) use=s390-linux;; + ia64*linux*) use=ia64-linux;; +@@ -335,17 +336,19 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof + sh4*) enableval="no";; + ia64*) enableval="no";; + hppa*) enableval="no";; +-# arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++# arm*) if echo $canonical |grep -q hf$; then enableval="no"; fi;;#FIXME CALL and JUMP24 veneers needed for thumb 20190201 #FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible + aarch64*) enableval="no";;#unreproducible buildd bug 20170824 + *gnu) enableval="no";; + esac +- if test "$enableval" != "yes" ; then ++ GP_FLAG="" ++ if test "$enableval" != "yes" ; then + AC_MSG_RESULT([disabled]) + else + AC_MSG_RESULT([ok]) + OLD_CFLAGS=$CFLAGS # Do not run configure tests with -pg + assert_arg_to_cflags -pg +- CFLAGS=$OLD_CFLAGS ++ GP_FLAG="-pg" ++ CFLAGS=$OLD_CFLAGS + TFPFLAG="" + AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) + fi +@@ -387,8 +390,11 @@ case $use in + ia64*) + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 + ;; ++ armhf*) ++ assert_arg_to_cflags -fdollars-in-identifiers ++ assert_arg_to_cflags -g #? ++ ;; + arm*) +-# assert_arg_to_cflags -mlong-calls + assert_arg_to_cflags -fdollars-in-identifiers + assert_arg_to_cflags -g #? + ;; +@@ -2108,6 +2114,7 @@ LDFLAGS="`echo $LDFLAGS | sed 's,gcl.scr + AC_SUBST(LDFLAGS) + LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $LIBS $TLIBS" + AC_SUBST(LIBS) ++CFLAGS="$CFLAGS $GP_FLAG" + FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS" + AC_SUBST(FINAL_CFLAGS) + # Work around bug with gcc on ppc -- CM +--- /dev/null ++++ gcl-2.6.12/h/armhf-linux.h +@@ -0,0 +1,17 @@ ++#include "linux.h" ++ ++#ifdef IN_GBC ++#undef MPROTECT_ACTION_FLAGS ++#define MPROTECT_ACTION_FLAGS SA_RESTART|SA_SIGINFO ++#define GET_FAULT_ADDR(sig,code,sv,a) \ ++ ((siginfo_t *)code)->si_addr ++/* #define GET_FAULT_ADDR(sig,code,sv,a) \ */ ++/* ((void *)(*((char ***)(&code)))[44]) */ ++#endif ++ ++#define SGC ++ ++#define RELOC_H "elf32_armhf_reloc.h" ++#define SPECIAL_RELOC_H "elf32_armhf_reloc_special.h" ++ ++#define NEED_STACK_CHK_GUARD +--- gcl-2.6.12.orig/h/elf32_arm_reloc.h ++++ gcl-2.6.12/h/elf32_arm_reloc.h +@@ -1,44 +1,7 @@ +-#define R_ARM_THM_CALL 10 +-#define R_ARM_CALL 28 +-#define R_ARM_V4BX 40 +-#define R_ARM_THM_MOVW_ABS_NC 47 +-#define R_ARM_THM_MOVW_ABS 48 + #define R_ARM_MOVW_ABS_NC 43 + #define R_ARM_MOVT_ABS 44 +- case R_ARM_THM_JUMP24: +- s+=a; +- if (ELF_ST_TYPE(sym->st_info)==STT_FUNC) s|=1; +- s-=p+4; /*FIXME maybe drop 4 and add_val below*/ +- s=((long)s>>1); +- massert(!(abs(s)&0xff000000)); +- store_val(where,MASK(11)<<16,(s&0x7ff)<<16); +- store_val(where,MASK(10),s>>11); +- store_val(where,MASK(1)<<(16+11),(~((s>>21&0x1)^(s>>23&0x1)))<<(16+11)); +- store_val(where,MASK(1)<<(16+13),(~((s>>22&0x1)^(s>>23&0x1)))<<(16+13)); +- store_val(where,MASK(1)<<10,(s>>23&0x1)<<10); +- break; +- case R_ARM_THM_CALL: +- s+=a; +- if (ELF_ST_TYPE(sym->st_info)==STT_FUNC) s|=1; +- s-=p+4; /*FIXME maybe drop 4 and add_val below*/ +- s=((long)s>>1); +- massert(!(abs(s)&0xffc00000)); +- store_val(where,MASK(11),s>>11); +- store_val(where,MASK(11)<<16,(s&0x7ff)<<16); +- break; +- case R_ARM_THM_MOVW_ABS_NC: +- s+=a; +- if (ELF_ST_TYPE(sym->st_info)==STT_FUNC) s|=1; +- s&=0xffff; +- s=((s>>12)&0xf)|(((s>>11)&0x1)<<10)|((s&0xff)<<16)|(((s>>8)&0x7)<<28); +- add_vals(where,~0L,s); +- break; +- case R_ARM_THM_MOVW_ABS: +- s+=a; +- s>>=16; +- s=((s>>12)&0xf)|(((s>>11)&0x1)<<10)|((s&0xff)<<16)|(((s>>8)&0x7)<<28); +- add_vals(where,~0L,s); +- break; ++#define R_ARM_CALL 28 ++#define R_ARM_V4BX 40 + case R_ARM_MOVW_ABS_NC: + s+=a; + s&=0xffff; +@@ -53,21 +16,21 @@ + break; + case R_ARM_CALL: + case R_ARM_JUMP24: +- massert(!a); + { +- long x=((long)(s-p))/4; +- if (abs(x)&(~MASK(23))) { ++ long x=((long)(s+a-p))/4; ++ if (abs(x)&(~MASK(23))) {/*24?*/ + got+=(sym->st_size-1)*tz; + memcpy(got,tramp,sizeof(tramp)); ++ /*relocate*/ + got[sizeof(tramp)/sizeof(*got)]=s; + x=((long)got-p)/4; + } + add_vals(where,MASK(24),x); + } + break; +- case R_ARM_ABS32: ++ case R_ARM_V4BX: + add_vals(where,~0L,s+a); + break; +- case R_ARM_V4BX: ++ case R_ARM_ABS32: + add_vals(where,~0L,s+a); + break; +--- gcl-2.6.12.orig/h/elf32_arm_reloc_special.h ++++ gcl-2.6.12/h/elf32_arm_reloc_special.h +@@ -1,9 +1,7 @@ +-/* #define R_AARCH64_TRAMP 1 */ +-static int tramp[]={0xe59fc000, /*ldr r12, [pc]*/ /*FIXME? Can this refer to an earlier address?*/ +- 0xe12fff1c}; /*br r12*/ ++static int tramp[]={0xe59fc000, /*ldr r12, [pc]*/ /*FIXME? Can this refer to an earlier address?*/ ++ 0xe12fff1c}; /*br r12*/ + static ul tz=1+sizeof(tramp)/sizeof(ul); + +- + static int + find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, + const char *st1,Sym *ds1,Sym *dse,Sym *sym,Sym *syme) { +@@ -26,8 +24,10 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + for (*gs=0,sec=sec1;secsh_type==SHT_REL) + for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) +- if (ELF_R_TYPE(r->r_info)==R_ARM_CALL || +- ELF_R_TYPE(r->r_info)==R_ARM_JUMP24) { ++ if ( ++ ELF_R_TYPE(r->r_info)==R_ARM_CALL || ++ ELF_R_TYPE(r->r_info)==R_ARM_JUMP24 ++ ) { + + sym=sym1+ELF_R_SYM(r->r_info); + +--- /dev/null ++++ gcl-2.6.12/h/elf32_armhf_reloc.h +@@ -0,0 +1,71 @@ ++#define R_ARM_THM_CALL 10 ++#define R_ARM_THM_MOVW_ABS_NC 47 ++#define R_ARM_THM_MOVW_ABS 48 ++ case R_ARM_THM_JUMP24: ++ { ++ long x=(long)(s+a-p); ++ if (1||abs(x)&(~MASK(25))) { ++ ++ got+=(sym->st_size-1)*tz; ++ memcpy(got,tramp,sizeof(tramp)); ++ ++ r->r_offset=(void *)got-(void *)start; ++ r->r_info=ELF_R_INFO(ELF_R_SYM(r->r_info),R_ARM_THM_MOVW_ABS_NC); ++ relocate(sym1,r,0,start,got,gote); ++ ++ r->r_offset=(void *)(got+1)-(void *)start; ++ r->r_info=ELF_R_INFO(ELF_R_SYM(r->r_info),R_ARM_THM_MOVW_ABS); ++ relocate(sym1,r,0,start,got,gote); ++ ++ x=((long)got-p); ++ } ++ if (ELF_ST_TYPE(sym->st_info)==STT_FUNC) x|=1; ++ x-=4; /*FIXME maybe drop 4 and add_val below*/ ++ x=((long)x>>1); ++ store_val(where,MASK(11)<<16,(x&0x7ff)<<16); ++ store_val(where,MASK(10),x>>11); ++ store_val(where,MASK(1)<<(16+11),(~((x>>21&0x1)^(x>>23&0x1)))<<(16+11)); ++ store_val(where,MASK(1)<<(16+13),(~((x>>22&0x1)^(x>>23&0x1)))<<(16+13)); ++ store_val(where,MASK(1)<<10,(x>>23&0x1)<<10); ++ } ++ break; ++ case R_ARM_THM_CALL: ++ { ++ long x=(long)(s+a-p); ++ if (1||abs(x)&(~MASK(23))) {/*24?*/ ++ got+=(sym->st_size-1)*tz; ++ memcpy(got,tramp,sizeof(tramp)); ++ ++ r->r_offset=(void *)got-(void *)start; ++ r->r_info=ELF_R_INFO(ELF_R_SYM(r->r_info),R_ARM_THM_MOVW_ABS_NC); ++ relocate(sym1,r,0,start,got,gote); ++ ++ r->r_offset=(void *)(got+1)-(void *)start; ++ r->r_info=ELF_R_INFO(ELF_R_SYM(r->r_info),R_ARM_THM_MOVW_ABS); ++ relocate(sym1,r,0,start,got,gote); ++ ++ x=((long)got-p); ++ } ++ if (ELF_ST_TYPE(sym->st_info)==STT_FUNC) x|=1; ++ x-=4; /*FIXME maybe drop 4 and add_val below*/ ++ x=((long)x>>1); ++ store_val(where,MASK(11),x>>11); ++ store_val(where,MASK(11)<<16,(x&0x7ff)<<16); ++ } ++ break; ++ case R_ARM_THM_MOVW_ABS_NC: ++ s+=a; ++ if (ELF_ST_TYPE(sym->st_info)==STT_FUNC) s|=1; ++ s&=0xffff; ++ s=((s>>12)&0xf)|(((s>>11)&0x1)<<10)|((s&0xff)<<16)|(((s>>8)&0x7)<<28); ++ add_vals(where,~0L,s); ++ break; ++ case R_ARM_THM_MOVW_ABS: ++ s+=a; ++ s>>=16; ++ s=((s>>12)&0xf)|(((s>>11)&0x1)<<10)|((s&0xff)<<16)|(((s>>8)&0x7)<<28); ++ add_vals(where,~0L,s); ++ break; ++ case R_ARM_ABS32: ++ add_vals(where,~0L,s+a); ++ break; +--- /dev/null ++++ gcl-2.6.12/h/elf32_armhf_reloc_special.h +@@ -0,0 +1,85 @@ ++static int tramp[]={0x0c00f240, /*movw r12, #0*/ ++ 0x0c00f2c0, /*movt r12, #0*/ ++ 0xbf004760}; /*bx r12 nop*/ ++static ul tz=sizeof(tramp)/sizeof(ul); ++ ++static ul * ++next_plt_entry(ul *p,ul *pe) { ++ ++ ul l0=0xe5bef000,/*ldr pc,[ip,#]*/ ++ l1=0xe5bcf000;/*ldr pc,[lr,#]*/ ++ ++ for (;psh_addr; ++ pe=(void *)p+psec->sh_size; ++ ++ massert((sec=get_section( ".rel.plt",sec1,sece,sn)) || ++ (sec=get_section(".rela.plt",sec1,sece,sn))); ++ ++ v+=sec->sh_offset; ++ ve=v+sec->sh_size; ++ ++ p=next_plt_entry(p,pe);/*plt0*/ ++ ++ for (r=v;vsh_entsize,r=v,p=next_plt_entry(p,pe)) { ++ if (!ds1[ELF_R_SYM(r->r_info)].st_value) ++ ds1[ELF_R_SYM(r->r_info)].st_value=(ul)p; ++ } ++ ++ massert(p==pe); ++ massert(v==ve); ++ ++ return 0; ++ ++} ++ ++static int ++label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,const char *sn,ul *gs) { ++ ++ Rel *r; ++ Sym *sym; ++ Shdr *sec; ++ void *v,*ve; ++ ++ for (sym=sym1;symst_size=0; ++ ++ for (*gs=0,sec=sec1;secsh_type==SHT_REL) ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++ if ( ++#define R_ARM_THM_CALL 10 ++ ELF_R_TYPE(r->r_info)==R_ARM_THM_CALL || ++ ELF_R_TYPE(r->r_info)==R_ARM_THM_JUMP24 ++ ) { ++ ++ sym=sym1+ELF_R_SYM(r->r_info); ++ ++ if (!sym->st_size) ++ sym->st_size=++*gs; ++ ++ } ++ ++ (*gs)*=tz; ++ ++ return 0; ++ ++} +--- gcl-2.6.12.orig/makedefc.in ++++ gcl-2.6.12/makedefc.in +@@ -6,10 +6,6 @@ + # for main link of raw_gcl + LIBS=@LIBS@ + +-#The multi precision library stuff +-MPFILES=$(MPDIR)/@MPI_FILE@ $(MPDIR)/libmport.a +- +- + # root for the installation, eg /usr/local + # This would cause make install to create /usr/local/bin/gcl and + # /usr/local/lib/gcl-2-??/* with some basic files. +--- gcl-2.6.12.orig/o/unexelf.c ++++ gcl-2.6.12/o/unexelf.c +@@ -887,7 +887,7 @@ unexec (char *new_name, char *old_name, + + /* Walk through all section headers, insert the new data2 section right + before the new bss section. */ +- for (n = 1, nn = 1; n < (int) old_file_h->e_shnum; n++, nn++) ++ for (n = 0, nn = 0; n < (int) old_file_h->e_shnum; n++, nn++) + { + caddr_t src; + /* If it is (s)bss section, insert the new data2 section before it. */ diff --git a/patches/Version_2_6_13pre77 b/patches/Version_2_6_13pre77 new file mode 100644 index 00000000..42293a88 --- /dev/null +++ b/patches/Version_2_6_13pre77 @@ -0,0 +1,71 @@ +Description: + 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-83) unstable; urgency=high + . + * Version_2_6_13pre76 + * FIx acl2 arm builds (Closes: #919477). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/919477 + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-02-05 + +--- gcl-2.6.12.orig/h/elf32_arm_reloc.h ++++ gcl-2.6.12/h/elf32_arm_reloc.h +@@ -18,10 +18,10 @@ + case R_ARM_JUMP24: + { + long x=((long)(s+a-p))/4; +- if (abs(x)&(~MASK(23))) {/*24?*/ ++ if (abs(x)&(~MASK(24))) { + got+=(sym->st_size-1)*tz; + memcpy(got,tramp,sizeof(tramp)); +- /*relocate*/ ++ /*recurse on relocate?*/ + got[sizeof(tramp)/sizeof(*got)]=s; + x=((long)got-p)/4; + } +@@ -29,8 +29,6 @@ + } + break; + case R_ARM_V4BX: +- add_vals(where,~0L,s+a); +- break; + case R_ARM_ABS32: + add_vals(where,~0L,s+a); + break; +--- gcl-2.6.12.orig/h/elf32_armhf_reloc.h ++++ gcl-2.6.12/h/elf32_armhf_reloc.h +@@ -4,7 +4,7 @@ + case R_ARM_THM_JUMP24: + { + long x=(long)(s+a-p); +- if (1||abs(x)&(~MASK(25))) { ++ if (abs(x)&(~MASK(24))) { + + got+=(sym->st_size-1)*tz; + memcpy(got,tramp,sizeof(tramp)); +@@ -32,7 +32,7 @@ + case R_ARM_THM_CALL: + { + long x=(long)(s+a-p); +- if (1||abs(x)&(~MASK(23))) {/*24?*/ ++ if (abs(x)&(~MASK(23))) { + got+=(sym->st_size-1)*tz; + memcpy(got,tramp,sizeof(tramp)); + diff --git a/patches/Version_2_6_13pre78 b/patches/Version_2_6_13pre78 new file mode 100644 index 00000000..85136467 --- /dev/null +++ b/patches/Version_2_6_13pre78 @@ -0,0 +1,38 @@ +Description: + 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-83) unstable; urgency=high + . + * Version_2_6_13pre77 + * FIx acl2 arm builds (Closes: #919477). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/919477 + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-02-05 + +--- gcl-2.6.12.orig/h/elf32_arm_reloc.h ++++ gcl-2.6.12/h/elf32_arm_reloc.h +@@ -18,7 +18,7 @@ + case R_ARM_JUMP24: + { + long x=((long)(s+a-p))/4; +- if (abs(x)&(~MASK(24))) { ++ if (abs(x)&(~MASK(23))) { + got+=(sym->st_size-1)*tz; + memcpy(got,tramp,sizeof(tramp)); + /*recurse on relocate?*/ diff --git a/patches/Version_2_6_13pre79 b/patches/Version_2_6_13pre79 new file mode 100644 index 00000000..6105d421 --- /dev/null +++ b/patches/Version_2_6_13pre79 @@ -0,0 +1,47 @@ +Description: + 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-83) unstable; urgency=high + . + * Version_2_6_13pre78 + * FIx acl2 arm builds (Closes: #919477). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/919477 + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-02-06 + +--- gcl-2.6.12.orig/h/elf32_armhf_reloc.h ++++ gcl-2.6.12/h/elf32_armhf_reloc.h +@@ -4,7 +4,7 @@ + case R_ARM_THM_JUMP24: + { + long x=(long)(s+a-p); +- if (abs(x)&(~MASK(24))) { ++ if (abs(x)&(~MASK(23))) { + + got+=(sym->st_size-1)*tz; + memcpy(got,tramp,sizeof(tramp)); +@@ -32,7 +32,7 @@ + case R_ARM_THM_CALL: + { + long x=(long)(s+a-p); +- if (abs(x)&(~MASK(23))) { ++ if (abs(x)&(~MASK(22))) { + got+=(sym->st_size-1)*tz; + memcpy(got,tramp,sizeof(tramp)); + diff --git a/patches/Version_2_6_13pre80 b/patches/Version_2_6_13pre80 new file mode 100644 index 00000000..ad89d0de --- /dev/null +++ b/patches/Version_2_6_13pre80 @@ -0,0 +1,111 @@ +Description: + 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-83) unstable; urgency=high + . + * Version_2_6_13pre79 + * Fix acl2 arm builds (Closes: #919477). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/919477 + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-03-21 + +--- gcl-2.6.12.orig/h/notcomp.h ++++ gcl-2.6.12/h/notcomp.h +@@ -175,7 +175,7 @@ TS_MEMBER(t0,TS(t1)|TS(t2)|TS(t3)...) + #define TS(s) (1<tm_npage)); +- CEerror("The storage for ~A is exhausted.~%\ +-Currently, ~D pages are allocated.~% \ +-Use ALLOCATE to expand the space.", +- "Continues execution.", +- 2, vs_top[-2], vs_top[-1], Cnil, Cnil); +- +- vs_popp; +- vs_popp; ++ CEerror("Continues execution.", ++ "The storage for ~A is exhausted. ~D pages allocated. Use ALLOCATE to expand the space.", ++ 2, type_name(t), make_fixnum(tm->tm_npage)); + + call_after_gbc_hook(t); + +--- gcl-2.6.12.orig/o/array.c ++++ gcl-2.6.12/o/array.c +@@ -211,14 +211,18 @@ DEFUN_NEW("ASET1", object, fSaset1, SI, + break; + case aet_bit: + i += BV_OFFSET(x); +- AGAIN_BIT: + ASSURE_TYPE(val,t_fixnum); +- {int v = Mfix(val); +- if (v == 0) CLEAR_BITREF(x,i); +- else if (v == 1) SET_BITREF(x,i); +- else {val= fSincorrect_type(val,sLbit); +- goto AGAIN_BIT;} +- break;} ++ switch (Mfix(val)) { ++ case 0: ++ CLEAR_BITREF(x,i); ++ break; ++ case 1: ++ SET_BITREF(x,i); ++ break; ++ default: ++ TYPE_ERROR(val,sLbit); ++ } ++ break; + case aet_fix: + ASSURE_TYPE(val,t_fixnum); + (x->fixa.fixa_self[i]) = Mfix(val); +--- gcl-2.6.12.orig/o/utils.c ++++ gcl-2.6.12/o/utils.c +@@ -169,20 +169,6 @@ Ifuncall_n(object fun,int n,...) { + /* return res; */ + /* } */ + +-object +-Icheck_one_type(object x, enum type t) +-{ if (x->d.t != t) +- { return CEerror("Expected a ~a ","Supply right type",1,type_name(t),Cnil,Cnil,Cnil); +- } +- return x; +-} +- +- +-object +-fSincorrect_type(object val, object type) +-{ return CEerror("Got ~a,Expected a ~a","Supply a new one",1,val,type,Cnil,Cnil); +-} +- + /* static void */ + /* Ineed_in_image(object (*foo) (/\* ??? *\/)) */ + /* {;} */ diff --git a/patches/Version_2_6_13pre81 b/patches/Version_2_6_13pre81 new file mode 100644 index 00000000..63f2a285 --- /dev/null +++ b/patches/Version_2_6_13pre81 @@ -0,0 +1,71 @@ +Description: + 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-84) unstable; urgency=medium + . + * Version_2_6_13pre80 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-03-28 + +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -329,7 +329,7 @@ empty_relblock(void) { + void + setup_rb(bool preserve_rb_pointerp) { + +- int lowp=new_rb_start!=rb_start || rb_high(); ++ int lowp=rb_high(); + + update_pool(2*(nrbpage-page(rb_size()))); + rb_start=new_rb_start; +@@ -349,10 +349,13 @@ resize_hole(ufixnum hp,enum type tp,bool + char *start=rb_begin(),*new_start=heap_end+hp*PAGESIZE; + ufixnum size=rb_pointer-start; + +- if (!in_placep && +- ((new_start<=start && startrb_end : ++ new_start+(nrbpage<s.s_dbind != Cnil) +- emsg("Toggling relblock when resizing hole to %lu\n",hp); ++ emsg("[GC Toggling relblock when resizing hole to %lu]\n",hp); + tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + return resize_hole(hp,tp,in_placep); +@@ -389,7 +392,7 @@ alloc_page(long n) { + d=(available_pages/3)s.s_dbind != Cnil) +- emsg("Hole overrun\n"); ++ emsg("[GC Hole overrun]\n"); + + resize_hole(d+nn,t_relocatable,0); + +@@ -852,7 +855,7 @@ add_pages(struct typemanager *tm,fixnum + + if (rb_high() && m>((rb_start-heap_end)>>PAGEWIDTH)) { + if (sSAnotify_gbcA->s.s_dbind != Cnil) +- emsg("Moving relblock low before expanding relblock pages\n"); ++ emsg("[GC Moving relblock low before expanding relblock pages]\n"); + tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + } diff --git a/patches/Version_2_6_13pre82 b/patches/Version_2_6_13pre82 new file mode 100644 index 00000000..17a9f6f6 --- /dev/null +++ b/patches/Version_2_6_13pre82 @@ -0,0 +1,40 @@ +Description: + 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-85) unstable; urgency=medium + . + * Version_2_6_13pre81 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-03-28 + +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -349,9 +349,10 @@ resize_hole(ufixnum hp,enum type tp,bool + char *start=rb_begin(),*new_start=heap_end+hp*PAGESIZE; + ufixnum size=rb_pointer-start; + ++#define OVERLAP(c_,t_,s_) ((t_)<(c_)+(s_) && (c_)<(t_)+(s_)) + if (!in_placep && (rb_high() ? +- new_start+size>rb_end : +- new_start+(nrbpage<s.s_dbind != Cnil) diff --git a/patches/Version_2_6_13pre83 b/patches/Version_2_6_13pre83 new file mode 100644 index 00000000..585f44fc --- /dev/null +++ b/patches/Version_2_6_13pre83 @@ -0,0 +1,446 @@ +Description: + 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-85) unstable; urgency=medium + . + * Version_2_6_13pre82 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-04-02 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -6375,7 +6375,7 @@ main () + FILE *f; + if (!(f=fopen("conftest1","w"))) + return -1; +- fprintf(f,"%u",sbrk(0)); ++ fprintf(f,"%p",sbrk(0)); + + ; + return 0; +@@ -6591,7 +6591,7 @@ else + #endif + if (!(f=fopen("conftest1","w"))) + return -1; +- fprintf(f,"%u",sbrk(0)); ++ fprintf(f,"%p",sbrk(0)); + return 0; + } + +@@ -6625,7 +6625,7 @@ else + #include "h/unrandomize.h" + #endif + if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%u",sbrk(0)); ++ fprintf(f,"%p",sbrk(0)); + return 0; + } + +@@ -6653,8 +6653,9 @@ $as_echo "no" >&6; } + as_fn_error $? "exiting" "$LINENO" 5 + fi + fi +-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking CSTACK_ADDRESS" >&5 +-$as_echo_n "checking CSTACK_ADDRESS... " >&6; } ++ ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking CSTACK_DIRECTION" >&5 ++$as_echo_n "checking CSTACK_DIRECTION... " >&6; } + if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 + $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +@@ -6666,14 +6667,61 @@ else + + #include + #include +- void * +- foo() { ++ ++ unsigned long w; ++ ++ void ++ foo(void) { + int i; +- return (void *)&i; ++ w=(unsigned long)&i; + } + + int + main(int argc,char **argv,char **envp) { ++ void *b; ++ FILE *fp = fopen("conftest1","w"); ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ foo(); ++ fprintf(fp,"%d",((unsigned long) &b) > w ? -1 : 1); ++ fclose(fp); ++ return 0; ++ } ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ cstack_direction=`cat conftest1` ++else ++ cstack_direction=0 ++fi ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++fi ++ ++ ++cat >>confdefs.h <<_ACEOF ++#define CSTACK_DIRECTION $cstack_direction ++_ACEOF ++ ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cstack_direction" >&5 ++$as_echo "$cstack_direction" >&6; } ++ ++ ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking CSTACK_ADDRESS" >&5 ++$as_echo_n "checking CSTACK_ADDRESS... " >&6; } ++if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "cannot run test program while cross compiling ++See \`config.log' for more details" "$LINENO" 5; } ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++ ++ #include ++ #include ++ int ++ main(int argc,char **argv,char **envp) { + void *v ; + FILE *fp = fopen("conftest1","w"); + unsigned long i,j; +@@ -6685,13 +6733,13 @@ else + j<<=$PAGEWIDTH; + j<<=16; + i=(unsigned long)&v; +- if (foo()>i) i-=j; +- j--; +- i+=j; +- i&=~j; +- fprintf(fp,"0x%lx",i-1); +- fclose(fp); +- return 0; ++ if ($cstack_direction==1) i-=j; ++ j--; ++ i+=j; ++ i&=~j; ++ fprintf(fp,"0x%lx",i-1); ++ fclose(fp); ++ return 0; + } + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : +@@ -6724,12 +6772,6 @@ else + + #include + #include +- void * +- foo() { +- int i; +- return (void *)&i; +- } +- + int + main(int argc,char **argv,char **envp) { + void *v ; +@@ -6743,14 +6785,14 @@ else + j<<=$PAGEWIDTH; + j<<=16; + i=(unsigned long)&v; +- if (foo()>i) i-=j; +- j--; +- i+=j; +- i&=~j; +- for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); +- fprintf(fp,"%d",j); +- fclose(fp); +- return 0; ++ if ($cstack_direction==1) i-=j; ++ j--; ++ i+=j; ++ i&=~j; ++ for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); ++ fprintf(fp,"%ld",j); ++ fclose(fp); ++ return 0; + } + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : +@@ -6854,54 +6896,6 @@ _ACEOF + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $cstack_alignment" >&5 + $as_echo "$cstack_alignment" >&6; } + +-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking CSTACK_DIRECTION" >&5 +-$as_echo_n "checking CSTACK_DIRECTION... " >&6; } +-if test "$cross_compiling" = yes; then : +- { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +-as_fn_error $? "cannot run test program while cross compiling +-See \`config.log' for more details" "$LINENO" 5; } +-else +- cat confdefs.h - <<_ACEOF >conftest.$ac_ext +-/* end confdefs.h. */ +- +- #include +- #include +- void * +- foo(void) { +- int i; +- return (void *)&i; +- } +- +- int +- main(int argc,char **argv,char **envp) { +- char *b; +- FILE *fp = fopen("conftest1","w"); +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- fprintf(fp,"%d",((long) &b) > ((long) foo()) ? -1 : 1); +- fclose(fp); +- return 0; +- } +-_ACEOF +-if ac_fn_c_try_run "$LINENO"; then : +- cstack_direction=`cat conftest1` +-else +- cstack_direction=0 +-fi +-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ +- conftest.$ac_objext conftest.beam conftest.$ac_ext +-fi +- +- +-cat >>confdefs.h <<_ACEOF +-#define CSTACK_DIRECTION $cstack_direction +-_ACEOF +- +-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cstack_direction" >&5 +-$as_echo "$cstack_direction" >&6; } +- + # Check whether --enable-immfix was given. + if test "${enable_immfix+set}" = set; then : + enableval=$enable_immfix; +@@ -7050,8 +7044,7 @@ int + main () + { + +- void *v; +- unsigned long i,j,k,l,m; ++ unsigned long i,j,k,l; + FILE *fp = fopen("conftest1","w"); + + for (i=2,k=1;i;k=i,i<<=1); +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -1049,7 +1049,7 @@ AC_RUN_IFELSE( + FILE *f; + if (!(f=fopen("conftest1","w"))) + return -1; +- fprintf(f,"%u",sbrk(0)); ++ fprintf(f,"%p",sbrk(0)); + ]])], + [HAVE_SBRK=1;AC_MSG_RESULT([yes])], + AC_MSG_RESULT([no: WARNING you must be able to emulate sbrk: as on mingw or macosx]), +@@ -1145,7 +1145,7 @@ if test "$HAVE_SBRK" = "1" ; then + #endif + if (!(f=fopen("conftest1","w"))) + return -1; +- fprintf(f,"%u",sbrk(0)); ++ fprintf(f,"%p",sbrk(0)); + return 0; + } + ]])],[SBRK=`cat conftest1`]) +@@ -1165,7 +1165,7 @@ if test "$HAVE_SBRK" = "1" ; then + #include "h/unrandomize.h" + #endif + if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%u",sbrk(0)); ++ fprintf(f,"%p",sbrk(0)); + return 0; + } + ]])],[SBRK1=`cat conftest1`]) +@@ -1183,20 +1183,47 @@ if test "$HAVE_SBRK" = "1" ; then + AC_MSG_ERROR([exiting]) + fi + fi +-AC_MSG_CHECKING(CSTACK_ADDRESS) ++ ++AC_MSG_CHECKING(CSTACK_DIRECTION) + AC_RUN_IFELSE( + [AC_LANG_SOURCE( + [[ + #include + #include +- void * +- foo() { ++ ++ unsigned long w; ++ ++ void ++ foo(void) { + int i; +- return (void *)&i; ++ w=(unsigned long)&i; + } + + int + main(int argc,char **argv,char **envp) { ++ void *b; ++ FILE *fp = fopen("conftest1","w"); ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ foo(); ++ fprintf(fp,"%d",((unsigned long) &b) > w ? -1 : 1); ++ fclose(fp); ++ return 0; ++ }]])], ++ [cstack_direction=`cat conftest1`],[cstack_direction=0]) ++AC_DEFINE_UNQUOTED(CSTACK_DIRECTION,$cstack_direction,[whether C stack grows up or down]) ++AC_MSG_RESULT($cstack_direction) ++ ++ ++AC_MSG_CHECKING(CSTACK_ADDRESS) ++AC_RUN_IFELSE( ++ [AC_LANG_SOURCE( ++ [[ ++ #include ++ #include ++ int ++ main(int argc,char **argv,char **envp) { + void *v ; + FILE *fp = fopen("conftest1","w"); + unsigned long i,j; +@@ -1208,13 +1235,13 @@ AC_RUN_IFELSE( + j<<=$PAGEWIDTH; + j<<=16; + i=(unsigned long)&v; +- if (foo()>i) i-=j; +- j--; +- i+=j; +- i&=~j; +- fprintf(fp,"0x%lx",i-1); +- fclose(fp); +- return 0; ++ if ($cstack_direction==1) i-=j; ++ j--; ++ i+=j; ++ i&=~j; ++ fprintf(fp,"0x%lx",i-1); ++ fclose(fp); ++ return 0; + }]])], + [cstack_address=`cat conftest1`],[cstack_address=0]) + AC_DEFINE_UNQUOTED(CSTACK_ADDRESS,$cstack_address,[starting C stack address]) +@@ -1226,12 +1253,6 @@ AC_RUN_IFELSE( + [[ + #include + #include +- void * +- foo() { +- int i; +- return (void *)&i; +- } +- + int + main(int argc,char **argv,char **envp) { + void *v ; +@@ -1245,14 +1266,14 @@ AC_RUN_IFELSE( + j<<=$PAGEWIDTH; + j<<=16; + i=(unsigned long)&v; +- if (foo()>i) i-=j; +- j--; +- i+=j; +- i&=~j; +- for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); +- fprintf(fp,"%d",j); +- fclose(fp); +- return 0; ++ if ($cstack_direction==1) i-=j; ++ j--; ++ i+=j; ++ i&=~j; ++ for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); ++ fprintf(fp,"%ld",j); ++ fclose(fp); ++ return 0; + }]])], + [cstack_bits=`cat conftest1`],[cstack_bits=0]) + AC_DEFINE_UNQUOTED(CSTACK_BITS,$cstack_bits,[log starting C stack address]) +@@ -1302,33 +1323,6 @@ AC_RUN_IFELSE( + AC_DEFINE_UNQUOTED(CSTACK_ALIGNMENT,$cstack_alignment,[C stack alignment]) + AC_MSG_RESULT($cstack_alignment) + +-AC_MSG_CHECKING(CSTACK_DIRECTION) +-AC_RUN_IFELSE( +- [AC_LANG_SOURCE( +- [[ +- #include +- #include +- void * +- foo(void) { +- int i; +- return (void *)&i; +- } +- +- int +- main(int argc,char **argv,char **envp) { +- char *b; +- FILE *fp = fopen("conftest1","w"); +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- fprintf(fp,"%d",((long) &b) > ((long) foo()) ? -1 : 1); +- fclose(fp); +- return 0; +- }]])], +- [cstack_direction=`cat conftest1`],[cstack_direction=0]) +-AC_DEFINE_UNQUOTED(CSTACK_DIRECTION,$cstack_direction,[whether C stack grows up or down]) +-AC_MSG_RESULT($cstack_direction) +- + AC_ARG_ENABLE([immfix],[ --enable-immfix will enable an immediate fixnum table above the C stack]) + + AC_ARG_ENABLE([fastimmfix],[ --enable-fastimmfix=XXXX will reject low immediate fixnums unless 2^XXX can be attained],,[enable_fastimmfix=64]) +@@ -1429,8 +1423,7 @@ AC_RUN_IFELSE( + #include + ]], + [[ +- void *v; +- unsigned long i,j,k,l,m; ++ unsigned long i,j,k,l; + FILE *fp = fopen("conftest1","w"); + + for (i=2,k=1;i;k=i,i<<=1); +--- gcl-2.6.12.orig/h/unrandomize.h ++++ gcl-2.6.12/h/unrandomize.h +@@ -14,7 +14,7 @@ + long pers = personality(READ_IMPLIES_EXEC|personality(0xffffffffUL)); + long flag = ADDR_NO_RANDOMIZE; + +- if (sizeof(long)==4) flag|=ADDR_LIMIT_3GB|ADDR_COMPAT_LAYOUT; ++ if (sizeof(long)==4) flag|=ADDR_LIMIT_3GB/* |ADDR_COMPAT_LAYOUT */; + + if (pers==-1) {printf("personality failure %d\n",errno);exit(-1);} + if ((pers & flag)!=flag && !getenv("GCL_UNRANDOMIZE")) { diff --git a/patches/Version_2_6_13pre84 b/patches/Version_2_6_13pre84 new file mode 100644 index 00000000..ce8c974f --- /dev/null +++ b/patches/Version_2_6_13pre84 @@ -0,0 +1,45 @@ +Description: + 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-86) unstable; urgency=medium + . + * Version_2_6_13pre83 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-04-06 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4121,6 +4121,7 @@ $as_echo_n "checking working gprof... " + powerpc*) if test "$host_cpu" = "powerpc64le" ; then enableval="no"; fi;; + s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 + sh4*) enableval="no";; ++ m68k*) enableval="no";; + ia64*) enableval="no";; + hppa*) enableval="no";; + # arm*) if echo $canonical |grep -q hf$; then enableval="no"; fi;;#FIXME CALL and JUMP24 veneers needed for thumb 20190201 #FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -334,6 +334,7 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof + powerpc*) if test "$host_cpu" = "powerpc64le" ; then enableval="no"; fi;; + s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 + sh4*) enableval="no";; ++ m68k*) enableval="no";; + ia64*) enableval="no";; + hppa*) enableval="no";; + # arm*) if echo $canonical |grep -q hf$; then enableval="no"; fi;;#FIXME CALL and JUMP24 veneers needed for thumb 20190201 #FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible diff --git a/patches/Version_2_6_13pre85 b/patches/Version_2_6_13pre85 new file mode 100644 index 00000000..8f38b607 --- /dev/null +++ b/patches/Version_2_6_13pre85 @@ -0,0 +1,123 @@ +Description: + 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-88) unstable; urgency=medium + . + * Source only upload +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-12-07 + +--- gcl-2.6.12.orig/h/elf64_ppcle_reloc.h ++++ gcl-2.6.12/h/elf64_ppcle_reloc.h +@@ -1,9 +1,25 @@ ++#define R_PPC64_PLTSEQ 119 /*FIXME not in elf.h*/ ++#define R_PPC64_PLTCALL 120 ++ + #define ha(x_) ((((x_) >> 16) + (((x_) & 0x8000) ? 1 : 0)) & 0xffff) + #define lo(x_) ((x_) & 0xffff) + + case R_PPC64_REL16_HA: + store_val(where,MASK(16),ha(s+a-p)); + break; ++ case R_PPC64_PLT16_HA: ++ gote=got+sym->st_size-1; ++ *gote=s+a; ++ store_val(where,MASK(16),ha((ul)gote-toc->st_value)); ++ break; ++ case R_PPC64_PLT16_LO_DS: ++ gote=got+sym->st_size-1; ++ *gote=s+a; ++ store_val(where,MASK(16),lo((ul)gote-toc->st_value));/*>>2*/ ++ break; ++ case R_PPC64_PLTSEQ: ++ case R_PPC64_PLTCALL: ++ break; + case R_PPC64_TOC16_HA: + store_val(where,MASK(16),ha(s+a-toc->st_value)); + break; +--- gcl-2.6.12.orig/h/elf64_ppcle_reloc_special.h ++++ gcl-2.6.12/h/elf64_ppcle_reloc_special.h +@@ -9,16 +9,12 @@ static int tramp[]={0,0, + }; + + static int +-find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, +- const char *st1,Sym *ds1,Sym *dse,Sym *sym,Sym *syme) { +- +- Shdr *sec; ++load_trampolines(void *v,Shdr *sec,Sym *ds1) { ++ + Rela *r; + void *ve; + ul *u,j; + +- massert((sec=get_section(".rela.dyn",sec1,sece,sn))); +- + v+=sec->sh_offset; + ve=v+sec->sh_size; + +@@ -42,8 +38,25 @@ find_special_params(void *v,Shdr *sec1,S + } + + static int ++find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, ++ const char *st1,Sym *ds1,Sym *dse,Sym *sym,Sym *syme) { ++ ++ Shdr *sec; ++ ++ massert((sec=get_section(".rela.dyn",sec1,sece,sn))); ++ massert(!load_trampolines(v,sec,ds1)); ++ if ((sec=get_section(".rela.plt",sec1,sece,sn))) ++ massert(!load_trampolines(v,sec,ds1)); ++ ++ return 0; ++ ++} ++ ++static int + label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,const char *sn,ul *gs) { + ++ Rela *r; ++ void *v,*ve; + Shdr *sec; + Sym *sym; + +@@ -58,6 +71,22 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + } + } + ++ for (sym=sym1;symst_size=0; ++ ++ for (*gs=0,sec=sec1;secsh_type==SHT_RELA) ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++ if (ELF_R_TYPE(r->r_info)==R_PPC64_PLT16_HA|| ++ ELF_R_TYPE(r->r_info)==R_PPC64_PLT16_LO_DS) { ++ ++ sym=sym1+ELF_R_SYM(r->r_info); ++ ++ if (!sym->st_size) ++ sym->st_size=++*gs; ++ ++ } ++ + return 0; + + } diff --git a/patches/Version_2_6_13pre86 b/patches/Version_2_6_13pre86 new file mode 100644 index 00000000..9bc68f2a --- /dev/null +++ b/patches/Version_2_6_13pre86 @@ -0,0 +1,45 @@ +Description: + 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-88) unstable; urgency=medium + . + * Source only upload +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-12-07 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4194,6 +4194,7 @@ case $use in + ;; + powerpc*) + assert_arg_to_cflags -mlongcall ++ if test "$host_cpu" != "powerpc64le" ; then assert_arg_to_cflags -mno-pltseq; fi + ;; + esac;; + esac +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -401,6 +401,7 @@ case $use in + ;; + powerpc*) + assert_arg_to_cflags -mlongcall ++ if test "$host_cpu" != "powerpc64le" ; then assert_arg_to_cflags -mno-pltseq; fi + ;; + esac;; + esac diff --git a/patches/Version_2_6_13pre87 b/patches/Version_2_6_13pre87 new file mode 100644 index 00000000..b38d6b45 --- /dev/null +++ b/patches/Version_2_6_13pre87 @@ -0,0 +1,89 @@ +Description: + 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-89) unstable; urgency=medium + . + * Bug fix: "gcl - FTBFS on ppc64el - invalid relocation type 31", thanks + to thierry.fauck@fr.ibm.com; (Closes: #942312). + * Bug fix: "FTBFS on ppc64el", thanks to Ivo De Decker (Closes: + #944651). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/942312 +Bug-Debian: https://bugs.debian.org/944651 + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-12-08 + +--- gcl-2.6.12.orig/h/elf64_ppcle_reloc.h ++++ gcl-2.6.12/h/elf64_ppcle_reloc.h +@@ -10,32 +10,38 @@ + case R_PPC64_PLT16_HA: + gote=got+sym->st_size-1; + *gote=s+a; ++ massert(toc); + store_val(where,MASK(16),ha((ul)gote-toc->st_value)); + break; + case R_PPC64_PLT16_LO_DS: + gote=got+sym->st_size-1; + *gote=s+a; ++ massert(toc); + store_val(where,MASK(16),lo((ul)gote-toc->st_value));/*>>2*/ + break; + case R_PPC64_PLTSEQ: + case R_PPC64_PLTCALL: + break; + case R_PPC64_TOC16_HA: ++ massert(toc); + store_val(where,MASK(16),ha(s+a-toc->st_value)); + break; + case R_PPC64_TOC16_LO_DS: ++ massert(toc); + store_val(where,MASK(16),lo(s+a-toc->st_value));/*>>2*/ + break; + case R_PPC64_REL16_LO: + store_val(where,MASK(16),lo(s+a-p)); + break; + case R_PPC64_TOC16_LO: ++ massert(toc); + store_val(where,MASK(16),lo(s+a-toc->st_value)); + break; + case R_PPC64_ADDR64: + store_val(where,~0L,(s+a)); + break; + case R_PPC64_TOC: ++ massert(toc); + store_val(where,~0L,toc->st_value); + break; + case R_PPC64_REL32: +--- gcl-2.6.12.orig/h/elf64_ppcle_reloc_special.h ++++ gcl-2.6.12/h/elf64_ppcle_reloc_special.h +@@ -60,13 +60,12 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + Shdr *sec; + Sym *sym; + +- massert(sec=get_section(".toc",sec1,sece,sn)); +- +- for (sym=sym1;symst_name; + if (!strcmp(s,".TOC.") || !strcmp(s,".toc.")) { + toc=sym; + toc->st_info=ELF_ST_INFO(STB_LOCAL,ELF_ST_TYPE(sym->st_info)); ++ massert((sec=get_section(".bss",sec1,sece,sn))); + toc->st_shndx=sec-sec1; + } + } diff --git a/patches/Version_2_6_13pre88 b/patches/Version_2_6_13pre88 new file mode 100644 index 00000000..5701ceb6 --- /dev/null +++ b/patches/Version_2_6_13pre88 @@ -0,0 +1,151 @@ +Description: + 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-90) unstable; urgency=medium + . + * Version_2_6_13pre87 + * latest standards +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-12-18 + +--- gcl-2.6.12.orig/h/pool.h ++++ gcl-2.6.12/h/pool.h +@@ -20,9 +20,8 @@ static struct pool { + ufixnum s; + } *Pool; + +-static struct flock pl,*plp=&pl; +- +-static const char *gcl_pool="/tmp/gcl_pool"; ++static struct flock f,pl,*plp=&pl; ++static char gcl_pool[PATH_MAX]; + + static int + set_lock(void) { +@@ -66,8 +65,8 @@ open_pool(void) { + + if (pool==-1) { + +- struct flock f; +- ++ massert(!home_namestring1("~",1,FN1,sizeof(FN1))); ++ massert(snprintf(gcl_pool,sizeof(gcl_pool),"%sgcl_pool",FN1)>=0); + massert((pool=open(gcl_pool,O_CREAT|O_RDWR,0644))!=-1); + massert(!ftruncate(pool,sizeof(struct pool))); + massert((Pool=mmap(NULL,sizeof(struct pool),PROT_READ|PROT_WRITE,MAP_SHARED,pool,0))!=(void *)-1); +@@ -111,6 +110,9 @@ close_pool(void) { + + #ifndef NO_FILE_LOCKING + if (pool!=-1) { ++ f.l_type=F_WRLCK; ++ if (!fcntl(pool,F_SETLK,&f)) ++ massert(!unlink(gcl_pool)); + register_pool(-1); + massert(!close(pool)); + massert(!munmap(Pool,sizeof(struct pool))); +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1971,3 +1971,6 @@ travel_find_sharing(object,object); + + object + new_cfdata(void); ++ ++int ++home_namestring1(const char *,int,char *,int); +--- gcl-2.6.12.orig/o/unixfsys.c ++++ gcl-2.6.12/o/unixfsys.c +@@ -95,16 +95,20 @@ DEFUN_NEW("UID-TO-NAME",object,fSuid_to_ + #endif + } + +-DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") { ++int ++home_namestring1(const char *n,int s,char *o,int so) { + +-#ifndef __MINGW32__ ++ #ifndef __MINGW32__ + struct passwd *pwent,pw; + long r; + ++ massert(s>0); ++ massert(*n=='~'); ++ + massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); + massert(r<=sizeof(GETPW_BUF));/*FIXME maybe once at image startup*/ + +- if (nm->st.st_fillp==1) ++ if (s==1) + + if ((pw.pw_dir=getenv("HOME"))) + pwent=&pw; +@@ -113,26 +117,44 @@ DEFUN_NEW("HOME-NAMESTRING",object,fShom + + else { + +- massert(nm->st.st_fillpst.st_self+1,nm->st.st_fillp-1); +- FN2[nm->st.st_fillp-1]=0; ++ massert(spw_dir))+2pw_dir,r); +- FN3[r]='/'; +- FN3[r+1]=0; +- RETURN1(make_simple_string(FN3)); ++ massert((r=strlen(pwent->pw_dir))+2pw_dir,r); ++ o[r]='/'; ++ o[r+1]=0; ++ return 0; + #else +- massert(snprintf(FN1,sizeof(FN1)-1,"%s%s",getenv("SystemDrive"),getenv("HOMEPATH"))>=0); +- RETURN1(make_simple_string(FN1)); ++ massert(snprintf(o,so-1,"%s%s",getenv("SystemDrive"),getenv("HOMEPATH"))>=0); ++ return 0; + #endif + + } + ++ ++DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") { ++ ++ check_type_string(&nm); ++ ++ massert(!home_namestring1(nm->st.st_self,nm->st.st_fillp,FN1,sizeof(FN1))); ++ RETURN1(make_simple_string(FN1)); ++ ++} ++#ifdef STATIC_FUNCTION_POINTERS ++object ++fShome_namestring(object x) { ++ return FFN(fShome_namestring)(x); ++} ++#endif ++ ++ ++ + #define FILE_EXISTS_P(a_,b_) !stat(a_,&b_) && S_ISREG(b_.st_mode) + #define DIR_EXISTS_P(a_,b_) !stat(a_,&b_) && S_ISDIR(b_.st_mode) + diff --git a/patches/Version_2_6_13pre89 b/patches/Version_2_6_13pre89 new file mode 100644 index 00000000..dec85967 --- /dev/null +++ b/patches/Version_2_6_13pre89 @@ -0,0 +1,277 @@ +Description: + 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-91) unstable; urgency=medium + . + * Version_2_6_13pre88 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-12-30 + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -57,28 +57,19 @@ + + + ;; Let the user write dump c-file etc to /dev/null. +-(defun get-output-pathname (file ext name &optional (dir (pathname-directory *default-pathname-defaults*)) ++(defun get-output-pathname (file ext name &optional ++ (dir (pathname-directory *default-pathname-defaults*)) + (device (pathname-device *default-pathname-defaults*))) +- (cond +- ((equal file "/dev/null") (pathname file)) ++ (cond ((equal file "/dev/null") (pathname file)) + #+aix3 + ((and (equal name "float") + (equal ext "h")) + (get-output-pathname file ext "Float" )) +- (t +- (make-pathname :device (or (and (not (null file)) +- (not (eq file t)) +- (pathname-device file)) +- device) +- :directory (or (and (not (null file)) +- (not (eq file t)) +- (pathname-directory file)) +- dir) +- :name (or (and (not (null file)) +- (not (eq file t)) +- (pathname-name file)) +- name) +- :type ext)))) ++ ((let ((lf (and file (not (eq file t))))) ++ (let ((device (if lf (pathname-device file) device)) ++ (dir (if lf (pathname-directory file) dir)) ++ (name (if lf (pathname-name file) name))) ++ (make-pathname :device device :directory dir :name name :type ext)))))) + + (defun safe-system (string) + (multiple-value-bind +@@ -109,15 +100,7 @@ + ;; will be performed for separate chunks of the lisp files. + (defvar *split-files* nil) ;; if + +-(defun check-end (form eof) +- (cond ((eq form eof) +- (setf (third *split-files*) nil)) +- ((> (file-position *compiler-input*) +- (car *split-files*)) +- (setf (third *split-files*)(file-position *compiler-input*))))) +- +- +-(defun compile-file (&rest args ++(defun compile-file (filename &rest args + &aux (*print-pretty* nil) + (*package* *package*) (*split-files* *split-files*) + (*PRINT-CIRCLE* NIL) +@@ -131,17 +114,17 @@ + (*PRINT-BASE* 10) + (*PRINT-ESCAPE* T) + (section-length *split-files*) +- tem) ++ tem warnings failures ++ (filename (pathname filename)) ++ (*compile-file-pathname* (merge-pathnames filename #p".lsp")) ++ (*compile-file-truename* (truename *compile-file-pathname*))) + (loop + (compiler::init-env) +- (setq tem (apply 'compiler::compile-file1 args)) +- (cond ((atom *split-files*)(return tem)) +- ((and (consp *split-files*) +- (null (third *split-files*))) +- (let ((gaz (let ((*DEFAULT-PATHNAME-DEFAULTS* (car args))) +- (gazonk-name))) +- (*readtable* (si::standard-readtable))) +- (setq gaz (get-output-pathname gaz "lsp" (car args))) ++ (setq tem (apply 'compile-file1 filename args)) ++ (cond ((atom *split-files*) ++ (return (values (when tem (truename tem)) warnings failures))) ++ ((null (third *split-files*)) ++ (let ((gaz (gazonk-name))(*readtable* (si::standard-readtable))) + (with-open-file (st gaz :direction :output) + (print + `(eval-when (load eval) +@@ -149,16 +132,15 @@ + (load (merge-pathnames v si::*load-pathname*)))) + st)) + (setq *split-files* nil) +- (or (member :output-file args) +- (setq args (append args (list :output-file (car args))))) + (return +- (prog1 (apply 'compile-file gaz (cdr args)) +- (unless *keep-gaz* (mdelete-file gaz)))) +- )) +- (t nil)) +- (if (consp *split-files*) +- (setf (car *split-files*) (+ (third *split-files*) section-length))) +- )) ++ (let ((tem (apply 'compile-file gaz ++ (append args ++ (unless (member :output-file args) ++ (list :output-file ++ (get-output-pathname filename "o" nil nil nil))))))) ++ (unless *keep-gaz* (mdelete-file gaz)) ++ (values (when tem (truename tem)) warnings failures))))) ++ ((setf (car *split-files*) (+ (third *split-files*) section-length)))))) + + + (defun compile-file1 (input-pathname +@@ -172,13 +154,14 @@ + (prof-p *default-prof-p*) + (print nil) + (load nil) +- &aux (*standard-output* *standard-output*) +- (*prof-p* prof-p) ++ &aux ++ (*standard-output* *standard-output*) ++ (*prof-p* prof-p) ++ (output-file (pathname output-file)) + (*error-output* *error-output*) + (*compiler-in-use* *compiler-in-use*) + (*c-debug* c-debug) + (*compile-print* (or print *compile-print*)) +- (*package* *package*) + (*DEFAULT-PATHNAME-DEFAULTS* #p"") + (*data* (list nil)) + *init-name* +@@ -211,41 +194,30 @@ Cannot compile ~a.~%" + (*compiler-input* (merge-pathnames input-pathname #p".lsp")) + + +- (cond ((numberp *split-files*) +- (if (< (file-length *compiler-input*) *split-files*) +- (setq *split-files* nil) +- (setq *split-files* (list *split-files* nil 0 nil))))) ++ (when (numberp *split-files*) ++ (setq *split-files* (unless (< (file-length *compiler-input*) *split-files*) (list *split-files* nil 0 nil)))) + +- (cond ((consp *split-files*) +- (file-position *compiler-input* (third *split-files*)) +- (setq output-file +- (make-pathname :directory (pathname-directory output-file) +- :name (format nil "~a~a" (length (second *split-files*)) (pathname-name (pathname output-file))) +- :type "o")) +- +- (push (pathname-name output-file) (second *split-files*)))) ++ (when (consp *split-files*) ++ (file-position *compiler-input* (third *split-files*)) ++ (setq output-file ++ (make-pathname :directory (pathname-directory output-file) ++ :name (format nil "~a~a" ++ (pathname-name output-file) ++ (length (second *split-files*))) ++ :type "o"))) + + +- (let* ((eof (cons nil nil)) +- (dir (or (and (not (null output-file)) +- (pathname-directory output-file)) +- (pathname-directory input-pathname))) +- (name (or (and (not (null output-file)) +- (pathname-name output-file)) +- (pathname-name input-pathname))) +- (device (or (and (not (null output-file)) +- (pathname-device output-file)) +- (pathname-device input-pathname))) +- (typ (or (and (not (null output-file)) +- (pathname-type output-file)) +- "o")) +- +- (o-pathname (get-output-pathname o-file typ name dir device)) +- (c-pathname (get-output-pathname c-file "c" name dir device)) +- (h-pathname (get-output-pathname h-file "h" name dir device)) +- (data-pathname (get-output-pathname data-file "data" name dir device))) ++ (let* ((eof (cons nil nil)) ++ (dir (pathname-directory (or output-file input-pathname))) ++ (name (pathname-name (or output-file input-pathname))) ++ (device (pathname-device (or output-file input-pathname))) ++ (typ (pathname-type (or output-file #p".o"))) ++ (o-pathname (get-output-pathname o-file typ name dir device)) ++ (c-pathname (get-output-pathname c-file "c" name dir device)) ++ (h-pathname (get-output-pathname h-file "h" name dir device)) ++ (data-pathname (get-output-pathname data-file "data" name dir device))) + +- (declare (special dir name )) ++ (declare (special dir name)) + + (init-env) + +@@ -278,21 +250,32 @@ Cannot compile ~a.~%" + (setq prev nil)) + + ;; t1expr the package ops again.. +- (if (consp *split-files*) +- (dolist (v (fourth *split-files*)) (t1expr v))) ++ (when (consp *split-files*) ++ (dolist (v (fourth *split-files*)) (t1expr v))) ++ + (unwind-protect + (do ((form (read *compiler-input* nil eof)(read *compiler-input* nil eof)) +- (load-flag (if *eval-when-defaults* (member 'load *eval-when-defaults*) t))) ++ (load-flag (if *eval-when-defaults* ++ (or (member 'load *eval-when-defaults*) ++ (member :load-toplevel *eval-when-defaults*)) ++ t))) + (nil) +- (cond +- ((eq form eof)) +- (load-flag (t1expr form)) +- ((maybe-eval nil form))) +- (cond +- ((and *split-files* (check-end form eof)) +- (setf (fourth *split-files*) nil);(reverse (third *data*)) ;FIXME check this +- (return nil)) +- ((eq form eof) (return nil)))) ++ ++ (unless (eq form eof) ++ (if load-flag ++ (t1expr form) ++ (maybe-eval nil form))) ++ ++ (when (or (eq form eof) ++ (when *split-files* ++ (> (file-position *compiler-input*) (car *split-files*)))) ++ ++ (when *split-files* ++ (push (pathname-name output-file) (second *split-files*)) ++ (setf (third *split-files*) (unless (eq form eof) (file-position *compiler-input*))) ++ (setf (fourth *split-files*) nil));(reverse (third *data*)) ;FIXME check this ++ ++ (return nil))) + + (when prev (set-dispatch-macro-character #\# #\, prev rtb))))) + +@@ -331,7 +314,7 @@ Cannot compile ~a.~%" + (unless c-file (mdelete-file c-pathname)) + (unless h-file (mdelete-file h-pathname)) + (unless (or data-file #+ld-not-accept-data t system-p) (mdelete-file data-pathname)) +- o-pathname) ++ (when o-file o-pathname)) + + (progn + (when (probe-file c-pathname) (mdelete-file c-pathname)) +@@ -339,8 +322,7 @@ Cannot compile ~a.~%" + (when (probe-file data-pathname) (mdelete-file data-pathname)) + (format t "~&No FASL generated.~%") + (setq *error-p* t) +- (values) +- )))))) ++ (values)))))) + + (defun gazonk-name () + (dotimes (i 1000) diff --git a/patches/Version_2_6_13pre8a b/patches/Version_2_6_13pre8a new file mode 100644 index 00000000..1031df65 --- /dev/null +++ b/patches/Version_2_6_13pre8a @@ -0,0 +1,1359 @@ +Description: + 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-8) unstable; urgency=medium + . + * Version_2_6_13pre7 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/gcl-tk/comm.c ++++ gcl-2.6.12/gcl-tk/comm.c +@@ -66,7 +66,7 @@ fScheck_fd_for_input(fixnum fd,fixnum ti + + + struct connection_state * +-setup_connection_state(fd) ++setup_connection_state(int fd) + { struct connection_state * res; + res = (void *)malloc(sizeof(struct connection_state)); + bzero(res,sizeof(struct connection_state)); +--- gcl-2.6.12.orig/gcl-tk/guis.h ++++ gcl-2.6.12/gcl-tk/guis.h +@@ -4,6 +4,10 @@ + #include + + #define NO_PRELINK_UNEXEC_DIVERSION ++#define IMMNUM_H ++#define GMP_WRAPPERS_H ++#define ERROR_H ++ + #include "include.h" + + #ifdef NeXT +--- gcl-2.6.12.orig/gmp4/mpn/x86_64/k8/redc_1.asm ++++ gcl-2.6.12/gmp4/mpn/x86_64/k8/redc_1.asm +@@ -114,7 +114,7 @@ ifdef(`PIC',` + + JUMPTABSECT + ALIGN(8) +-L(tab): JMPENT( L(0m4), L(tab)) ++L(tab): JMPENT( L(0), L(tab)) + JMPENT( L(1), L(tab)) + JMPENT( L(2), L(tab)) + JMPENT( L(3), L(tab)) +@@ -397,6 +397,7 @@ L(le1): add %r10, (up) + + + ALIGN(16) ++L(0): + L(0m4): + L(lo0): mov (mp,nneg,8), %rax + mov nneg, i +--- gcl-2.6.12.orig/h/att_ext.h ++++ gcl-2.6.12/h/att_ext.h +@@ -29,7 +29,7 @@ void *malloc(size_t); + void *realloc(void *,size_t); + /* void * memalign(size_t,size_t); */ + void *alloc_contblock(size_t); +-inline void *alloc_relblock(size_t); ++void *alloc_relblock(size_t); + /* object fSallocate_contiguous_pages(); */ + /* object fSallocate_relocatable_pages(); */ + +@@ -291,9 +291,7 @@ EXTER object sSAsystem_directoryA; + #ifdef UNIX + EXTER char *kcl_self; + #endif +-#if !defined(IN_MAIN) || !defined(ATT) + EXTER bool raw_image; +-#endif + char *merge_system_directory(); + + +--- gcl-2.6.12.orig/h/cmpincl1.h ++++ gcl-2.6.12/h/cmpincl1.h +@@ -1,2 +1 @@ +-#define EXTER extern + #define CMPINCLUDE +--- gcl-2.6.12.orig/h/compbas.h ++++ gcl-2.6.12/h/compbas.h +@@ -1,2 +1,12 @@ + #include + #define _VA_LIST_DEFINED ++#ifndef EXTER ++#define EXTER extern ++#endif ++#ifndef INLINE ++#if defined(__GNUC__) && __GNUC__ <= 4 ++#define INLINE extern inline ++#else ++#define INLINE inline ++#endif ++#endif +--- gcl-2.6.12.orig/h/error.h ++++ gcl-2.6.12/h/error.h +@@ -1,4 +1,7 @@ +-#define Icall_error_handler(a_,b_,c_,d_...) \ ++#ifndef ERROR_H ++#define ERROR_H ++ ++#define Icall_error_handler(a_,b_,c_,d_...) \ + Icall_gen_error_handler(Cnil,null_string,a_,b_,c_,##d_) + #define Icall_continue_error_handler(a_,b_,c_,d_,e_...) \ + Icall_gen_error_handler(Ct,a_,b_,c_,d_,##e_) +@@ -8,12 +11,8 @@ extern enum type t_vtype; + extern int vtypep_fn(object); + extern void Check_type(object *,int (*)(object),object); + ++#define PFN(a_) INLINE int Join(a_,_fn)(object x) {return a_(x);} + +-#ifdef IN_MAIN +-#define PFN(a_) int Join(a_,_fn)(object x) {return a_(x);} +-#else +-#define PFN(a_) extern int Join(a_,_fn)(object x); +-#endif + PFN(integerp) + PFN(non_negative_integerp) + PFN(rationalp) +@@ -201,3 +200,4 @@ object ihs_top_function_name(ihs_ptr h); + abort();\ + }) + ++#endif /*ERROR_H*/ +--- gcl-2.6.12.orig/h/gmp_wrappers.h ++++ gcl-2.6.12/h/gmp_wrappers.h +@@ -1,12 +1,8 @@ +-#ifndef GMP_EXTERN +-#define GMP_EXTERN extern +-#endif +-#ifndef GMP_EXTERN_INLINE +-#define GMP_EXTERN_INLINE GMP_EXTERN __inline__ +-#endif ++#ifndef GMP_WRAPPERS_H ++#define GMP_WRAPPERS_H + +-GMP_EXTERN jmp_buf gmp_jmp; +-GMP_EXTERN int jmp_gmp,gmp_relocatable; ++EXTER jmp_buf gmp_jmp; ++EXTER int jmp_gmp,gmp_relocatable; + + #define join(a_,b_) a_ ## b_ + #define Join(a_,b_) join(a_,b_) +@@ -95,7 +91,7 @@ GMP_EXTERN int jmp_gmp,gmp_relocatable; + set to -1 otherwise. 20040815 CM*/ + + #define MEM_GMP_CALL(n_,rt_,a_,s_,b_...) \ +- GMP_EXTERN_INLINE Join(RF_,rt_) Join(m,a_)(Join(P,n_)(b_)) { \ ++ INLINE Join(RF_,rt_) Join(m,a_)(Join(P,n_)(b_)) { \ + int j;\ + Join(RD_,rt_);\ + if (gmp_relocatable) {\ +@@ -195,3 +191,5 @@ MEM_GMP_CALL(2,size_t,mpz_sizeinbase,0,m + /*#define __gmpz_realloc m__gmpz_realloc*/ + #define __gmpz_size m__gmpz_size + #define __gmpz_sizeinbase m__gmpz_sizeinbase ++ ++#endif /*GMP_WRAPPERS_H*/ +--- gcl-2.6.12.orig/h/immnum.h ++++ gcl-2.6.12/h/immnum.h +@@ -17,10 +17,10 @@ + #define iif2(x,y) is_imm_fixnum2(x,y) + + +-EXTER inline fixnum ++INLINE fixnum + lnabs(fixnum x) {return x<0 ? ~x : x;} + +-EXTER inline char ++INLINE char + clz(ufixnum x) { + #ifdef HAVE_CLZL + return x ? __builtin_clzl(x) : sizeof(x)*8; +@@ -29,7 +29,7 @@ clz(ufixnum x) { + #endif + } + +-EXTER inline char ++INLINE char + ctz(ufixnum x) { + #ifdef HAVE_CTZL + return __builtin_ctzl(x);/*x ? __builtin_clzl(x) : sizeof(x)*8;*/ +@@ -38,10 +38,10 @@ ctz(ufixnum x) { + #endif + } + +-EXTER inline char ++INLINE char + fixnum_length(fixnum x) {return sizeof(x)*8-clz(lnabs(x));} + +-EXTER inline object ++INLINE object + immnum_length(object x) {return iif(x) ? mif(fixnum_length(fif(x))) : integer_length(x);} + + +@@ -57,7 +57,7 @@ immnum_length(object x) {return iif(x) ? + #define POPD 0x3F + #endif + +-EXTER inline char ++INLINE char + fixnum_popcount(ufixnum x) { + x-=POPA&(x>>1); + x=(x&POPB)+((x>>2)&POPB); +@@ -70,33 +70,33 @@ fixnum_popcount(ufixnum x) { + return x&POPD; + } + +-EXTER inline char ++INLINE char + /* fixnum_count(fixnum x) {return __builtin_popcountl(lnabs(x));} */ + fixnum_count(fixnum x) {return fixnum_popcount(lnabs(x));} + +-EXTER inline object ++INLINE object + immnum_count(object x) {return iif(x) ? mif(fixnum_count(fif(x))) : integer_count(x);} + + /*bs=sizeof(long)*8; + lb=bs-clz(labs(x));|x*y|=|x|*|y|<2^(lbx+lby)<2^(bs-1); + 0 bounded by 2^0, +-1 by 2^1,mpf by 2^(bs-1), which is sign bit + protect labs from most negative fix, here all immfix ok*/ +-EXTER inline bool ++INLINE bool + fixnum_mul_safe_abs(fixnum x,fixnum y) {return clz(x)+clz(y)>sizeof(x)*8+1;} +-EXTER inline object ++INLINE object + safe_mul_abs(fixnum x,fixnum y) {return fixnum_mul_safe_abs(x,y) ? make_fixnum(x*y) : fixnum_times(x,y);} +-EXTER inline bool ++INLINE bool + fixnum_mul_safe(fixnum x,fixnum y) {return fixnum_mul_safe_abs(labs(x),labs(y));} +-EXTER inline object ++INLINE object + safe_mul(fixnum x,fixnum y) {return fixnum_mul_safe(x,y) ? make_fixnum(x*y) : fixnum_times(x,y);} +-EXTER inline object ++INLINE object + immnum_times(object x,object y) {return iif2(x,y) ? safe_mul(fif(x),fif(y)) : number_times(x,y);} + +-EXTER inline object ++INLINE object + immnum_plus(object x,object y) {return iif2(x,y) ? make_fixnum(fif(x)+fif(y)) : number_plus(x,y);} +-EXTER inline object ++INLINE object + immnum_minus(object x,object y) {return iif2(x,y) ? make_fixnum(fif(x)-fif(y)) : number_minus(x,y);} +-EXTER inline object ++INLINE object + immnum_negate(object x) {return iif(x) ? make_fixnum(-fif(x)) : number_negate(x);} + + #define BOOLCLR 0 +@@ -116,7 +116,7 @@ immnum_negate(object x) {return iif(x) ? + #define BOOLORC1 015 + #define BOOLORC2 013 + +-EXTER inline fixnum ++INLINE fixnum + fixnum_boole(fixnum op,fixnum x,fixnum y) { + switch(op) { + case BOOLCLR: return 0; +@@ -139,7 +139,7 @@ fixnum_boole(fixnum op,fixnum x,fixnum y + return 0;/*FIXME error*/ + } + +-EXTER inline object ++INLINE object + immnum_boole(fixnum o,object x,object y) {return iif2(x,y) ? mif(fixnum_boole(o,fif(x),fif(y))) : log_op2(o,x,y);} + + #define immnum_bool(o,x,y) immnum_boole(fixint(o),x,y) +@@ -156,93 +156,93 @@ immnum_boole(fixnum o,object x,object y) + #define immnum_orc1(x,y) immnum_boole(BOOLORC1,x,y) + #define immnum_orc2(x,y) immnum_boole(BOOLORC2,x,y) + +-EXTER inline fixnum ++INLINE fixnum + fixnum_div(fixnum x,fixnum y,fixnum d) { + fixnum z=x/y; + if (d && x!=y*z && (x*d>0 ? y>0 : y<0)) + z+=d; + return z; + } +-EXTER inline fixnum ++INLINE fixnum + fixnum_rem(fixnum x,fixnum y,fixnum d) { + fixnum z=x%y; + if (d && z && (x*d>0 ? y>0 : y<0)) + z+=y; + return z; + } +-EXTER inline object ++INLINE object + immnum_truncate(object x,object y) {return iif2(x,y)&&y!=make_fixnum(0) ? mif(fixnum_div(fif(x),fif(y),0)) : (intdivrem(x,y,0,&x,NULL),x);} +-EXTER inline object ++INLINE object + immnum_floor(object x,object y) {return iif2(x,y)&&y!=make_fixnum(0) ? mif(fixnum_div(fif(x),fif(y),-1)) : (intdivrem(x,y,-1,&x,NULL),x);} +-EXTER inline object ++INLINE object + immnum_ceiling(object x,object y) {return iif2(x,y)&&y!=make_fixnum(0) ? mif(fixnum_div(fif(x),fif(y),1)) : (intdivrem(x,y,1,&x,NULL),x);} +-EXTER inline object ++INLINE object + immnum_mod(object x,object y) {return iif2(x,y)&&y!=make_fixnum(0) ? mif(fixnum_rem(fif(x),fif(y),-1)) : (intdivrem(x,y,-1,NULL,&y),y);} +-EXTER inline object ++INLINE object + immnum_rem(object x,object y) {return iif2(x,y)&&y!=make_fixnum(0) ? mif(fixnum_rem(fif(x),fif(y),0)) : (intdivrem(x,y,0,NULL,&y),y);} + +-EXTER inline fixnum ++INLINE fixnum + fixnum_rshft(fixnum x,fixnum y) { + return y>=sizeof(x)*8 ? (x<0 ? -1 : 0) : x>>y; + } +-EXTER inline object ++INLINE object + fixnum_lshft(fixnum x,fixnum y) { + return clz(labs(x))>y ? make_fixnum(x<);} +-EXTER inline bool ++INLINE bool + immnum_ge(object x,object y) {return immnum_comp(x,y,>=);} + +-EXTER inline bool ++INLINE bool + immnum_minusp(object x) {return iif(x) ? ((ufixnum)x)<((ufixnum)make_fixnum(0)) : number_minusp(x);} +-EXTER inline bool ++INLINE bool + immnum_plusp(object x) {return iif(x) ? ((ufixnum)x)>((ufixnum)make_fixnum(0)) : number_plusp(x);} +-EXTER inline bool ++INLINE bool + immnum_zerop(object x) {return iif(x) ? ((ufixnum)x)==((ufixnum)make_fixnum(0)) : number_zerop(x);} +-EXTER inline bool ++INLINE bool + immnum_evenp(object x) {return iif(x) ? !(((ufixnum)x)&0x1) : number_evenp(x);} +-EXTER inline bool ++INLINE bool + immnum_oddp(object x) {return iif(x) ? (((ufixnum)x)&0x1) : number_oddp(x);} + +-EXTER inline object ++INLINE object + immnum_signum(object x) { + ufixnum ux=(ufixnum)x,uz=((ufixnum)make_fixnum(0)); + return iif(x) ? (ux=(ufixnum)y ? x : y) : (number_compare(x,y)>=0?x:y);} +-EXTER inline object ++INLINE object + immnum_min(object x,object y) {return iif2(x,y) ? ((ufixnum)x<=(ufixnum)y ? x : y) : (number_compare(x,y)<=0?x:y);} + +-EXTER inline bool ++INLINE bool + immnum_logt(object x,object y) {return iif2(x,y) ? fixnum_boole(BOOLAND,fif(x),fif(y))!=0 : !number_zerop(log_op2(BOOLAND,x,y));} + +-EXTER inline fixnum ++INLINE fixnum + fixnum_gcd(fixnum x,fixnum y) { + + fixnum t; +@@ -343,16 +343,16 @@ fixnum_gcd(fixnum x,fixnum y) { + + } + +-EXTER inline object ++INLINE object + immnum_gcd(object x,object y) {return iif2(x,y) ? mif(fixnum_gcd(labs(fif(x)),labs(fif(y)))) : get_gcd(x,y);} + +-EXTER inline object ++INLINE object + fixnum_lcm(fixnum x,fixnum y) { + fixnum g=fixnum_gcd(x,y); + return g ? safe_mul_abs(x,fixnum_div(y,g,0)) : make_fixnum(0); + } + +-EXTER inline object ++INLINE object + immnum_lcm(object x,object y) {return iif2(x,y) ? fixnum_lcm(labs(fif(x)),labs(fif(y))) : get_lcm(x,y);} + + #endif +--- gcl-2.6.12.orig/h/include.h ++++ gcl-2.6.12/h/include.h +@@ -87,12 +87,6 @@ Foundation, 675 Mass Ave, Cambridge, MA + #define isalphanum(x) isalnum(x) + #endif + +-#ifdef IN_MAIN +-#define EXTER +-#else +-#define EXTER extern +-#endif +- + #if defined(GMP) || defined(NEED_MP_H) + #include "../h/mp.h" + #endif +--- gcl-2.6.12.orig/h/notcomp.h ++++ gcl-2.6.12/h/notcomp.h +@@ -28,10 +28,7 @@ EXTER long real_maxpage; + char *getenv(); + EXTER char *this_lisp; + +-#ifndef IN_MAIN +-EXTER +-char stdin_buf[], stdout_buf[]; +-#endif ++EXTER char stdin_buf[],stdout_buf[]; + + EXTER object user_package; + +--- gcl-2.6.12.orig/h/page.h ++++ gcl-2.6.12/h/page.h +@@ -106,7 +106,7 @@ extern fixnum writable_pages; + EXTER long first_data_page,real_maxpage,phys_pages,available_pages; + EXTER void *data_start,*initial_sbrk; + +-#if !defined(IN_MAIN) && defined(SGC) ++#if defined(SGC) + #include "writable.h" + #endif + +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1,13 +1,12 @@ + /* alloc.c:89:OF */ extern void *alloc_page (long n); /* (n) int n; */ +-/* alloc.c:149:OF */ inline void add_page_to_freelist (char *p, struct typemanager *tm); /* (p, tm) char *p; struct typemanager *tm; */ + /* alloc.c:196:OF */ extern object type_name (int t); /* (t) int t; */ +-/* alloc.c:213:OF */ inline object alloc_object (enum type t); /* (t) enum type t; */ +-/* alloc.c:213:OF */ inline void add_pages(struct typemanager *,fixnum); +-/* alloc.c:296:OF */ extern inline object make_cons (object a, object d); /* (a, d) object a; object d; */ ++/* alloc.c:213:OF */ object alloc_object (enum type t); /* (t) enum type t; */ ++/* alloc.c:213:OF */ void add_pages(struct typemanager *,fixnum); ++/* alloc.c:296:OF */ extern object make_cons (object a, object d); /* (a, d) object a; object d; */ + /* 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 inline void insert_contblock (void *p, ufixnum 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 *); /* () */ +@@ -1841,43 +1840,40 @@ struct htent *gethash(object,object); + int + update_real_maxpage(void); + +-inline fixnum ++fixnum + set_tm_maxpage(struct typemanager *,fixnum); + + void + init_gmp_rnd_state(__gmp_randstate_struct *); + +-inline void +-set_sgc_bit(struct pageinfo *,void *); +- + void + reinit_gmp(void); + + object + mod(object,object); + +-inline void ++void + intdivrem(object,object,fixnum,object *,object *); + +-inline object ++object + integer_count(object); + +-inline object ++object + integer_length(object); + +-inline bool ++bool + integer_bitp(object,object); + +-inline object ++object + fixnum_times(fixnum,fixnum); + +-inline object ++object + log_op2(fixnum,object,object); + +-inline object ++object + fixnum_big_shift(fixnum,fixnum); + +-inline object ++object + integer_shift(object,object); + + object +@@ -1921,22 +1917,19 @@ sigint(void); + void + allocate_code_block_reserve(void); + +-inline void +-resize_hole(ufixnum,enum type); +- +-inline void * ++void * + alloc_contblock_no_gc(size_t); + +-inline void ++void + reset_contblock_freelist(void); + +-inline void ++void + empty_relblock(void); + + fixnum + check_avail_pages(void); + +-inline int ++int + mbrk(void *); + + void +@@ -1948,5 +1941,8 @@ alloc_code_space(size_t); + object + fSmake_vector1_2(fixnum,fixnum,object,object); + +-inline struct pageinfo * ++struct pageinfo * + get_pageinfo(void *); ++ ++void ++add_page_to_freelist(char *, struct typemanager *); +--- gcl-2.6.12.orig/h/writable.h ++++ gcl-2.6.12/h/writable.h +@@ -1,7 +1,7 @@ + EXTER fixnum last_page; + EXTER int last_result; + +-EXTER inline int ++INLINE int + set_writable(fixnum i,bool m) { + + fixnum j; +@@ -32,7 +32,7 @@ set_writable(fixnum i,bool m) { + + } + +-EXTER inline int ++INLINE int + is_writable(fixnum i) { + + fixnum j; +@@ -51,7 +51,7 @@ is_writable(fixnum i) { + + } + +-EXTER inline int ++INLINE int + is_writable_cached(fixnum i) { + + if (last_page==i) +--- gcl-2.6.12.orig/makefile ++++ gcl-2.6.12/makefile +@@ -265,7 +265,7 @@ $(HDIR)new_decl.h: + + $(HDIR)mcompdefs.h: $(HDIR)compdefs.h $(HDIR)new_decl.h + $(AWK) 'BEGIN {print "#include \"include.h\"";print "#include \"cmponly.h\"";print "---"} {a=$$1;gsub("\\.\\.\\.","",a);print "\"#define " $$1 "\" " a}' $< |\ +- $(CC) -E -I./$(HDIR) - |\ ++ $(CC) -E -P -I./$(HDIR) - |\ + $(AWK) '/^\-\-\-$$/ {i=1;next} {if (!i) next} {gsub("\"","");print}' >$@ + + $(HDIR)cmpinclude.h: $(HDIR)mcompdefs.h $(CMPINCLUDE_FILES) $(HDIR)config.h +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -134,7 +134,7 @@ acomp(const void *v1,const void *v2) { + + } + +-inline struct pageinfo * ++struct pageinfo * + get_pageinfo(void *x) { + + struct pageinfo **pp=bsearchleq(&x,contblock_array->v.v_self,contblock_array->v.v_fillp,sizeof(*contblock_array->v.v_self),acomp); +@@ -144,7 +144,7 @@ get_pageinfo(void *x) { + + } + +-inline void ++static inline void + add_page_to_contblock_list(void *p,fixnum m) { + + struct pageinfo *pp=pageinfo(p); +@@ -176,7 +176,70 @@ icomp(const void *v1,const void *v2) { + return *f1<*f2 ? -1 : *f1==*f2 ? 0 : +1; + } + +-inline void ++ ++void ++add_page_to_freelist(char *p, struct typemanager *tm) { ++ ++ short t,size; ++ long i=tm->tm_nppage,fw; ++ object x,f; ++ struct pageinfo *pp; ++ ++ t=tm->tm_type; ++ ++ size=tm->tm_size; ++ f=tm->tm_free; ++ pp=pageinfo(p); ++ bzero(pp,sizeof(*pp)); ++ pp->type=t; ++ pp->magic=PAGE_MAGIC; ++ ++ if (cell_list_head==NULL) ++ cell_list_tail=cell_list_head=pp; ++ else if (pp > cell_list_tail) { ++ cell_list_tail->next=pp; ++ cell_list_tail=pp; ++ } ++ ++ x= (object)pagetochar(page(p)); ++ /* set_type_of(x,t); */ ++ make_free(x); ++ ++#ifdef SGC ++ ++ 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 ++ are many arrays in a system to make the headers not writable, ++ but just SGC_TOUCH the header each time you write to it. this ++ is what is done with t_structure */ ++ if (t==(tm_of(t_array)->tm_type)) ++ pp->sgc_flags|=SGC_PERM_WRITABLE; ++ ++#endif ++ ++ fw= *(fixnum *)x; ++ while (--i >= 0) { ++ *(fixnum *)x=fw; ++ SET_LINK(x,f); ++ f=x; ++ x= (object) ((char *)x + size); ++ } ++ ++ tm->tm_free=f; ++ tm->tm_nfree += tm->tm_nppage; ++ tm->tm_npage++; ++ ++} ++ ++static inline void + maybe_reallocate_page(struct typemanager *ntm,ufixnum count) { + + void **y,**n; +@@ -248,7 +311,7 @@ int reserve_pages_for_signal_handler=30; + reserve_pages_for_signal_handler pages on hand in the hole + */ + +-inline void ++void + empty_relblock(void) { + + object o=sSAleaf_collection_thresholdA->s.s_dbind; +@@ -262,7 +325,7 @@ empty_relblock(void) { + + } + +-inline void ++static inline void + resize_hole(ufixnum hp,enum type tp) { + + char *new_start=heap_end+hp*PAGESIZE; +@@ -283,7 +346,7 @@ resize_hole(ufixnum hp,enum type tp) { + + } + +-inline void * ++void * + alloc_page(long n) { + + bool s=n<0; +@@ -332,7 +395,7 @@ alloc_page(long n) { + + struct pageinfo *cell_list_head=NULL,*cell_list_tail=NULL;; + +-inline ufixnum ++static inline ufixnum + sum_maxpages(void) { + + ufixnum i,j; +@@ -352,7 +415,7 @@ check_avail_pages(void) { + } + + +-inline fixnum ++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); +@@ -365,69 +428,6 @@ set_tm_maxpage(struct typemanager *tm,fi + return 1; + } + +- +-inline void +-add_page_to_freelist(char *p, struct typemanager *tm) { +- +- short t,size; +- long i=tm->tm_nppage,fw; +- object x,f; +- struct pageinfo *pp; +- +- t=tm->tm_type; +- +- size=tm->tm_size; +- f=tm->tm_free; +- pp=pageinfo(p); +- bzero(pp,sizeof(*pp)); +- pp->type=t; +- pp->magic=PAGE_MAGIC; +- +- if (cell_list_head==NULL) +- cell_list_tail=cell_list_head=pp; +- else if (pp > cell_list_tail) { +- cell_list_tail->next=pp; +- cell_list_tail=pp; +- } +- +- x= (object)pagetochar(page(p)); +- /* set_type_of(x,t); */ +- make_free(x); +- +-#ifdef SGC +- +- 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 +- are many arrays in a system to make the headers not writable, +- but just SGC_TOUCH the header each time you write to it. this +- is what is done with t_structure */ +- if (t==(tm_of(t_array)->tm_type)) +- pp->sgc_flags|=SGC_PERM_WRITABLE; +- +-#endif +- +- fw= *(fixnum *)x; +- while (--i >= 0) { +- *(fixnum *)x=fw; +- SET_LINK(x,f); +- f=x; +- x= (object) ((char *)x + size); +- } +- +- tm->tm_free=f; +- tm->tm_nfree += tm->tm_nppage; +- tm->tm_npage++; +- +-} +- + object + type_name(int t) { + return make_simple_string(tm_table[(int)t].tm_name+1); +@@ -435,7 +435,7 @@ type_name(int t) { + + + static void +-call_after_gbc_hook(t) { ++call_after_gbc_hook(int t) { + if (sSAafter_gbc_hookA && sSAafter_gbc_hookA->s.s_dbind!= Cnil) { + set_up_string_register(tm_table[(int)t].tm_name+1); + ifuncall1(sSAafter_gbc_hookA->s.s_dbind,intern(string_register,system_package)); +@@ -536,7 +536,7 @@ rebalance_maxpages(struct typemanager *m + + } + +-inline long ++long + opt_maxpage(struct typemanager *my_tm) { + + double x=0.0,y=0.0,z,r; +@@ -707,7 +707,7 @@ find_contblock(ufixnum n,void **p) { + return find_cbpp(*p,n); + } + +-inline void ++void + print_cb(int print) { + + struct contblock *cbp,***cbppp,**cbpp=&cb_pointer; +@@ -729,7 +729,7 @@ print_cb(int print) { + + } + +-inline void ++void + insert_contblock(void *p,ufixnum s) { + + struct contblock *cbp=p,**cbpp,***cbppp; +@@ -761,7 +761,7 @@ delete_contblock(void *p,struct contbloc + + } + +-inline void ++void + reset_contblock_freelist(void) { + + cb_pointer=NULL; +@@ -769,7 +769,7 @@ reset_contblock_freelist(void) { + + } + +-inline void * ++static inline void * + alloc_from_freelist(struct typemanager *tm,fixnum n) { + + void *p; +@@ -851,7 +851,7 @@ too_full_p(struct typemanager *tm) { + + } + +-inline void * ++static inline void * + alloc_after_gc(struct typemanager *tm,fixnum n) { + + if (tm->tm_npage+tpage(tm,n)>tm->tm_maxpage && GBC_enable) { +@@ -883,7 +883,7 @@ alloc_after_gc(struct typemanager *tm,fi + + } + +-inline void ++void + add_pages(struct typemanager *tm,fixnum m) { + + switch (tm->tm_type) { +@@ -923,7 +923,7 @@ add_pages(struct typemanager *tm,fixnum + + } + +-inline void * ++static inline void * + alloc_after_adding_pages(struct typemanager *tm,fixnum n) { + + fixnum m=tpage(tm,n); +@@ -945,7 +945,7 @@ alloc_after_adding_pages(struct typemana + + } + +-inline void * ++static inline void * + alloc_after_reclaiming_pages(struct typemanager *tm,fixnum n) { + + fixnum m=tpage(tm,n),reloc_min; +@@ -972,10 +972,10 @@ alloc_after_reclaiming_pages(struct type + + } + +-inline void *alloc_mem(struct typemanager *,fixnum); ++static inline void *alloc_mem(struct typemanager *,fixnum); + + #ifdef SGC +-inline void * ++static inline void * + alloc_after_turning_off_sgc(struct typemanager *tm,fixnum n) { + + if (!sgc_enabled) return NULL; +@@ -985,7 +985,7 @@ alloc_after_turning_off_sgc(struct typem + } + #endif + +-inline void * ++static inline void * + alloc_mem(struct typemanager *tm,fixnum n) { + + void *p; +@@ -1007,7 +1007,7 @@ alloc_mem(struct typemanager *tm,fixnum + return exhausted_report(tm->tm_type,tm); + } + +-inline object ++object + alloc_object(enum type t) { + + object obj; +@@ -1022,12 +1022,12 @@ alloc_object(enum type t) { + + } + +-inline void * ++void * + alloc_contblock(size_t n) { + return alloc_mem(tm_of(t_contiguous),CEI(n,CPTR_SIZE)); + } + +-inline void * ++void * + alloc_contblock_no_gc(size_t n) { + + struct typemanager *tm=tm_of(t_contiguous); +@@ -1073,7 +1073,7 @@ alloc_code_space(size_t sz) { + + } + +-inline void * ++void * + alloc_relblock(size_t n) { + + return alloc_mem(tm_of(t_relocatable),CEI(n,PTR_ALIGN)); +@@ -1089,7 +1089,7 @@ load_cons(object p,object a,object d) { + p->c.c_car=a; + } + +-inline object ++object + make_cons(object a,object d) { + + static struct typemanager *tm=tm_table+t_cons;/*FIXME*/ +@@ -1105,7 +1105,7 @@ make_cons(object a,object d) { + + + +-inline object on_stack_cons(object x, object y) { ++object on_stack_cons(object x, object y) { + object p = (object) alloca_val; + load_cons(p,x,y); + return p; +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -158,7 +158,7 @@ in_contblock_stack_list(void *p,void *** + return a && a[0]==p; + } + +-inline char ++static inline char + get_bit(char *v,struct pageinfo *pi,void *x) { + void *ve=CB_DATA_START(pi); + fixnum off=(x-ve)>>LOG_BYTES_CONTBLOCK,i=off>>LOG_BITS_CHAR,s=off&~(~0UL<>s)&0x1; + } + +-inline void ++static inline void + set_bit(char *v,struct pageinfo *pi,void *x) { + void *ve=CB_DATA_START(pi); + fixnum off=(x-ve)>>LOG_BYTES_CONTBLOCK,i=off>>LOG_BITS_CHAR,s=off&~(~0UL<>LOG_BYTES_CONTBLOCK;i=_o>>LOG_BITS_CHAR;s=_o&~(~0UL< + void change_contexts(); +@@ -47,6 +45,11 @@ int ovm_process_created; + void initialize_process(); + #endif + ++ ++#define EXTER ++#define INLINE ++ ++ + #include "include.h" + #include + #include "page.h" +@@ -118,7 +121,7 @@ cstack_dir(fixnum j) { + + fixnum log_maxpage_bound=sizeof(fixnum)*8-1; + +-inline int ++int + mbrk(void *v) { + + ufixnum uv=(ufixnum)v,uc=(ufixnum)sbrk(0),ux,um; +@@ -1120,10 +1123,6 @@ init_main(void) { + + } + +-#ifdef SGC +-#include "writable.h" +-#endif +- + #ifdef HAVE_PRINT_INSN_I386 + + #include "dis-asm.h" +--- gcl-2.6.12.orig/o/makefile ++++ gcl-2.6.12/o/makefile +@@ -20,7 +20,7 @@ OBJS:=$(addsuffix .o,typespec main alloc + num_pred num_comp num_arith num_sfun num_co num_log num_rand earith character sequence list hash\ + array string regexpr structure toplevel file read backq print format pathname unixfsys unixfasl\ + error unixtime unixsys unixsave funlink fat_string run_process nfunlink usig usig2 utils makefun\ +- sockets gmp_wrappers clxsocket init_pari nsocket sfasl prelink) ++ sockets clxsocket init_pari nsocket sfasl prelink) + OBJS:=$(OBJS) $(RL_OBJS) $(EXTRAS) + + INI_FILES=$(patsubst %.o,%.ini,${OBJS}) +--- gcl-2.6.12.orig/o/num_arith.c ++++ gcl-2.6.12/o/num_arith.c +@@ -62,7 +62,7 @@ object fixnum_sub(fixnum i, fixnum j) + } + } + +-inline object ++object + fixnum_times(fixnum i, fixnum j) { + + #ifdef HAVE_CLZL +--- gcl-2.6.12.orig/o/num_co.c ++++ gcl-2.6.12/o/num_co.c +@@ -277,7 +277,7 @@ LFD(Ldenominator)(void) + vs_base[0] = small_fixnum(1); + } + +-inline void ++void + intdivrem(object x,object y,fixnum d,object *q,object *r) { + + enum type tx=type_of(x),ty=type_of(y); +--- gcl-2.6.12.orig/o/num_log.c ++++ gcl-2.6.12/o/num_log.c +@@ -37,12 +37,12 @@ Foundation, 675 Mass Ave, Cambridge, MA + + + +-inline object ++object + fixnum_big_shift(fixnum x,fixnum w) { + MPOP(return,shifti,SI_TO_MP(x,big_fixnum1),w); + } + +-inline object ++object + integer_fix_shift(object x, fixnum w) { + if (type_of(x)==t_fixnum) { + fixnum fx=fix(x); +@@ -51,7 +51,7 @@ integer_fix_shift(object x, fixnum w) { + MPOP(return,shifti,MP(x),w); + } + +-inline object ++object + integer_shift(object x,object y) { + enum type tx=type_of(x),ty=type_of(y); + if (ty==t_fixnum) +@@ -66,12 +66,12 @@ integer_shift(object x,object y) { + } + } + +-inline object ++object + integer_length(object x) { + return make_fixnum(type_of(x)==t_fixnum ? fixnum_length(fix(x)) : MP_SIZE_IN_BASE2(MP(x))); + } + +-inline object ++object + integer_count(object x) { + return make_fixnum(type_of(x)==t_fixnum ? fixnum_count(fix(x)) : MP_BITCOUNT(MP(x))); + } +@@ -120,7 +120,7 @@ LFD(Lboole)(void) + + } + +-inline bool ++bool + integer_bitp(object p,object x) { + enum type tp=type_of(p),tx=type_of(x); + +--- gcl-2.6.12.orig/o/num_sfun.c ++++ gcl-2.6.12/o/num_sfun.c +@@ -94,7 +94,7 @@ number_exp(object x) + } + } + +-inline object ++static inline object + number_fix_iexpt(object x,fixnum y,fixnum ly,fixnum j) { + object z; + +@@ -103,7 +103,7 @@ number_fix_iexpt(object x,fixnum y,fixnu + return fixnum_bitp(j,y) ? number_times(x,z) : z; + } + +-inline object ++static inline object + number_big_iexpt(object x,object y,fixnum ly,fixnum j) { + object z; + +@@ -113,7 +113,7 @@ number_big_iexpt(object x,object y,fixnu + + } + +-inline object ++static inline object + number_zero_expt(object x,bool promote_short_p) { + + switch (type_of(x)) { +@@ -135,7 +135,7 @@ number_zero_expt(object x,bool promote_s + } + + +-inline object ++static inline object + number_ui_expt(object x,fixnum fy) { + + switch (type_of(x)) { +@@ -173,17 +173,17 @@ number_ui_expt(object x,fixnum fy) { + + } + +-inline object ++static inline object + number_ump_expt(object x,object y) { + return number_big_iexpt(x,y,fix(integer_length(y)),0); + } + +-inline object ++static inline object + number_log_expt(object x,object y) { + return number_zerop(y) ? number_zero_expt(y,type_of(x)==t_longfloat) : number_exp(number_times(number_nlog(x),y)); + } + +-inline object ++static inline object + number_invert(object x,object y,object z) { + + switch (type_of(z)) { +@@ -198,7 +198,7 @@ number_invert(object x,object y,object z + } + + +-inline object ++static inline object + number_si_expt(object x,object y) { + switch (type_of(y)) { + case t_fixnum: +--- gcl-2.6.12.orig/o/package.d ++++ gcl-2.6.12/o/package.d +@@ -114,7 +114,7 @@ static int package_sizes[]={ + 32749, 65521, 131071, 262139, 524287, 1048573}; + + static int +-suitable_package_size(n) ++suitable_package_size(int n) + {int *i=package_sizes; + if (n>= 1000000) return 1048573; + while(*i < n) { i++;} diff --git a/patches/Version_2_6_13pre8b b/patches/Version_2_6_13pre8b new file mode 100644 index 00000000..fef1bb0f --- /dev/null +++ b/patches/Version_2_6_13pre8b @@ -0,0 +1,43 @@ +Description: + 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-9) unstable; urgency=medium + . + * Version_2_6_13pre8a + * Bug fix: "ftbfs with GCC-5", thanks to Matthias Klose (Closes: + #777866). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/777866 + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/o/prelink.c ++++ gcl-2.6.12/o/prelink.c +@@ -2,6 +2,12 @@ + + #include "include.h" + ++extern FILE *stdin __attribute__((weak)); ++extern FILE *stderr __attribute__((weak)); ++extern FILE *stdout __attribute__((weak)); ++extern rl_compentry_func_t *rl_completion_entry_function __attribute__((weak)); ++extern const char *rl_readline_name __attribute__((weak)); ++ + void + prelink_init(void) { + diff --git a/patches/ansi-test-clean-target b/patches/ansi-test-clean-target new file mode 100644 index 00000000..15f42d93 --- /dev/null +++ b/patches/ansi-test-clean-target @@ -0,0 +1,33 @@ +Description: + 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-39) unstable; urgency=medium + . + * pathnames1.1 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-12 + +--- gcl-2.6.12.orig/ansi-tests/makefile ++++ gcl-2.6.12/ansi-tests/makefile +@@ -8,3 +8,5 @@ test: + + clean: + rm -f test.out *.fasl *.o *.so *~ *.fn *.x86f *.fasl *.ufsl ++ rm -f foo.txt temp.dat file-that-was-renamed.txt tmp.dat tmp.dat.BAK tmp2.dat ++ rm -rf scratch tmp.txt foo.lsp 'CLTEST:foo.txt' diff --git a/patches/data_bss_offset-in-unexec-sparc64-fix b/patches/data_bss_offset-in-unexec-sparc64-fix new file mode 100644 index 00000000..08d1543d --- /dev/null +++ b/patches/data_bss_offset-in-unexec-sparc64-fix @@ -0,0 +1,83 @@ +Description: + 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-31) unstable; urgency=medium + . + * Version_2_6_13pre39 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/o/unexelf.c ++++ gcl-2.6.12/o/unexelf.c +@@ -428,6 +428,8 @@ extern void fatal (char *, ...); + #include /* for HDRR declaration */ + #endif /* __sgi */ + ++#include "page.h" ++ + #ifndef MAP_ANON + #ifdef MAP_ANONYMOUS + #define MAP_ANON MAP_ANONYMOUS +@@ -655,7 +657,7 @@ unexec (char *new_name, char *old_name, + char *old_section_names; + + 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; ++ ElfW(Off) old_bss_size, new_data2_size,old_bss_offset,new_data2_offset,old_file_size,new_file_size,data_bss_offset; + + int n, nn; + int old_bss_index, old_sbss_index; +@@ -772,7 +774,9 @@ unexec (char *new_name, char *old_name, + if (new_file < 0) + fatal ("Can't creat (%s): errno %d\n", new_name, errno); + +- new_file_size = stat_buf.st_size + old_file_h->e_shentsize + new_data2_size + (new_data2_offset-old_bss_offset); ++ data_bss_offset=CEI(new_data2_offset-old_bss_offset,sizeof(long));/*????, e.g. sparc64*/ ++ ++ new_file_size = stat_buf.st_size + old_file_h->e_shentsize + new_data2_size + data_bss_offset; + + if (ftruncate (new_file, new_file_size)) + fatal ("Can't ftruncate (%s): errno %d\n", new_name, errno); +@@ -784,7 +788,7 @@ unexec (char *new_name, char *old_name, + new_file_h = (ElfW(Ehdr) *) new_base; + new_program_h = (ElfW(Phdr) *) ((byte *) new_base + old_file_h->e_phoff); + new_section_h = (ElfW(Shdr) *) +- ((byte *) new_base + old_file_h->e_shoff + new_data2_size + (new_data2_offset-old_bss_offset)); ++ ((byte *) new_base + old_file_h->e_shoff + new_data2_size + data_bss_offset); + + + /* Make our new file, program and section headers as copies of the +@@ -802,7 +806,7 @@ unexec (char *new_name, char *old_name, + * further away now. + */ + +- new_file_h->e_shoff += new_data2_size + (new_data2_offset-old_bss_offset); ++ new_file_h->e_shoff += new_data2_size + data_bss_offset; + new_file_h->e_shnum += 1; + + #ifdef DEBUG +@@ -958,7 +962,7 @@ unexec (char *new_name, char *old_name, + if (NEW_SECTION_H (nn).sh_offset >= old_bss_offset || + /* solaris has symtab straddling bss offset */ + NEW_SECTION_H (nn).sh_offset+NEW_SECTION_H (nn).sh_size > old_bss_offset) +- NEW_SECTION_H (nn).sh_offset += new_data2_size+(new_data2_offset-old_bss_offset); ++ NEW_SECTION_H (nn).sh_offset += new_data2_size+data_bss_offset; + #endif + /* Any section that was originally placed after the section + header table should now be off by the size of one section diff --git a/patches/defined_real_maxpage b/patches/defined_real_maxpage new file mode 100644 index 00000000..4fe1d27f --- /dev/null +++ b/patches/defined_real_maxpage @@ -0,0 +1,71 @@ +Description: + 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-50) unstable; urgency=medium + . + * list_order.6 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-06-14 + +--- gcl-2.6.12.orig/h/386-gnu.h ++++ gcl-2.6.12/h/386-gnu.h +@@ -59,3 +59,5 @@ + #define RELOC_H "elf32_i386_reloc.h" + + #define NEED_STACK_CHK_GUARD ++ ++#define DEFINED_REAL_MAXPAGE (1UL<<18) /*FIXME brk probe broken*/ +--- gcl-2.6.12.orig/h/m68k-linux.h ++++ gcl-2.6.12/h/m68k-linux.h +@@ -78,3 +78,5 @@ int cacheflush(void *,int,int,int); + #define RELOC_H "elf32_m68k_reloc.h" + + #define NEED_STACK_CHK_GUARD ++ ++#define DEFINED_REAL_MAXPAGE (1UL<<18) /*FIXME brk probe broken*/ +--- gcl-2.6.12.orig/h/sh4-linux.h ++++ gcl-2.6.12/h/sh4-linux.h +@@ -56,3 +56,5 @@ + #define RELOC_H "elf32_sh4_reloc.h" + + #define NEED_STACK_CHK_GUARD ++ ++#define DEFINED_REAL_MAXPAGE (1UL<<18) /*FIXME brk probe broken*/ +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -302,6 +302,9 @@ update_real_maxpage(void) { + } + #endif + ++#ifdef DEFINED_REAL_MAXPAGE ++ real_maxpage=DEFINED_REAL_MAXPAGE; ++#else + massert(cur=sbrk(0)); + beg=data_start ? data_start : cur; + for (i=0,j=(1L<PAGESIZE;j>>=1) +@@ -311,7 +314,8 @@ update_real_maxpage(void) { + i+=j; + } + massert(!mbrk(cur)); +- ++#endif ++ + phys_pages=ufmin(get_phys_pages1(0)+page(beg),real_maxpage)-page(beg); + + get_gc_environ(); diff --git a/patches/disable_gprof_aarch64 b/patches/disable_gprof_aarch64 new file mode 100644 index 00000000..239d89c2 --- /dev/null +++ b/patches/disable_gprof_aarch64 @@ -0,0 +1,56 @@ +Description: + 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-54) unstable; urgency=medium + . + * list_order.11 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-08-24 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4122,6 +4122,7 @@ $as_echo_n "checking working gprof... " + ia64*) enableval="no";; + hppa*) enableval="no";; + arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++ aarch64*) enableval="no";;#unreproducible buildd bug 20170824 + *gnu) enableval="no";; + esac + if test "$enableval" != "yes" ; then +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -335,6 +335,7 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof + ia64*) enableval="no";; + hppa*) enableval="no";; + arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++ aarch64*) enableval="no";;#unreproducible buildd bug 20170824 + *gnu) enableval="no";; + esac + if test "$enableval" != "yes" ; then +--- gcl-2.6.12.orig/o/regexp.c ++++ gcl-2.6.12/o/regexp.c +@@ -231,7 +231,7 @@ int case_fold_search = 0; + * of the structure of the compiled regexp. + */ + static regexp * +-regcomp(char *exp,int *sz) ++regcomp(char *exp,ufixnum *sz) + { + register regexp *r; + register char *scan; diff --git a/patches/list_order.1 b/patches/list_order.1 new file mode 100644 index 00000000..f04c29e2 --- /dev/null +++ b/patches/list_order.1 @@ -0,0 +1,8651 @@ +Description: + 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-47) unstable; urgency=high + . + * pathnames1.13 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-05-28 + +--- gcl-2.6.12.orig/clcs/sys-proclaim.lisp ++++ gcl-2.6.12/clcs/sys-proclaim.lisp +@@ -4,7 +4,9 @@ + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- CONDITIONS::COERCE-TO-FN CONDITIONS::SLOT-SYM)) ++ COMMON-LISP::DEFINE-CONDITION COMMON-LISP::HANDLER-CASE ++ COMMON-LISP::IGNORE-ERRORS COMMON-LISP::HANDLER-BIND ++ CONDITIONS::SLOT-SYM CONDITIONS::COERCE-TO-FN)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +@@ -20,27 +22,27 @@ + CONDITIONS::|(PCL::FAST-METHOD MAKE-LOAD-FORM (CONDITION))|)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +- CONDITIONS::IS-CONDITION CONDITIONS::DEFAULT-REPORT +- CONDITIONS::IS-WARNING 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 (PACKAGE-ERROR T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CASE-FAILURE T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ABORT-FAILURE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (STREAM-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNDEFINED-FUNCTION T))| + CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (FILE-ERROR T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-VARIABLE T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ARITHMETIC-ERROR T))| + CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (END-OF-FILE T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (STREAM-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PRINT-NOT-READABLE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CASE-FAILURE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PACKAGE-ERROR T))| + CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CELL-ERROR T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (SIMPLE-CONDITION T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-SLOT T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNDEFINED-FUNCTION T))| + CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-CONDITION T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PRINT-NOT-READABLE T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (TYPE-ERROR T))|)) +\ No newline at end of file ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ABORT-FAILURE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ARITHMETIC-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-SLOT T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (TYPE-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (SIMPLE-CONDITION T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-VARIABLE T))|)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ CONDITIONS::CONDITIONP CONDITIONS::DEFAULT-REPORT ++ CONDITIONS::IS-CONDITION CONDITIONS::IS-WARNING)) +\ No newline at end of file +--- gcl-2.6.12.orig/cmpnew/gcl_cmpcall.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpcall.lsp +@@ -27,8 +27,7 @@ + (eval-when (compile eval) + (defmacro link-arg-p (x) + `(let ((.u ,x)) +- (not (member .u '(character boolean long-float short-float))))) +-) ++ (not (member .u '(character boolean long-float short-float) :test 'eq))))) + + (defun fast-link-proclaimed-type-p (fname &optional args) + (and +@@ -134,6 +133,7 @@ + (let ((*vs* *vs*) (form (caddr funob))) + (declare (object form)) + (cond ((and (listp args) ++ (< (length args) 12) ;FIXME fcalln1 limitation + *use-sfuncall* + ;;Determine if only one value at most is required: + (or +@@ -167,8 +167,9 @@ + (defun fcalln-inline (&rest args) + (wt-nl "({object _f=" (car args) ";enum type _t=type_of(_f);") + (wt-nl "_f = _t==t_symbol && _f->s.s_gfdef!=OBJNULL ? (_t=type_of(_f->s.s_gfdef),_f->s.s_gfdef) : _f;") +- (wt-nl "_t==t_sfun ? _f->sfn.sfn_self : ") +- (wt-nl "(fcall.argd= " (length (cdr args)) ",_t==t_vfun ? _f->vfn.vfn_self : ") ++ (wt-nl "_t==t_sfun&&(_f->sfn.sfn_argd&0xff)== " (length (cdr args)) " ? _f->sfn.sfn_self : ") ++ (wt-nl "(fcall.argd= " (length (cdr args)) ++ ",_t==t_vfun&&_f->vfn.vfn_minargs<= " (length (cdr args)) "&&" (length (cdr args)) "<=_f->vfn.vfn_maxargs ? _f->vfn.vfn_self : ") + (wt-nl "(fcall.fun=_f,fcalln));})") + (wt-nl "(") + (when (cdr args) (wt (cadr args)) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpenv.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpenv.lsp +@@ -376,9 +376,7 @@ + doc form) + (loop + (when (endp body) (return)) +- (setq form (cmp-macroexpand (car body))) +- (when (and (consp form) (eq (car form) 'load-time-value)) +- (setq form (cmp-eval form))) ++ (setq form (car body)) + (cond + ((stringp form) + (when (or (null doc-p) (endp (cdr body)) doc) (return)) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpfun.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpfun.lsp +@@ -603,7 +603,9 @@ + (t + `(si::structure-subtype-p + ,x ',type)))) +-; ((and (print (list 'slow 'typep type)) nil)) ++ ((and (symbolp type) (setq tem (get type 'si::deftype-definition))) ++ `(typep ,x ',(funcall tem))) ++ ;; ((and (print (list 'slow 'typep type)) nil)) + (t nil))) + (and new (c1expr `(the boolean , new))))) + +@@ -877,36 +879,6 @@ + (c1expr (cmp-eval (cons f args)))))) + + +-(si::putprop 'do 'co1special-fix-decl 'co1special) +-(si::putprop 'do* 'co1special-fix-decl 'co1special) +-(si::putprop 'prog 'co1special-fix-decl 'co1special) +-(si::putprop 'prog* 'co1special-fix-decl 'co1special) +- +-(defun co1special-fix-decl (f args) +- (flet ((fixup (forms &aux decls ) +- (block nil +- (tagbody +- top +- (or (consp forms) (go end)) +- (let ((tem (car forms))) +- (if (and (consp tem) +- (setq tem (cmp-macroexpand tem)) +- (eq (car tem) 'declare)) +- (progn (push tem decls) (pop forms)) +- (go end))) +- (go top) +- ; all decls made explicit. +- end +- (return (nconc (nreverse decls) forms)))))) +- (c1expr +- (cmp-macroexpand +- (case f +- ((do do*) `(,f ,(car args) +- ,(second args) +- ,@ (fixup (cddr args)))) +- ((prog prog*) +- `(,f ,(car args) +- ,@ (fixup (cdr args))))))))) + (si::putprop 'sublis 'co1sublis 'co1) + (defun co1sublis (f args &aux test) f + (and (case (length args) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpinline.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpinline.lsp +@@ -465,7 +465,7 @@ + (t . INLINE))) + + (defun inline-type (type) +- (or (cdr (assoc type *inline-types*)) 'inline)) ++ (or (cdr (assoc type *inline-types* :test 'eq)) 'inline)) + + (defun get-inline-info (fname args return-type &aux x ii) + (and (fast-link-proclaimed-type-p fname args) +--- gcl-2.6.12.orig/cmpnew/gcl_cmplam.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmplam.lsp +@@ -475,9 +475,9 @@ + (*unwind-exit* *unwind-exit*) + (*ccb-vs* *ccb-vs*)) + (when rest +- (wt-nl "vs_top[0]=Cnil;") +- (wt-nl "{object *p=vs_top, *q=vs_base+" (length optionals) ";") +- (wt-nl " for(;p>q;p--)p[-1]=MMcons(p[-1],p[0]);}")) ++ (wt-nl "{object *q=vs_base+" (length optionals) ",*l;") ++ (wt-nl " for (l=q;qc.c_cdr) *l=MMcons(*q,Cnil);") ++ (wt-nl " *l=Cnil;}")) + (do ((opts optionals (cdr opts))) + ((endp opts)) + (declare (object opts)) +@@ -510,11 +510,11 @@ + + (wt-label label))) + (rest +- (wt-nl "vs_top[0]=Cnil;") +- (wt-nl "{object *p=vs_top;") +- (wt-nl " for(;p>vs_base;p--)p[-1]=" ++ (wt-nl "{object *q=vs_base,*l;") ++ (wt-nl " for (l=q;qc.c_cdr) *l=" + (if *rest-on-stack* "ON_STACK_CONS" "MMcons") +- "(p[-1],p[0]);}") ++ "(*q,Cnil);") ++ (wt-nl " *l=Cnil;}") + (c2bind rest) + (wt-nl) + (reset-top)) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmulti.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmulti.lsp +@@ -108,22 +108,11 @@ + (unwind-exit 'fun-val nil (if top-data (car top-data))) + ) + +-(defun c1values (args &aux (info (make-info))) +- (cond ((and args (not (cdr args)) +- (or (not (consp (car args))) +- (and (symbolp (caar args)) +- (let ((tem (get-return-type (caar args)))) +- (and tem +- (or (atom tem) +- (and (consp tem) +- (null (cdr tem)) +- (not (eq '* (car tem)))))))))) +- ;;the compiler put in unnecessary code +- ;;if we just had say (values nil) +- ;; so if we know there's one value only: +- (c1expr (car args))) +- (t (setq args (c1args args info)) +- (list 'values info args)))) ++(defun c1values (args &aux (info (make-info))(s (si::sgen "VALUES"))) ++ (cond ((and args (not (cdr args))) ++ (c1expr `(let ((,s ,(car args))) ,s))) ++ (t (setq args (c1args args info)) ++ (list 'values info args)))) + + (defun c2values (forms &aux (base *vs*) (*vs* *vs*)) + (cond ((and (eq *value-to-go* 'return-object) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpopt.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpopt.lsp +@@ -66,6 +66,10 @@ + (push '((t) boolean #.(flags)"type_of(#0)==t_longfloat") + (get 'long-float-p 'inline-always)) + ++;;COMPLEX-P ++ (push '((t) boolean #.(flags)"type_of(#0)==t_complex") ++ (get 'si::complexp 'inline-always)) ++ + ;;SFEOF + (push '((object) boolean #.(flags set)"(gcl_feof((#0)->sm.sm_fp))") + (get 'sfeof 'inline-unsafe)) +@@ -479,21 +483,56 @@ + (get 'array-total-size 'inline-unsafe)) + + ;;ARRAYP +- (push '((t) boolean #.(flags) +- "@0;type_of(#0)==t_array|| +-type_of(#0)==t_vector|| +-type_of(#0)==t_string|| +-type_of(#0)==t_bitvector") +- (get 'arrayp 'inline-always)) ++;; (push '((t) boolean #.(flags) ++;; "@0;type_of(#0)==t_array|| ++;; type_of(#0)==t_vector|| ++;; type_of(#0)==t_string|| ++;; type_of(#0)==t_bitvector") ++;; (get 'arrayp 'inline-always)) + + ;;ATOM +- (push '((t) boolean #.(flags)"type_of(#0)!=t_cons") ++ (push '((t) boolean #.(flags)"atom(#0)") + (get 'atom 'inline-always)) + + ;;BIT-VECTOR-P + (push '((t) boolean #.(flags)"(type_of(#0)==t_bitvector)") + (get 'bit-vector-p 'inline-always)) + ++;;BIT-VECTOR-P ++ (push '((t) boolean #.(flags)"(type_of(#0)==t_bitvector)") ++ (get 'bit-vector-p 'inline-always)) ++ ++;;HASH-TABLE-P ++ (push '((t) boolean #.(flags)"(type_of(#0)==t_hashtable)") ++ (get 'hash-table-p 'inline-always)) ++ ++;;RANDOM-STATE-P ++ (push '((t) boolean #.(flags)"(type_of(#0)==t_random)") ++ (get 'random-state-p 'inline-always)) ++ ++;;RANDOM-STATE-P ++ (push '((t) boolean #.(flags)"(type_of(#0)==t_random)") ++ (get 'random-state-p 'inline-always)) ++ ++;;PACKAGEP ++ (push '((t) boolean #.(flags)"(type_of(#0)==t_package)") ++ (get 'packagep 'inline-always)) ++ ++;;STREAMP ++ (push '((t) boolean #.(flags)"(type_of(#0)==t_stream)") ++ (get 'streamp 'inline-always)) ++ ++;;READTABLEP ++ (push '((t) boolean #.(flags)"(type_of(#0)==t_readtable)") ++ (get 'readtablep 'inline-always)) ++ ++;;COMPOUND PREDICATES ++(dolist (l '(integerp rationalp floatp realp numberp vectorp arrayp compiled-function-p)) ++ (push ++ `((t) boolean #.(flags) ,(substitute #\_ #\- (concatenate 'string (string-downcase l) "(#0)"))) ++ (get l 'inline-always))) ++ ++ + ;;BOUNDP + (push '((t) boolean #.(flags)"(#0)->s.s_dbind!=OBJNULL") + (get 'boundp 'inline-unsafe)) +@@ -739,7 +778,7 @@ type_of(#0)==t_bitvector") + (get 'cons 'inline-always)) + + ;;CONSP +- (push '((t) boolean #.(flags)"type_of(#0)==t_cons") ++ (push '((t) boolean #.(flags)"consp(#0)") + (get 'consp 'inline-always)) + + ;;COS +@@ -832,9 +871,9 @@ type_of(#0)==t_bitvector") + (get 'float 'inline-always)) + + ;;FLOATP +- (push '((t) boolean #.(flags) +- "@0;type_of(#0)==t_shortfloat||type_of(#0)==t_longfloat") +- (get 'floatp 'inline-always)) ++ ;; (push '((t) boolean #.(flags) ++ ;; "@0;type_of(#0)==t_shortfloat||type_of(#0)==t_longfloat") ++ ;; (get 'floatp 'inline-always)) + + ;;CEILING + (push '((t t) t #.(compiler::flags) "immnum_ceiling(#0,#1)") (get 'ceiling 'compiler::inline-always)) +@@ -861,9 +900,9 @@ type_of(#0)==t_bitvector") + (get 'get 'inline-always)) + + ;;INTEGERP +- (push '((t) boolean #.(flags) +- "@0;type_of(#0)==t_fixnum||type_of(#0)==t_bignum") +- (get 'integerp 'inline-always)) ++ ;; (push '((t) boolean #.(flags) ++ ;; "@0;type_of(#0)==t_fixnum||type_of(#0)==t_bignum") ++ ;; (get 'integerp 'inline-always)) + (push '((fixnum) boolean #.(flags) + "1") + (get 'integerp 'inline-always)) +@@ -940,7 +979,7 @@ type_of(#0)==t_bitvector") + (get 'list* 'inline-always)) + + ;;LISTP +- (push '((t) boolean #.(flags)"@0;type_of(#0)==t_cons||(#0)==Cnil") ++ (push '((t) boolean #.(flags)"listp(#0)") + (get 'listp 'inline-always)) + + ;;si::spice-p +@@ -1082,14 +1121,14 @@ type_of(#0)==t_bitvector") + (get 'null 'inline-always)) + + ;;NUMBERP +- (push '((t) boolean #.(flags) +- "@0;type_of(#0)==t_fixnum|| +-type_of(#0)==t_bignum|| +-type_of(#0)==t_ratio|| +-type_of(#0)==t_shortfloat|| +-type_of(#0)==t_longfloat|| +-type_of(#0)==t_complex") +- (get 'numberp 'inline-always)) ++;; (push '((t) boolean #.(flags) ++;; "@0;type_of(#0)==t_fixnum|| ++;; type_of(#0)==t_bignum|| ++;; type_of(#0)==t_ratio|| ++;; type_of(#0)==t_shortfloat|| ++;; type_of(#0)==t_longfloat|| ++;; type_of(#0)==t_complex") ++;; (get 'numberp 'inline-always)) + + ;;PLUSP + (push '((t) boolean #.(flags) "immnum_plusp(#0)");"number_compare(small_fixnum(0),#0)<0" +@@ -1175,7 +1214,7 @@ type_of(#0)==t_complex") + (get 'si::pathname-designatorp 'inline-always)) + + ;;PATHNAMEP +-(push '((t) boolean #.(flags)"pathnamep(#0)") ++(push '((t) boolean #.(flags)"type_of(#0)==t_pathname") + (get 'pathnamep 'inline-always)) + + ;;STRINGP +@@ -1235,11 +1274,11 @@ type_of(#0)==t_complex") + + + ;;VECTORP +- (push '((t) boolean #.(flags) +- "@0;type_of(#0)==t_vector|| +-type_of(#0)==t_string|| +-type_of(#0)==t_bitvector") +- (get 'vectorp 'inline-always)) ++;; (push '((t) boolean #.(flags) ++;; "@0;type_of(#0)==t_vector|| ++;; type_of(#0)==t_string|| ++;; type_of(#0)==t_bitvector") ++;; (get 'vectorp 'inline-always)) + + ;;WRITE-CHAR + (push '((t) t #.(flags set) +--- gcl-2.6.12.orig/cmpnew/gcl_cmptop.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmptop.lsp +@@ -135,7 +135,6 @@ + ;;; Pass 2 initializers. + + (si:putprop 'defun 't2defun 't2) +-(si:putprop 'defmacro 't2defmacro 't2) + (si:putprop 'declare 't2declare 't2) + (si:putprop 'defentry 't2defentry 't2) + (si:putprop 'si:putprop 't2putprop 't2) +@@ -143,7 +142,6 @@ + ;;; Pass 2 C function generators. + + (si:putprop 'defun 't3defun 't3) +-(si:putprop 'defmacro 't3defmacro 't3) + (si:putprop 'ordinary 't3ordinary 't3) + (si:putprop 'sharp-comma 't3sharp-comma 't3) + (si:putprop 'clines 't3clines 't3) +@@ -205,26 +203,20 @@ + (let ((new (copy-seq str))) + (dash-to-underscore-int new 0 (length new)))) + +-(defun init-name (p &optional sp (gp t) (dc t) (nt t)) + +- (cond ((not sp) "code") +- ((not (pathnamep p)) (init-name (pathname p) sp gp dc nt)) +- (gp (init-name (truename (merge-pathnames p #p".lsp")) sp nil dc nt)) +- ((pathname-type p) +- (init-name (make-pathname +- :host (pathname-host p) +- :device (pathname-device p) +- :directory (pathname-directory p) +- :name (pathname-name p) +- :version (pathname-version p)) sp gp dc nt)) +-; #-aosvs(dc (string-downcase (init-name p sp gp nil nt))) +- ((and nt +- (let* ((pn (pathname-name p)) +- (pp (make-pathname :name pn))) +- (and (not (equal pp p)) +- (eql 4 (string<= "gcl_" pn)) +- (init-name pp sp gp dc nil))))) +- ((dash-to-underscore (namestring p))))) ++(defun init-name (p &optional sp) ++ ++ (if sp ++ (let* ((p (truename (merge-pathnames p #p".lsp"))) ++ (pn (pathname-name p)) ++ (g (zerop (si::string-match #v"^gcl_" pn)))) ++ (dash-to-underscore ++ (namestring ++ (make-pathname :host (unless g (pathname-host p)) ++ :device (unless g (pathname-device p)) ++ :directory (unless g (pathname-directory p)) ++ :name pn)))) ++ "code")) + + ;; FIXME consider making this a macro + (defun c-function-name (prefix num fname) +@@ -469,7 +461,7 @@ + (too-few-args 'defun 2 (length args))) + (cmpck (not (symbolp (car args))) + "The function name ~s is not a symbol." (car args)) +- (maybe-eval nil (cons 'defun args)) ++ (unless (macro-function (car args)) (maybe-eval nil (cons 'defun args))) + (tagbody + top + (setq *non-package-operation* t) +@@ -615,8 +607,9 @@ + (setq type (f-type (pop args)))))) + + +-(defun wt-if-proclaimed (fname cfun lambda-expr) +- (cond ((fast-link-proclaimed-type-p fname) ++(defun wt-if-proclaimed (fname cfun lambda-expr macro-p) ++ (cond (macro-p (add-init `(si::MM ',fname ,(add-address (c-function-name "LI" cfun fname))))) ++ ((fast-link-proclaimed-type-p fname) + (cond ((unless (member '* (get fname 'proclaimed-arg-types)) (assoc fname *inline-functions*)) + (add-init `(si::mfsfun ',fname ,(add-address (c-function-name "LI" cfun fname)) + ,(proclaimed-argd (get fname 'proclaimed-arg-types) +@@ -698,11 +691,11 @@ + (defun si::add-debug (fname x) + (si::putprop fname x 'si::debugger)) + +-(defun t3init-fun (fname cfun lambda-expr doc) ++(defun t3init-fun (fname cfun lambda-expr doc macro-p) + + (when doc (add-init `(si::putprop ',fname ,doc 'si::function-documentation))) + +- (cond ((wt-if-proclaimed fname cfun lambda-expr)) ++ (cond ((wt-if-proclaimed fname cfun lambda-expr macro-p)) + ((vararg-p fname) + (let ((keyp (ll-keywords-p (lambda-list lambda-expr)))) + ; (wt-h "static object LI" cfun "();") +@@ -724,6 +717,7 @@ + (add-init `(si::mf ',fname ,(add-address (c-function-name "" cfun fname))))))) + + (defun t3defun (fname cfun lambda-expr doc sp &aux inline-info ++ (macro-p (equal `(mflag ,fname) (cadr (member *current-form* *top-level-forms*)))) + (*current-form* (list 'defun fname)) + (*volatile* (volatile (second lambda-expr))) + *downward-closures*) +@@ -736,9 +730,9 @@ + (return (setq inline-info v)))) + + ;;; Add global entry information. +- (when (not (fast-link-proclaimed-type-p fname)) +- (push (list fname cfun (cadr inline-info) (caddr inline-info)) +- *global-entries*)) ++ (unless (or macro-p (fast-link-proclaimed-type-p fname)) ++ (push (list fname cfun (cadr inline-info) (caddr inline-info)) ++ *global-entries*)) + + ;;; Local entry + (analyze-regs (cadr lambda-expr) 0) +@@ -761,7 +755,7 @@ + + (wt-downward-closure-macro cfun) + +- (t3init-fun fname cfun lambda-expr doc) ++ (t3init-fun fname cfun lambda-expr doc macro-p) + + (add-debug-info fname lambda-expr)) + +@@ -1333,63 +1327,13 @@ + (long-float "double ") + (otherwise "object "))) + +- +-(defun t1defmacro (args) +- (when (or (endp args) (endp (cdr args))) +- (too-few-args 'defmacro 2 (length args))) +- (cmpck (not (symbolp (car args))) +- "The macro name ~s is not a symbol." (car args)) +- (maybe-eval t (cons 'defmacro args)) +- (setq *non-package-operation* t) +- (let ((*vars* nil) (*funs* nil) (*blocks* nil) (*tags* nil) +- (*sharp-commas* nil) (*special-binding* nil) +- macro-lambda (cfun (next-cfun))) +- (setq macro-lambda (c1dm (car args) (cadr args) (cddr args))) +- (add-load-time-sharp-comma) +- (push (list 'defmacro (car args) cfun (cddr macro-lambda) +- (car macro-lambda) ;doc +- (cadr macro-lambda) ; ppn +- *special-binding*) +- *top-level-forms*)) +- ) +- +- +-(defun t2defmacro (fname cfun macro-lambda doc ppn sp) +- +- (declare (ignore macro-lambda doc ppn sp)) +- (wt-h "static void " (c-function-name "L" cfun fname) "();") +- ) +- +-(defun t3defmacro (fname cfun macro-lambda doc ppn sp +- &aux (*volatile* (if (get fname 'contains-setjmp) +- " VOL " ""))) +- (let-pass3 +- ((*exit* 'return)) +- (wt-comment "macro definition for " fname) +- (wt-nl1 "static void " (c-function-name "L" cfun fname) "()") +- (wt-nl1 "{register object *" *volatile* "base=vs_base;") +- (assign-down-vars (nth 4 macro-lambda) cfun ;*dm-info* +- 't3defun) +- (wt-nl "register object *"*volatile* "sup=base+VM" *reservation-cmacro* ";") +- (wt " VC" *reservation-cmacro*) +- (if *safe-compile* +- (wt-nl "vs_reserve(VM" *reservation-cmacro* ");") +- (wt-nl "vs_check;")) +- (when sp (wt-nl "bds_check;")) +- (when *compiler-push-events* (wt-nl "ihs_check;")) +- (c2dm (car macro-lambda) (cadr macro-lambda) (caddr macro-lambda) +- (cadddr macro-lambda)) +- (wt-nl1 "}") +- (push (cons *reservation-cmacro* *max-vs*) *reservations*) +- (wt-h "#define VC" *reservation-cmacro*) +- (wt-cvars) +- +- (when doc (add-init `(si::putprop ',fname ,doc 'si::function-documentation) )) +- (when ppn +- (add-init `(si::putprop ',fname ',ppn 'si::pretty-print-format) )) +- (add-init `(si::MM ',fname ,(add-address (c-function-name "L" cfun fname))) ) +- +- )) ++(defun t1defmacro (args &aux (w args)(n (pop args))(l (symbol-plist n)) ++ (macp (when (listp n) (eq 'macro (car n))))(n (if macp (cdr n) n))) ++ (proclaim `(ftype (function (t t) t) ,n)) ++ (maybe-eval (not (macro-function n)) (cons 'defmacro w));FIXME? ++ (t1expr `(defun ,n ,@(if macp args (cddr (caddr (si::defmacro* n (pop args) args)))))) ++ (setf (symbol-plist n) l) ++ (push `(mflag ,n) *top-level-forms*)) + + (defun t1ordinary (form &aux tem ) + (setq *non-package-operation* t) +--- gcl-2.6.12.orig/cmpnew/gcl_cmputil.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmputil.lsp +@@ -180,33 +180,27 @@ + (or (member-if (lambda (x) (when (consp x) (eq (car x) fname))) *funs*) + (macro-function fname)))) + +-(defun do-macro-expansion (how form &aux env) +- (dolist (v *funs*) ++(defun macro-env (&aux env) ++ (dolist (v *funs* (when env (list nil (nreverse env) nil))) + (when (consp v) +- (push (list (car v) 'macro (cadr v)) env))) +- (when env (setq env (list nil (nreverse env) nil))) +- (let ((x (multiple-value-list (cmp-toplevel-eval `(,@how ',form ',env))))) +- (if (car x) +- (let ((*print-case* :upcase)) +- (incf *error-count*) +- (print-current-form) +- (format t ";;; The macro form ~s was not expanded successfully.~%" form) +- `(error "Macro-expansion of ~s failed at compile time." ',form)) +- (cadr x)))) ++ (push (list (car v) 'macro (cadr v)) env)))) + + (defun cmp-macroexpand (form) + (if (macro-def-p form) +- (do-macro-expansion '(macroexpand) form) ++ (macroexpand form (macro-env)) + form)) + + (defun cmp-macroexpand-1 (form) + (if (macro-def-p form) +- (do-macro-expansion '(macroexpand-1) form) ++ (macroexpand-1 form (macro-env)) + form)) + + (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) ++ (let ((env (macro-env))) ++ (if (eq *macroexpand-hook* 'funcall) ++ (funcall fd form env) ++ (funcall *macroexpand-hook* fd form env))) + form)) + + (defvar *compiler-break-enable* nil) +--- gcl-2.6.12.orig/cmpnew/sys-proclaim.lisp ++++ gcl-2.6.12/cmpnew/sys-proclaim.lisp +@@ -2,24 +2,116 @@ + (COMMON-LISP::IN-PACKAGE "COMPILER") + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- ((COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807) +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807)) +- COMMON-LISP::T) +- COMPILER::MLIN)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ COMPILER::TAG-REF-CLB COMPILER::SET-TOP ++ COMPILER::C1MULTIPLE-VALUE-BIND COMPILER::C1LIST-NTH ++ COMPILER::C1RPLACA-NTHCDR COMPILER::C1DEFINE-STRUCTURE ++ COMPILER::BLK-REF-CLB COMPILER::WT-VV COMPILER::C1LENGTH ++ COMPILER::C1MAPC COMPILER::C1LOCAL-CLOSURE ++ COMPILER::CHECK-VREF COMPILER::WT-VAR-DECL COMPILER::C1TAGBODY ++ COMPILER::BLK-REF-CCB COMPILER::C1LOAD-TIME-VALUE ++ COMPILER::C1ASH COMPILER::FUN-LEVEL COMPILER::COPY-INFO ++ COMPILER::INLINE-POSSIBLE COMPILER::WT-VS-BASE ++ COMPILER::T1DEFENTRY COMPILER::CHARACTER-LOC-P ++ COMPILER::C2RPLACA COMPILER::RESET-INFO-TYPE ++ COMPILER::TYPE-FILTER COMPILER::TAG-SWITCH ++ COMPILER::DECL-BODY-SAFETY COMPILER::C1AND ++ COMPILER::C1FMLA-CONSTANT COMPILER::C2GO-CLB ++ COMPILER::C1FUNCTION COMPILER::C1MAPLIST COMPILER::VAR-TYPE ++ COMPILER::CLINK COMPILER::UNWIND-NO-EXIT COMPILER::VAR-LOC ++ COMPILER::C2RPLACD COMPILER::VERIFY-DATA-VECTOR ++ COMPILER::TAG-REF-CCB COMPILER::C1RETURN-FROM ++ COMPILER::T1DEFINE-STRUCTURE COMPILER::MDELETE-FILE ++ COMPILER::OBJECT-TYPE COMPILER::WT-CAR COMPILER::TAG-P ++ COMPILER::ADD-LOOP-REGISTERS COMPILER::C1MEMQ ++ COMPILER::C2FUNCTION COMPILER::CMP-MACRO-FUNCTION ++ COMPILER::C1BOOLE-CONDITION COMPILER::REP-TYPE COMPILER::C2GET ++ COMPILER::C2VAR COMPILER::C2EXPR* COMPILER::C1ADD-GLOBALS ++ COMPILER::WT1 COMPILER::C1BLOCK COMPILER::C1MAPL ++ COMPILER::C1MAPCAR COMPILER::FSET-FN-NAME COMPILER::C2GO-CCB ++ COMPILER::T1DEFLA COMPILER::C1NTH-CONDITION ++ COMPILER::ADD-OBJECT2 COMPILER::VAR-NAME COMPILER::C1EXPR ++ COMPILER::FUN-REF COMPILER::SCH-LOCAL-FUN ++ COMPILER::FIXNUM-LOC-P COMPILER::BLK-VAR ++ COMPILER::C1UNWIND-PROTECT COMPILER::C2BIND ++ COMPILER::PARSE-CVSPECS COMPILER::C1NTH ++ COMPILER::WT-SWITCH-CASE SYSTEM::UNDEF-COMPILER-MACRO ++ COMPILER::SET-UP-VAR-CVS COMPILER::C1ECASE ++ COMPILER::C1STRUCTURE-REF COMPILER::FUN-INFO ++ COMPILER::C1MEMBER COMPILER::C1GET COMPILER::WT-FUNCTION-LINK ++ COMPILER::C1ASH-CONDITION COMPILER::WT-CCB-VS COMPILER::INFO-P ++ COMPILER::REGISTER COMPILER::TAG-VAR COMPILER::C1VAR ++ COMPILER::C1TERPRI COMPILER::LTVP ++ COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::C1MAPCON ++ COMPILER::PUSH-ARGS-LISPCALL COMPILER::C1SETQ ++ COMPILER::C2DOWNWARD-FUNCTION COMPILER::T3ORDINARY ++ COMPILER::C1VREF COMPILER::WT-VS COMPILER::CONSTANT-FOLD-P ++ COMPILER::C1MULTIPLE-VALUE-PROG1 COMPILER::BLK-EXIT ++ COMPILER::T1DEFUN COMPILER::C1LABELS COMPILER::C1FSET ++ COMPILER::T1MACROLET COMPILER::FUN-NAME COMPILER::C1APPLY ++ COMPILER::FUN-P COMPILER::WT-DATA-PACKAGE-OPERATION ++ COMPILER::C1FUNOB COMPILER::WT-SYMBOL-FUNCTION ++ COMPILER::GET-RETURN-TYPE COMPILER::ADD-CONSTANT ++ COMPILER::SAFE-SYSTEM COMPILER::BLK-VALUE-TO-GO ++ COMPILER::NEED-TO-SET-VS-POINTERS COMPILER::C2TAGBODY-LOCAL ++ COMPILER::C1DECLARE COMPILER::C1OR COMPILER::C1ASSOC ++ COMPILER::ADD-ADDRESS COMPILER::VAR-KIND ++ COMPILER::PROCLAMATION COMPILER::FIX-OPT COMPILER::WT-DATA1 ++ COMPILER::INFO-SP-CHANGE COMPILER::ARGS-CAUSE-SIDE-EFFECT ++ COMPILER::WRITE-BLOCK-OPEN COMPILER::C2TAGBODY-BODY ++ COMPILER::CONS-TO-LISTA COMPILER::SAVE-FUNOB COMPILER::VAR-REF ++ COMPILER::C1LOCAL-FUN COMPILER::VAR-REP-LOC ++ COMPILER::SET-PUSH-CATCH-FRAME COMPILER::CTOP-WRITE ++ COMPILER::C2TAGBODY-CLB COMPILER::T1CLINES ++ COMPILER::ADD-OBJECT COMPILER::GET-LOCAL-RETURN-TYPE ++ COMPILER::DEFAULT-INIT COMPILER::FUNCTION-ARG-TYPES ++ COMPILER::C1STRUCTURE-SET COMPILER::CMP-MACROEXPAND-1 ++ COMPILER::INLINE-TYPE COMPILER::VAR-REGISTER ++ COMPILER::DECLARATION-TYPE COMPILER::C1CATCH COMPILER::C1LET ++ COMPILER::T3CLINES COMPILER::UNDEFINED-VARIABLE COMPILER::C1GO ++ COMPILER::TAG-NAME COMPILER::SCH-GLOBAL COMPILER::C1IF ++ COMPILER::C1FLET COMPILER::INLINE-BOOLE3-STRING ++ COMPILER::INFO-CHANGED-ARRAY COMPILER::C2FUNCALL-AUX ++ COMPILER::FUN-REF-CCB COMPILER::WT-CADR COMPILER::FUN-CFUN ++ COMPILER::WT-VS* COMPILER::WT-DOWN COMPILER::C2GETHASH ++ COMPILER::ADD-REG1 COMPILER::REPLACE-CONSTANT ++ COMPILER::C2DM-RESERVE-V COMPILER::RESULT-TYPE ++ COMPILER::C1FUNCALL COMPILER::C1THE COMPILER::VARARG-P ++ COMPILER::INFO-REFERRED-ARRAY COMPILER::C1PROGV ++ COMPILER::T2DECLARE COMPILER::T1DEFCFUN COMPILER::C2VALUES ++ COMPILER::C1SWITCH COMPILER::C1MAPCAN ++ COMPILER::CMP-MACROEXPAND COMPILER::TAG-LABEL ++ COMPILER::TAG-UNWIND-EXIT COMPILER::C1PRINC COMPILER::C1THROW ++ COMPILER::SAVE-AVMA COMPILER::VOLATILE COMPILER::FLAGS-POS ++ COMPILER::INFO-TYPE COMPILER::C1NTHCDR-CONDITION ++ COMPILER::C1MULTIPLE-VALUE-SETQ COMPILER::WT-FUNCALL-C ++ COMPILER::PUSH-ARGS COMPILER::C1DM-BAD-KEY ++ COMPILER::T1ORDINARY COMPILER::C1PSETQ COMPILER::BLK-REF ++ COMPILER::C2DM-RESERVE-VL COMPILER::C1MACROLET ++ COMPILER::C1SHARP-COMMA COMPILER::C1RPLACA ++ COMMON-LISP::PROCLAIM COMPILER::PUSH-DATA-INCF ++ COMPILER::MACRO-DEF-P COMPILER::BLK-NAME COMPILER::C1VALUES ++ COMPILER::C1DOWNWARD-FUNCTION COMPILER::T1DEFMACRO ++ COMPILER::GET-ARG-TYPES COMPILER::ADD-SYMBOL ++ COMPILER::NAME-SD1 COMPILER::C2GO-LOCAL ++ COMPILER::C2TAGBODY-CCB COMPILER::WT-LIST ++ COMPILER::GET-LOCAL-ARG-TYPES COMPILER::C1BOOLE3 ++ COMPILER::C1STACK-LET COMPILER::WT-CDR COMPILER::C1QUOTE ++ COMPILER::C1EVAL-WHEN COMPILER::VAR-P COMPILER::CHECK-DOWNWARD ++ COMPILER::T1PROGN COMPILER::BLK-P COMPILER::C2LOCATION ++ COMPILER::THE-PARAMETER COMPILER::C2VAR-KIND ++ COMPILER::C1GETHASH COMPILER::LTVP-EVAL COMPILER::C1RPLACD ++ COMPILER::INFO-VOLATILE COMPILER::LONG-FLOAT-LOC-P ++ COMPILER::FUNCTION-RETURN-TYPE COMPILER::SHORT-FLOAT-LOC-P ++ COMPILER::WT-H1 COMPILER::C1MULTIPLE-VALUE-CALL ++ COMPILER::NAME-TO-SD COMPILER::C1PROGN COMPILER::SET-RETURN ++ COMPILER::C1LET* COMPILER::AET-C-TYPE COMPILER::C1COMPILER-LET ++ COMPILER::MAXARGS COMPILER::VAR-REF-CCB COMPILER::VV-STR ++ COMPILER::C1NTHCDR COMPILER::TAG-REF COMPILER::GET-INCLUDED)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER +- COMMON-LISP::*) +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807) +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807)) +- COMMON-LISP::T) +- COMPILER::DASH-TO-UNDERSCORE-INT)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++ COMPILER::INLINE-BOOLE3)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -29,332 +121,93 @@ + COMPILER::TS COMPILER::DASH-TO-UNDERSCORE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +- COMPILER::C1NIL COMPILER::WT-DATA-FILE +- COMPILER::CLOSE-INLINE-BLOCKS COMPILER::WT-NEXT-VAR-ARG +- COMPILER::RESET-TOP COMPILER::VS-PUSH COMPILER::BABOON +- COMPILER::GAZONK-NAME COMPILER::PRINT-COMPILER-INFO +- COMPILER::ADD-LOAD-TIME-SHARP-COMMA COMPILER::INIT-ENV +- COMPILER::PRINT-CURRENT-FORM COMPILER::WT-C-PUSH COMPILER::C1T +- COMPILER::WT-FIRST-VAR-ARG COMPILER::CCB-VS-PUSH +- COMPILER::INC-INLINE-BLOCKS COMPILER::WT-CVARS +- COMPILER::WT-FASD-DATA-FILE COMPILER::WFS-ERROR +- COMPILER::WT-DATA-END COMPILER::TAIL-RECURSION-POSSIBLE +- COMPILER::CVS-PUSH COMPILER::WT-DATA-BEGIN)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::FIXNUM) +- COMPILER::ANALYZE-REGS1 COMPILER::ANALYZE-REGS +- COMPILER::PROCLAIMED-ARGD)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) + COMMON-LISP::T) +- COMPILER::CHECK-FNAME-ARGS COMPILER::COERCE-LOC +- COMPILER::TYPE>= COMPILER::C2BIND-LOC +- COMPILER::RESULT-TYPE-FROM-ARGS COMPILER::ADD-DEBUG-INFO +- COMPILER::MAKE-USER-INIT COMPILER::CO1EQL COMPILER::C2ASSOC!2 +- COMPILER::WT-VAR COMPILER::CFAST-WRITE COMPILER::C2STACK-LET +- COMPILER::C2DM-BIND-INIT COMPILER::IS-REP-REFERRED +- COMPILER::CO1CONS COMPILER::SHIFT<< +- COMPILER::C2MULTIPLE-VALUE-SETQ COMPILER::C2CALL-LOCAL +- COMPILER::CO1SCHAR COMPILER::C1CONSTANT-VALUE +- COMPILER::WT-CHARACTER-VALUE COMPILER::CONVERT-CASE-TO-SWITCH +- COMPILER::C2MULTIPLE-VALUE-CALL COMPILER::C2EXPR-TOP +- COMPILER::CO1READ-BYTE COMPILER::PRIN1-CMP +- COMPILER::STRUCT-TYPE-OPT COMPILER::C1DECL-BODY +- COMPILER::COERCE-LOC-STRUCTURE-REF +- COMPILER::CO1STRUCTURE-PREDICATE COMPILER::WT-MAKE-DCLOSURE +- COMPILER::ARGS-INFO-CHANGED-VARS +- COMPILER::C2LIST-NTH-IMMEDIATE COMPILER::CO1LDB +- COMPILER::CO1WRITE-BYTE COMPILER::C1PROGN* +- COMPILER::CO1CONSTANT-FOLD COMPILER::SET-JUMP-TRUE +- COMPILER::C1SETQ1 COMPILER::CO1READ-CHAR COMPILER::C2BIND-INIT +- COMPILER::CO1TYPEP COMPILER::WT-FIXNUM-VALUE +- COMPILER::MULTIPLE-VALUE-CHECK COMPILER::SHIFT>> +- COMPILER::CO1SUBLIS COMPILER::DO-MACRO-EXPANSION +- COMPILER::C2UNWIND-PROTECT COMPILER::C2CALL-LAMBDA +- COMPILER::C2MEMBER!2 COMPILER::GET-INLINE-LOC +- COMPILER::C1LAMBDA-FUN COMPILER::JUMPS-TO-P COMPILER::C1EXPR* +- COMPILER::C2SETQ COMPILER::C2APPLY COMPILER::UNWIND-BDS +- COMPILER::SET-BDS-BIND COMPILER::NEED-TO-PROTECT +- COMPILER::C1FMLA COMPILER::TYPE-AND COMPILER::CMPFIX-ARGS +- COMPILER::MAYBE-EVAL COMPILER::C2BLOCK-CLB COMPILER::SET-DBIND +- COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY +- COMPILER::WT-LONG-FLOAT-VALUE COMPILER::C2DM-BIND-VL +- COMPILER::WT-SHORT-FLOAT-VALUE COMPILER::T3SHARP-COMMA +- COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES COMPILER::C2CATCH +- COMPILER::C2EXPR-TOP* COMPILER::SET-JUMP-FALSE +- COMPILER::CO1VECTOR-PUSH COMPILER::WT-V*-MACROS +- COMPILER::ARGS-INFO-REFERRED-VARS COMPILER::SET-VS +- COMPILER::WT-REQUIREDS COMPILER::C2RETURN-CCB +- COMPILER::C2THROW COMPILER::CHECK-END +- COMPILER::PUSH-CHANGED-VARS COMPILER::C2BLOCK-CCB +- SYSTEM::ADD-DEBUG COMPILER::C2PSETQ COMPILER::C1ARGS +- COMPILER::COMPILER-CC COMPILER::INLINE-PROC +- COMPILER::CO1WRITE-CHAR COMPILER::COMPILER-DEF-HOOK +- COMPILER::CAN-BE-REPLACED COMPILER::C2MULTIPLE-VALUE-PROG1 +- COMPILER::C2DM-BIND-LOC COMPILER::ADD-INFO +- COMPILER::CO1SPECIAL-FIX-DECL COMPILER::C2LAMBDA-EXPR-WITH-KEY +- COMPILER::FAST-READ COMPILER::C2RETURN-CLB +- COMPILER::PROCLAIM-VAR)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::*) +- COMPILER::COMPILE-FILE1)) ++ COMPILER::C2CALL-UNKNOWN-GLOBAL COMPILER::WT-IF-PROCLAIMED ++ COMPILER::MY-CALL COMPILER::WT-GLOBAL-ENTRY ++ COMPILER::T3DEFUN-NORMAL COMPILER::C2STRUCTURE-REF ++ COMPILER::C2SWITCH COMPILER::C2CALL-GLOBAL ++ COMPILER::T3DEFUN-VARARG COMPILER::C1MAKE-VAR)) + (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::MAKE-INLINE-STRING COMPILER::GET-INLINE-INFO +- COMPILER::C1STRUCTURE-REF1 COMPILER::CJF COMPILER::SET-VAR +- COMPILER::CHECK-FORM-TYPE COMPILER::AND-FORM-TYPE +- COMPILER::SUBLIS1-INLINE COMPILER::T3DEFCFUN +- COMPILER::WT-INLINE-INTEGER COMPILER::C-FUNCTION-NAME +- COMPILER::FIX-DOWN-ARGS COMPILER::ASSIGN-DOWN-VARS +- COMPILER::WT-INLINE-FIXNUM COMPILER::C2GO COMPILER::CJT +- COMPILER::TOO-FEW-ARGS COMPILER::C2PRINC COMPILER::C2CASE +- COMPILER::C2LET* COMPILER::BOOLE3 COMPILER::COMPILER-PASS2 +- COMPILER::C1DM COMPILER::CHECK-VDECL COMPILER::C2LET +- COMPILER::MYSUB COMPILER::CAN-BE-REPLACED* +- COMPILER::ADD-FUNCTION-PROCLAMATION COMPILER::WT-IF-PROCLAIMED +- COMPILER::C1MAP-FUNCTIONS COMPILER::ADD-FAST-LINK +- COMPILER::WT-INLINE-LONG-FLOAT COMPILER::TOO-MANY-ARGS +- COMPILER::C2MULTIPLE-VALUE-BIND COMPILER::C2PROGV +- COMPILER::WT-INLINE-CHARACTER +- COMPILER::ADD-FUNCTION-DECLARATION COMPILER::CMP-EXPAND-MACRO +- COMPILER::C2MAPCAR COMPILER::INLINE-TYPE-MATCHES +- COMPILER::C2FUNCALL-SFUN COMPILER::WT-MAKE-CCLOSURE +- COMPILER::C2MAPCAN COMPILER::C2TAGBODY +- COMPILER::WT-INLINE-COND COMPILER::C2MAPC +- COMPILER::WT-INLINE-SHORT-FLOAT)) ++ COMPILER::LINK COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL ++ 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 COMMON-LISP::*) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- COMPILER::T3LOCAL-FUN COMPILER::T3LOCAL-DCFUN)) ++ COMPILER::WT-INLINE-INTEGER COMPILER::ADD-FUNCTION-DECLARATION ++ COMPILER::C1STRUCTURE-REF1 COMPILER::ADD-FAST-LINK ++ COMPILER::AND-FORM-TYPE COMPILER::C2PRINC COMPILER::C2MAPCAN ++ COMPILER::CJT COMPILER::C2CASE COMPILER::WT-INLINE-LONG-FLOAT ++ COMPILER::SUBLIS1-INLINE COMPILER::MYSUB ++ COMPILER::ADD-FUNCTION-PROCLAMATION COMPILER::FIX-DOWN-ARGS ++ COMPILER::TOO-MANY-ARGS COMPILER::CMP-EXPAND-MACRO ++ COMPILER::C2MULTIPLE-VALUE-BIND COMPILER::C2GO ++ COMPILER::WT-INLINE-FIXNUM COMPILER::WT-INLINE-COND ++ COMPILER::C1MAP-FUNCTIONS COMPILER::C1DM ++ COMPILER::WT-MAKE-CCLOSURE COMPILER::CAN-BE-REPLACED* ++ COMPILER::C-FUNCTION-NAME COMPILER::C2LET* COMPILER::CJF ++ COMPILER::TOO-FEW-ARGS COMPILER::BOOLE3 COMPILER::T3DEFCFUN ++ COMPILER::C2FUNCALL-SFUN COMPILER::C2MAPC ++ COMPILER::CHECK-FORM-TYPE COMPILER::SET-VAR ++ COMPILER::C2TAGBODY COMPILER::CHECK-VDECL ++ COMPILER::GET-INLINE-INFO COMPILER::ASSIGN-DOWN-VARS ++ COMPILER::C2LET COMPILER::INLINE-TYPE-MATCHES ++ COMPILER::COMPILER-PASS2 COMPILER::C2PROGV COMPILER::C2MAPCAR ++ COMPILER::MAKE-INLINE-STRING COMPILER::WT-INLINE-CHARACTER ++ COMPILER::WT-INLINE-SHORT-FLOAT)) + (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::T3DEFMACRO COMPILER::T3DEFENTRY COMPILER::T2DEFENTRY +- COMPILER::DEFSYSFUN COMPILER::T2DEFMACRO)) ++ COMPILER::T2DEFENTRY COMPILER::DEFSYSFUN 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::T3DEFUN COMPILER::T3DEFUN-LOCAL-ENTRY +- COMPILER::C2STRUCTURE-SET COMPILER::T2DEFUN ++ COMPILER::T3DEFUN-LOCAL-ENTRY COMPILER::T3INIT-FUN ++ COMPILER::T2DEFUN COMPILER::T3DEFUN COMPILER::C2STRUCTURE-SET + COMPILER::C1APPLY-OPTIMIZE)) + (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::INLINE-ARGS COMPILER::LINK)) +-(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::T3INIT-FUN COMPILER::C2STRUCTURE-REF +- COMPILER::WT-GLOBAL-ENTRY COMPILER::T3DEFUN-NORMAL +- COMPILER::T3DEFUN-VARARG COMPILER::C1MAKE-VAR +- COMPILER::C2SWITCH COMPILER::MY-CALL COMPILER::C2CALL-GLOBAL +- COMPILER::C2CALL-UNKNOWN-GLOBAL)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::*) + COMMON-LISP::T) + COMPILER::GET-OUTPUT-PATHNAME COMPILER::WT-SIMPLE-CALL)) +-(COMMON-LISP::MAPC +- (COMMON-LISP::LAMBDA (COMPILER::X) +- (COMMON-LISP::SETF +- (COMMON-LISP::GET COMPILER::X 'COMPILER::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::*) COMMON-LISP::T) +- COMPILER::MAKE-VAR COMPILER::COMPILER-COMMAND +- COMPILER::LIST*-INLINE COMMON-LISP::COMPILE-FILE +- COMPILER::CS-PUSH COMPILER::MAKE-INFO COMPILER::FCALLN-INLINE +- COMPILER::C2FSET COMPILER::MAKE-TAG COMPILER::WT-CLINK +- COMPILER::LIST-INLINE COMPILER::MAKE-FUN COMPILER::MAKE-BLK)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) +- COMPILER::T1EVAL-WHEN COMPILER::T1EXPR +- COMPILER::WT-CHARACTER-LOC COMPILER::SET-LOC +- COMPILER::CMP-TOPLEVEL-EVAL COMPILER::C2PROGN +- COMPILER::WT-TO-STRING COMPILER::MEXPAND-DEFTYPE +- COMPILER::WT-SHORT-FLOAT-LOC COMPILER::CMP-EVAL +- COMPILER::WT-LOC COMPILER::C2AND COMPILER::C2EXPR +- COMPILER::WT-LONG-FLOAT-LOC COMPILER::C2OR +- COMPILER::WT-FIXNUM-LOC)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +- COMPILER::LTVP-EVAL COMPILER::FSET-FN-NAME COMPILER::C1MAPCON +- COMPILER::FUNCTION-ARG-TYPES COMPILER::C1SHARP-COMMA +- COMPILER::SAVE-AVMA COMPILER::C2TAGBODY-CCB COMPILER::VAR-LOC +- COMPILER::WT-DOWN COMPILER::C1SETQ COMPILER::TAG-REF-CCB +- COMPILER::T1DEFINE-STRUCTURE COMPILER::SAVE-FUNOB +- COMPILER::C1VAR COMPILER::VV-STR COMPILER::C1RPLACA +- COMPILER::INFO-SP-CHANGE COMPILER::BLK-REF-CCB +- COMPILER::T1ORDINARY COMPILER::FIXNUM-LOC-P +- COMPILER::FUN-REF-CCB COMPILER::C2GET COMPILER::FUN-NAME +- COMPILER::FUN-P COMPILER::SCH-GLOBAL COMPILER::C1LET +- COMPILER::C2TAGBODY-CLB COMPILER::C1UNWIND-PROTECT +- COMPILER::SET-RETURN COMPILER::WT-VAR-DECL +- COMPILER::VAR-REGISTER COMPILER::C1DEFINE-STRUCTURE +- COMPILER::LTVP COMPILER::INLINE-POSSIBLE COMPILER::CHECK-VREF +- COMPILER::TAG-NAME COMPILER::C2DM-RESERVE-VL +- COMPILER::VAR-TYPE COMPILER::WT-LIST COMPILER::C1LET* +- COMPILER::VARARG-P COMPILER::C1LOAD-TIME-VALUE +- COMPILER::C2FUNCALL-AUX COMPILER::INFO-TYPE COMPILER::C1GET +- COMPILER::C1NTHCDR-CONDITION COMPILER::C1AND +- COMPILER::C1MULTIPLE-VALUE-CALL COMPILER::C1RPLACA-NTHCDR +- COMPILER::INFO-VOLATILE COMPILER::INLINE-TYPE +- COMPILER::LONG-FLOAT-LOC-P COMPILER::INFO-CHANGED-ARRAY +- SYSTEM::UNDEF-COMPILER-MACRO COMPILER::DECL-BODY-SAFETY +- COMPILER::TAG-VAR COMPILER::CHARACTER-LOC-P COMPILER::C2BIND +- COMPILER::C1DECLARE COMPILER::CONS-TO-LISTA +- COMPILER::C1MULTIPLE-VALUE-SETQ COMPILER::NAME-SD1 +- COMPILER::BLK-NAME COMPILER::PARSE-CVSPECS COMPILER::C1MAPL +- COMPILER::AET-C-TYPE COMPILER::C2VAR COMPILER::COPY-INFO +- COMPILER::C1PSETQ COMPILER::C1VREF COMPILER::FUN-REF +- COMPILER::WT-H1 COMPILER::T1DEFCFUN COMPILER::T1PROGN +- COMPILER::C1EVAL-WHEN COMPILER::FLAGS-POS COMPILER::WT-VS +- COMPILER::C2VAR-KIND COMPILER::C1LENGTH +- COMPILER::C1MULTIPLE-VALUE-BIND COMPILER::C2LOCATION +- COMPILER::C2DM-RESERVE-V COMPILER::C2FUNCTION +- COMPILER::WT-SWITCH-CASE COMPILER::C2TAGBODY-LOCAL +- COMPILER::CONSTANT-FOLD-P COMPILER::NEED-TO-SET-VS-POINTERS +- COMPILER::C1MAPCAN COMPILER::WT-FUNCALL-C COMPILER::WT-CCB-VS +- COMPILER::C1RETURN-FROM COMPILER::GET-INCLUDED +- COMPILER::C1BLOCK COMPILER::ADD-CONSTANT COMPILER::WT-VS-BASE +- COMPILER::C1NTH-CONDITION COMPILER::FUN-LEVEL +- COMPILER::UNWIND-NO-EXIT COMMON-LISP::PROCLAIM +- COMPILER::C1PRINC COMPILER::C2EXPR* COMPILER::RESULT-TYPE +- COMPILER::TAG-REF COMPILER::C1FUNCALL COMPILER::C1PROGN +- COMPILER::MAXARGS COMPILER::UNDEFINED-VARIABLE COMPILER::C1THE +- COMPILER::CMP-MACROEXPAND COMPILER::C1MAPCAR +- COMPILER::DEFAULT-INIT COMPILER::C1STRUCTURE-SET +- COMPILER::WT-SYMBOL-FUNCTION COMPILER::T1DEFUN +- COMPILER::WT-DATA1 COMPILER::PUSH-DATA-INCF COMPILER::C1IF +- COMPILER::C1NTHCDR COMPILER::ADD-SYMBOL +- COMPILER::C1MULTIPLE-VALUE-PROG1 COMPILER::BLK-REF +- COMPILER::WT-FUNCTION-LINK COMPILER::INFO-P COMPILER::C1FSET +- COMPILER::C1PROGV COMPILER::C1ASSOC COMPILER::VAR-REF +- COMPILER::ARGS-CAUSE-SIDE-EFFECT COMPILER::MDELETE-FILE +- COMPILER::CMP-MACRO-FUNCTION COMPILER::C2DOWNWARD-FUNCTION +- COMPILER::C2GO-LOCAL COMPILER::T1DEFLA COMPILER::VAR-REF-CCB +- COMPILER::C1FLET COMPILER::C1LIST-NTH +- COMPILER::ADD-LOOP-REGISTERS COMPILER::INFO-REFERRED-ARRAY +- COMPILER::BLK-VALUE-TO-GO COMPILER::WT-VS* +- COMPILER::NAME-TO-SD COMPILER::C1RPLACD +- COMPILER::WT-DATA-PACKAGE-OPERATION COMPILER::C1SWITCH +- COMPILER::C1CATCH COMPILER::WT-CAR COMPILER::C1MACROLET +- COMPILER::OBJECT-TYPE COMPILER::C1MAPC COMPILER::T1CLINES +- COMPILER::C1COMPILER-LET COMPILER::CMP-MACROEXPAND-1 +- COMPILER::C1TAGBODY COMPILER::C1MAPLIST COMPILER::PUSH-ARGS +- COMPILER::T3ORDINARY COMPILER::C1MEMBER COMPILER::T1MACROLET +- COMPILER::WT-CDR COMPILER::C1BOOLE3 COMPILER::PROCLAMATION +- COMPILER::GET-LOCAL-RETURN-TYPE COMPILER::C1LOCAL-FUN +- COMPILER::VAR-KIND COMPILER::WT1 COMPILER::TAG-SWITCH +- COMPILER::C1OR COMPILER::C1STRUCTURE-REF +- COMPILER::THE-PARAMETER COMPILER::VAR-REP-LOC +- COMPILER::DECLARATION-TYPE COMPILER::TAG-P COMPILER::C2GETHASH +- COMPILER::C1EXPR COMPILER::REPLACE-CONSTANT COMPILER::C1ECASE +- COMPILER::FUN-CFUN COMPILER::SET-TOP COMPILER::TAG-LABEL +- COMPILER::C1DM-BAD-KEY COMPILER::C1THROW COMPILER::C2GO-CCB +- COMPILER::REP-TYPE COMPILER::C2VALUES +- COMPILER::SHORT-FLOAT-LOC-P COMPILER::FUNCTION-RETURN-TYPE +- COMPILER::ADD-OBJECT COMPILER::CTOP-WRITE COMPILER::C1MEMQ +- COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::C1TERPRI +- COMPILER::T1DEFMACRO COMPILER::T3CLINES COMPILER::ADD-REG1 +- COMPILER::C1NTH COMPILER::C1ASH COMPILER::C1FMLA-CONSTANT +- COMPILER::C2GO-CLB COMPILER::WT-CADR +- COMPILER::C1BOOLE-CONDITION COMPILER::CLINK COMPILER::VAR-NAME +- COMPILER::PUSH-ARGS-LISPCALL COMPILER::GET-ARG-TYPES +- COMPILER::BLK-VAR COMPILER::C1APPLY COMPILER::CHECK-DOWNWARD +- COMPILER::C1QUOTE COMPILER::TAG-REF-CLB +- COMPILER::GET-LOCAL-ARG-TYPES COMPILER::REGISTER +- COMPILER::BLK-P COMPILER::FUN-INFO COMPILER::C2RPLACD +- COMPILER::ADD-OBJECT2 COMPILER::C2TAGBODY-BODY +- COMPILER::T1DEFENTRY COMPILER::C1FUNCTION +- COMPILER::C1DOWNWARD-FUNCTION COMPILER::SAFE-SYSTEM +- COMPILER::C1GO COMPILER::BLK-EXIT COMPILER::VERIFY-DATA-VECTOR +- COMPILER::C2RPLACA COMPILER::T2DECLARE COMPILER::MACRO-DEF-P +- COMPILER::C1LABELS COMPILER::C1GETHASH COMPILER::FIX-OPT +- COMPILER::SCH-LOCAL-FUN COMPILER::C1FUNOB +- COMPILER::SET-PUSH-CATCH-FRAME COMPILER::GET-RETURN-TYPE +- COMPILER::SET-UP-VAR-CVS COMPILER::TAG-UNWIND-EXIT +- COMPILER::VAR-P COMPILER::C1ADD-GLOBALS COMPILER::TYPE-FILTER +- COMPILER::WT-VV COMPILER::C1ASH-CONDITION COMPILER::VOLATILE +- COMPILER::INLINE-BOOLE3-STRING COMPILER::C1LOCAL-CLOSURE +- COMPILER::WRITE-BLOCK-OPEN COMPILER::ADD-ADDRESS +- COMPILER::RESET-INFO-TYPE COMPILER::C1VALUES +- COMPILER::BLK-REF-CLB COMPILER::C1STACK-LET)) +-(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::INTEGER -9223372036854775808 +- 9223372036854775807)) +- COMMON-LISP::T) +- COMPILER::MEMOIZED-HASH-EQUAL)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::*) +- COMPILER::WT-INLINE-LOC COMPILER::NCONC-FILES +- COMPILER::COMPILER-BUILD COMPILER::C2BLOCK-LOCAL +- COMPILER::C2DECL-BODY COMPILER::C1SYMBOL-FUN COMPILER::C2BLOCK +- COMPILER::C1BODY COMPILER::C2RETURN-LOCAL)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- COMPILER::C1LAMBDA-EXPR COMPILER::CMPWARN COMPILER::ADD-INIT +- COMPILER::UNWIND-EXIT COMPILER::CMPNOTE COMPILER::CMPERR +- COMPILER::C1CASE COMPILER::WT-COMMENT COMPILER::INIT-NAME +- COMPILER::FAST-LINK-PROCLAIMED-TYPE-P COMPILER::WT-INTEGER-LOC +- COMPILER::WT-CVAR)) ++ COMPILER::T3LOCAL-DCFUN COMPILER::T3LOCAL-FUN)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::*) +- COMPILER::C2IF COMPILER::WT-INLINE COMPILER::C2COMPILER-LET +- COMPILER::C2FLET COMPILER::C2LABELS)) ++ COMPILER::C2LABELS COMPILER::C2FLET COMPILER::C2IF ++ COMPILER::WT-INLINE COMPILER::C2COMPILER-LET)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T) + COMMON-LISP::*) +- COMPILER::C2RETURN-FROM COMPILER::C2APPLY-OPTIMIZE +- COMPILER::C2DM COMPILER::C1DM-V COMPILER::C1DM-VL)) ++ COMPILER::C2RETURN-FROM COMPILER::C2DM COMPILER::C1DM-VL ++ COMPILER::C2APPLY-OPTIMIZE COMPILER::C1DM-V)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -363,6 +216,36 @@ + COMPILER::T3DEFUN-AUX)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++ COMPILER::C2PROGN COMPILER::WT-LONG-FLOAT-LOC ++ COMPILER::WT-CHARACTER-LOC COMPILER::WT-TO-STRING ++ COMPILER::WT-LOC COMPILER::MEXPAND-DEFTYPE ++ COMPILER::CMP-TOPLEVEL-EVAL COMPILER::T1EVAL-WHEN ++ COMPILER::T1EXPR COMPILER::C2OR COMPILER::WT-FIXNUM-LOC ++ COMPILER::C2EXPR COMPILER::C2AND COMPILER::CMP-EVAL ++ COMPILER::SET-LOC COMPILER::WT-SHORT-FLOAT-LOC)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++ COMPILER::MAKE-INFO COMPILER::FCALLN-INLINE ++ COMPILER::LIST-INLINE COMPILER::LIST*-INLINE ++ COMPILER::COMPILER-COMMAND COMPILER::MAKE-BLK ++ COMPILER::MAKE-FUN COMPILER::WT-CLINK COMPILER::C2FSET ++ COMPILER::MAKE-TAG COMPILER::CS-PUSH COMPILER::MAKE-VAR ++ COMMON-LISP::COMPILE-FILE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++ COMPILER::F-TYPE)) ++(COMMON-LISP::MAPC ++ (COMMON-LISP::LAMBDA (COMPILER::X) ++ (COMMON-LISP::SETF ++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) ++ COMMON-LISP::T)) ++ '(COMMON-LISP::DISASSEMBLE COMPILER::CMP-TMP-MACRO ++ COMPILER::CMP-ANON COMMON-LISP::COMPILE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + ((COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*))) + COMMON-LISP::T) +@@ -374,11 +257,9 @@ + (COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*)) + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807) +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807) + COMMON-LISP::T) + COMMON-LISP::FIXNUM) +- COMPILER::BSEARCHLEQ)) ++ COMPILER::PUSH-ARRAY)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -386,10 +267,148 @@ + (COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*)) + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) + COMMON-LISP::T) + COMMON-LISP::FIXNUM) +- COMPILER::PUSH-ARRAY)) ++ COMPILER::BSEARCHLEQ)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) +- COMPILER::F-TYPE)) +\ No newline at end of file ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++ COMMON-LISP::*) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::T) ++ COMPILER::DASH-TO-UNDERSCORE-INT)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::T) ++ COMPILER::MLIN)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::T) ++ COMPILER::MEMOIZED-HASH-EQUAL)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++ COMPILER::MACRO-ENV COMPILER::C1T COMPILER::PRINT-CURRENT-FORM ++ COMPILER::CCB-VS-PUSH COMPILER::C1NIL ++ COMPILER::WT-FASD-DATA-FILE COMPILER::INIT-ENV ++ COMPILER::WT-CVARS COMPILER::CVS-PUSH ++ COMPILER::WT-FIRST-VAR-ARG COMPILER::WT-NEXT-VAR-ARG ++ COMPILER::WT-DATA-FILE COMPILER::WT-C-PUSH ++ COMPILER::GAZONK-NAME COMPILER::WT-DATA-END ++ COMPILER::INC-INLINE-BLOCKS COMPILER::TAIL-RECURSION-POSSIBLE ++ COMPILER::RESET-TOP COMPILER::CLOSE-INLINE-BLOCKS ++ COMPILER::PRINT-COMPILER-INFO COMPILER::WFS-ERROR ++ COMPILER::VS-PUSH COMPILER::BABOON COMPILER::WT-DATA-BEGIN ++ COMPILER::ADD-LOAD-TIME-SHARP-COMMA)) ++(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::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ COMPILER::UNWIND-EXIT COMPILER::WT-COMMENT COMPILER::CMPERR ++ COMPILER::WT-CVAR COMPILER::FAST-LINK-PROCLAIMED-TYPE-P ++ COMPILER::C1CASE COMPILER::CMPWARN COMPILER::ADD-INIT ++ COMPILER::INIT-NAME COMPILER::WT-INTEGER-LOC COMPILER::CMPNOTE ++ COMPILER::C1LAMBDA-EXPR)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ COMPILER::C2BLOCK COMPILER::C1SYMBOL-FUN ++ COMPILER::C2BLOCK-LOCAL COMPILER::C2DECL-BODY ++ COMPILER::COMPILER-BUILD COMPILER::NCONC-FILES ++ COMPILER::WT-INLINE-LOC COMPILER::C2RETURN-LOCAL ++ COMPILER::C1BODY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ COMPILER::WT-FIXNUM-VALUE COMPILER::DOLIST** COMPILER::CO1LDB ++ COMPILER::PUSH-REFERRED-WITH-START COMPILER::C2ASSOC!2 ++ COMPILER::ADD-DEBUG-INFO COMPILER::WT-CHARACTER-VALUE ++ COMPILER::MAYBE-WT-C2DM-BIND-VL COMPILER::C2BIND-LOC ++ COMPILER::C2CATCH COMPILER::DO-REFERRED COMPILER::C2BLOCK-CLB ++ COMPILER::CO1CONSTANT-FOLD COMPILER::C2CALL-LOCAL ++ COMPILER::SHIFT<< COMPILER::C2UNWIND-PROTECT ++ COMPILER::C2MULTIPLE-VALUE-SETQ COMPILER::C2DM-BIND-VL ++ COMPILER::DOTIMES* COMPILER::REFERRED-LENGTH COMPILER::C1ARGS ++ COMPILER::CK-SPEC COMPILER::C2MULTIPLE-VALUE-CALL ++ COMPILER::C2CALL-LAMBDA COMPILER::CO1READ-BYTE ++ COMPILER::CO1VECTOR-PUSH COMPILER::STACK-LET COMPILER::CMPCK ++ COMPILER::MAYBE-EVAL COMPILER::COERCE-LOC COMPILER::C2PSETQ ++ SYSTEM::DEFINE-INLINE-FUNCTION COMPILER::WT-MAKE-DCLOSURE ++ COMPILER::COMPILER-CC COMPILER::WT-GO COMPILER::C1LAMBDA-FUN ++ COMPILER::C2RETURN-CLB COMPILER::C1DECL-BODY ++ COMPILER::PUSH-CHANGED-VARS COMPILER::GET-INLINE-LOC ++ COMPILER::CO1SUBLIS COMPILER::CHANGED-LENGTH COMPILER::CO1CONS ++ COMPILER::ARGS-INFO-REFERRED-VARS COMPILER::SET-JUMP-FALSE ++ COMPILER::MAKE-USER-INIT COMPILER::NEXT-CVAR ++ COMPILER::CAN-BE-REPLACED COMPILER::WT-V*-MACROS ++ COMPILER::NEXT-CMACRO COMPILER::C2RETURN-CCB ++ COMPILER::CO1SCHAR COMPILER::IS-CHANGED ++ COMMON-LISP::DEFINE-COMPILER-MACRO COMPILER::SET-DBIND ++ COMPILER::WT-H COMPILER::COERCE-LOC-STRUCTURE-REF ++ COMPILER::C1EXPR* COMPILER::IS-REFERRED COMPILER::SHIFT>> ++ COMPILER::WT COMPILER::TYPE-AND COMPILER::PRIN1-CMP ++ COMPILER::C2BIND-INIT COMPILER::RESULT-TYPE-FROM-ARGS ++ COMPILER::EQL-NOT-NIL COMPILER::C2APPLY COMPILER::C2BLOCK-CCB ++ COMPILER::WT-NL1 COMPILER::CO1WRITE-CHAR COMPILER::CFAST-WRITE ++ COMPILER::NEED-TO-PROTECT COMPILER::T3SHARP-COMMA ++ SYSTEM::ADD-DEBUG COMPILER::BIGNUM-EXPANSION-STORAGE ++ COMPILER::C2SETQ COMPILER::FLAG-P ++ COMPILER::PUSH-CHANGED-WITH-START COMPILER::CMPFIX-ARGS ++ COMPILER::CO1STRUCTURE-PREDICATE COMPILER::FAST-READ ++ COMPILER::C1CONSTANT-VALUE COMPILER::BASE-USED ++ COMPILER::PROCLAIM-VAR COMPILER::CO1TYPEP ++ COMPILER::SET-JUMP-TRUE COMPILER::TYPE>= COMPILER::DOTIMES** ++ COMPILER::CONVERT-CASE-TO-SWITCH COMPILER::C2MEMBER!2 ++ COMPILER::DO-CHANGED COMPILER::ADD-INFO COMPILER::SET-VS ++ COMPILER::CHECK-FNAME-ARGS ++ COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES ++ COMPILER::C2MULTIPLE-VALUE-PROG1 COMPILER::NEXT-LABEL* ++ COMPILER::WT-VAR COMPILER::C2THROW COMPILER::INLINE-PROC ++ COMPILER::PUSH-REFERRED COMPILER::C2LIST-NTH-IMMEDIATE ++ COMPILER::C1FMLA COMPILER::PUSH-CHANGED ++ COMPILER::MULTIPLE-VALUE-CHECK COMPILER::MIA ++ COMPILER::WT-LABEL COMPILER::WT-NL ++ COMPILER::WT-SHORT-FLOAT-VALUE COMPILER::SET-BDS-BIND ++ COMPILER::DO-ARRAY COMPILER::WT-REQUIREDS ++ COMPILER::C2EXPR-TOP* COMPILER::C2DM-BIND-LOC ++ COMPILER::DOLIST* SYSTEM::SWITCH-FINISH ++ COMPILER::IS-REP-REFERRED COMPILER::WT-LONG-FLOAT-VALUE ++ COMPILER::C1SETQ1 COMPILER::FLAGS COMPILER::CO1EQL ++ COMPILER::CHECK-END COMPILER::NEXT-LABEL COMPILER::CK-VL ++ COMPILER::ARGS-INFO-CHANGED-VARS COMPILER::C1PROGN* ++ COMPILER::C2DM-BIND-INIT COMPILER::STRUCT-TYPE-OPT ++ COMPILER::UNWIND-BDS COMPILER::SAFE-COMPILE ++ COMPILER::CO1READ-CHAR COMPILER::JUMPS-TO-P SYSTEM::SWITCH ++ COMPILER::NEXT-CFUN COMPILER::CO1WRITE-BYTE ++ COMPILER::DOWNWARD-FUNCTION COMPILER::COMPILER-DEF-HOOK ++ COMPILER::C2STACK-LET COMPILER::C2EXPR-TOP ++ COMPILER::C2LAMBDA-EXPR-WITH-KEY COMPILER::IN-ARRAY ++ COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ COMPILER::COMPILE-FILE1)) +\ No newline at end of file +--- gcl-2.6.12.orig/config.sub ++++ gcl-2.6.12/config.sub +@@ -1,8 +1,8 @@ + #! /bin/sh + # Configuration validation subroutine script. +-# Copyright 1992-2014 Free Software Foundation, Inc. ++# Copyright 1992-2015 Free Software Foundation, Inc. + +-timestamp='2014-05-01' ++timestamp='2015-08-20' + + # This file is free software; you can redistribute it and/or modify it + # under the terms of the GNU General Public License as published by +@@ -25,7 +25,7 @@ timestamp='2014-05-01' + # of the GNU General Public License, version 3 ("GPLv3"). + + +-# Please send patches with a ChangeLog entry to config-patches@gnu.org. ++# Please send patches to . + # + # Configuration subroutine to validate and canonicalize a configuration type. + # Supply the specified configuration type as an argument. +@@ -68,7 +68,7 @@ Report bugs and patches to >32)-1; + a&=MASK(32); +- store_val(where,MASK(16),((void *)gote-(void *)got)); + if (s>=ggot && sr_addend=((void *)gote-(void *)got)-s; ++ switch(tp) { ++ case R_MIPS_GOT_HI16: ++ case R_MIPS_CALL_HI16: ++ r->r_info=((ul)R_MIPS_HI16<<56)|(r->r_info&MASK(32)); ++ relocate(sym1,r,((Rela *)r)->r_addend,start,got,gote); ++ break; ++ case R_MIPS_GOT_LO16: ++ case R_MIPS_CALL_LO16: ++ r->r_info=((ul)R_MIPS_LO16<<56)|(r->r_info&MASK(32)); ++ relocate(sym1,r,((Rela *)r)->r_addend,start,got,gote); ++ break; ++ default: ++ store_val(where,MASK(16),((void *)gote-(void *)got)); ++ break; ++ } + break; + case R_MIPS_GOT_OFST: + recurse(s+a); +--- gcl-2.6.12.orig/h/elf64_mips_reloc_special.h ++++ gcl-2.6.12/h/elf64_mips_reloc_special.h +@@ -108,6 +108,10 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) + if (ELF_R_TYPE(r->r_info)==R_MIPS_CALL16|| + ELF_R_TYPE(r->r_info)==R_MIPS_GOT_DISP|| ++ ELF_R_TYPE(r->r_info)==R_MIPS_GOT_HI16|| ++ ELF_R_TYPE(r->r_info)==R_MIPS_GOT_LO16|| ++ ELF_R_TYPE(r->r_info)==R_MIPS_CALL_HI16|| ++ ELF_R_TYPE(r->r_info)==R_MIPS_CALL_LO16|| + ELF_R_TYPE(r->r_info)==R_MIPS_GOT_PAGE) { + + sym=sym1+ELF_R_SYM(r->r_info); +--- gcl-2.6.12.orig/h/lu.h ++++ gcl-2.6.12/h/lu.h +@@ -143,7 +143,7 @@ struct hashtable { + int ht_size; + short ht_test; + short ht_static; +- SPAD; ++ struct htent *ht_cache; + + }; + +@@ -290,6 +290,8 @@ struct random { + struct readtable { + FIRSTWORD; + struct rtent *rt_self; ++ object rt_case; ++ SPAD; + }; + + struct pathname { +--- gcl-2.6.12.orig/h/notcomp.h ++++ gcl-2.6.12/h/notcomp.h +@@ -373,3 +373,4 @@ typedef struct {void *a,*b,*c,*d;} gmp_r + EXTER gmp_randfnptr_t Mersenne_Twister_Generator_Noseed; + #endif + ++#define collect(p_,f_) (p_)=&(*(p_)=(f_))->c.c_cdr +--- gcl-2.6.12.orig/h/object.h ++++ gcl-2.6.12/h/object.h +@@ -249,6 +249,9 @@ struct freelist { + #define FL_LINK F_LINK + #define SET_LINK(x,val) F_LINK(x) = (address_int) (val) + #define OBJ_LINK(x) ((object) INT_TO_ADDRESS(F_LINK(x))) ++#define PHANTOM_FREELIST(x) ({struct freelist f;(object)((void *)&x+((void *)&f-(void *)&f.f_link));}) ++#define FREELIST_TAIL(tm_) ({struct typemanager *_tm=tm_;\ ++ _tm->tm_free==OBJNULL ? PHANTOM_FREELIST(_tm->tm_free) : _tm->tm_tail;}) + + #define FREE (-1) /* free object */ + +@@ -261,6 +264,8 @@ struct typemanager { + long tm_nppage; /* number per page */ + object tm_free; /* free list */ + /* Note that it is of type object. */ ++ object tm_tail; /* free list tail */ ++ /* Note that it is of type object. */ + long tm_nfree; /* number of free elements */ + long tm_npage; /* number of pages */ + long tm_maxpage; /* maximum number of pages */ +@@ -562,6 +567,9 @@ EXTER unsigned plong signals_allowed, si + /* #define equal(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (!IMMNIL(_a)&&!IMMNIL(_b)&&equal1(_a,_b));}) */ + /* #define equalp(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (_a!=Cnil&&_b!=Cnil&&equalp1(_a,_b));}) */ + +-#define eql(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b ? TRUE : (IMMNIL(_a)||IMMNIL(_b) ? FALSE : eql1(_a,_b));}) ++#define eql_is_eq(a_) (is_imm_fixnum(a_)||valid_cdr(a_)||(a_->d.t>t_complex)) ++ ++#define eql(a_,b_) ({register object _a=(a_);register object _b=(b_);\ ++ _a==_b ? TRUE : (eql_is_eq(_a)||eql_is_eq(_b)||_a->d.t!=_b->d.t ? FALSE : eql1(_a,_b));}) + #define equal(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b ? TRUE : (IMMNIL(_a)||IMMNIL(_b) ? FALSE : equal1(_a,_b));}) + #define equalp(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b ? TRUE : (_a==Cnil||_b==Cnil ? FALSE : equalp1(_a,_b));}) +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1961,3 +1961,6 @@ do_gcl_abort(void); + + int + vsystem(const char *); ++ ++object ++n_cons_from_x(fixnum,object); +--- gcl-2.6.12.orig/h/type.h ++++ gcl-2.6.12/h/type.h +@@ -134,7 +134,7 @@ enum smmode { /* stream mode */ + #define fixnump(a_) SPP(a_,fixnum) + #define readtablep(a_) SPP(a_,readtable) + #define functionp(a_) ({enum type _t=type_of(a_);_t>=t_cfun && _t<=t_closure;}) +-#define compiled_functionp(a_) functionp(a_) ++#define compiled_function_p(a_) functionp(a_) + + #define integerp(a_) ({enum type _tp=type_of(a_); _tp >= t_fixnum && _tp <= t_bignum;}) + #define non_negative_integerp(a_) ({enum type _tp=type_of(a_); (_tp == t_fixnum && fix(a_)>=0) || (_tp==t_bignum && big_sign(a_)>=0);}) +--- gcl-2.6.12.orig/lsp/gcl_arraylib.lsp ++++ gcl-2.6.12/lsp/gcl_arraylib.lsp +@@ -27,14 +27,14 @@ + (proclaim '(optimize (safety 2) (space 3))) + + (defvar *baet-hash* (make-hash-table :test 'equal)) +-(defun best-array-element-type (type) +- (or (gethash type *baet-hash*) +- (setf (gethash type *baet-hash*) +- (if type +- (car (member type '(character bit signed-char unsigned-char signed-short unsigned-short +- fixnum short-float long-float t) +- :test 'subtypep)) t))))) +- ++(defun best-array-element-type (type &aux ++ (tps '(character bit signed-char unsigned-char signed-short unsigned-short ++ fixnum short-float long-float t))) ++ (if type ++ (or (car (member type tps)) ++ (gethash type *baet-hash*) ++ (setf (gethash type *baet-hash*) (car (member type tps :test 'subtypep)))) t)) ++ + (defun upgraded-array-element-type (type &optional environment) + (declare (ignore environment)) + (best-array-element-type type)) +--- gcl-2.6.12.orig/lsp/gcl_autoload.lsp ++++ gcl-2.6.12/lsp/gcl_autoload.lsp +@@ -267,7 +267,7 @@ + (push (list (nth nfree *type-list*) typename) + link-alist)))))) + (terpri) +- (dolist (info (reverse info-list)) ++ (dolist (info (nreverse info-list)) + (apply #'format t "~8D/~D~19T~6,1F%~@[~8D~]~35T~{~A~^ ~}" + (append (cdr info) + (if (assoc (car info) link-alist) +--- gcl-2.6.12.orig/lsp/gcl_debug.lsp ++++ gcl-2.6.12/lsp/gcl_debug.lsp +@@ -167,7 +167,7 @@ + ,@ (do ((v (cdr lis) (cdr v)) + (i 0 (1+ i)) + (res)) +- ((null v)(reverse res)) ++ ((null v)(nreverse res)) + (push `(setf ,(car v) (mv-ref ,i)) res)))) + + (defmacro mv-values (&rest lis) +@@ -175,7 +175,7 @@ + ,@ (do ((v (cdr lis) (cdr v)) + (i 0 (1+ i)) + (res)) +- ((null v)(reverse res)) ++ ((null v)(nreverse res)) + (push `(set-mv ,i ,(car v)) res)))) + + ;;start a lisp debugger loop. Exit it by using :step +--- gcl-2.6.12.orig/lsp/gcl_defmacro.lsp ++++ gcl-2.6.12/lsp/gcl_defmacro.lsp +@@ -103,7 +103,7 @@ + (push `(unless (endp ,(dm-nth-cdr (cdr ac) (car ac))) + (dm-too-many-arguments)) body)) + (unless envp (push `(declare (ignore ,env)) body)) +- (list doc ppn `(lambda-block ,name ,(reverse *dl*) ,@(append decls body))) ++ (list doc ppn `(lambda-block ,name ,(nreverse *dl*) ,@(append decls body))) + ) + + (defun dm-vl (vl whole top) +--- gcl-2.6.12.orig/lsp/gcl_directory.lsp ++++ gcl-2.6.12/lsp/gcl_directory.lsp +@@ -41,7 +41,7 @@ + (l (length yy)) + (y (link-expand (vector-push-string yy s) l)) + (y (if (eq y yy) y (make-frame y)))) +- (when (or (eq (stat z) :directory) (zerop (length z))) ++ (when (or (eq (stat1 z) :directory) (zerop (length z))) + (cond ((eq (car x) :wild-inferiors) (recurse-dir z y f)) + (x (walk-dir z y (lambda (q e l) + (declare (ignore l)) +--- gcl-2.6.12.orig/lsp/gcl_evalmacros.lsp ++++ gcl-2.6.12/lsp/gcl_evalmacros.lsp +@@ -23,178 +23,146 @@ + (in-package :si) + + +-(eval-when (compile) (proclaim '(optimize (safety 2) (space 3)))) ++;(eval-when (compile) (proclaim '(optimize (safety 2) (space 3)))) + ;(eval-when (eval compile) (defun si:clear-compiler-properties (symbol))) +-(eval-when (eval compile) (setq si:*inhibit-macro-special* nil)) +- +-(defmacro sgen (&optional (pref "G")) +- `(load-time-value (gensym ,pref))) ++(eval-when (eval compile) ++ (setq si:*inhibit-macro-special* nil) ++ (defmacro ?cons (f x &aux (s (sgen "?CONS"))) `(let ((,s ,x)) (if (cdr ,s) (cons ,f ,s) (car ,s)))) ++ (defmacro ?list (x &aux (s (sgen "?LIST"))) `(let ((,s ,x)) (when ,s (list ,s)))) ++ (defmacro collect (v r rp np &aux (s (sgen "COLLECT"))) ++ `(let ((,s ,v)) (setf rp (if rp (rplacd rp (list ,s)) (setq r ,s)) rp np))) ++ (defmacro ?let (k kf r) `(let ((r ,r)) (if (eq ,k ,kf) r `(let ((,,k ,,kf)) (declare (ignorable ,,k)) ,r)))) ++ (defmacro ?key (x &aux (s (sgen "?KEY"))) `(if (or (constantp ,x) (symbolp ,x)) ,x ',s))) + ++(defmacro sgen (&optional (pref "G")) `(load-time-value (gensym ,pref))) + + (defmacro defvar (var &optional (form nil form-sp) doc-string) +- `(progn (si:*make-special ',var) +- ,(if doc-string +- `(si:putprop ',var ,doc-string 'variable-documentation)) +- ,(if form-sp +- `(or (boundp ',var) +- (setq ,var ,form))) +- ',var) +- ) ++ (declare (optimize (safety 1))) ++ `(progn (*make-special ',var) ++ ,@(when doc-string `((putprop ',var ,doc-string 'variable-documentation))) ++ ,@(when form-sp `((unless (boundp ',var) (setq ,var ,form)))) ++ ',var)) + + (defmacro defparameter (var form &optional doc-string) +- (if doc-string +- `(progn (si:*make-special ',var) +- (si:putprop ',var ,doc-string 'variable-documentation) +- (setq ,var ,form) +- ',var) +- `(progn (si:*make-special ',var) +- (setq ,var ,form) +- ',var))) ++ (declare (optimize (safety 1))) ++ `(progn (*make-special ',var) ++ ,@(when doc-string `((putprop ',var ,doc-string 'variable-documentation))) ++ (setq ,var ,form) ++ ',var)) + + (defmacro defconstant (var form &optional doc-string) +- (if doc-string +- `(progn (si:*make-constant ',var ,form) +- (si:putprop ',var ,doc-string 'variable-documentation) +- ',var) +- `(progn (si:*make-constant ',var ,form) +- ',var))) ++ (declare (optimize (safety 1))) ++ `(progn (*make-constant ',var ,form) ++ ,@(when doc-string `((putprop ',var ,doc-string 'variable-documentation))) ++ ',var)) + + + ;;; Each of the following macros is also defined as a special form. + ;;; Thus their names need not be exported. + +-(defmacro and (&rest forms) +- (if (endp forms) +- t +- (let ((x (reverse forms))) +- (do ((forms (cdr x) (cdr forms)) +- (form (car x) `(if ,(car forms) ,form))) +- ((endp forms) form)))) +- ) +- +-(defmacro or (&rest forms) +- (if (endp forms) +- nil +- (let ((x (reverse forms))) +- (do ((forms (cdr x) (cdr forms)) +- (form (car x) +- (let ((temp (gensym))) +- `(let ((,temp ,(car forms))) +- (if ,temp ,temp ,form))))) +- ((endp forms) form)))) +- ) +- +-(defun parse-body-header (x &optional doc decl ctps &aux (a (car x))) +- (cond +- ((unless (or doc ctps) (and (stringp a) (cdr x))) (parse-body-header (cdr x) a decl ctps)) +- ((unless ctps (when (consp a) (eq (car a) 'declare))) (parse-body-header (cdr x) doc (cons a decl) ctps)) +- ((when (consp a) (eq (car a) 'check-type)) (parse-body-header (cdr x) doc decl (cons a ctps))) +- (t (values doc (nreverse decl) (nreverse ctps) x)))) ++(defmacro and (&rest forms &aux r rp np) ++ (declare (optimize (safety 1))) ++ (do ((y forms))((endp y) (if forms r t)) ++ (let ((x (pop y))) ++ (if (constantp x) (unless (if (eval x) y) (collect x r rp np) (setq y nil)) ++ (if y (collect `(if ,@(setq np (list x))) r rp np) ++ (collect x r rp np)))))) ++ ++(defmacro or (&rest forms &aux r rp np (s (sgen "OR"))) ++ (declare (optimize (safety 1))) ++ (do ((y forms))((endp y) r) ++ (let ((x (pop y))) ++ (if (constantp x) (when (eval x) (collect x r rp np) (setq y nil)) ++ (if (symbolp x) (collect `(if ,x ,@(setq np (list x))) r rp np) ++ (if y (collect `(let ((,s ,x)) (if ,s ,@(setq np (list s)))) r rp np) ++ (collect x r rp np))))))) ++ ++(defun parse-body-header (x) ++ (let* ((doc x)(x (or (when (stringp (car x)) (cdr x)) x)) ++ (dec x)(x (member-if-not (lambda (x) (when (consp x) (eq (car x) 'declare))) x)) ++ (ctp x)(x (member-if-not (lambda (x) (when (consp x) (eq (car x) 'check-type))) x))) ++ (values (car (ldiff doc dec)) (ldiff dec ctp) (ldiff ctp x) x))) + + (defmacro locally (&rest body) + (multiple-value-bind +- (doc decls ctps body) ++ (doc dec) + (parse-body-header body) ++ (declare (ignore doc)) + `(let (,@(mapcan (lambda (x &aux (z (pop x))(z (if (eq z 'type) (pop x) z))) + (case z + ((ftype inline notinline optimize) nil) + (otherwise (mapcar (lambda (x) (list x x)) x)))) +- (apply 'append (mapcar 'cdr decls)))) +- ,@(when doc (list doc)) +- ,@decls +- ,@ctps ++ (apply 'append (mapcar 'cdr dec)))) + ,@body))) + +-(defmacro loop (&rest body &aux (tag (gensym))) +- `(block nil (tagbody ,tag (progn ,@body) (go ,tag)))) ++(defmacro loop (&rest body &aux (tag (sgen "LOOP"))) ++ `(block nil (tagbody ,tag ,(?cons 'progn body) (go ,tag)))) + +-(import 'while 'user) + (defmacro while (test &rest forms) +- `(loop (unless ,test (return)) ,@forms) ) ++ `(loop (unless ,test (return)) ,@forms)) + + (defmacro defmacro (name vl &rest body) + `(si:define-macro ',name (si:defmacro* ',name ',vl ',body))) + + (defmacro defun (name lambda-list &rest body) +- (multiple-value-bind (doc decl body) +- (find-doc body nil) +- (if doc +- `(progn (setf (get ',name 'si:function-documentation) ,doc) +- (setf (symbol-function ',name) +- #'(lambda ,lambda-list +- ,@decl (block ,name ,@body))) +- ',name) +- `(progn (setf (symbol-function ',name) +- #'(lambda ,lambda-list +- ,@decl (block ,name ,@body))) +- ',name)))) ++ (multiple-value-bind ++ (doc dec ctp body) ++ (parse-body-header body) ++ `(progn ,@(when doc `((setf (get ',name 'function-documentation) ,doc))) ++ (setf (symbol-function ',name) (lambda ,lambda-list ,@dec ,@ctp (block ,name ,@body))) ++ ',name))) + + ; assignment + + (defmacro psetq (&rest args) +- (do ((l args (cddr l)) +- (forms nil) +- (bindings nil)) +- ((endp l) (list* 'let* (nreverse bindings) (nreverse (cons nil forms)))) +- (declare (object l)) +- (let ((sym (gensym))) +- (push (list sym (cadr l)) bindings) +- (push (list 'setq (car l) sym) forms))) +- ) ++ (declare (optimize (safety 1))) ++ (assert (evenp (length args))) ++ (let ((x (let ((i 0)) (mapcon (lambda (x) (when (oddp (incf i)) `((,(cadr x) ,(car x) ,(gensym))))) args)))) ++ (when x ++ `(let* ,(mapcar (lambda (x) `(,(caddr x) ,(car x))) x) ++ (setq ,@(mapcan 'cdr x)) ++ nil)))) + + ; conditionals ++(defmacro cond (&rest clauses &aux r rp np (s (sgen "COND"))) ++ (declare (optimize (safety 1))) ++ (do ((y clauses))((endp y) r) ++ (let* ((x (pop y))(z (pop x))) ++ (if (constantp z) (when (eval z) (collect (if x (?cons 'progn x) z) r rp np) (setq y nil)) ++ (if x (collect `(if ,z ,@(setq np (list (?cons 'progn x)))) r rp np) ++ (if (symbolp z) (collect `(if ,z ,@(setq np (list z))) r rp np) ++ (if y (collect `(let ((,s ,z)) (if ,s ,@(setq np (list s)))) r rp np) ++ (collect `(values ,z) r rp np)))))))) ++ ++(defmacro when (pred &rest body &aux (x (?cons 'progn body))) ++ (declare (optimize (safety 1))) ++ (if (constantp pred) (if (eval pred) x) `(if ,pred ,x))) ++ ++(defmacro unless (pred &rest body &aux (x (?cons 'progn body))) ++ (declare (optimize (safety 1))) ++ (if (constantp pred) (if (not (eval pred)) x) `(if (not ,pred) ,x))) + +-(defmacro cond (&rest clauses &aux (form nil)) +- (let ((x (reverse clauses))) +- (dolist (l x form) +- (cond ((endp (cdr l)) +- (if (or (constantp (car l)) (eq l (car x))) +- (setq form (car l)) +- (let ((sym (gensym))) +- (setq form `(let ((,sym ,(car l))) (if ,sym ,sym ,form)))))) +- ((and (constantp (car l)) (car l)) +- (setq form (if (endp (cddr l)) (cadr l) `(progn ,@(cdr l))))) +- ((setq form (if (endp (cddr l)) +- `(if ,(car l) ,(cadr l) ,form) +- `(if ,(car l) (progn ,@(cdr l)) ,form)))))))) +- +- +-(defmacro when (pred &rest body) +- `(if ,pred (progn ,@body))) ++; program feature + +-(defmacro unless (pred &rest body) +- `(if (not ,pred) (progn ,@body))) ++(defun prog?* (let?* vl body) ++ (multiple-value-bind ++ (doc dec ctp body) ++ (parse-body-header body) ++ (declare (ignore doc)) ++ `(block nil (,let?* ,vl ,@dec (tagbody ,@(append ctp body)))))) + +-; program feature ++(defmacro prog (vl &rest body) ++ (prog?* 'let vl body)) + +-(defmacro prog (vl &rest body &aux (decl nil)) +- (do () +- ((or (endp body) +- (not (consp (car body))) +- (not (eq (caar body) 'declare))) +- `(block nil (let ,vl ,@decl (tagbody ,@body))) +- ) +- (push (car body) decl) +- (pop body)) +- ) +- +-(defmacro prog* (vl &rest body &aux (decl nil)) +- (do () +- ((or (endp body) +- (not (consp (car body))) +- (not (eq (caar body) 'declare))) +- `(block nil (let* ,vl ,@decl (tagbody ,@body))) +- ) +- (push (car body) decl) +- (pop body)) +- ) ++(defmacro prog* (vl &rest body) ++ (prog?* 'let* vl body)) + + ; sequencing + +-(defmacro prog1 (first &rest body &aux (sym (gensym))) ++(defmacro prog1 (first &rest body &aux (sym (sgen "PROG1"))) + `(let ((,sym ,first)) ,@body ,sym)) + +-(defmacro prog2 (first second &rest body &aux (sym (gensym))) ++(defmacro prog2 (first second &rest body &aux (sym (sgen "PROG2"))) + `(progn ,first (let ((,sym ,second)) ,@body ,sym))) + + ; multiple values +@@ -203,115 +171,79 @@ + `(multiple-value-call 'list ,form)) + + (defmacro multiple-value-setq (vars form) +- (do ((vl vars (cdr vl)) +- (sym (gensym)) +- (forms nil) +- (n 0 (1+ n))) +- ((endp vl) `(let ((,sym (multiple-value-list ,form))) ,@forms)) +- (declare (fixnum n) (object vl)) +- (push `(setq ,(car vl) (nth ,n ,sym)) forms)) +- ) +- +-(defmacro multiple-value-bind (vars form &rest body) +- (do ((vl vars (cdr vl)) +- (sym (gensym)) +- (bind nil) +- (n 0 (1+ n))) +- ((endp vl) `(let* ((,sym (multiple-value-list ,form)) ,@(nreverse bind)) +- ,@body)) +- (declare (fixnum n) (object vl)) +- (push `(,(car vl) (nth ,n ,sym)) bind)) +- ) +- +-(defmacro do (control (test . result) &rest body +- &aux (decl nil) (label (gensym)) (vl nil) (step nil)) +- (do () +- ((or (endp body) +- (not (consp (car body))) +- (not (eq (caar body) 'declare)))) +- (push (car body) decl) +- (pop body)) +- (dolist (c control) +- (declare (object c)) +- (if(symbolp c) (setq c (list c))) +- (push (list (car c) (cadr c)) vl) +- (unless (endp (cddr c)) +- (push (car c) step) +- (push (caddr c) step))) +- `(block nil +- (let ,(nreverse vl) +- ,@decl +- (tagbody +- ,label (if ,test (return (progn ,@result))) +- (tagbody ,@body) +- (psetq ,@(nreverse step)) +- (go ,label))))) +- +-(defmacro do* (control (test . result) &rest body +- &aux (decl nil) (label (gensym)) (vl nil) (step nil)) +- (do () +- ((or (endp body) +- (not (consp (car body))) +- (not (eq (caar body) 'declare)))) +- (push (car body) decl) +- (pop body)) +- (dolist (c control) +- (declare (object c)) +- (if(symbolp c) (setq c (list c))) +- (push (list (car c) (cadr c)) vl) +- (unless (endp (cddr c)) +- (push (car c) step) +- (push (caddr c) step))) +- `(block nil +- (let* ,(nreverse vl) +- ,@decl +- (tagbody +- ,label (if ,test (return (progn ,@result))) +- (tagbody ,@body) +- (setq ,@(nreverse step)) +- (go ,label)))) +- ) +- +-(defmacro case (keyform &rest clauses &aux (key (load-time-value (gensym "CASE"))) (c (reverse clauses))) +- (declare (optimize (safety 2))) +- (labels ((sw (x) `(eql ,key ',x))(dfp (x) (or (eq x t) (eq x 'otherwise))) +- (v (x) (if (when (listp x) (not (cdr x))) (car x) x)) +- (m (x c &aux (v (v x))) (if (eq v x) (cons c v) v))) +- `(let ((,key ,keyform)) +- (declare (ignorable ,key)) +- ,(let ((df (when (dfp (caar c)) (m (cdr (pop c)) 'progn)))) +- (reduce (lambda (y c &aux (a (pop c))(v (v a))) +- (when (dfp a) (error "default case must be last")) +- `(if ,(if (when (eq a v) (listp v)) (m (mapcar #'sw v) 'or) (sw v)) ,(m c 'progn) ,y)) +- c :initial-value df))))) +- +-(defmacro ecase (keyform &rest clauses &aux (key (sgen "ECASE"))) +- (declare (optimize (safety 2))) +- `(let ((,key ,keyform)) +- (declare (ignorable ,key)) +- (case ,key ++ (declare (optimize (safety 1))) ++ (let ((syms (mapcar (lambda (x) (declare (ignore x)) (gensym)) (or vars (list nil))))) ++ `(multiple-value-bind ,syms ,form ,@(?list (?cons 'setq (mapcan 'list vars syms))) ,(car syms)))) ++ ++(defmacro multiple-value-bind (vars form &rest body &aux (sym (sgen "MULTIPLE-VALUE-BIND"))) ++ (declare (optimize (safety 1))) ++ `(let* ((,sym (multiple-value-list ,form)) ++ ,@(mapcon (lambda (x) `((,(car x) (car ,sym)) ,@(when (cdr x) `((,sym (cdr ,sym)))))) vars)) ++ (declare (ignorable ,sym)) ++ ,@body)) ++ ++(defun do?* (?* control test result body &aux (label (sgen "DO"))) ++ (multiple-value-bind ++ (doc dec ctp body) ++ (parse-body-header body) ++ (declare (ignore doc)) ++ (labels ((?let (vl dec body) (if (or vl dec) `(,(if ?* 'let* 'let) ,vl ,@dec ,body) body)) ++ (?tagbody (l x y &aux (x (macroexpand x))) (if x `(tagbody ,l ,x ,@(?list (when (eq (car x) 'if) y))) y))) ++ `(block nil ++ ,(?let ++ (mapcar (lambda (x) (if (listp x) (ldiff x (cddr x)) x)) control) ++ dec ++ (?tagbody ++ label ++ `(unless ,test ++ ,@(?list (?cons 'tagbody (append ctp body))) ++ ,@(?list (?cons (if ?* 'setq 'psetq) (mapcan (lambda (x) (when (and (listp x) (cddr x)) (list (car x) (caddr x)))) control))) ++ (go ,label)) ++ `(return ,(?cons 'progn result)))))))) ++ ++(defmacro do (control (test . result) &rest body) ++ (do?* nil control test result body)) ++ ++(defmacro do* (control (test . result) &rest body) ++ (do?* t control test result body)) ++ ++(defmacro case (keyform &rest clauses &aux r rp np (key (?key keyform))) ++ (declare (optimize (safety 1))) ++ (labels ((sw (x) `(eql ,key ,(if (constantp x) x `',x)))) ++ (do ((y clauses))((endp y) (?let key keyform r)) ++ (let* ((x (pop y))(z (pop x))) ++ (if (member z '(t otherwise)) ++ (if y (error "default case must be last") (collect (?cons 'progn x) r rp np)) ++ (when z ++ (if (constantp key) ++ (let ((key (eval key))) (when (if (listp z) (member key z) (eql key z)) (collect (?cons 'progn x) r rp np) (setq y nil))) ++ (collect `(if ,(if (listp z) (?cons 'or (mapcar #'sw z)) (sw z)) ++ ,@(setq np (list (?cons 'progn x)))) r rp np)))))))) ++ ++(defmacro ecase (keyform &rest clauses &aux (key (?key keyform))) ++ (declare (optimize (safety 1))) ++ (?let key keyform ++ `(case ,key + ,@(mapcar (lambda (x) (if (member (car x) '(t otherwise)) (cons (list (car x)) (cdr x)) x)) clauses) + (otherwise + (error 'type-error :datum ,key + :expected-type '(member ,@(apply 'append (mapcar (lambda (x &aux (x (car x))) (if (listp x) x (list x))) clauses)))))))) + ++(defmacro ccase (keyform &rest clauses &aux (key (?key keyform))) ++ (declare (optimize (safety 1))) ++ (?let key keyform ++ `(do nil (nil) ++ (case ,key ++ ,@(mapcar (lambda (x &aux (k (pop x))) ++ `(,(if (member k '(t otherwise)) (list k) k) (return ,(?cons 'progn x)))) clauses) ++ (otherwise ++ (check-type ,key (member ,@(apply 'append (mapcar (lambda (x &aux (x (car x))) (if (listp x) x (list x))) clauses))))))))) + +-(defmacro ccase (keyform &rest clauses &aux (key (sgen "CCASE"))) +- (declare (optimize (safety 2))) +- `(let ((,key ,keyform)) +- (declare (ignorable ,key)) +- (do nil (nil) +- (case ,key +- ,@(mapcar (lambda (x &aux (k (pop x))) +- `(,(if (member k '(t otherwise)) (list k) k) (return ,(if (cdr x) (cons 'progn x) (car x))))) clauses) +- (otherwise +- (check-type ,key (member ,@(apply 'append (mapcar (lambda (x &aux (x (car x))) (if (listp x) x (list x))) clauses))))))))) +- +-(defmacro return (&optional (val nil)) `(return-from nil ,val)) +- +-(defmacro dolist ((var form &optional (val nil)) &rest body +- &aux (temp (gensym))) +- `(do* ((,temp ,form (cdr ,temp)) (,var (car ,temp) (car ,temp))) ++ ++(defmacro return (&optional val) `(return-from nil ,val)) ++ ++(defmacro dolist ((var form &optional (val nil)) &rest body &aux (temp (sgen "DOLIST"))) ++ `(do* ((,temp ,form (cdr ,temp))(,var (car ,temp) (car ,temp))) + ((endp ,temp) ,val) + ,@body)) + +@@ -327,59 +259,19 @@ + ;; appears to treat this as positive or negative depending on the sign + ;; of the other argument in the comparison, apparently to symmetrize + ;; the long integer range. 20040403 CM. +-(defmacro dotimes ((var form &optional (val nil)) &rest body) +- (cond +- ((symbolp form) +- (let ((temp (gensym))) +- `(cond ((< ,form 0) +- (let ((,var 0)) +- (declare (fixnum ,var) (ignorable ,var)) +- ,val)) +- ((<= ,form most-positive-fixnum) +- (let ((,temp ,form)) +- (declare (fixnum ,temp)) +- (do* ((,var 0 (1+ ,var))) ((>= ,var ,temp) ,val) +- (declare (fixnum ,var)) +- ,@body))) +- (t +- (let ((,temp ,form)) +- (do* ((,var 0 (1+ ,var))) ((>= ,var ,temp) ,val) +- ,@body)))))) +- ((constantp form) +- (cond ((< form 0) +- `(let ((,var 0)) +- (declare (fixnum ,var) (ignorable ,var)) +- ,val)) +- ((<= form most-positive-fixnum) +- `(do* ((,var 0 (1+ ,var))) ((>= ,var ,form) ,val) +- (declare (fixnum ,var)) +- ,@body)) +- (t +- `(do* ((,var 0 (1+ ,var))) ((>= ,var ,form) ,val) +- ,@body)))) +- (t +- (let ((temp (gensym))) +- `(let ((,temp ,form)) +- (cond ((< ,temp 0) +- (let ((,var 0)) +- (declare (fixnum ,var) (ignorable ,var)) +- ,val)) +- ((<= ,temp most-positive-fixnum) +- (let ((,temp ,temp)) +- (declare (fixnum ,temp)) +- (do* ((,var 0 (1+ ,var))) ((>= ,var ,temp) ,val) +- (declare (fixnum ,var)) +- ,@body))) +- (t +- (do* ((,var 0 (1+ ,var))) ((>= ,var ,temp) ,val) +- ,@body)))))))) +- ++(defmacro dotimes ((var form &optional val) &rest body &aux (s (sgen "DOTIMES"))(m (sgen "DOTIMES"))) ++ `(let* ((,s (block nil ,form))(,m (min ,s most-positive-fixnum))) ++ (declare (fixnum ,m)) ++ (do ((,var 0 (1+ ,var))) ++ ((>= ,var ,m) (if (eql ,s ,m) ,val (do ((,var ,m (1+ ,var)))((>= ,var ,s) ,val) ,@body))) ++ (declare (fixnum ,var)) ++ ,@body))) + + (defmacro declaim (&rest l) +- `(eval-when (compile eval load) +- ,@(mapcar #'(lambda (x) `(proclaim ',x)) l))) ++ `(eval-when (compile eval load) ++ ,@(mapcar (lambda (x) `(proclaim ',x)) l))) + +-(defmacro lambda ( &rest l) `(function (lambda ,@l))) ++(defmacro lambda (&rest l) `(function (lambda ,@l))) + + (defun compiler-macro-function (name) + (get name 'compiler-macro-prop)) +--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp ++++ gcl-2.6.12/lsp/gcl_iolib.lsp +@@ -380,7 +380,7 @@ + + (defun get-byte-stream-nchars (s) + (let* ((tp (stream-element-type s))) +- (ceiling (if (consp tp) (cadr tp) char-length) char-length))) ++ (values (ceiling (if (consp tp) (cadr tp) char-length) char-length)))) + + ;; (defun parse-integer (s &key start end (radix 10) junk-allowed) + ;; (declare (optimize (safety 1))) +@@ -488,21 +488,19 @@ + (stream (load-stream p print))) + (when verbose (format t ";; Finished loading ~s~%" p)))) + +-(defun ensure-directories-exist (ps &key verbose &aux created) ++(defun ensure-directories-exist (ps &key verbose) + (declare (optimize (safety 1))) + (check-type ps pathname-designator) + (when (wild-pathname-p ps) + (error 'file-error :pathname ps :format-control "Pathname is wild")) +- (labels ((d (x y &aux (z (ldiff x y)) (n (namestring (make-pathname :directory z)))) +- (when (when z (stringp (car (last z)))) +- (unless (eq :directory (stat n)) +- (mkdir n) +- (setq created t) +- (when verbose (format *standard-output* "Creating directory ~s~%" n)))) +- (when y (d x (cdr y))))) +- (let ((pd (pathname-directory ps))) +- (d pd (cdr pd))) +- (values ps created))) ++ (let ((pd (pathname-directory ps)) ls) ++ (dotimes (i (length pd)) ++ (let ((s (namestring (make-pathname :directory (if (zerop i) pd (ldiff pd (last pd i))))))) ++ (if (eq (stat1 s) :directory) (return) (push s ls)))) ++ (dolist (s ls) ++ (mkdir s) ++ (when verbose (format *standard-output* "Creating directory ~s~%" s))) ++ (values ps (if ls t)))) + + (defun file-length (x) + (declare (optimize (safety 1))) +@@ -511,7 +509,7 @@ + (let ((s (broadcast-stream-streams x))) (if s (file-length (car (last s))) 0)) + (multiple-value-bind (tp sz) (stat x) + (declare (ignore tp)) +- (/ sz (get-byte-stream-nchars x))))) ++ (values (truncate sz (get-byte-stream-nchars x)))))) + + (defun file-position (x &optional (pos :start pos-p)) + (declare (optimize (safety 1))) +--- gcl-2.6.12.orig/lsp/gcl_loop.lsp ++++ gcl-2.6.12/lsp/gcl_loop.lsp +@@ -793,6 +793,8 @@ a LET-like macro, and a SETQ-like macro, + (unless (= (length before-loop) (length after-loop)) + (error "LOOP-BODY called with non-synched before- and after-loop lists.")) + ;;All our work is done from these copies, working backwards from the end: ++ (when (equal before-loop after-loop) ++ (setq main-body (append before-loop main-body) before-loop nil after-loop nil));accelerator + (setq rbefore (reverse before-loop) rafter (reverse after-loop)) + (labels ((psimp (l) + (let ((ans nil)) +--- gcl-2.6.12.orig/lsp/gcl_parse_namestring.lsp ++++ gcl-2.6.12/lsp/gcl_parse_namestring.lsp +@@ -2,15 +2,6 @@ + + (deftype seqind nil `fixnum) + +-(defun match-beginning (i &aux (v *match-data*)) +- (declare ((vector fixnum) v)(seqind i)) +- (the (or (integer -1 -1 ) seqind) (aref v i))) +-(defun match-end (i &aux (v *match-data*)) +- (declare ((vector fixnum) v)(seqind i)) +- (the (or (integer -1 -1 ) seqind) (aref v (+ i (ash (length v) -1))))) +- +-(declaim (inline match-beginning match-end)) +- + (defun dir-conj (x) (if (eq x :relative) :absolute :relative)) + + (defvar *up-key* :up) +--- gcl-2.6.12.orig/lsp/gcl_predlib.lsp ++++ gcl-2.6.12/lsp/gcl_predlib.lsp +@@ -348,8 +348,7 @@ + ;; FIXME this needs to be more robust + (defun known-type-p (type) + (when (consp type) (setq type (car type))) +- (if (or (equal (string type) "ERROR") +- (member type ++ (if (or (member type + '(t nil boolean null symbol keyword atom cons list sequence + signed-char unsigned-char signed-short unsigned-short + number integer bignum rational ratio float method-combination +@@ -370,8 +369,9 @@ + storage-condition stream-error string-stream structure-class + style-warning synonym-stream two-way-stream structure-object + type-error unbound-slot unbound-variable undefined-function +- warning )) +- (get type 's-data)) ++ warning) :test 'eq) ++ (get type 's-data) ++ (equal (string type) "ERROR")) + t + nil)) + +--- gcl-2.6.12.orig/lsp/gcl_rename_file.lsp ++++ gcl-2.6.12/lsp/gcl_rename_file.lsp +@@ -26,7 +26,7 @@ + (defun delete-file (f &aux (pf (truename f))(nf (namestring pf))) + (declare (optimize (safety 1))) + (check-type f pathname-designator) +- (unless (if (eq :directory (stat nf)) (rmdir nf) (unlink nf)) ++ (unless (if (eq :directory (stat1 nf)) (rmdir nf) (unlink nf)) + (error 'file-error :pathname (pathname nf) :format-control "Cannot delete pathname.")) + t) + +--- gcl-2.6.12.orig/lsp/gcl_seqlib.lsp ++++ gcl-2.6.12/lsp/gcl_seqlib.lsp +@@ -25,7 +25,7 @@ + (in-package :si) + + +-(proclaim '(optimize (safety 2) (space 3))) ++;(proclaim '(optimize (safety 2) (space 3))) + + + (proclaim '(function seqtype (t) t)) +@@ -274,40 +274,87 @@ + (list 'quote f))) + + (defmacro eval-body () *body*) ++(defmacro mcf (x) `(when ,x (coerce ,x 'function))) ++(deftype function-designator nil `(or (and symbol (not boolean)) function)) ++(defmacro rcollect (r rp form) ++ `(let ((tmp ,form)) ++ (setq ,rp (last (if ,rp (rplacd ,rp tmp) (setq ,r tmp)))))) ++ ++ (defmacro dcollect (r rp form) ++ `(let ((tmp ,form)) ++ (declare (dynamic-extent tmp)) ++ (setq ,rp (cond (,rp (rplacd ,rp tmp) tmp) ((setq ,r tmp)))))) ++ + ) + ++(defun remove (item sequence &key key test test-not from-end count (start 0) end ++ &aux (kf (mcf key))(tf (mcf test))(tnf (mcf test-not)) r rp q qp xz (from-end (when count from-end)) ++ (l (listp sequence))(ln (if l array-dimension-limit (length sequence))) ++ (e (if end (min ln (max 0 end)) ln)) ++ (c (if count (min ln (max 0 count)) ln))) ++ ++ (declare (optimize (safety 1))(dynamic-extent q)(fixnum c e)) ++ ++ (check-type sequence sequence) ++ (check-type start seqind) ++ (check-type end (or null seqind)) ++ (check-type count (or null integer)) ++ (check-type key (or null function-designator)) ++ (check-type test (or null function-designator)) ++ (check-type test-not (or null function-designator)) ++ ++ (cond ((unless from-end l) ++ (do ((i start (1+ i))(j 0)(s (if (zerop start) sequence (nthcdr start sequence)) (cdr s))) ++ ((or (endp s) (>= i e) (>= j c)) (rcollect r rp sequence) r) ++ (declare (fixnum i j)) ++ (let* ((x (car s))(kx (if kf (funcall kf x) x))) ++ (when (cond (tf (funcall tf item kx))(tnf (not (funcall tnf item kx)))((eql item kx))) ++ (do nil ((eq sequence s) (setq sequence (cdr sequence))) (rcollect r rp (cons (pop sequence) nil))) ++ (incf j))))) ++ (t ++ (do* ((j 0 (1+ j))) ++ ((not (when (< j c) ++ (setq xz (position item sequence ++ :start (if (unless from-end xz) (1+ xz) start) ++ :end (if (when from-end xz) xz end) ++ :key kf :test tf :test-not tnf :from-end from-end))))) ++ (declare (fixnum j)) ++ (if from-end (push xz q) (dcollect q qp (cons xz nil)))) ++; (print q) ++ (cond ((not q) sequence) ++ (l (do* ((lq -1 (car q))(q q (cdr q))(v sequence (cdr v)))((not q) (rcollect r rp v) r) ++ (declare (fixnum lq)) ++ (dotimes (i (the fixnum (- (car q) lq 1))) (declare (fixnum i))(rcollect r rp (cons (pop v) nil))))) ++ ((let ((r (make-array (- (length sequence) (length q)) :element-type (array-element-type sequence)))) ++ (do* ((j 0 (+ j (- (car q) lq 1)))(lq -1 (car q))(q q (cdr q))) ++ ((when (replace r sequence :start1 j :start2 (1+ lq) :end2 (car q)) (not q)) r))))))) ++) + +-(defseq remove () t nil +- (if (not from-end) +- `(if (listp sequence) +- (let ((l sequence) (l1 nil)) +- (do ((i 0 (f+ 1 i))) +- ((>= i start)) +- (declare (fixnum i)) +- (push (car l) l1) +- (pop l)) +- (do ((i start (f+ 1 i)) (j 0)) +- ((or (>= i end) (>= j count) (endp l)) +- (nreconc l1 l)) +- (declare (fixnum i j)) +- (cond ((call-test test test-not item (funcall key (car l))) +- (setf j (f+ 1 j)) +- (pop l)) +- (t +- (push (car l) l1) +- (pop l))))) +- (delete item sequence +- :from-end from-end +- :test test :test-not test-not +- :start start :end end +- :count count +- :key key)) +- `(delete item sequence +- :from-end from-end +- :test test :test-not test-not +- :start start :end end +- :count count +- :key key))) ++(defun remove-if (p s &key key from-end count (start 0) end &aux (kf (mcf key))) ++ ++ (declare (optimize (safety 1))) ++ ++ (check-type p function-designator) ++ (check-type s sequence) ++ (check-type start seqind) ++ (check-type end (or null seqind)) ++ (check-type count (or null integer)) ++ (check-type key (or null function-designator)) ++ ++ (remove p s :key kf :test #'funcall :start start :end end :count count :from-end from-end)) ++ ++(defun remove-if-not (p s &key key from-end count (start 0) end &aux (kf (mcf key))) ++ ++ (declare (optimize (safety 1))) ++ ++ (check-type p function-designator) ++ (check-type s sequence) ++ (check-type start seqind) ++ (check-type end (or null seqind)) ++ (check-type count (or null integer)) ++ (check-type key (or null function-designator)) ++ ++ (remove p s :key kf :test-not #'funcall :start start :end end :count count :from-end from-end)) + + + (defseq delete () t t +--- gcl-2.6.12.orig/lsp/gcl_setf.lsp ++++ gcl-2.6.12/lsp/gcl_setf.lsp +@@ -197,6 +197,7 @@ + (defsetf symbol-plist si:set-symbol-plist) + (defsetf gethash (k h &optional d) (v) `(si:hash-set ,k ,h ,v)) + (defsetf row-major-aref si:aset1) ++(defsetf readtable-case si::set-readtable-case) + (defsetf documentation (s d) (v) + `(case ,d + (variable (si:putprop ,s ,v 'variable-documentation)) +--- gcl-2.6.12.orig/lsp/gcl_top.lsp ++++ gcl-2.6.12/lsp/gcl_top.lsp +@@ -582,7 +582,7 @@ First directory is checked for first nam + (defvar *tmp-dir*) + + (defun ensure-dir-string (str) +- (if (eq (stat str) :directory) ++ (if (eq (stat1 str) :directory) + (coerce-slash-terminated str) + str)) + +@@ -590,7 +590,7 @@ First directory is checked for first nam + (dolist (x `(,@(mapcar 'si::getenv '("TMPDIR" "TMP" "TEMP")) "/tmp" "")) + (when x + (let ((x (coerce-slash-terminated x))) +- (when (eq (stat x) :directory) ++ (when (eq (stat1 x) :directory) + (return-from get-temp-dir x)))))) + + +--- gcl-2.6.12.orig/lsp/gcl_translate_pathname.lsp ++++ gcl-2.6.12/lsp/gcl_translate_pathname.lsp +@@ -51,7 +51,7 @@ + + (defun list-toggle-case (x f) + (typecase x +- (string (funcall f x)) ++ (string (values (funcall f x))) + (cons (mapcar (lambda (x) (list-toggle-case x f)) x)) + (otherwise x))) + +--- gcl-2.6.12.orig/lsp/gcl_truename.lsp ++++ gcl-2.6.12/lsp/gcl_truename.lsp +@@ -6,7 +6,7 @@ + (set-fr (fr e &aux (fr (or fr (frame 0 b)))) (setf (fill-pointer fr) e) fr)) + (let* ((i (string-match +dirsep+ str b)) + (fr (set-fr fr (if (eql i -1) n i))) +- (l (when (eq (stat fr) :link) (readlinkat 0 fr)))) ++ (l (when (eq (stat1 fr) :link) (readlinkat 0 fr)))) + (cond (l (let ((b (if (eql #\/ (aref l 0)) 0 b))) + (link-expand (string-concatenate (set-fr fr b) l (frame (if (eql i -1) n i) n)) b))) + ((eql i -1) str) +@@ -25,7 +25,7 @@ + (error 'file-error :pathname pd :format-control "Pathname is wild")) + (let* ((ns (ensure-dir-string (link-expand ns))) + (ppd (if (eq (namestring pd) ns) pd (pathname ns)))) +- (unless (or (zerop (length ns)) (stat ns)) ++ (unless (or (zerop (length ns)) (stat1 ns)) + (error 'file-error :pathname ns :format-control "Pathname does not exist")) + (let* ((d (pathname-directory ppd)) + (d1 (subst :back :up d)) +@@ -38,5 +38,5 @@ + (check-type pd pathname-designator) + (when (wild-pathname-p pn) + (error 'file-error :pathname pn :format-control "Pathname is wild")) +- (when (eq (stat (link-expand (namestring pn))) :file) ++ (when (eq (stat1 (link-expand (namestring pn))) :file) + (truename pn))) +--- gcl-2.6.12.orig/lsp/sys-proclaim.lisp ++++ gcl-2.6.12/lsp/sys-proclaim.lisp +@@ -3,239 +3,282 @@ + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER +- COMMON-LISP::*)) +- COMMON-LISP::T) +- SYSTEM::RESET-SYS-PATHS)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- (COMMON-LISP::VECTOR COMMON-LISP::T)) +- SYSTEM::CONTEXT-VEC)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION + ((COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807)) ++ 9223372036854775807) ++ COMMON-LISP::T) + COMMON-LISP::T) +- SYSTEM::PUSH-CONTEXT SYSTEM::GET-CONTEXT)) ++ SYSTEM::SMALLNTHCDR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +- SLOOP::PARSE-LOOP-DO ANSI-LOOP::LOOP-WHEN-IT-VARIABLE +- SYSTEM::GET-INDEX-NODE SLOOP::LOOP-PEEK +- ANSI-LOOP::LOOP-POP-SOURCE SYSTEM::STEP-READ-LINE +- SYSTEM::SET-UP-TOP-LEVEL SLOOP::LOOP-POP SYSTEM::SET-ENV +- SYSTEM::DBL COMMON-LISP::TYPE-ERROR SYSTEM::INSPECT-INDENT +- SLOOP::PARSE-LOOP-COLLECT SYSTEM::CLEANUP +- SYSTEM::DEFAULT-SYSTEM-BANNER +- SYSTEM::CURRENT-DIRECTORY-PATHNAME ANSI-LOOP::LOOP-DO-WITH +- SYSTEM::INIT-BREAK-POINTS SYSTEM::TEST-ERROR +- SYSTEM::GET-SIG-FN-NAME SLOOP::PARSE-ONE-WHEN-CLAUSE +- ANSI-LOOP::LOOP-DO-DO SYSTEM::READ-EVALUATED-FORM +- SYSTEM::INSPECT-INDENT-1 ANSI-LOOP::LOOP-DO-NAMED +- SLOOP::PARSE-LOOP-FOR SYSTEM::ALL-TRACE-DECLARATIONS +- ANSI-LOOP::LOOP-GET-FORM ANSI-LOOP::LOOP-BIND-BLOCK +- SLOOP::PARSE-LOOP-WHEN SYSTEM::TOP-LEVEL +- SYSTEM::DM-TOO-FEW-ARGUMENTS SYSTEM::KCL-TOP-RESTARTS +- SYSTEM::DEFAULT-INFO-HOTLIST SYSTEM::SHOW-RESTARTS +- SYSTEM::DM-TOO-MANY-ARGUMENTS SYSTEM::SETUP-LINEINFO +- SYSTEM::GET-TEMP-DIR ANSI-LOOP::LOOP-ITERATION-DRIVER +- SLOOP::PARSE-LOOP1 SLOOP::LOOP-UN-POP +- ANSI-LOOP::LOOP-DO-FINALLY SYSTEM::INSPECT-READ-LINE +- ANSI-LOOP::LOOP-CONTEXT SYSTEM::SET-CURRENT +- ANSI-LOOP::LOOP-DO-REPEAT SYSTEM::ILLEGAL-BOA +- COMMON-LISP::LISP-IMPLEMENTATION-VERSION +- ANSI-LOOP::LOOP-DO-RETURN ANSI-LOOP::LOOP-DO-INITIALLY +- ANSI-LOOP::LOOP-GET-PROGN)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ SYSTEM::NORMALIZE-TYPE SYSTEM::PNL1 ++ ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS SYSTEM::DM-BAD-KEY ++ SYSTEM::S-DATA-INCLUDES ++ ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS ++ COMMON-LISP::HOST-NAMESTRING ++ COMMON-LISP::TWO-WAY-STREAM-INPUT-STREAM COMMON-LISP::LOGNOT ++ SYSTEM::BREAK-FORWARD-SEARCH-STACK ++ SLOOP::SUBSTITUTE-SLOOP-BODY ++ COMMON-LISP::CONCATENATED-STREAM-STREAMS ++ ANSI-LOOP::LOOP-MINIMAX-OPERATIONS SYSTEM::ADD-TO-HOTLIST ++ SYSTEM::RESTART-REPORT-FUNCTION COMMON-LISP::THIRD ++ SYSTEM::DWIM SYSTEM::GET-INSTREAM SYSTEM::TOGGLE-CASE ++ SYSTEM::INSTREAM-P COMMON-LISP::DELETE-FILE ++ SYSTEM::BEST-ARRAY-ELEMENT-TYPE COMMON-LISP::ISQRT ++ SYSTEM::INSERT-BREAK-POINT SYSTEM::WILD-DIR-ELEMENT-P ++ COMMON-LISP::ABS SYSTEM::WHICH COMMON-LISP::ACOS ++ SYSTEM::COERCE-SLASH-TERMINATED ++ COMMON-LISP::LOAD-LOGICAL-PATHNAME-TRANSLATIONS ++ ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD ++ COMMON-LISP::ECHO-STREAM-OUTPUT-STREAM SYSTEM::DIR-P ++ SYSTEM::SETUP-INFO SYSTEM::S-DATA-TYPE ++ ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS ++ SYSTEM::PRINT-SYMBOL-APROPOS SYSTEM::S-DATA-FROZEN ++ SYSTEM::REAL-ASINH ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS ++ SLOOP::PARSE-NO-BODY SYSTEM::INSPECT-STRING SYSTEM::PRINT-FRS ++ SYSTEM::LEAP-YEAR-P SYSTEM::RESTRICT-STREAM-ELEMENT-TYPE ++ SYSTEM::RESTART-INTERACTIVE-FUNCTION ++ SYSTEM::S-DATA-SLOT-DESCRIPTIONS SYSTEM::S-DATA-STATICP ++ SYSTEM::INSPECT-STRUCTURE COMMON-LISP::ASINH ++ ANSI-LOOP::LOOP-PATH-USER-DATA SYSTEM::RE-QUOTE-STRING ++ SYSTEM::MLP SYSTEM::GET-STRING-INPUT-STREAM-INDEX ++ SYSTEM::INFO-GET-FILE COMMON-LISP::EIGHTH ++ SYSTEM::SHOW-BREAK-POINT SYSTEM::SIMPLE-ARRAY-P ++ COMMON-LISP::RESTART-NAME SLOOP::POINTER-FOR-COLLECT ++ COMMON-LISP::PHASE SYSTEM::LNP ++ SYSTEM::REWRITE-RESTART-CASE-CLAUSE ++ SLOOP::LOOP-COLLECT-KEYWORD-P SYSTEM::S-DATA-HAS-HOLES ++ SYSTEM::EVAL-FEATURE ANSI-LOOP::DESTRUCTURING-SIZE ++ COMMON-LISP::BROADCAST-STREAM-STREAMS ++ ANSI-LOOP::LOOP-PATH-FUNCTION COMMON-LISP::BYTE-POSITION ++ ANSI-LOOP::LOOP-MINIMAX-TYPE COMMON-LISP::TANH ++ SYSTEM::BKPT-FILE SYSTEM::FRS-KIND ++ SYSTEM::S-DATA-PRINT-FUNCTION SYSTEM::UNIQUE-ID ++ SYSTEM::IHS-NOT-INTERPRETED-ENV SYSTEM::INSPECT-PACKAGE ++ ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA SYSTEM::BKPT-FILE-LINE ++ ANSI-LOOP::LOOP-EMIT-BODY SYSTEM::PATCH-SHARP ++ ANSI-LOOP::LOOP-COLLECTOR-P SYSTEM::DIR-CONJ ++ SYSTEM::CHECK-TRACE-SPEC ANSI-LOOP::LOOP-COLLECTOR-HISTORY ++ ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS SYSTEM::FIX-LOAD-PATH ++ ANSI-LOOP::LOOP-COLLECTOR-NAME SYSTEM::PATH-STREAM-NAME ++ SLOOP::LOOP-LET-BINDINGS ANSI-LOOP::LOOP-TYPED-INIT ++ FPE::ST-LOOKUP SYSTEM::IHS-VISIBLE SYSTEM::INFO-GET-TAGS ++ SYSTEM::EXPAND-HOME-DIR SYSTEM::DM-KEY-NOT-ALLOWED ++ ANSI-LOOP::LOOP-UNIVERSE-P ++ SYSTEM::CANONICALIZE-PATHNAME-DIRECTORY ++ COMMON-LISP::CONSTANTLY SYSTEM::WILD-NAMESTRING-P ++ SYSTEM::INSPECT-NUMBER SYSTEM::LOGICAL-PATHNAME-DESIGNATOR-P ++ COMMON-LISP::FOURTH SYSTEM::NODES-FROM-INDEX ++ SYSTEM::LOGICAL-PATHNAME-HOST-P SYSTEM::S-DATA-NAMED ++ COMMON-LISP::INVOKE-DEBUGGER SYSTEM::INSPECT-VECTOR ++ SYSTEM::VERSION-PARSE SYSTEM::WILD-PATH-ELEMENT-P ++ SLOOP::RETURN-SLOOP-MACRO SYSTEM::REGEXP-CONV ++ SYSTEM::NUMBER-OF-DAYS-FROM-1900 ++ COMMON-LISP::ECHO-STREAM-INPUT-STREAM SYSTEM::CHDIR ++ SYSTEM::DBL-RPL-LOOP COMMON-LISP::ASIN COMMON-LISP::RATIONAL ++ ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED ++ COMMON-LISP::NAMESTRING SYSTEM::TRACE-ONE-PREPROCESS ++ SYSTEM::TERMINAL-INTERRUPT SYSTEM::SEQTYPE SYSTEM::S-DATA-RAW ++ SYSTEM::GET-NEXT-VISIBLE-FUN FPE::XMM-LOOKUP ++ SYSTEM::MAKE-KCL-TOP-RESTART ANSI-LOOP::LOOP-MINIMAX-P ++ ANSI-LOOP::LOOP-MAXMIN-COLLECTION ++ COMMON-LISP::COMPILER-MACRO-FUNCTION SYSTEM::BKPT-FUNCTION ++ SYSTEM::DIRECTORY-LIST-CHECK SYSTEM::S-DATA-SLOT-POSITION ++ SYSTEM::SHORT-NAME SYSTEM::DBL-EVAL ++ ANSI-LOOP::LOOP-COLLECTOR-DATA SYSTEM::S-DATA-DOCUMENTATION ++ ANSI-LOOP::LOOP-EMIT-FINAL-VALUE COMMON-LISP::NINTH ++ SYSTEM::CHECK-DECLARATIONS ANSI-LOOP::LOOP-PATH-NAMES ++ COMMON-LISP::LOGICAL-PATHNAME COMMON-LISP::SIGNUM ++ COMMON-LISP::FIND-ALL-SYMBOLS COMMON-LISP::FIFTH ++ SYSTEM::S-DATA-P ANSI-LOOP::LOOP-CONSTANTP SYSTEM::IDESCRIBE ++ SYSTEM::BKPT-FORM ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE ++ SLOOP::SLOOP-SLOOP-MACRO SYSTEM::NEXT-STACK-FRAME ++ SYSTEM::INSPECT-CONS SYSTEM::KNOWN-TYPE-P ++ SYSTEM::RESET-TRACE-DECLARATIONS COMMON-LISP::SINH ++ ANSI-LOOP::LOOP-PATH-P COMMON-LISP::PROVIDE ++ SYSTEM::INSPECT-SYMBOL SYSTEM::FIND-DOCUMENTATION ++ ANSI-LOOP::LOOP-MAKE-DESETQ COMMON-LISP::TENTH ++ SYSTEM::MAKE-DEFPACKAGE-FORM COMMON-LISP::FILE-WRITE-DATE ++ COMMON-LISP::TWO-WAY-STREAM-OUTPUT-STREAM ++ COMMON-LISP::TRUENAME COMMON-LISP::COMPLEMENT ++ COMMON-LISP::FIRST ANSI-LOOP::LOOP-COLLECTOR-CLASS ++ ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS COMMON-LISP::ATANH ++ SYSTEM::LOGICAL-PATHNAMEP COMMON-LISP::DIRECTORY-NAMESTRING ++ SYSTEM::RESTART-P ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE ++ SYSTEM::FIND-KCL-TOP-RESTART COMMON-LISP::FILE-NAMESTRING ++ COMMON-LISP::STREAM-EXTERNAL-FORMAT COMMON-LISP::SECOND ++ COMMON-LISP::FILE-LENGTH SYSTEM::INSTREAM-STREAM ++ ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE COMMON-LISP::PATHNAME ++ SYSTEM::DO-F COMMON-LISP::FILE-AUTHOR ++ SYSTEM::LOAD-PATHNAME-EXISTS SLOOP::AVERAGING-SLOOP-MACRO ++ ANSI-LOOP::LOOP-CONSTRUCT-RETURN ANSI-LOOP::LOOP-UNIVERSE-ANSI ++ ANSI-LOOP::LOOP-PSEUDO-BODY SLOOP::PARSE-LOOP ++ ANSI-LOOP::LOOP-HACK-ITERATION SYSTEM::S-DATA-CONC-NAME ++ SYSTEM::SEARCH-STACK ANSI-LOOP::LOOP-DO-THEREIS ++ COMMON-LISP::BYTE-SIZE ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE ++ COMMON-LISP::ACOSH SYSTEM::GET-PATH ++ COMMON-LISP::LOGICAL-PATHNAME-TRANSLATIONS ++ SYSTEM::S-DATA-CONSTRUCTORS SYSTEM::ENSURE-DIR-STRING ++ SYSTEM::FREEZE-DEFSTRUCT SYSTEM::PRINT-IHS ++ SYSTEM::INSPECT-CHARACTER COMMON-LISP::ARRAY-DIMENSIONS ++ SLOOP::PARSE-LOOP-INITIALLY SYSTEM::COMPUTING-ARGS-P ++ SYSTEM::INSTREAM-STREAM-NAME SYSTEM::PROCESS-ARGS FPE::GREF ++ SYSTEM::S-DATA-NAME ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS ++ SYSTEM::GET-BYTE-STREAM-NCHARS SYSTEM::S-DATA-INCLUDED ++ SYSTEM::WALK-THROUGH SYSTEM::RESTART-FUNCTION ++ SLOOP::TRANSLATE-NAME ++ ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED ++ COMMON-LISP::SEVENTH COMMON-LISP::CIS FPE::LOOKUP ++ COMMON-LISP::COSH COMMON-LISP::VECTOR-POP SYSTEM::IHS-FNAME ++ SYSTEM::BREAK-BACKWARD-SEARCH-STACK SLOOP::REPEAT-SLOOP-MACRO ++ COMMON-LISP::PROBE-FILE ANSI-LOOP::LOOP-LIST-COLLECTION ++ SYSTEM::CONTEXT-P COMMON-LISP::SIXTH SYSTEM::NC ++ SYSTEM::MAKE-FRAME COMMON-LISP::COMPILE-FILE-PATHNAME ++ SYSTEM::INFO-NODE-FROM-POSITION SYSTEM::NODE-OFFSET ++ SYSTEM::RESTART-TEST-FUNCTION SYSTEM::ALOAD ++ ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS ++ ANSI-LOOP::LOOP-COLLECTOR-DTYPE SYSTEM::S-DATA-OFFSET ++ SYSTEM::SHOW-ENVIRONMENT COMMON-LISP::SYNONYM-STREAM-SYMBOL ++ SYSTEM::INSPECT-ARRAY ANSI-LOOP::LOOP-MAKE-PSETQ)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- COMMON-LISP::HASH-TABLE) +- SYSTEM::CONTEXT-SPICE)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++ SYSTEM::BREAK-QUIT SYSTEM::DBL-BACKTRACE ++ SYSTEM::BREAK-PREVIOUS SYSTEM::INFO-ERROR SYSTEM::BREAK-VS ++ SYSTEM::BREAK-LOCAL SYSTEM::IHS-BACKTRACE ++ ANSI-LOOP::LOOP-OPTIONAL-TYPE SYSTEM::BREAK-NEXT ++ COMMON-LISP::MUFFLE-WARNING SYSTEM::BREAK-BDS ++ COMMON-LISP::CONTINUE SYSTEM::SHOW-BREAK-VARIABLES)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- (COMMON-LISP::OR COMMON-LISP::NULL +- COMMON-LISP::HASH-TABLE)) +- SYSTEM::CONTEXT-HASH)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::FIXNUM) +- ANSI-LOOP::DUPLICATABLE-CODE-P SYSTEM::RELATIVE-LINE +- SYSTEM::LENEL SYSTEM::GET-NODE-INDEX SYSTEM::FASLINK +- SYSTEM::THE-END)) ++ (COMMON-LISP::VECTOR COMMON-LISP::T)) ++ SYSTEM::CONTEXT-VEC)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++ COMMON-LISP::*)) + COMMON-LISP::T) +- SLOOP::IN-PACKAGE-SLOOP-MAP SLOOP::DESETQ1 +- COMMON-LISP::LOGANDC2 ANSI-LOOP::MAKE-LOOP-MINIMAX +- COMMON-LISP::WRITE-BYTE SYSTEM::MATCH-DIMENSIONS +- SLOOP::IN-CAREFULLY-SLOOP-FOR SLOOP::SUM-SLOOP-COLLECT +- SYSTEM::DOT-DIR-P SLOOP::IN-FRINGE-SLOOP-MAP +- SLOOP::COLLATE-SLOOP-COLLECT ANSI-LOOP::LOOP-TMEMBER +- FPE::READ-OPERANDS SYSTEM::IN-INTERVAL-P SYSTEM::SUBSTRINGP +- FPE::PAREN-READER ANSI-LOOP::HIDE-VARIABLE-REFERENCES +- SYSTEM::QUOTATION-READER SYSTEM::ALL-MATCHES SYSTEM::GET-MATCH +- SYSTEM::ADD-FILE ANSI-LOOP::LOOP-DO-ALWAYS SLOOP::THE-TYPE +- SYSTEM::?PUSH SYSTEM::INCREMENT-CURSOR +- SYSTEM::CHECK-SEQ-START-END SLOOP::MAKE-VALUE +- SLOOP::THEREIS-SLOOP-COLLECT ANSI-LOOP::LOOP-DO-WHILE +- COMMON-LISP::COERCE ANSI-LOOP::LOOP-TEQUAL +- ANSI-LOOP::LOOP-DECLARE-VARIABLE COMMON-LISP::LOGNAND +- COMMON-LISP::LOGORC1 SYSTEM::BREAK-STEP-NEXT +- SLOOP::LOGXOR-SLOOP-COLLECT COMMON-LISP::LOGNOR +- COMPILER::COMPILER-DEF-HOOK ANSI-LOOP::LOOP-TASSOC +- SYSTEM::GET-LINE-OF-FORM SLOOP::MAXIMIZE-SLOOP-COLLECT +- ANSI-LOOP::LOOP-DO-IF SYSTEM::SETF-EXPAND SYSTEM::DM-V +- SYSTEM::ITERATE-OVER-BKPTS COMMON-LISP::NTHCDR +- SYSTEM::CONDITION-PASS SYSTEM::DISPLAY-COMPILED-ENV +- COMMON-LISP::LDB-TEST ANSI-LOOP::LOOP-MAYBE-BIND-FORM +- SYSTEM::SUPER-GO SYSTEM::SETF-LOGICAL-PATHNAME-TRANSLATIONS +- FPE::RF SYSTEM::SUB-INTERVAL-P SYSTEM::LEFT-PARENTHESIS-READER +- COMMON-LISP::FILE-STRING-LENGTH SYSTEM::OBJLT SYSTEM::MSUB +- SYSTEM::COERCE-TO-STRING SYSTEM::SAFE-EVAL +- SYSTEM::SET-PATH-STREAM-NAME SYSTEM::SET-BACK +- ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION COMMON-LISP::LOGTEST +- SYSTEM::*BREAK-POINTS* SLOOP::=-SLOOP-FOR +- SLOOP::MINIMIZE-SLOOP-COLLECT SYSTEM::KEYWORD-SUPPLIED-P +- SLOOP::COUNT-SLOOP-COLLECT FPE::%-READER COMMON-LISP::LOGORC2 +- SYSTEM::SEQUENCE-CURSOR SYSTEM::LOOKUP-KEYWORD +- COMMON-LISP::BYTE SYSTEM::PARSE-SLOT-DESCRIPTION +- COMMON-LISP::LOGANDC1 SYSTEM::DM-NTH-CDR FPE::0-READER +- SLOOP::L-EQUAL SYSTEM::LIST-DELQ SYSTEM::DM-NTH +- COMMON-LISP::LDB SYSTEM::SETF-HELPER +- SLOOP::NEVER-SLOOP-COLLECT SLOOP::PARSE-LOOP-MAP +- COMMON-LISP::NTH SYSTEM::BREAK-STEP-INTO +- SYSTEM::GET-INFO-CHOICES SLOOP::IN-TABLE-SLOOP-MAP +- SYSTEM::GET-NODES COMMON-LISP::VECTOR-PUSH +- COMMON-LISP::PATHNAME-MATCH-P SYSTEM::DBL-UP +- ANSI-LOOP::LOOP-LOOKUP-KEYWORD FPE::READ-INSTRUCTION +- SLOOP::ALWAYS-SLOOP-COLLECT SYSTEM::SET-DIR SYSTEM::INFO-AUX +- SYSTEM::DISPLAY-ENV COMMON-LISP::DOCUMENTATION +- SYSTEM::OVERWRITE-SLOT-DESCRIPTIONS)) ++ SYSTEM::RESET-SYS-PATHS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::*) +- COMMON-LISP::APROPOS ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE +- COMMON-LISP::FFLOOR SYSTEM::PRINT-DOC SYSTEM::INFO +- SYSTEM::PARSE-BODY-HEADER COMMON-LISP::INVOKE-RESTART +- SYSTEM::BREAK-FUNCTION SYSTEM::SHOW-INFO COMMON-LISP::FROUND +- COMMON-LISP::GET-SETF-EXPANSION COMMON-LISP::PARSE-NAMESTRING +- SYSTEM::APROPOS-DOC COMMON-LISP::ENSURE-DIRECTORIES-EXIST +- COMMON-LISP::USE-VALUE COMMON-LISP::READ-FROM-STRING +- COMMON-LISP::FTRUNCATE COMMON-LISP::STORE-VALUE +- SYSTEM::STEPPER SYSTEM::GET-SETF-METHOD-MULTIPLE-VALUE +- COMMON-LISP::APROPOS-LIST COMMON-LISP::FCEILING +- COMMON-LISP::WRITE-TO-STRING +- COMMON-LISP::DECODE-UNIVERSAL-TIME)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::T) ++ SYSTEM::MAYBE-BREAK SYSTEM::MME3 SYSTEM::FIND-LINE-IN-FUN ++ SYSTEM::SETF-STRUCTURE-ACCESS SYSTEM::EXPAND-RANGE ++ SYSTEM::MINMAX SYSTEM::COERCE-TO-CONDITION ++ SLOOP::FIRST-SLOOP-FOR SLOOP::FIRST-USE-SLOOP-FOR ++ SYSTEM::DO-BREAK-LEVEL SYSTEM::ELSUB ++ ANSI-LOOP::LOOP-FOR-ARITHMETIC SYSTEM::CALL-TEST ++ SYSTEM::ELEMENT SYSTEM::LOAD-PATHNAME)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- SYSTEM::SETF-EXPAND-1 SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS +- SYSTEM::WARN-VERSION ANSI-LOOP::LOOP-TRANSLATE +- ANSI-LOOP::LOOP-FOR-IN ANSI-LOOP::PRINT-LOOP-UNIVERSE +- ANSI-LOOP::LOOP-STANDARD-EXPANSION +- ANSI-LOOP::LOOP-ANSI-FOR-EQUALS SYSTEM::DM-VL +- SYSTEM::SHARP-A-READER COMMON-LISP::DEPOSIT-FIELD +- SYSTEM::RESTART-CASE-EXPRESSION-CONDITION +- SYSTEM::APPLY-DISPLAY-FUN ANSI-LOOP::HIDE-VARIABLE-REFERENCE +- SYSTEM::FLOATING-POINT-ERROR SYSTEM::GET-SLOT-POS ++ SYSTEM::SHARP-P-READER ANSI-LOOP::HIDE-VARIABLE-REFERENCE ++ SYSTEM::CHECK-TRACE-ARGS SYSTEM::SHARP-U-READER ++ SYSTEM::FLOATING-POINT-ERROR ANSI-LOOP::LOOP-FOR-IN ++ COMMON-LISP::DEPOSIT-FIELD SYSTEM::GET-SLOT-POS ++ SYSTEM::SHARP-A-READER SYSTEM::SHARP-V-READER ++ SYSTEM::PATHNAME-PARSE ++ SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS SYSTEM::SETF-EXPAND-1 ++ COMMON-LISP::DPB SYSTEM::RESTART-CASE-EXPRESSION-CONDITION ++ SYSTEM::CHECK-S-DATA ANSI-LOOP::LOOP-FOR-BEING ++ SYSTEM::TO-REGEXP-OR-NAMESTRING SYSTEM::APPLY-DISPLAY-FUN ++ ANSI-LOOP::LOOP-ANSI-FOR-EQUALS ANSI-LOOP::LOOP-SUM-COLLECTION ++ ANSI-LOOP::LOOP-FOR-ON SYSTEM::MFR ++ ANSI-LOOP::LOOP-STANDARD-EXPANSION SYSTEM::PROG?* + ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE +- SYSTEM::MAKE-BREAK-POINT SYSTEM::SHARP-V-READER +- SYSTEM::TO-REGEXP-OR-NAMESTRING ANSI-LOOP::LOOP-FOR-ON +- SYSTEM::SHARP-U-READER ANSI-LOOP::LOOP-SUM-COLLECTION +- SYSTEM::SHARP-P-READER SYSTEM::MAKE-T-TYPE +- ANSI-LOOP::LOOP-FOR-ACROSS SYSTEM::MFR SYSTEM::RECURSE-DIR +- SYSTEM::PATHNAME-PARSE ANSI-LOOP::LOOP-FOR-BEING +- COMMON-LISP::DPB SYSTEM::SHARP-DQ-READER +- SYSTEM::CHECK-TRACE-ARGS SYSTEM::DEFMACRO* +- SYSTEM::CHECK-S-DATA FPE::REF)) ++ SYSTEM::SHARP-DQ-READER SYSTEM::RECURSE-DIR SYSTEM::DM-VL ++ ANSI-LOOP::LOOP-FOR-ACROSS ANSI-LOOP::PRINT-LOOP-UNIVERSE ++ SYSTEM::WARN-VERSION ANSI-LOOP::LOOP-TRANSLATE ++ SYSTEM::DEFMACRO* SYSTEM::MAKE-BREAK-POINT SYSTEM::MAKE-T-TYPE ++ FPE::REF)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::T) ++ SYSTEM::MME2 COMMON-LISP::SUBSTITUTE-IF-NOT ++ ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH ++ COMMON-LISP::SUBSTITUTE SYSTEM::WALK-DIR ++ SYSTEM::CHECK-TYPE-SYMBOL COMMON-LISP::TRANSLATE-PATHNAME ++ ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH ++ COMMON-LISP::MAP ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH ++ ANSI-LOOP::ADD-LOOP-PATH SLOOP::LOOP-DECLARE-BINDING ++ SYSTEM::COMPLETE-PROP SYSTEM::MATCH-COMPONENT ++ COMMON-LISP::NSUBSTITUTE COMMON-LISP::NSUBSTITUTE-IF ++ COMMON-LISP::SUBSTITUTE-IF COMMON-LISP::NSUBSTITUTE-IF-NOT ++ SYSTEM::PUSH-LET-BINDING ANSI-LOOP::LOOP-MAKE-VARIABLE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- SYSTEM::FIND-IHS COMMON-LISP::NSET-DIFFERENCE +- COMMON-LISP::BIT-NAND SYSTEM::BREAK-CALL +- COMMON-LISP::COUNT-IF-NOT COMMON-LISP::DELETE +- SYSTEM::INTERNAL-COUNT COMMON-LISP::BIT-ORC1 +- COMMON-LISP::DELETE-IF COMMON-LISP::BIT-ANDC1 +- SYSTEM::VECTOR-PUSH-STRING COMMON-LISP::MISMATCH +- COMMON-LISP::NOTEVERY SYSTEM::PROCESS-ERROR COMMON-LISP::TYPEP +- COMMON-LISP::BIT-IOR COMMON-LISP::BIT-EQV +- COMMON-LISP::COUNT-IF COMMON-LISP::REMOVE-IF +- COMMON-LISP::EVERY COMMON-LISP::POSITION-IF-NOT +- COMMON-LISP::ADJUST-ARRAY COMMON-LISP::VECTOR-PUSH-EXTEND +- SYSTEM::INTERNAL-COUNT-IF-NOT COMMON-LISP::COUNT +- COMMON-LISP::DELETE-IF-NOT COMMON-LISP::NINTERSECTION +- COMMON-LISP::FIND-IF-NOT COMMON-LISP::BIT-ORC2 +- COMMON-LISP::SUBSETP COMMON-LISP::SOME SYSTEM::WREADDIR +- COMMON-LISP::SET-DIFFERENCE COMMON-LISP::UNION +- COMMON-LISP::BIT-XOR SLOOP::PARSE-LOOP-MACRO +- COMMON-LISP::REPLACE COMMON-LISP::REMOVE +- SLOOP::LOOP-ADD-BINDING COMMON-LISP::BIT-ANDC2 +- COMMON-LISP::READ-SEQUENCE COMMON-LISP::CERROR +- COMMON-LISP::INTERSECTION COMMON-LISP::POSITION-IF +- ANSI-LOOP::LOOP-CHECK-DATA-TYPE SYSTEM::INTERNAL-COUNT-IF +- COMMON-LISP::NUNION COMMON-LISP::WRITE-SEQUENCE +- COMMON-LISP::MAP-INTO COMMON-LISP::MAKE-SEQUENCE +- COMMON-LISP::SET-EXCLUSIVE-OR SLOOP::IN-ARRAY-SLOOP-FOR +- COMMON-LISP::FIND-IF COMMON-LISP::SEARCH COMMON-LISP::FILL +- COMMON-LISP::FIND COMMON-LISP::NOTANY +- COMMON-LISP::NSET-EXCLUSIVE-OR COMMON-LISP::BIT-NOR +- COMMON-LISP::REMOVE-IF-NOT COMMON-LISP::POSITION +- COMMON-LISP::BIT-AND)) ++ COMMON-LISP::DELETE-IF-NOT COMMON-LISP::FILL ++ COMMON-LISP::SET-EXCLUSIVE-OR ANSI-LOOP::LOOP-CHECK-DATA-TYPE ++ SYSTEM::INTERNAL-COUNT-IF-NOT COMMON-LISP::SOME ++ COMMON-LISP::COUNT COMMON-LISP::NOTANY SYSTEM::INTERNAL-COUNT ++ COMMON-LISP::POSITION-IF-NOT COMMON-LISP::SET-DIFFERENCE ++ SLOOP::IN-ARRAY-SLOOP-FOR COMMON-LISP::NUNION ++ COMMON-LISP::BIT-NAND SYSTEM::PROCESS-ERROR ++ COMMON-LISP::BIT-ANDC2 COMMON-LISP::POSITION-IF ++ COMMON-LISP::NSET-DIFFERENCE COMMON-LISP::WRITE-SEQUENCE ++ COMMON-LISP::BIT-XOR COMMON-LISP::READ-SEQUENCE ++ COMMON-LISP::DELETE-IF COMMON-LISP::MAP-INTO ++ COMMON-LISP::SUBSETP COMMON-LISP::REMOVE-IF-NOT ++ COMMON-LISP::FIND-IF COMMON-LISP::INTERSECTION ++ COMMON-LISP::REPLACE COMMON-LISP::VECTOR-PUSH-EXTEND ++ COMMON-LISP::BIT-ORC2 COMMON-LISP::POSITION ++ COMMON-LISP::CERROR COMMON-LISP::FIND COMMON-LISP::BIT-ORC1 ++ SYSTEM::BREAK-CALL SLOOP::PARSE-LOOP-MACRO COMMON-LISP::EVERY ++ COMMON-LISP::COUNT-IF-NOT COMMON-LISP::ADJUST-ARRAY ++ COMMON-LISP::SEARCH COMMON-LISP::REMOVE-IF ++ COMMON-LISP::NOTEVERY COMMON-LISP::TYPEP COMMON-LISP::COUNT-IF ++ SYSTEM::WREADDIR SYSTEM::INTERNAL-COUNT-IF COMMON-LISP::DELETE ++ COMMON-LISP::NSET-EXCLUSIVE-OR COMMON-LISP::UNION ++ COMMON-LISP::BIT-EQV COMMON-LISP::NINTERSECTION ++ COMMON-LISP::MISMATCH SYSTEM::FIND-IHS COMMON-LISP::REMOVE ++ SYSTEM::VECTOR-PUSH-STRING COMMON-LISP::BIT-IOR ++ COMMON-LISP::FIND-IF-NOT COMMON-LISP::MAKE-SEQUENCE ++ COMMON-LISP::BIT-ANDC1 SLOOP::LOOP-ADD-BINDING ++ COMMON-LISP::BIT-NOR COMMON-LISP::BIT-AND)) + (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) +- SYSTEM::FIND-LINE-IN-FUN ANSI-LOOP::LOOP-FOR-ARITHMETIC +- SYSTEM::EXPAND-RANGE SYSTEM::MAYBE-BREAK SYSTEM::MINMAX +- SLOOP::FIRST-USE-SLOOP-FOR SLOOP::FIRST-SLOOP-FOR +- SYSTEM::SETF-STRUCTURE-ACCESS SYSTEM::DO-BREAK-LEVEL +- SYSTEM::CALL-TEST SYSTEM::ELEMENT SYSTEM::LOAD-PATHNAME +- SYSTEM::COERCE-TO-CONDITION SYSTEM::ELSUB)) ++ SYSTEM::DO-ARG-COUNT-ERROR SYSTEM::PUSH-SUB-LIST-BINDING)) + (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 COMMON-LISP::T) + COMMON-LISP::T) +- SLOOP::DEF-LOOP-INTERNAL COMMON-LISP::MERGE +- SYSTEM::PRINT-STACK-FRAME)) ++ SYSTEM::MAKE-PREDICATE SYSTEM::DO?* 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::T +- COMMON-LISP::*) ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) + COMMON-LISP::T) +- COMMON-LISP::ENCODE-UNIVERSAL-TIME)) ++ ANSI-LOOP::LOOP-SEQUENCER)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) ++ COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH +- SYSTEM::COMPLETE-PROP SYSTEM::CHECK-TYPE-SYMBOL +- COMMON-LISP::NSUBSTITUTE +- ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH COMMON-LISP::SUBSTITUTE +- COMMON-LISP::TRANSLATE-PATHNAME COMMON-LISP::NSUBSTITUTE-IF +- COMMON-LISP::MAP SLOOP::LOOP-DECLARE-BINDING SYSTEM::WALK-DIR +- SYSTEM::MATCH-COMPONENT ANSI-LOOP::LOOP-MAKE-VARIABLE +- ANSI-LOOP::ADD-LOOP-PATH COMMON-LISP::SUBSTITUTE-IF +- COMMON-LISP::NSUBSTITUTE-IF-NOT SYSTEM::MME2 +- ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH +- COMMON-LISP::SUBSTITUTE-IF-NOT SYSTEM::PUSH-LET-BINDING)) ++ SYSTEM::EXPAND-WILD-DIRECTORY SLOOP::DEF-LOOP-INTERNAL ++ COMMON-LISP::MERGE SYSTEM::PRINT-STACK-FRAME)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -243,88 +286,120 @@ + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807)) + COMMON-LISP::T) +- SYSTEM::SHARP-SHARP-READER SYSTEM::SHARP-EQ-READER)) ++ SYSTEM::SHARP-EQ-READER SYSTEM::SHARP-SHARP-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::T ++ COMMON-LISP::*) + COMMON-LISP::T) +- SYSTEM::DO-ARG-COUNT-ERROR SYSTEM::PUSH-SUB-LIST-BINDING)) ++ 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::*) + COMMON-LISP::T) +- SYSTEM::MAKE-CONSTRUCTOR SYSTEM::MAKE-PREDICATE)) ++ SYSTEM::UNIVERSAL-ERROR-HANDLER)) ++(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 SYSTEM::PARSE-DEFMACRO-LAMBDA-LIST)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::*) ++ COMMON-LISP::SUBST COMMON-LISP::SUBST-IF-NOT ++ COMMON-LISP::SUBST-IF SYSTEM::MASET)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ SYSTEM::READ-INSPECT-COMMAND SYSTEM::RESTART-PRINT ++ ANSI-LOOP::LOOP-GET-COLLECTION-INFO SYSTEM::SHARP-+-READER ++ SYSTEM::VERIFY-KEYWORDS SYSTEM::SHARP-S-READER ++ SYSTEM::LIST-MERGE-SORT SYSTEM::SHARP---READER)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ SYSTEM::PARSE-BODY COMMON-LISP::SORT ++ SLOOP::FIND-IN-ORDERED-LIST COMMON-LISP::REDUCE ++ COMMON-LISP::STABLE-SORT COMMON-LISP::SUBTYPEP)) + (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::*) ++ SYSTEM::TRACE-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::*) +- COMMON-LISP::T) +- SYSTEM::UNIVERSAL-ERROR-HANDLER)) +-(COMMON-LISP::MAPC +- (COMMON-LISP::LAMBDA (COMPILER::X) +- (COMMON-LISP::SETF +- (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) +- COMMON-LISP::T)) +- '(SYSTEM::SI-FIND-CLASS SYSTEM::WARNINGP SYSTEM::SI-CLASS-OF +- SYSTEM::CONDITION-CLASS-P SYSTEM::UNTRACE-ONE +- SYSTEM::MAKE-ACCESS-FUNCTION SYSTEM::SIMPLE-CONDITION-CLASS-P +- SYSTEM::CONDITIONP SYSTEM::AUTOLOAD +- SYSTEM::SI-CLASS-PRECEDENCE-LIST SYSTEM::SI-CLASSP +- FPE::BREAK-ON-FLOATING-POINT-EXCEPTIONS SYSTEM::TRACE-ONE +- SYSTEM::AUTOLOAD-MACRO SYSTEM::DEFINE-STRUCTURE +- SYSTEM::SI-CLASS-NAME)) ++ 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::*) +- SYSTEM::INSTREAM-NAME ANSI-LOOP::LOOP-LIST-STEP +- COMMON-LISP::PRIN1-TO-STRING ANSI-LOOP::NAMED-VARIABLE +- SYSTEM::WAITING SYSTEM::FIND-DECLARATIONS COMMON-LISP::INSPECT +- SYSTEM::END-WAITING SYSTEM::BREAK-GO SYSTEM::INFO-SUBFILE +- COMMON-LISP::INVOKE-RESTART-INTERACTIVELY +- ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES SYSTEM::INSPECT-OBJECT +- SYSTEM::BREAK-LEVEL-INVOKE-RESTART SYSTEM::EXPAND-RANGES +- SYSTEM::GET-&ENVIRONMENT COMMON-LISP::DESCRIBE +- COMMON-LISP::PRINC-TO-STRING)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++ SYSTEM::MAKE-CONTEXT ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE ++ ANSI-LOOP::MAKE-LOOP-UNIVERSE SYSTEM::MAKE-S-DATA ++ SYSTEM::NEXT-MATCH COMMON-LISP::USER-HOMEDIR-PATHNAME ++ SYSTEM::STEP-NEXT ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL ++ COMMON-LISP::VECTOR SLOOP::PARSE-LOOP-WITH ++ COMMON-LISP::COMPUTE-RESTARTS COMMON-LISP::BREAK ++ ANSI-LOOP::MAKE-LOOP-PATH ANSI-LOOP::LOOP-GENTEMP ++ COMMON-LISP::ABORT COMMON-LISP::YES-OR-NO-P ++ SYSTEM::MAKE-INSTREAM SYSTEM::DBL-READ ++ SYSTEM::MAYBE-CLEAR-INPUT SYSTEM::MAKE-RESTART ++ ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL COMMON-LISP::Y-OR-N-P ++ SLOOP::PARSE-LOOP-DECLARE ANSI-LOOP::MAKE-LOOP-COLLECTOR ++ SYSTEM::DESCRIBE-ENVIRONMENT SYSTEM::STEP-INTO ++ SYSTEM::CURRENT-STEP-FUN COMMON-LISP::DRIBBLE ++ COMMON-LISP::MAKE-PATHNAME SYSTEM::BREAK-LOCALS SYSTEM::LOC ++ SYSTEM::TRANSFORM-KEYWORDS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +- COMMON-LISP::ABORT ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE +- SYSTEM::MAKE-S-DATA ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL +- ANSI-LOOP::MAKE-LOOP-PATH SYSTEM::CURRENT-STEP-FUN SYSTEM::LOC +- SYSTEM::DBL-READ SYSTEM::MAKE-RESTART +- SYSTEM::TRANSFORM-KEYWORDS COMMON-LISP::Y-OR-N-P +- SYSTEM::NEXT-MATCH COMMON-LISP::COMPUTE-RESTARTS +- SLOOP::PARSE-LOOP-WITH COMMON-LISP::VECTOR SYSTEM::STEP-NEXT +- ANSI-LOOP::MAKE-LOOP-COLLECTOR +- COMMON-LISP::USER-HOMEDIR-PATHNAME SLOOP::PARSE-LOOP-DECLARE +- COMMON-LISP::YES-OR-NO-P SYSTEM::STEP-INTO +- SYSTEM::MAKE-CONTEXT SYSTEM::BREAK-LOCALS +- SYSTEM::DESCRIBE-ENVIRONMENT COMMON-LISP::DRIBBLE +- ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL SYSTEM::MAYBE-CLEAR-INPUT +- COMMON-LISP::BREAK ANSI-LOOP::LOOP-GENTEMP +- ANSI-LOOP::MAKE-LOOP-UNIVERSE SYSTEM::MAKE-INSTREAM +- COMMON-LISP::MAKE-PATHNAME)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++ ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES ++ COMMON-LISP::PRIN1-TO-STRING SYSTEM::GET-&ENVIRONMENT ++ COMMON-LISP::INSPECT SYSTEM::BREAK-GO ++ SYSTEM::PARSE-BODY-HEADER COMMON-LISP::PRINC-TO-STRING ++ SYSTEM::EXPAND-RANGES ANSI-LOOP::NAMED-VARIABLE ++ ANSI-LOOP::LOOP-LIST-STEP SYSTEM::INSTREAM-NAME ++ SYSTEM::WAITING SYSTEM::END-WAITING COMMON-LISP::DESCRIBE ++ SYSTEM::INFO-SUBFILE SYSTEM::FIND-DECLARATIONS ++ SYSTEM::INSPECT-OBJECT SYSTEM::BREAK-LEVEL-INVOKE-RESTART ++ COMMON-LISP::INVOKE-RESTART-INTERACTIVELY)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- ((COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807)) +- COMMON-LISP::FIXNUM) +- FPE::FE-ENABLE SYSTEM::DBL-WHAT-FRAME)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++ SYSTEM::S-DATA-SIZE FPE::REG-LOOKUP SYSTEM::INSTREAM-LINE ++ SYSTEM::S-DATA-LENGTH SYSTEM::THE-START)) ++(COMMON-LISP::MAPC ++ (COMMON-LISP::LAMBDA (COMPILER::X) ++ (COMMON-LISP::SETF ++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) ++ COMMON-LISP::T)) ++ '(SYSTEM::SI-CLASS-PRECEDENCE-LIST SYSTEM::AUTOLOAD ++ SYSTEM::UNTRACE-ONE SYSTEM::TRACE-ONE SYSTEM::CONDITIONP ++ SYSTEM::MAKE-ACCESS-FUNCTION SYSTEM::SI-CLASS-NAME ++ SYSTEM::SI-CLASSP SYSTEM::SI-CLASS-OF SYSTEM::SI-FIND-CLASS ++ SYSTEM::CONDITION-CLASS-P SYSTEM::AUTOLOAD-MACRO ++ SYSTEM::WARNINGP SYSTEM::DEFINE-STRUCTURE ++ FPE::BREAK-ON-FLOATING-POINT-EXCEPTIONS ++ SYSTEM::SIMPLE-CONDITION-CLASS-P)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -336,155 +411,9 @@ + SYSTEM::ROUND-UP)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER +- COMMON-LISP::*) +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807)) +- COMMON-LISP::FIXNUM) +- SYSTEM::ATOI)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +- SYSTEM::REGEXP-CONV SYSTEM::DIR-CONJ SYSTEM::DIR-P +- ANSI-LOOP::LOOP-LIST-COLLECTION COMMON-LISP::COSH +- SYSTEM::GET-BYTE-STREAM-NCHARS SYSTEM::INSPECT-CONS +- SYSTEM::KNOWN-TYPE-P SYSTEM::LNP COMMON-LISP::SEVENTH +- SYSTEM::BKPT-FUNCTION SYSTEM::WILD-DIR-ELEMENT-P +- COMMON-LISP::COMPILER-MACRO-FUNCTION +- ANSI-LOOP::LOOP-HACK-ITERATION +- COMMON-LISP::ECHO-STREAM-OUTPUT-STREAM +- SYSTEM::DIRECTORY-LIST-CHECK COMMON-LISP::FILE-WRITE-DATE +- SYSTEM::NORMALIZE-TYPE COMMON-LISP::EIGHTH SYSTEM::TOGGLE-CASE +- SYSTEM::SHOW-ENVIRONMENT +- COMMON-LISP::TWO-WAY-STREAM-INPUT-STREAM SYSTEM::GET-PATH +- COMMON-LISP::ASINH SYSTEM::FIND-KCL-TOP-RESTART +- SYSTEM::RESTART-P SYSTEM::EVAL-FEATURE SYSTEM::ALOAD +- COMMON-LISP::PHASE SLOOP::SUBSTITUTE-SLOOP-BODY +- COMMON-LISP::ASIN SYSTEM::NODES-FROM-INDEX +- SYSTEM::MAKE-DEFPACKAGE-FORM ANSI-LOOP::LOOP-COLLECTOR-DTYPE +- SYSTEM::LOGICAL-PATHNAMEP SYSTEM::INSPECT-VECTOR +- ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS +- SYSTEM::RESTART-REPORT-FUNCTION SYSTEM::IHS-VISIBLE +- SLOOP::LOOP-COLLECT-KEYWORD-P ANSI-LOOP::LOOP-TYPED-INIT +- COMMON-LISP::VECTOR-POP SYSTEM::UNIQUE-ID +- ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS +- SYSTEM::SIMPLE-ARRAY-P COMMON-LISP::ACOS SYSTEM::DBL-EVAL +- SYSTEM::INSPECT-STRING SYSTEM::MLP +- SYSTEM::INSTREAM-STREAM-NAME SYSTEM::WILD-NAMESTRING-P +- ANSI-LOOP::LOOP-PATH-FUNCTION +- SYSTEM::GET-STRING-INPUT-STREAM-INDEX +- ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE SYSTEM::SEQTYPE +- ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS +- SYSTEM::BEST-ARRAY-ELEMENT-TYPE +- ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA SYSTEM::S-DATA-FROZEN +- SYSTEM::S-DATA-DOCUMENTATION SYSTEM::DWIM COMMON-LISP::SIGNUM +- SYSTEM::FIND-DOCUMENTATION ANSI-LOOP::LOOP-COLLECTOR-HISTORY +- ANSI-LOOP::LOOP-MAKE-PSETQ FPE::GREF SYSTEM::S-DATA-OFFSET +- SYSTEM::WILD-PATH-ELEMENT-P SYSTEM::INSTREAM-P +- COMMON-LISP::DIRECTORY-NAMESTRING SYSTEM::INSPECT-ARRAY +- COMMON-LISP::ARRAY-DIMENSIONS +- ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS ANSI-LOOP::LOOP-MINIMAX-P +- SLOOP::RETURN-SLOOP-MACRO SYSTEM::WALK-THROUGH +- SYSTEM::NEXT-STACK-FRAME SYSTEM::S-DATA-NAME COMMON-LISP::TANH +- SYSTEM::BREAK-BACKWARD-SEARCH-STACK COMMON-LISP::TENTH +- SYSTEM::INFO-NODE-FROM-POSITION FPE::ST-LOOKUP +- COMMON-LISP::RESTART-NAME SYSTEM::S-DATA-TYPE +- SYSTEM::BKPT-FILE-LINE COMMON-LISP::FIND-ALL-SYMBOLS +- COMMON-LISP::FIFTH SLOOP::LOOP-LET-BINDINGS +- COMMON-LISP::ECHO-STREAM-INPUT-STREAM +- ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED +- COMMON-LISP::PROBE-FILE SYSTEM::MAKE-FRAME +- SYSTEM::IHS-NOT-INTERPRETED-ENV SYSTEM::SEARCH-STACK +- COMMON-LISP::COMPILE-FILE-PATHNAME +- SYSTEM::PRINT-SYMBOL-APROPOS COMMON-LISP::LOGNOT +- SYSTEM::INFO-GET-TAGS SYSTEM::SHORT-NAME +- ANSI-LOOP::LOOP-MINIMAX-TYPE COMMON-LISP::SIXTH +- COMMON-LISP::SECOND ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS +- COMMON-LISP::TWO-WAY-STREAM-OUTPUT-STREAM +- SYSTEM::S-DATA-INCLUDES SYSTEM::RESTART-INTERACTIVE-FUNCTION +- SLOOP::TRANSLATE-NAME SYSTEM::PATCH-SHARP COMMON-LISP::ABS +- ANSI-LOOP::LOOP-CONSTANTP SYSTEM::LEAP-YEAR-P +- ANSI-LOOP::LOOP-UNIVERSE-ANSI ANSI-LOOP::LOOP-EMIT-BODY +- COMMON-LISP::HOST-NAMESTRING COMMON-LISP::FIRST +- SYSTEM::INSERT-BREAK-POINT +- COMMON-LISP::LOAD-LOGICAL-PATHNAME-TRANSLATIONS +- COMMON-LISP::DELETE-FILE ANSI-LOOP::LOOP-PSEUDO-BODY +- SYSTEM::GET-NEXT-VISIBLE-FUN SYSTEM::S-DATA-HAS-HOLES +- ANSI-LOOP::LOOP-COLLECTOR-NAME COMMON-LISP::FOURTH +- SYSTEM::BKPT-FILE SYSTEM::CANONICALIZE-PATHNAME-DIRECTORY +- SYSTEM::INSTREAM-STREAM SYSTEM::PNL1 SYSTEM::IHS-FNAME +- SYSTEM::S-DATA-SLOT-POSITION SLOOP::PARSE-LOOP +- SYSTEM::CHECK-TRACE-SPEC SYSTEM::S-DATA-CONSTRUCTORS +- SYSTEM::S-DATA-STATICP SYSTEM::CONTEXT-P +- COMMON-LISP::LOGICAL-PATHNAME-TRANSLATIONS +- SYSTEM::INFO-GET-FILE COMMON-LISP::COMPLEMENT +- SYSTEM::INSPECT-NUMBER SYSTEM::RESET-TRACE-DECLARATIONS +- ANSI-LOOP::LOOP-PATH-P SLOOP::REPEAT-SLOOP-MACRO SYSTEM::DO-F +- SYSTEM::INSPECT-PACKAGE SYSTEM::PATH-STREAM-NAME +- SYSTEM::GET-INSTREAM COMMON-LISP::BYTE-SIZE +- SYSTEM::RESTART-FUNCTION FPE::LOOKUP SYSTEM::S-DATA-CONC-NAME +- COMMON-LISP::PROVIDE SYSTEM::S-DATA-NAMED SYSTEM::PRINT-FRS +- ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE SYSTEM::NODE-OFFSET +- ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE SYSTEM::PRINT-IHS +- ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS COMMON-LISP::TRUENAME +- SYSTEM::BREAK-FORWARD-SEARCH-STACK +- COMMON-LISP::CONCATENATED-STREAM-STREAMS SYSTEM::VERSION-PARSE +- SYSTEM::INSPECT-CHARACTER SYSTEM::LOGICAL-PATHNAME-HOST-P +- SYSTEM::DM-BAD-KEY SYSTEM::EXPAND-HOME-DIR +- ANSI-LOOP::LOOP-PATH-USER-DATA +- ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS SYSTEM::INSPECT-SYMBOL +- COMMON-LISP::INVOKE-DEBUGGER +- SYSTEM::LOGICAL-PATHNAME-DESIGNATOR-P +- COMMON-LISP::BYTE-POSITION COMMON-LISP::ISQRT COMMON-LISP::CIS +- ANSI-LOOP::LOOP-COLLECTOR-CLASS +- COMMON-LISP::SYNONYM-STREAM-SYMBOL ANSI-LOOP::LOOP-PATH-NAMES +- SYSTEM::RE-QUOTE-STRING SYSTEM::INSPECT-STRUCTURE +- COMMON-LISP::RATIONAL FPE::XMM-LOOKUP +- SYSTEM::REWRITE-RESTART-CASE-CLAUSE +- SYSTEM::S-DATA-PRINT-FUNCTION +- SYSTEM::RESTRICT-STREAM-ELEMENT-TYPE SLOOP::SLOOP-SLOOP-MACRO +- COMMON-LISP::NAMESTRING SYSTEM::ENSURE-DIR-STRING +- COMMON-LISP::CONSTANTLY SLOOP::PARSE-LOOP-INITIALLY +- SYSTEM::S-DATA-RAW SYSTEM::ADD-TO-HOTLIST SYSTEM::FRS-KIND +- ANSI-LOOP::LOOP-MAXMIN-COLLECTION +- ANSI-LOOP::LOOP-COLLECTOR-DATA SYSTEM::PROCESS-ARGS +- SYSTEM::COERCE-SLASH-TERMINATED SYSTEM::MAKE-KCL-TOP-RESTART +- COMMON-LISP::ATANH ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD +- COMMON-LISP::SINH ANSI-LOOP::LOOP-UNIVERSE-P +- ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED +- SYSTEM::S-DATA-INCLUDED COMMON-LISP::STREAM-EXTERNAL-FORMAT +- SYSTEM::COMPUTING-ARGS-P SYSTEM::REAL-ASINH +- ANSI-LOOP::LOOP-CONSTRUCT-RETURN +- SYSTEM::S-DATA-SLOT-DESCRIPTIONS SYSTEM::FIX-LOAD-PATH +- SYSTEM::CHECK-DECLARATIONS +- ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS +- SLOOP::POINTER-FOR-COLLECT COMMON-LISP::LOGICAL-PATHNAME +- SYSTEM::CHDIR SYSTEM::IDESCRIBE +- ANSI-LOOP::LOOP-MINIMAX-OPERATIONS COMMON-LISP::ACOSH +- COMMON-LISP::NINTH ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE +- ANSI-LOOP::LOOP-COLLECTOR-P SYSTEM::S-DATA-P SYSTEM::BKPT-FORM +- COMMON-LISP::FILE-NAMESTRING SYSTEM::TERMINAL-INTERRUPT +- SYSTEM::SETUP-INFO SLOOP::PARSE-NO-BODY +- SYSTEM::DM-KEY-NOT-ALLOWED ANSI-LOOP::LOOP-EMIT-FINAL-VALUE +- SYSTEM::FREEZE-DEFSTRUCT SYSTEM::DBL-RPL-LOOP +- SYSTEM::TRACE-ONE-PREPROCESS +- COMMON-LISP::BROADCAST-STREAM-STREAMS COMMON-LISP::THIRD +- SLOOP::AVERAGING-SLOOP-MACRO SYSTEM::SHOW-BREAK-POINT +- COMMON-LISP::PATHNAME ANSI-LOOP::LOOP-DO-THEREIS +- COMMON-LISP::FILE-AUTHOR ANSI-LOOP::LOOP-MAKE-DESETQ +- SYSTEM::NC SYSTEM::NUMBER-OF-DAYS-FROM-1900 +- SYSTEM::RESTART-TEST-FUNCTION SYSTEM::WHICH +- ANSI-LOOP::DESTRUCTURING-SIZE COMMON-LISP::FILE-LENGTH)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) +- SYSTEM::BREAK-VS ANSI-LOOP::LOOP-OPTIONAL-TYPE +- SYSTEM::BREAK-BDS SYSTEM::IHS-BACKTRACE SYSTEM::INFO-ERROR +- SYSTEM::BREAK-LOCAL SYSTEM::SHOW-BREAK-VARIABLES +- COMMON-LISP::MUFFLE-WARNING SYSTEM::BREAK-PREVIOUS +- SYSTEM::BREAK-QUIT SYSTEM::DBL-BACKTRACE COMMON-LISP::CONTINUE +- SYSTEM::BREAK-NEXT)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ COMMON-LISP::HASH-TABLE) ++ SYSTEM::CONTEXT-SPICE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) +@@ -512,124 +441,227 @@ + SYSTEM::BIGNTHCDR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::T) +- COMMON-LISP::FIND-RESTART COMMON-LISP::PATHNAME-HOST +- SYSTEM::LINK-EXPAND COMMON-LISP::CONCATENATE COMMON-LISP::WARN +- COMMON-LISP::FILE-POSITION ANSI-LOOP::LOOP-WARN +- COMMON-LISP::PATHNAME-DIRECTORY COMMON-LISP::SBIT +- COMMON-LISP::BIT ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES +- COMMON-LISP::PATHNAME-TYPE COMMON-LISP::MAKE-ARRAY +- ANSI-LOOP::LOOP-ERROR COMMON-LISP::DIRECTORY SYSTEM::DIR-PARSE +- COMMON-LISP::TRANSLATE-LOGICAL-PATHNAME +- SYSTEM::NTH-STACK-FRAME COMMON-LISP::REQUIRE COMMON-LISP::LOAD +- SYSTEM::MGLIST COMMON-LISP::DELETE-DUPLICATES +- COMMON-LISP::PATHNAME-VERSION COMMON-LISP::ENOUGH-NAMESTRING +- SYSTEM::BAD-SEQ-LIMIT COMMON-LISP::REMOVE-DUPLICATES +- COMMON-LISP::PATHNAME-NAME +- COMMON-LISP::MAKE-STRING-INPUT-STREAM SLOOP::LOOP-ADD-TEMPS +- SYSTEM::NLOAD SYSTEM::LIST-MATCHES +- COMMON-LISP::ARRAY-ROW-MAJOR-INDEX +- COMMON-LISP::ARRAY-IN-BOUNDS-P SYSTEM::BREAK-LEVEL +- SYSTEM::PROCESS-SOME-ARGS SYSTEM::TO-REGEXP +- COMMON-LISP::UPGRADED-ARRAY-ELEMENT-TYPE COMMON-LISP::OPEN +- SYSTEM::FILE-SEARCH COMMON-LISP::READ-BYTE +- SYSTEM::FILE-TO-STRING SLOOP::ADD-FROM-DATA COMMON-LISP::ERROR +- COMMON-LISP::SIGNAL SYSTEM::MGSUB COMMON-LISP::WILD-PATHNAME-P +- COMMON-LISP::PATHNAME-DEVICE SYSTEM::LOGICAL-PATHNAME-PARSE +- COMMON-LISP::MERGE-PATHNAMES SYSTEM::INFO-SEARCH +- COMMON-LISP::BIT-NOT)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::*) +- ANSI-LOOP::ESTIMATE-CODE-SIZE-1 SYSTEM::DO-REPL +- SYSTEM::SOURCE-PORTION SYSTEM::RESTART-REPORT +- SYSTEM::NEW-SEMI-COLON-READER SYSTEM::FIND-DOC +- ANSI-LOOP::ESTIMATE-CODE-SIZE SYSTEM::NEWLINE +- COMMON-LISP::RENAME-FILE SYSTEM::LIST-TOGGLE-CASE)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::*) +- COMMON-LISP::REDUCE COMMON-LISP::STABLE-SORT +- SYSTEM::PARSE-BODY SLOOP::FIND-IN-ORDERED-LIST +- COMMON-LISP::SUBTYPEP COMMON-LISP::SORT)) ++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++ COMMON-LISP::*) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::FIXNUM) ++ SYSTEM::ATOI)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::*) +- SYSTEM::LIST-MERGE-SORT ANSI-LOOP::LOOP-GET-COLLECTION-INFO +- SYSTEM::SHARP---READER SYSTEM::SHARP-S-READER +- SYSTEM::VERIFY-KEYWORDS SYSTEM::RESTART-PRINT +- SYSTEM::SHARP-+-READER SYSTEM::READ-INSPECT-COMMAND)) ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++ ANSI-LOOP::LOOP-DO-INITIALLY SYSTEM::GET-INDEX-NODE ++ SLOOP::PARSE-ONE-WHEN-CLAUSE SYSTEM::STEP-READ-LINE ++ SYSTEM::DM-TOO-MANY-ARGUMENTS SYSTEM::READ-EVALUATED-FORM ++ SYSTEM::DM-TOO-FEW-ARGUMENTS SYSTEM::KCL-TOP-RESTARTS ++ ANSI-LOOP::LOOP-ITERATION-DRIVER ++ SYSTEM::CURRENT-DIRECTORY-PATHNAME SYSTEM::INSPECT-INDENT ++ SYSTEM::CLEANUP ANSI-LOOP::LOOP-WHEN-IT-VARIABLE ++ SLOOP::PARSE-LOOP-WHEN ANSI-LOOP::LOOP-DO-NAMED ++ ANSI-LOOP::LOOP-GET-FORM SYSTEM::GET-TEMP-DIR ++ SYSTEM::ILLEGAL-BOA SYSTEM::SET-UP-TOP-LEVEL ++ SYSTEM::SETUP-LINEINFO ANSI-LOOP::LOOP-CONTEXT ++ SYSTEM::TOP-LEVEL SYSTEM::DBL SLOOP::LOOP-UN-POP ++ SYSTEM::SET-CURRENT ANSI-LOOP::LOOP-GET-PROGN ++ ANSI-LOOP::LOOP-DO-REPEAT SYSTEM::INIT-BREAK-POINTS ++ SLOOP::PARSE-LOOP-FOR SLOOP::LOOP-POP ++ ANSI-LOOP::LOOP-POP-SOURCE ANSI-LOOP::LOOP-DO-WITH ++ ANSI-LOOP::LOOP-DO-DO COMMON-LISP::LISP-IMPLEMENTATION-VERSION ++ ANSI-LOOP::LOOP-DO-RETURN SLOOP::PARSE-LOOP-DO ++ SLOOP::LOOP-PEEK ANSI-LOOP::LOOP-BIND-BLOCK ++ SYSTEM::DEFAULT-SYSTEM-BANNER SLOOP::PARSE-LOOP1 ++ SYSTEM::INSPECT-READ-LINE ANSI-LOOP::LOOP-DO-FINALLY ++ SYSTEM::TEST-ERROR COMMON-LISP::TYPE-ERROR ++ SYSTEM::DEFAULT-INFO-HOTLIST SYSTEM::SHOW-RESTARTS ++ SYSTEM::SET-ENV SLOOP::PARSE-LOOP-COLLECT ++ SYSTEM::ALL-TRACE-DECLARATIONS SYSTEM::GET-SIG-FN-NAME ++ SYSTEM::INSPECT-INDENT-1)) + (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::FUNCTION (COMMON-LISP::T) ++ (COMMON-LISP::OR COMMON-LISP::NULL ++ COMMON-LISP::HASH-TABLE)) ++ SYSTEM::CONTEXT-HASH)) + (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::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++ SYSTEM::LENEL SYSTEM::GET-NODE-INDEX SYSTEM::FASLINK ++ SYSTEM::THE-END ANSI-LOOP::DUPLICATABLE-CODE-P ++ SYSTEM::RELATIVE-LINE)) + (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::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ 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::T +- COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::*) +- SYSTEM::EXPAND-WILD-DIRECTORY)) ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) ++ SYSTEM::GCL-TOP-LEVEL SYSTEM::BREAK-CURRENT ++ SYSTEM::BREAK-RESUME SYSTEM::BREAK-HELP SYSTEM::BREAK-MESSAGE ++ ANSI-LOOP::LOOP-DO-FOR SYSTEM::SIMPLE-BACKTRACE)) + (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 SYSTEM::PARSE-DEFMACRO-LAMBDA-LIST)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ SYSTEM::PROCESS-SOME-ARGS COMMON-LISP::CONCATENATE ++ SYSTEM::TO-REGEXP COMMON-LISP::PATHNAME-DEVICE ++ SYSTEM::LIST-MATCHES ANSI-LOOP::LOOP-WARN ++ COMMON-LISP::REMOVE-DUPLICATES COMMON-LISP::PATHNAME-HOST ++ COMMON-LISP::BIT COMMON-LISP::SBIT ++ COMMON-LISP::ENOUGH-NAMESTRING SYSTEM::DIR-PARSE ++ SYSTEM::FILE-SEARCH SYSTEM::BREAK-LEVEL ANSI-LOOP::LOOP-ERROR ++ SYSTEM::MGLIST COMMON-LISP::PATHNAME-NAME ++ COMMON-LISP::MAKE-STRING-INPUT-STREAM SLOOP::ADD-FROM-DATA ++ COMMON-LISP::TRANSLATE-LOGICAL-PATHNAME COMMON-LISP::DIRECTORY ++ SYSTEM::FILE-TO-STRING COMMON-LISP::ARRAY-ROW-MAJOR-INDEX ++ SYSTEM::NTH-STACK-FRAME SLOOP::LOOP-ADD-TEMPS ++ COMMON-LISP::WARN ++ ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES ++ SYSTEM::LINK-EXPAND COMMON-LISP::PATHNAME-TYPE ++ COMMON-LISP::OPEN COMMON-LISP::BIT-NOT ++ COMMON-LISP::DELETE-DUPLICATES COMMON-LISP::ERROR ++ COMMON-LISP::FILE-POSITION COMMON-LISP::PATHNAME-VERSION ++ COMMON-LISP::ARRAY-IN-BOUNDS-P COMMON-LISP::REQUIRE ++ SYSTEM::MGSUB COMMON-LISP::MERGE-PATHNAMES COMMON-LISP::LOAD ++ COMMON-LISP::PATHNAME-DIRECTORY COMMON-LISP::SIGNAL ++ COMMON-LISP::WILD-PATHNAME-P COMMON-LISP::FIND-RESTART ++ SYSTEM::INFO-SEARCH SYSTEM::LOGICAL-PATHNAME-PARSE ++ SYSTEM::BAD-SEQ-LIMIT COMMON-LISP::READ-BYTE ++ COMMON-LISP::UPGRADED-ARRAY-ELEMENT-TYPE SYSTEM::NLOAD ++ COMMON-LISP::MAKE-ARRAY)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::*) +- SYSTEM::MME3)) ++ COMMON-LISP::RENAME-FILE ANSI-LOOP::ESTIMATE-CODE-SIZE-1 ++ SYSTEM::FIND-DOC SYSTEM::SOURCE-PORTION SYSTEM::NEWLINE ++ SYSTEM::DO-REPL SYSTEM::RESTART-REPORT ++ ANSI-LOOP::ESTIMATE-CODE-SIZE SYSTEM::NEW-SEMI-COLON-READER)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + ((COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807) +- COMMON-LISP::T) ++ 9223372036854775807)) + COMMON-LISP::T) +- SYSTEM::SMALLNTHCDR)) ++ SYSTEM::GET-CONTEXT SYSTEM::PUSH-CONTEXT)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) +- SYSTEM::GCL-TOP-LEVEL SYSTEM::BREAK-MESSAGE +- SYSTEM::BREAK-RESUME SYSTEM::SIMPLE-BACKTRACE +- SYSTEM::BREAK-HELP ANSI-LOOP::LOOP-DO-FOR +- SYSTEM::BREAK-CURRENT)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) +- SYSTEM::S-DATA-LENGTH SYSTEM::THE-START SYSTEM::INSTREAM-LINE +- SYSTEM::S-DATA-SIZE FPE::REG-LOOKUP)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ COMMON-LISP::PSETF COMMON-LISP::PROG* SYSTEM::BREAK-STEP-INTO ++ SLOOP::IN-PACKAGE-SLOOP-MAP SLOOP::SLOOP-FINISH ++ SYSTEM::CHECK-SEQ-START-END SLOOP::SLOOP ++ COMMON-LISP::MULTIPLE-VALUE-SETQ COMMON-LISP::ASSERT ++ SLOOP::MINIMIZE-SLOOP-COLLECT COMMON-LISP::ROTATEF ++ SYSTEM::LIST-TOGGLE-CASE SYSTEM::INCREMENT-CURSOR ++ ANSI-LOOP::LOOP-COLLECT-ANSWER COMMON-LISP::PROG2 ++ SLOOP::SLOOP-SWAP COMMON-LISP::DEFTYPE ++ SYSTEM::SETF-LOGICAL-PATHNAME-TRANSLATIONS SYSTEM::?PUSH ++ COMMON-LISP::DO-EXTERNAL-SYMBOLS ++ ANSI-LOOP::LOOP-COLLECT-RPLACD COMMON-LISP::TRACE ++ ANSI-LOOP::LOOP-DO-IF ANSI-LOOP::MAKE-LOOP-MINIMAX ++ SYSTEM::SUBSTRINGP COMMON-LISP::LOGORC2 ++ ANSI-LOOP::LOOP-DO-WHILE ANSI-LOOP::LOOP-LOOKUP-KEYWORD ++ SLOOP::DEF-LOOP-COLLECT SYSTEM::SETF-HELPER ++ COMMON-LISP::WITH-CONDITION-RESTARTS SYSTEM::INSPECT-PRINT ++ SLOOP::PARSE-LOOP-MAP SYSTEM::KEYWORD-SUPPLIED-P ++ COMMON-LISP::LOOP-FINISH ANSI-LOOP::LOOP-TASSOC ++ SYSTEM::GET-LINE-OF-FORM ANSI-LOOP::LOOP-STORE-TABLE-DATA ++ SLOOP::L-EQUAL COMMON-LISP::ETYPECASE ++ SLOOP::THEREIS-SLOOP-COLLECT COMMON-LISP::RETURN ++ SYSTEM::SUB-INTERVAL-P COMMON-LISP::ECASE ++ COMMON-LISP::WRITE-BYTE SYSTEM::LOOKUP-KEYWORD ++ COMMON-LISP::DEFSETF ANSI-LOOP::LOOP-DO-ALWAYS ++ SYSTEM::PARSE-SLOT-DESCRIPTION COMMON-LISP::VECTOR-PUSH ++ SYSTEM::GET-INFO-CHOICES SYSTEM::SETF-EXPAND ++ SYSTEM::LEFT-PARENTHESIS-READER SLOOP::DEF-LOOP-FOR ++ COMMON-LISP::PROG SYSTEM::OVERWRITE-SLOT-DESCRIPTIONS ++ SYSTEM::SUPER-GO COMMON-LISP::LDB SYSTEM::NODE ++ SYSTEM::COERCE-TO-PACKAGE COMMON-LISP::DO SYSTEM::TP-ERROR ++ SYSTEM::GET-NODES SLOOP::THE-TYPE ANSI-LOOP::LOOP-TMEMBER ++ ANSI-LOOP::LOOP-TEQUAL COMMON-LISP::DEFPARAMETER ++ COMMON-LISP::WITH-OPEN-STREAM SYSTEM::DEFINE-SETF-METHOD ++ SYSTEM::IF-ERROR ANSI-LOOP::HIDE-VARIABLE-REFERENCES ++ SLOOP::DESETQ1 COMMON-LISP::LOOP COMMON-LISP::CTYPECASE ++ COMMON-LISP::DEFSTRUCT COMMON-LISP::CASE SYSTEM::DOT-DIR-P ++ SYSTEM::INSPECT-RECURSIVELY COMMON-LISP::DOTIMES ++ SYSTEM::BREAK-STEP-NEXT SYSTEM::ALL-MATCHES ++ COMMON-LISP::LOCALLY SLOOP::IN-TABLE-SLOOP-MAP ++ SYSTEM::DISPLAY-ENV COMMON-LISP::MULTIPLE-VALUE-LIST ++ COMMON-LISP::LDB-TEST COMMON-LISP::DECLAIM ++ COMMON-LISP::WITH-STANDARD-IO-SYNTAX SYSTEM::SGEN ++ SLOOP::ALWAYS-SLOOP-COLLECT COMMON-LISP::PUSHNEW ++ COMMON-LISP::MULTIPLE-VALUE-BIND FPE::%-READER ++ COMMON-LISP::CCASE SLOOP::DEF-LOOP-MACRO ++ ANSI-LOOP::LOOP-REALLY-DESETQ SYSTEM::IN-INTERVAL-P ++ SYSTEM::DBL-UP SLOOP::DEF-LOOP-MAP ANSI-LOOP::LOOP-BODY ++ SYSTEM::SEQUENCE-CURSOR COMMON-LISP::COERCE ++ COMMON-LISP::PATHNAME-MATCH-P SYSTEM::OBJLT ++ COMMON-LISP::RESTART-CASE ++ COMMON-LISP::WITH-HASH-TABLE-ITERATOR COMMON-LISP::STEP ++ SYSTEM::QUOTATION-READER SYSTEM::PUT-AUX COMMON-LISP::TYPECASE ++ SYSTEM::*BREAK-POINTS* COMMON-LISP::LOGTEST ++ SYSTEM::CONDITION-PASS COMMON-LISP::DEFVAR ++ COMMON-LISP::WITH-OUTPUT-TO-STRING SYSTEM::SET-BACK ++ COMMON-LISP::NTHCDR COMMON-LISP::DO-ALL-SYMBOLS ++ SYSTEM::INFO-AUX COMMON-LISP::LOGANDC1 COMMON-LISP::PROG1 ++ FPE::READ-OPERANDS SYSTEM::DISPLAY-COMPILED-ENV ++ COMMON-LISP::DEFCONSTANT SYSTEM::DM-V SLOOP::LOOP-RETURN ++ SYSTEM::ADD-FILE SYSTEM::WHILE SYSTEM::WITHOUT-INTERRUPTS ++ COMMON-LISP::NTH-VALUE COMMON-LISP::OR ++ ANSI-LOOP::LOOP-COPYLIST* SLOOP::IN-CAREFULLY-SLOOP-FOR ++ ANSI-LOOP::LOOP-DECLARE-VARIABLE SYSTEM::GET-MATCH ++ ANSI-LOOP::WITH-LOOP-LIST-COLLECTION-HEAD ++ ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION SYSTEM::MV-SETQ ++ SLOOP::COLLATE-SLOOP-COLLECT COMMON-LISP::LOGORC1 ++ SYSTEM::DM-NTH-CDR COMPILER::COMPILER-DEF-HOOK ++ SYSTEM::CHECK-TYPE-EVAL COMMON-LISP::DECF ++ COMMON-LISP::WITH-PACKAGE-ITERATOR SYSTEM::COERCE-TO-STRING ++ COMMON-LISP::DEFINE-MODIFY-MACRO FPE::0-READER ++ COMMON-LISP::WITH-COMPILATION-UNIT COMMON-LISP::LOGNAND ++ COMMON-LISP::CHECK-TYPE COMMON-LISP::INCF ++ SLOOP::MAXIMIZE-SLOOP-COLLECT SYSTEM::ITERATE-OVER-BKPTS ++ SLOOP::LOGXOR-SLOOP-COLLECT SLOOP::NEVER-SLOOP-COLLECT ++ SYSTEM::MV-VALUES SYSTEM::MSUB COMMON-LISP::DO* ++ SLOOP::=-SLOOP-FOR COMMON-LISP::UNLESS ++ SYSTEM::MATCH-DIMENSIONS COMMON-LISP::DOLIST ++ ANSI-LOOP::LOOP-MAYBE-BIND-FORM SLOOP::LOCAL-FINISH ++ COMMON-LISP::PSETQ COMMON-LISP::COND ++ COMMON-LISP::WITH-SIMPLE-RESTART COMMON-LISP::DO-SYMBOLS ++ COMMON-LISP::FILE-STRING-LENGTH COMMON-LISP::LAMBDA ++ ANSI-LOOP::LOOP-ACCUMULATE-MINIMAX-VALUE ++ SLOOP::IN-FRINGE-SLOOP-MAP SYSTEM::SET-DIR ++ COMMON-LISP::WITH-INPUT-FROM-STRING SYSTEM::LIST-DELQ ++ COMMON-LISP::BYTE COMMON-LISP::DOCUMENTATION SYSTEM::SAFE-EVAL ++ COMMON-LISP::DEFMACRO SLOOP::DESETQ COMMON-LISP::POP ++ SLOOP::COUNT-SLOOP-COLLECT SLOOP::LCASE ++ COMMON-LISP::DEFPACKAGE COMMON-LISP::DEFUN COMMON-LISP::TIME ++ COMMON-LISP::LOGNOR COMMON-LISP::RESTART-BIND ++ COMMON-LISP::PUSH COMMON-LISP::SHIFTF COMMON-LISP::AND ++ COMMON-LISP::WHEN SYSTEM::DM-NTH COMMON-LISP::WITH-OPEN-FILE ++ SLOOP::MAKE-VALUE COMMON-LISP::UNTRACE FPE::PAREN-READER ++ ANSI-LOOP::WITH-MINIMAX-VALUE COMMON-LISP::NTH ++ FPE::READ-INSTRUCTION SLOOP::SUM-SLOOP-COLLECT ++ COMMON-LISP::REMF COMMON-LISP::DESTRUCTURING-BIND ++ SYSTEM::SET-PATH-STREAM-NAME FPE::RF COMMON-LISP::LOGANDC2)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) +- SYSTEM::MATCH-BEGINNING SYSTEM::MATCH-END)) +\ No newline at end of file ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ COMMON-LISP::FCEILING COMMON-LISP::APROPOS-LIST ++ COMMON-LISP::READ-FROM-STRING ++ COMMON-LISP::ENSURE-DIRECTORIES-EXIST SYSTEM::APROPOS-DOC ++ COMMON-LISP::FTRUNCATE SYSTEM::BREAK-FUNCTION ++ SYSTEM::GET-SETF-METHOD-MULTIPLE-VALUE SYSTEM::STEPPER ++ COMMON-LISP::DECODE-UNIVERSAL-TIME ++ ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE ++ COMMON-LISP::STORE-VALUE COMMON-LISP::GET-SETF-EXPANSION ++ SYSTEM::PRINT-DOC SYSTEM::INFO COMMON-LISP::APROPOS ++ COMMON-LISP::WRITE-TO-STRING COMMON-LISP::USE-VALUE ++ COMMON-LISP::FROUND COMMON-LISP::PARSE-NAMESTRING ++ COMMON-LISP::INVOKE-RESTART COMMON-LISP::FFLOOR ++ SYSTEM::SHOW-INFO)) +\ No newline at end of file +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -182,61 +182,61 @@ void + add_page_to_freelist(char *p, struct typemanager *tm) { + + short t,size; +- long i=tm->tm_nppage,fw; +- object x,f; ++ long fw; ++ object x,xe,f; + struct pageinfo *pp; + +- t=tm->tm_type; ++ t=tm->tm_type; + +- size=tm->tm_size; +- f=tm->tm_free; +- pp=pageinfo(p); +- bzero(pp,sizeof(*pp)); +- pp->type=t; +- pp->magic=PAGE_MAGIC; +- +- if (cell_list_head==NULL) +- cell_list_tail=cell_list_head=pp; +- else if (pp > cell_list_tail) { +- cell_list_tail->next=pp; +- cell_list_tail=pp; +- } +- +- x= (object)pagetochar(page(p)); +- /* set_type_of(x,t); */ +- make_free(x); ++ size=tm->tm_size; ++ pp=pageinfo(p); ++ bzero(pp,sizeof(*pp)); ++ pp->type=t; ++ pp->magic=PAGE_MAGIC; ++ ++ if (cell_list_head==NULL) ++ cell_list_tail=cell_list_head=pp; ++ else if (pp > cell_list_tail) { ++ cell_list_tail->next=pp; ++ cell_list_tail=pp; ++ } ++ ++ x= (object)pagetochar(page(p)); ++ /* set_type_of(x,t); */ ++ make_free(x); + + #ifdef SGC + +- if (sgc_enabled && tm->tm_sgc) +- pp->sgc_flags=SGC_PAGE_FLAG; ++ 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; ++ 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 +- are many arrays in a system to make the headers not writable, +- but just SGC_TOUCH the header each time you write to it. this +- is what is done with t_structure */ ++ /* array headers must be always writable, since a write to the ++ body does not touch the header. It may be desirable if there ++ are many arrays in a system to make the headers not writable, ++ but just SGC_TOUCH the header each time you write to it. this ++ is what is done with t_structure */ + if (t==(tm_of(t_array)->tm_type)) + pp->sgc_flags|=SGC_PERM_WRITABLE; +- ++ + #endif + +- fw= *(fixnum *)x; +- while (--i >= 0) { +- *(fixnum *)x=fw; +- SET_LINK(x,f); +- f=x; +- x= (object) ((char *)x + size); +- } +- +- tm->tm_free=f; +- tm->tm_nfree += tm->tm_nppage; +- tm->tm_npage++; ++ f=FREELIST_TAIL(tm); ++ fw=x->fw; ++ xe=(object)((void *)x+tm->tm_nppage*size); ++ for (;xfw=fw; ++ SET_LINK(f,x); ++ } ++ ++ SET_LINK(f,OBJNULL); ++ tm->tm_tail=f; ++ tm->tm_nfree+=tm->tm_nppage; ++ tm->tm_npage++; + + } + +@@ -1065,15 +1065,13 @@ make_cons(object a,object d) { + + } + +- +- +-object on_stack_cons(object x, object y) { ++object ++on_stack_cons(object x, object y) { + object p = (object) alloca_val; + load_cons(p,x,y); + return p; + } + +- + DEFUNM_NEW("ALLOCATED",object,fSallocated,SI,1,1,NONE,OO,OO,OO,OO,(object typ),"") + { struct typemanager *tm=(&tm_table[t_from_type(typ)]); + tm = & tm_table[tm->tm_type]; +--- gcl-2.6.12.orig/o/assignment.c ++++ gcl-2.6.12/o/assignment.c +@@ -388,14 +388,7 @@ EVAL: + + OTHERWISE: + vs_base = vs_top; +- vs_push(sLsetf); +- vs_push(place); +- vs_push(form); +- result=vs_top[-1]; +- vs_push(Cnil); +- stack_cons(); +- stack_cons(); +- stack_cons(); ++ vs_push(list(3,sLsetf,place,result=form)); + /***/ + #define VS_PUSH_ENV \ + if(lex_env[1]){ \ +@@ -428,9 +421,7 @@ FFN(Fpush)(object form) + return; + } + vs_base = vs_top; +- vs_push(sLpush); +- vs_push(form); +- stack_cons(); ++ vs_push(make_cons(sLpush,form)); + /***/ + VS_PUSH_ENV ; + /***/ +@@ -457,9 +448,7 @@ FFN(Fpop)(object form) + return; + } + vs_base = vs_top; +- vs_push(sLpop); +- vs_push(form); +- stack_cons(); ++ vs_push(make_cons(sLpop,form)); + /***/ + VS_PUSH_ENV ; + /***/ +@@ -495,9 +484,7 @@ FFN(Fincf)(object form) + return; + } + vs_base = vs_top; +- vs_push(sLincf); +- vs_push(form); +- stack_cons(); ++ vs_push(make_cons(sLincf,form)); + /***/ + VS_PUSH_ENV ; + /***/ +@@ -533,9 +520,7 @@ FFN(Fdecf)(object form) + return; + } + vs_base = vs_top; +- vs_push(sLdecf); +- vs_push(form); +- stack_cons(); ++ vs_push(make_cons(sLdecf,form)); + /***/ + VS_PUSH_ENV ; + /***/ +--- gcl-2.6.12.orig/o/backq.c ++++ gcl-2.6.12/o/backq.c +@@ -22,7 +22,7 @@ Foundation, 675 Mass Ave, Cambridge, MA + #include "include.h" + + #define attach(x) (vs_head = make_cons(x, vs_head)) +-#define make_list (vs_push(Cnil), stack_cons(), stack_cons()) ++#define make_list (vs_popp,vs_head=list(2,vs_head,*vs_top)) + + + #define QUOTE 1 +--- gcl-2.6.12.orig/o/bind.c ++++ gcl-2.6.12/o/bind.c +@@ -433,10 +433,11 @@ SEARCH_DECLARE: + optional[i].opt_svar_spp); + } + if (rest_flag) { +- vs_push(Cnil); +- for (i = narg, j = nreq+nopt; --i >= j; ) +- vs_head = make_cons(base[i], vs_head); +- bind_var(rest->rest_var, vs_head, rest->rest_spp); ++ object *l=vs_top++; ++ for (i=nreq+nopt;irest_var, vs_head, rest->rest_spp); + } + if (key_flag) { + int allow_other_keys_found=0; +@@ -824,12 +825,11 @@ parse_key(object *base, bool rest, bool + } + } + if (rest) { +- top = vs_top; +- vs_push(Cnil); +- base++; +- while (base < vs_top) +- stack_cons(); +- vs_top = top; ++ object *a,*l; ++ for (l=a=base;as.s_sfdef != NOT_SPECIAL && sym->s.s_mflag) + sym->s.s_sfdef = NOT_SPECIAL; +- cf = alloc_object(t_cfun); +- cf->cf.cf_self = self; +- cf->cf.cf_name = sym; +- cf->cf.cf_data = data; ++ sfn = alloc_object(t_sfun); ++ sfn->sfn.sfn_self = (void *)self;/*FIXME*/ ++ sfn->sfn.sfn_name = sym; ++ sfn->sfn.sfn_data = data; ++ sfn->sfn.sfn_argd=2; + data->cfd.cfd_start=start; + data->cfd.cfd_size=size; +- sym = clear_compiler_properties(sym,cf); +- sym->s.s_gfdef = cf; ++ sym = clear_compiler_properties(sym,sfn); ++ sym->s.s_gfdef = sfn; + sym->s.s_mflag = TRUE; + return sym; + } +--- gcl-2.6.12.orig/o/eval.c ++++ gcl-2.6.12/o/eval.c +@@ -60,38 +60,41 @@ object sSAbreak_stepA; + /* for t_sfun,t_gfun with args on vs stack */ + + static void +-quick_call_sfun(object fun) +-{ DEBUG_AVMA ++quick_call_sfun(object fun) { ++ ++ DEBUG_AVMA + int i=fun->sfn.sfn_argd,n=SFUN_NARGS(i); + enum ftype restype; +- object *x,res,*base; +- object *temp_ar=alloca(n*sizeof(object)); +-/* i=fun->sfn.sfn_argd; */ +-/* n=SFUN_NARGS(i); */ +- base = vs_base; +- if (n != vs_top - base) +- {check_arg_failed(n);} ++ object *x,*base; ++ ++ if (n!=vs_top-vs_base) ++ check_arg_failed(n); ++ + restype = SFUN_RETURN_TYPE(i); + SFUN_START_ARG_TYPES(i); +- /* for moment just support object and int */ + #define COERCE_ARG(a,type) (type==f_object ? a : (object)(fix(a))) +- if (i==0) +- x=vs_base; +- else +- {int j; +- x=temp_ar; +- for (j=0; jcf.cf_self)();return;} +- if (type_of(fun)==t_sfun){call_sfun_no_check(fun); return;} +- if (type_of(fun)==t_gfun) +- {quick_call_sfun(fun); return;} +- if (type_of(fun)==t_vfun) +- {call_vfun(fun); return;} +- if (type_of(fun) == t_symbol) { +- if (fun->s.s_sfdef != NOT_SPECIAL || fun->s.s_mflag) +- FEinvalid_function(fun); +- if (fun->s.s_gfdef == OBJNULL) +- FEundefined_function(fun); +- fun = fun->s.s_gfdef; +- if (type_of(fun)==t_cfun){(*fun->cf.cf_self)(); +- return;} +- } +- funcall_no_event(fun); ++ ++ switch(type_of(fun)) { ++ case t_cfun: ++ (*fun->cf.cf_self)(); ++ return; ++ case t_sfun: ++ call_sfun_no_check(fun); return; ++ case t_gfun: ++ quick_call_sfun(fun); return; ++ case t_vfun: ++ call_vfun(fun); return; ++ case t_symbol: ++ if (fun->s.s_sfdef != NOT_SPECIAL || fun->s.s_mflag) ++ FEinvalid_function(fun); ++ if (fun->s.s_gfdef == OBJNULL) ++ FEundefined_function(fun); ++ super_funcall_no_event(fun->s.s_gfdef); ++ return; ++ default: ++ funcall_no_event(fun); ++ } ++ + } + + #ifdef USE_BROKEN_IEVAL +@@ -814,13 +823,7 @@ EVAL: + bds_bind(siVevalhook, Cnil); + vs_base = vs_top; + vs_push(form); +- vs_push(lex_env[0]); +- vs_push(lex_env[1]); +- vs_push(lex_env[2]); +- vs_push(Cnil); +- stack_cons(); +- stack_cons(); +- stack_cons(); ++ vs_push(list(3,lex_env[0],lex_env[1],lex_env[2])); + super_funcall(hookfun); + bds_unwind(old_bds_top); + return; +@@ -970,22 +973,12 @@ static void + call_applyhook(object fun) + { + object ah; +- object *v; + + ah = symbol_value(siVapplyhook); +- v = vs_base + 1; +- vs_push(Cnil); +- while (vs_top > v) +- stack_cons(); ++ Llist(); + vs_push(vs_base[0]); + vs_base[0] = fun; +- vs_push(lex_env[0]); +- vs_push(lex_env[1]); +- vs_push(lex_env[2]); +- vs_push(Cnil); +- stack_cons(); +- stack_cons(); +- stack_cons(); ++ vs_push(list(3,lex_env[0],lex_env[1],lex_env[2])); + super_funcall(ah); + } + +--- gcl-2.6.12.orig/o/fasdump.c ++++ gcl-2.6.12/o/fasdump.c +@@ -1130,8 +1130,7 @@ read_fasd1(int i, object *loc) + *loc=Cnil;return; + case DP(d_cons:) + read_fasd1(GET_OP(),&tem); +- *loc=make_cons(tem,Cnil); +- loc= &((*loc)->c.c_cdr); ++ collect(loc,make_cons(tem,Cnil)); + i=GET_OP(); + goto BEGIN; + case DP(d_list1:) i=1;goto READ_LIST; +@@ -1162,8 +1161,7 @@ read_fasd1(int i, object *loc) + read_fasd1(j,&tem); + DPRINTF("{Item=",(debug >= 2 ? pp(tem) : 0)); + DPRINTF("}",0); +- *loc=make_cons(tem,Cnil); +- loc= &((*loc)->c.c_cdr);}} ++ collect(loc,make_cons(tem,Cnil));}} + + case DP(d_delimiter:) + case DP(d_dot:) +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -1429,52 +1429,54 @@ LFD(Lmake_synonym_stream)() + vs_base[0] = x; + } + +-LFD(Lmake_broadcast_stream)() +-{ +- object x; +- int narg, i; +- +- narg = vs_top - vs_base; +- for (i = 0; i < narg; i++) +- if (type_of(vs_base[i]) != t_stream || +- !output_stream_p(vs_base[i])) +- cannot_write(vs_base[i]); +- vs_push(Cnil); +- for (i = narg; i > 0; --i) +- stack_cons(); +- x = alloc_object(t_stream); +- x->sm.sm_mode = (short)smm_broadcast; +- x->sm.sm_fp = NULL; +- x->sm.sm_buffer = 0; +- x->sm.sm_object0 = vs_base[0]; +- x->sm.sm_object1 = OBJNULL; +- x->sm.sm_int = 0; +- x->sm.sm_flags=0; +- vs_base[0] = x; ++LFD(Lmake_broadcast_stream)() { ++ ++ object x; ++ int narg, i; ++ ++ narg = vs_top - vs_base; ++ for (i = 0; i < narg; i++) ++ if (type_of(vs_base[i]) != t_stream || ++ !output_stream_p(vs_base[i])) ++ cannot_write(vs_base[i]); ++ ++ Llist(); ++ ++ x = alloc_object(t_stream); ++ x->sm.sm_mode = (short)smm_broadcast; ++ x->sm.sm_fp = NULL; ++ x->sm.sm_buffer = 0; ++ x->sm.sm_object0 = vs_base[0]; ++ x->sm.sm_object1 = OBJNULL; ++ x->sm.sm_int = 0; ++ x->sm.sm_flags=0; ++ vs_base[0] = x; ++ + } + +-LFD(Lmake_concatenated_stream)() +-{ +- object x; +- int narg, i; +- +- narg = vs_top - vs_base; +- for (i = 0; i < narg; i++) +- if (type_of(vs_base[i]) != t_stream || +- !input_stream_p(vs_base[i])) +- cannot_read(vs_base[i]); +- vs_push(Cnil); +- for (i = narg; i > 0; --i) +- stack_cons(); +- x = alloc_object(t_stream); +- x->sm.sm_mode = (short)smm_concatenated; +- x->sm.sm_fp = NULL; +- x->sm.sm_buffer = 0; +- x->sm.sm_object0 = vs_base[0]; +- x->sm.sm_object1 = OBJNULL; +- x->sm.sm_int = 0; +- x->sm.sm_flags=0; +- vs_base[0] = x; ++LFD(Lmake_concatenated_stream)() { ++ ++ object x; ++ int narg, i; ++ ++ narg = vs_top - vs_base; ++ for (i = 0; i < narg; i++) ++ if (type_of(vs_base[i]) != t_stream || ++ !input_stream_p(vs_base[i])) ++ cannot_read(vs_base[i]); ++ ++ Llist(); ++ ++ x = alloc_object(t_stream); ++ x->sm.sm_mode = (short)smm_concatenated; ++ x->sm.sm_fp = NULL; ++ x->sm.sm_buffer = 0; ++ x->sm.sm_object0 = vs_base[0]; ++ x->sm.sm_object1 = OBJNULL; ++ x->sm.sm_int = 0; ++ x->sm.sm_flags=0; ++ vs_base[0] = x; ++ + } + + LFD(Lmake_two_way_stream)() +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -543,7 +543,9 @@ mark_object1(object x) { + mark_object_address(&x->ht.ht_self[i].hte_key,i); + mark_object_address(&x->ht.ht_self[i].hte_value,i+1); + } ++ i=x->ht.ht_cache-x->ht.ht_self; + MARK_LEAF_DATA(x,x->ht.ht_self,x->ht.ht_size*sizeof(*x->ht.ht_self)); ++ if (x->ht.ht_cache) x->ht.ht_cache=x->ht.ht_self+i; + break; + + case t_array: +@@ -662,6 +664,7 @@ mark_object1(object x) { + break; + + case t_readtable: ++ mark_object(x->rt.rt_case); + if (x->rt.rt_self) { + for (i=0;irt.rt_self[i].rte_macro,i); +@@ -968,7 +971,7 @@ sweep_phase(void) { + tm = tm_of((enum type)v->type); + + p = pagetochar(page(v)); +- f = tm->tm_free; ++ f = FREELIST_TAIL(tm); + k = 0; + for (j = tm->tm_nppage; j > 0; --j, p += tm->tm_size) { + x = (object)p; +@@ -979,12 +982,13 @@ sweep_phase(void) { + continue; + } + +- SET_LINK(x,f); ++ SET_LINK(f,x); + make_free(x); + f = x; + k++; + } +- tm->tm_free = f; ++ SET_LINK(f,OBJNULL); ++ tm->tm_tail = f; + tm->tm_nfree += k; + pagetoinfo(page(v))->in_use-=k; + +--- gcl-2.6.12.orig/o/hash.d ++++ gcl-2.6.12/o/hash.d +@@ -196,33 +196,28 @@ DEFUN_NEW("HASH-EQUAL",object,fShash_equ + + + struct htent * +-gethash(object key, object hashtable) { ++gethash(object key, object ht) { + +- enum httest htest; +- long hsize,j,s,q; +- struct htent *e,*first_objnull=NULL; +- object hkey; ++ long s,q; ++ struct htent *e,*ee,*first_open=NULL; + static struct htent dummy={OBJNULL,OBJNULL}; + +- if (!hashtable->ht.ht_size) +- return &dummy; +- +- htest = (enum httest)hashtable->ht.ht_test; +- hsize = hashtable->ht.ht_size; ++ if (ht->ht.ht_cache && ht->ht.ht_cache->hte_key==key) ++ return ht->ht.ht_cache; ++ ht->ht.ht_cache=NULL; + + #define eq(x,y) x==y + #define hash_loop(t_,i_) \ +- for (s=i_%hsize,q=hsize,e=first_objnull;s>=0;q=s,s=s?0:-1) \ +- for (j=s;jht.ht_self[j]; \ +- hkey = e->hte_key; \ ++ for (q=ht->ht.ht_size,s=i_%q;s>=0;q=s,s=s?0:-1) \ ++ for (e=ht->ht.ht_self,ee=e+q,e+=s;ehte_key; \ + if (hkey==OBJNULL) { \ +- if (e->hte_value==OBJNULL) return first_objnull ? first_objnull : e; \ +- if (!first_objnull) first_objnull=e; \ +- } else if (t_(key,hkey)) return e; \ ++ if (e->hte_value==OBJNULL) return first_open ? first_open : e; \ ++ if (!first_open) first_open=e; \ ++ } else if (t_(key,hkey)) return ht->ht.ht_cache=e; \ + } + +- switch (htest) { ++ switch (ht->ht.ht_test) { + case htt_eq: + hash_loop(eq,hash_eq(key)); + break; +@@ -237,7 +232,7 @@ gethash(object key, object hashtable) { + return &dummy; + } + +- return first_objnull ? first_objnull : (FEerror("No free spot in hashtable ~S.", 1, hashtable),&dummy); ++ return first_open ? first_open : (FEerror("No free spot in hashtable ~S.", 1, ht),&dummy); + + } + +@@ -290,7 +285,7 @@ object hashtable; + old = alloc_object(t_hashtable); + old->ht = hashtable->ht; + vs_push(old); +- hashtable->ht.ht_self = NULL; ++ hashtable->ht.ht_cache=hashtable->ht.ht_self = NULL; + hashtable->ht.ht_size = new_size; + if (type_of(hashtable->ht.ht_rhthresh) == t_fixnum) + hashtable->ht.ht_rhthresh = +@@ -365,6 +360,7 @@ DEFVAR("*DEFAULT-HASH-TABLE-REHASH-THRES + h->ht.ht_size = fix(size); + h->ht.ht_rhsize = rehash_size; + h->ht.ht_rhthresh = rehash_threshold; ++ h->ht.ht_cache=NULL; + h->ht.ht_nent = 0; + h->ht.ht_static = static!=Cnil ? 1 : 0; + h->ht.ht_self = NULL; +--- gcl-2.6.12.orig/o/list.d ++++ gcl-2.6.12/o/list.d +@@ -277,93 +277,78 @@ object on_stack_list_vector_new(int n,ob + return ans; + }*/ + +-object list_vector_new(int n,object first,va_list ap) +-{object ans,*p; ++object ++list_vector_new(int n,object first,va_list ap) { ++ ++ object ans,*p; + +- if (n == 0) return Cnil; +- ans = make_cons(first==OBJNULL ? va_arg(ap,object) : first,Cnil); +- p = & (ans->c.c_cdr); +- while (--n > 0) +- { *p = make_cons(va_arg(ap,object),Cnil); +- p = & ((*p)->c.c_cdr); +- } +- return ans;} ++ for (p=&ans;n-->0;first=OBJNULL) ++ collect(p,make_cons(first==OBJNULL ? va_arg(ap,object) : first,Cnil)); ++ *p=Cnil; ++ return ans; + ++} + +-/* clean this up */ +-/* static object on_stack_list(int n, ...) +-{va_list ap; +- object res; +- va_start(ap,n); +- res=on_stack_list_vector(n,ap); +- va_end(ap); +- return res; +-}*/ + #ifdef WIDE_CONS + #define maybe_set_type_of(a,b) set_type_of(a,b) + #else + #define maybe_set_type_of(a,b) + #endif + ++void ++free_check(void) { + ++ int n=tm_table[t_cons].tm_nfree,m; ++ object f=tm_table[t_cons].tm_free; ++ for (m=0;f!=OBJNULL;m++,f=OBJ_LINK(f)); ++ massert(n==m); ++} ++ + #define multi_cons(n_,next_,last_) \ +- ({static struct typemanager *_tm=tm_table+t_cons; \ +- object _lis=OBJNULL; \ +- \ +- if (n<=_tm->tm_nfree) { \ +- \ +- object _tail=_tm->tm_free; \ +- \ +- _lis=_tail; \ +- \ ++ ({_tm->tm_nfree -= n_; \ ++ for(_x=_tm->tm_free,_p=&_x;n_-->0;_p=&(*_p)->c.c_cdr) { \ ++ object _z=*_p; \ ++ pageinfo(_z)->in_use++; \ ++ maybe_set_type_of(_z,t_cons); \ ++ _z->c.c_cdr=OBJ_LINK(_z); \ ++ _z->c.c_car=next_; \ ++ } \ ++ _tm->tm_free=*_p; \ ++ *_p=SAFE_CDR(last_); \ ++ _x;}) ++ ++#define n_cons(n_,next_,last_) \ ++ ({fixnum _n=n_;object _x=Cnil,*_p; \ ++ static struct typemanager *_tm=tm_table+t_cons; \ ++ if (_n>=0) {/*FIXME vs_toptm_nfree -= n_; \ +- while (--n_) { \ +- pageinfo(_tail)->in_use++; \ +- maybe_set_type_of(_tail,t_cons); \ +- _tail->c.c_cdr=OBJ_LINK(_tail); \ +- _tail->c.c_car=next_; \ +- _tail=_tail->c.c_cdr; \ ++ if (_n<=_tm->tm_nfree) \ ++ _x=multi_cons(_n,next_,last_); \ ++ else { \ ++ for (_p=&_x;_n--;) \ ++ collect(_p,make_cons(next_,Cnil)); \ ++ *_p=SAFE_CDR(last_); \ + } \ +- _tm->tm_free=OBJ_LINK(_tail); \ +- pageinfo(_tail)->in_use++; \ +- maybe_set_type_of(_tail,t_cons); \ +- _tail->c.c_car=next_; \ +- _tail->c.c_cdr=SAFE_CDR(last_); \ +- \ + END_NO_INTERRUPT; \ + } \ +- _lis;}) +- +- +- +-object listqA(int a,int n,va_list ap) { +- +- object x,*p; +- +- if (n<=0) return Cnil; ++ _x;}) ++ ++object ++n_cons_from_x(fixnum n,object x) { + +- if ((x=multi_cons(n,va_arg(ap,object),a ? va_arg(ap,object) : Cnil))!=OBJNULL) +- return x; ++ return n_cons(n,({object _z=x->c.c_car;x=x->c.c_cdr;_z;}),Cnil); ++ ++} + +- CHECK_INTERRUPT; + +- p = vs_top; +- +- vs_push(Cnil); +- while(--n>=0) { +- *p=make_cons(va_arg(ap,object),Cnil); +- p= &((*p)->c.c_cdr); +- } +- if (a) +- *p=SAFE_CDR(va_arg(ap,object)); ++object ++listqA(int a,int n,va_list ap) { + +- return(vs_pop); ++ return n_cons(n,va_arg(ap,object),a ? va_arg(ap,object) : Cnil); + + } + +-object list(int n,...) { ++object list(fixnum n,...) { + + va_list ap; + object lis; +@@ -375,7 +360,7 @@ object list(int n,...) { + + } + +-object listA(int n,...) { ++object listA(fixnum n,...) { + + va_list ap; + object lis; +@@ -417,163 +402,63 @@ BEGIN: + object + append(object x, object y) { + +- object z; +- fixnum n; +- +- if (endp(x)) +- return(y); +- +- for (z=x,n=0;!endp(z);z=z->c.c_cdr,n++); +- if ((z=multi_cons(n,({object _t=x->c.c_car;x=x->c.c_cdr;_t;}),y))!=OBJNULL) +- return z; ++ return n_cons(length(x),({object _t=x->c.c_car;x=x->c.c_cdr;_t;}),y); + +- z = make_cons(Cnil, Cnil); +- vs_push(z); +- for (;;) { +- z->c.c_car = x->c.c_car; +- x = x->c.c_cdr; +- if (endp(x)) +- break; +- z->c.c_cdr = make_cons(Cnil, Cnil); +- z = z->c.c_cdr; +- } +- z->c.c_cdr = SAFE_CDR(y); +- return(vs_pop); + } + +- +- +-/* object */ +-/* append(x, y) */ +-/* object x, y; */ +-/* { */ +-/* object z; */ +- +-/* if (endp(x)) */ +-/* return(y); */ +-/* z = make_cons(Cnil, Cnil); */ +-/* vs_push(z); */ +-/* for (;;) { */ +-/* z->c.c_car = x->c.c_car; */ +-/* x = x->c.c_cdr; */ +-/* if (endp(x)) */ +-/* break; */ +-/* z->c.c_cdr = make_cons(Cnil, Cnil); */ +-/* z = z->c.c_cdr; */ +-/* } */ +-/* z->c.c_cdr = SAFE_CDR(y); */ +-/* return(vs_pop); */ +-/* } */ +- + /* + Copy_list(x) copies list x. + */ + object +-copy_list(x) +-object x; +-{ +- object y; +- +- if (type_of(x) != t_cons) +- return(x); +- y = make_cons(x->c.c_car, Cnil); +- vs_push(y); +- for (x = x->c.c_cdr; type_of(x) == t_cons; x = x->c.c_cdr) { +- y->c.c_cdr = make_cons(x->c.c_car, Cnil); +- y = y->c.c_cdr; +- } +- y->c.c_cdr = SAFE_CDR(x); +- return(vs_pop); ++copy_list(object x) { ++ object h,y; ++ ++ if (type_of(x) != t_cons) ++ return(x); ++ h=y=make_cons(x->c.c_car, Cnil); ++ for (x = x->c.c_cdr; type_of(x) == t_cons; x = x->c.c_cdr) { ++ y->c.c_cdr = make_cons(x->c.c_car, Cnil); ++ y=y->c.c_cdr; ++ } ++ y->c.c_cdr=SAFE_CDR(x); ++ return(h); + } + + /* + Copy_alist(x) copies alist x. + */ + static object +-copy_alist(x) +-object x; +-{ +- object y; ++copy_alist(object x) { + +- if (endp(x)) +- return(Cnil); +- y = make_cons(Cnil, Cnil); +- vs_push(y); +- for (;;) { +- y->c.c_car = make_cons(car(x->c.c_car), cdr(x->c.c_car)); +- x = x->c.c_cdr; +- if (endp(x)) +- break; +- y->c.c_cdr = make_cons(Cnil, Cnil); +- y = y->c.c_cdr; +- } +- return(vs_pop); ++ object h,y; ++ ++ if (endp(x)) ++ return(Cnil); ++ h=y=make_cons(Cnil, Cnil); ++ for (;;) { ++ y->c.c_car=make_cons(car(x->c.c_car), cdr(x->c.c_car)); ++ x=x->c.c_cdr; ++ if (endp(x)) ++ break; ++ y->c.c_cdr=make_cons(Cnil, Cnil); ++ y=y->c.c_cdr; ++ } ++ return(h); + } + +-/* +- Copy_tree(x) copies tree x +- and pushes the result onto vs. +-*/ +-static void +-copy_tree(x) +-object x; +-{ +- cs_check(x); +- +- if (type_of(x) == t_cons) { +- copy_tree(x->c.c_car); +- copy_tree(x->c.c_cdr); +- stack_cons(); +- } else +- vs_check_push(x); +-} +- +-/* /\* */ +-/* Subst(new, tree) pushes */ +-/* the result of substituting new in tree */ +-/* onto vs. */ +-/* *\/ */ +-/* static void */ +-/* subst(new, tree) */ +-/* object new, tree; */ +-/* { */ +-/* cs_check(new); */ +- +-/* if (TEST(tree)) */ +-/* vs_check_push(new); */ +-/* else if (type_of(tree) == t_cons) { */ +-/* subst(new, tree->c.c_car); */ +-/* subst(new, tree->c.c_cdr); */ +-/* stack_cons(); */ +-/* } else */ +-/* vs_check_push(tree); */ +-/* } */ +- +-/* static object */ +-/* subst1(object new, object tree) { */ +- +-/* if (TEST(tree)) */ +-/* return new; */ +-/* else if (type_of(tree) == t_cons) { */ +-/* object oa=tree->c.c_car,a=subst1(new,oa),od=tree->c.c_cdr,d=subst1(new,od); */ +-/* return a==oa && d==od ? tree : make_cons(a,d); */ +-/* } else */ +-/* return tree; */ +- +-/* } */ +- +-/* static object */ +-/* subst1qi(object new, object tree) { */ +- +-/* if (item_compared == tree) */ +-/* return new; */ +-/* else if (type_of(tree) == t_cons) { */ +-/* object oa=tree->c.c_car,a=subst1qi(new,oa),od=tree->c.c_cdr,d=subst1qi(new,od); */ +-/* return a==oa && d==od ? tree : make_cons(a,d); */ +-/* } else */ +-/* return tree; */ ++static object ++copy_tree(object x) { + +-/* } */ ++ object y; ++ ++ if (type_of(x) == t_cons) { ++ y=make_cons(Cnil,Cnil); ++ y->c.c_car=copy_tree(x->c.c_car); ++ y->c.c_cdr=copy_tree(x->c.c_cdr); ++ x=y; ++ } ++ return x; ++} + + /* + Nsubst(new, treep) stores +@@ -599,27 +484,22 @@ object new, *treep; + result of substituting tree by alist + onto vs. + */ +-static void +-sublis(alist, tree) +-object alist, tree; +-{ +- object x; +- cs_check(alist); +- ++static object ++sublis(object alist, object tree) { + +- for (x = alist; !endp(x); x = x->c.c_cdr) { +- item_compared = car(x->c.c_car); +- if (TEST(tree)) { +- vs_check_push(cdr(x->c.c_car)); +- return; +- } +- } +- if (type_of(tree) == t_cons) { +- sublis(alist, tree->c.c_car); +- sublis(alist, tree->c.c_cdr); +- stack_cons(); +- } else +- vs_check_push(tree); ++ object x; ++ cs_check(alist); ++ ++ for (x=alist;!endp(x);x=x->c.c_cdr) { ++ item_compared=car(x->c.c_car); ++ if (TEST(tree)) ++ return x->c.c_car->c.c_cdr; ++ } ++ if (type_of(tree) == t_cons) { ++ object a=sublis(alist,tree->c.c_car),d=sublis(alist,tree->c.c_cdr); ++ return (a==tree->c.c_car && d==tree->c.c_cdr) ? tree : make_cons(a,d); ++ } else ++ return tree; + } + + /* +@@ -777,7 +657,7 @@ DEFUN_NEW("TENTH",object,fLtenth,LISP,1, + LFD(Lcons)() { + + check_arg(2); +- stack_cons(); ++ vs_base[0]=make_cons(vs_base[0],vs_pop); + + } + +@@ -907,36 +787,28 @@ LFD(Llast)() { + + } + +-LFD(Llist)() +-{ +- vs_push(Cnil); +- while (vs_top > vs_base + 1) +- stack_cons(); +-} ++LFD(Llist)() { ++ ++ object *a; ++ ++ a=vs_base; ++ vs_base[0]=n_cons(vs_top-vs_base,*a++,Cnil); ++ vs_top=vs_base+1; + +-LFD(LlistA)() +-{ +- if (vs_top == vs_base) +- too_few_arguments(); +- while (vs_top > vs_base + 1) +- stack_cons(); + } +-/* static object copy_off_stack_tree(x) */ +-/* object x; */ +-/* {object *p; */ +-/* p = &x; */ +-/* TOP: */ +-/* if (type_of(*p) ==t_cons) */ +-/* { if(!inheap(*p)) */ +-/* *p=make_cons(copy_off_stack_tree((*p)->c.c_car),(*p)->c.c_cdr); */ +-/* else */ +-/* (*p)->c.c_car = copy_off_stack_tree((*p)->c.c_car); */ +-/* p = &((*p)->c.c_cdr); */ +-/* goto TOP;} */ +-/* return x; */ +-/* } */ + +- ++LFD(LlistA)() { ++ ++ object *a; ++ ++ if (vs_top == vs_base) ++ too_few_arguments(); ++ ++ a=vs_base; ++ vs_base[0]=n_cons(vs_top-vs_base-1,*a++,vs_head); ++ vs_top=vs_base+1; ++ ++} + + object on_stack_make_list(n) + int n; +@@ -957,23 +829,20 @@ int n; + goto TOP; + } + +-object make_list(n) +-int n; +-{object x =Cnil ; +- while (n-- > 0) +- x = make_cons(Cnil, x); +- return x;} ++object ++make_list(int n) { ++ ++ return n_cons(n,Cnil,Cnil); ++ ++} + + @(defun make_list (size &key initial_element &aux x) +- int i; + @ +- check_type_non_negative_integer(&size); +- if (type_of(size) != t_fixnum) +- FEerror("Cannot make a list of the size ~D.", 1, size); +- i = fix(size); +- while (i-- > 0) +- x = make_cons(initial_element, x); +- @(return x) ++ check_type_non_negative_integer(&size); ++ if (type_of(size) != t_fixnum) ++ FEerror("Cannot make a list of the size ~D.", 1, size); ++ x=n_cons(fix(size),initial_element,Cnil); ++ @(return x) + @) + + LFD(Lappend)() +@@ -1006,22 +875,19 @@ LFD(Lcopy_alist)() + LFD(Lcopy_tree)() + { + check_arg(1); +- copy_tree(vs_base[0]); +- vs_base[0] = vs_pop; ++ vs_base[0]=copy_tree(vs_base[0]); + } + + LFD(Lrevappend)() { +- object x, y; + +- check_arg(2); +- y = vs_pop; +- for (x = vs_base[0]; !endp(x); x = x->c.c_cdr) { +- vs_push(x->c.c_car); +- vs_push(y); +- stack_cons(); +- y = vs_pop; +- } +- vs_base[0] = y; ++ object x, y; ++ ++ check_arg(2); ++ y=vs_pop; ++ for (x=vs_base[0];!endp(x);x=x->c.c_cdr) ++ y=make_cons(x->c.c_car,y); ++ vs_base[0] = y; ++ + } + + object +@@ -1078,26 +944,19 @@ LFD(Lreconc)() { + } + + @(defun butlast (lis &optional (nn `make_fixnum(1)`)) +- int i; ++ int i; ++ object *p,x,y,z; + @ +- check_type_non_negative_integer(&nn); +- if (!listp(lis))/*FIXME checktype*/ +- FEwrong_type_argument(sLlist, lis); +- if (type_of(nn) != t_fixnum) +- @(return Cnil) +- for (i = 0; consp(lis); i++, lis = lis->c.c_cdr) +- vs_check_push(lis->c.c_car); +- if (i <= fix((nn))) { +- vs_top -= i; +- @(return Cnil) +- } +- vs_top -= fix((nn)); +- i -= fix((nn)); +- vs_push(Cnil); +- while (i-- > 0) +- stack_cons(); +- lis = vs_pop; +- @(return lis) ++ check_type_non_negative_integer(&nn); ++ if (!listp(lis))/*FIXME checktype*/ ++ FEwrong_type_argument(sLlist, lis); ++ if (type_of(nn) != t_fixnum) ++ @(return Cnil) ++ for (x=y=lis,i=0;ic.c_cdr); ++ for (p=&z;consp(y);x=x->c.c_cdr,y=y->c.c_cdr) ++ collect(p,make_cons(x->c.c_car,Cnil)); ++ *p=i ? Cnil : x; ++ @(return `z`) + @) + + @(defun nbutlast (lis &optional (nn `make_fixnum(1)`)) +@@ -1119,21 +978,20 @@ LFD(Lreconc)() { + @) + + LFD(Lldiff)() { +- fixnum i; +- object x; + +- check_arg(2); +- x = vs_base[0]; +- if (!listp(x))/*FIXME checktype*/ +- FEwrong_type_argument(sLlist, x); +- for (i = 0; consp(x) && x!=vs_base[1] ; i++, x = x->c.c_cdr) +- vs_check_push(x->c.c_car); /*FIXME but a segfault breaker at vs_limit*/ +- x=eql(x,vs_base[1]) ? Cnil : x; +- vs_check_push(x); +- while (i-- > 0) +- stack_cons(); +- vs_base[0] = vs_pop; +- vs_popp; ++ fixnum i; ++ object x,y,*p,z; ++ ++ check_arg(2); ++ x=vs_base[0]; ++ z=vs_pop; ++ if (!listp(x))/*FIXME checktype*/ ++ FEwrong_type_argument(sLlist, x); ++ for (p=&y,i=0;consp(x) && x!=z;i++,x=x->c.c_cdr) ++ collect(p,make_cons(x->c.c_car,Cnil)); ++ *p=eql(x,z) ? Cnil : x; ++ vs_base[0]=y; ++ + } + + LFD(Lrplaca)() +@@ -1187,18 +1045,15 @@ LFD(Lrplacd)() + PREDICATE(Lnsubst,Lnsubst_if,Lnsubst_if_not, 3) + + object +-sublis1(alist,tree,tst) +- object alist,tree; +- bool (*tst)(); +-{object v; +- for (v=alist ; v!=Cnil; v=v->c.c_cdr) +- { if ((*tst)(v->c.c_car->c.c_car ,tree)) +- return(v->c.c_car->c.c_cdr);} +- if (type_of(tree)==t_cons) +- {object ntree=make_cons(sublis1(alist,tree->c.c_car,tst), +- tree->c.c_cdr); +- ntree->c.c_cdr=sublis1(alist,ntree->c.c_cdr,tst); +- return ntree; ++sublis1(object alist,object tree,bool (*tst)()) { ++ ++ object v; ++ for (v=alist;v!=Cnil;v=v->c.c_cdr) { ++ if ((*tst)(v->c.c_car->c.c_car,tree)) ++ return(v->c.c_car->c.c_cdr);} ++ if (type_of(tree)==t_cons){ ++ object a=sublis1(alist,tree->c.c_car,tst),d=sublis1(alist,tree->c.c_cdr,tst); ++ return a==tree->c.c_car && d==tree->c.c_cdr ? tree : make_cons(a,d); + } + return tree; + } +@@ -1226,8 +1081,7 @@ check_alist(alist) + @ + protectTEST; + setupTEST(Cnil, test, test_not, key); +- sublis(alist, tree); +- tree = vs_pop; ++ tree=sublis(alist,tree); + restoreTEST; + @(return tree) + @) +@@ -1321,27 +1175,25 @@ LFD(Lacons)() + } + + @(defun pairlis (keys data &optional a_list) +- object *vp, k, d; ++ object k,d,y,z,*p; + @ +- vp = vs_top + 1; +- k = keys; +- d = data; +- while (!endp(k)) { +- if (endp(d)) +- FEerror( +- "The keys ~S and the data ~S are not of the same length", +- 2, keys, data); +- vs_check_push(make_cons(k->c.c_car, d->c.c_car)); +- k = k->c.c_cdr; +- d = d->c.c_cdr; +- } +- if (!endp(d)) +- FEerror("The keys ~S and the data ~S are not of the same length", +- 2, keys, data); +- vs_push(a_list); +- while (vs_top > vp) +- stack_cons(); +- @(return `vp[-1]`) ++ k=keys; ++ d=data; ++ p=&y; ++ while (!endp(k)) { ++ if (endp(d)) ++ FEerror("The keys ~S and the data ~S are not of the same length",2,keys,data); ++ z=make_cons(Cnil,Cnil); ++ z->c.c_car=make_cons(k->c.c_car,d->c.c_car); ++ collect(p,z); ++ k = k->c.c_cdr; ++ d = d->c.c_cdr; ++ } ++ if (!endp(d)) ++ FEerror("The keys ~S and the data ~S are not of the same length",2,keys,data); ++ *p=a_list; ++ vs_top=vs_base+1; ++ @(return `y`) + @) + + @(static defun assoc_or_rassoc (item a_list &key test test_not key) +--- gcl-2.6.12.orig/o/makefile ++++ gcl-2.6.12/o/makefile +@@ -91,8 +91,8 @@ $(DECL): $(HDIR)/make-decl.h $(INI_FILES + grab_defs: grab_defs.c + ${CC} $(OFLAGS) -o grab_defs grab_defs.c + +-wpool: wpool.c +- $(CC) $(CFLAGS) $(DEFS) -o $@ $< ++wpool: wpool.o ++ $(CC) $(LDFLAGS) -o $@ $< + + $(GCLIB): ${ALIB} + rm -f gcllib.a +--- gcl-2.6.12.orig/o/makefun.c ++++ gcl-2.6.12/o/makefun.c +@@ -6,12 +6,20 @@ + MakeAfun(addr,F_ARGD(min,max,flags,ARGTYPES(a,b,c,d)),0); + MakeAfun(addr,F_ARGD(2,3,NONE,ARGTYPES(OO,OO,OO,OO)),0); + */ ++ ++static int mv; ++ + object MakeAfun(object (*addr)(object,object), unsigned int argd, object data) +-{int type = (F_ARG_FLAGS_P(argd,F_requires_fun_passed) ? t_closure : t_afun); ++{ ++ ufixnum at=F_TYPES(argd)>>F_TYPE_WIDTH; ++ ufixnum ma=F_MIN_ARGS(argd); ++ ufixnum xa=F_MAX_ARGS(argd); ++ ufixnum rt=F_RESULT_TYPE(argd); ++ int type = (F_ARG_FLAGS_P(argd,F_requires_fun_passed) ? t_closure : (!at&&!rt&&ma==xa&&!mv ? t_sfun : t_afun)); + object x = alloc_object(type); + x->sfn.sfn_name = Cnil; + x->sfn.sfn_self = addr; +- x->sfn.sfn_argd = argd; ++ x->sfn.sfn_argd = type==t_sfun ? ma : argd; + if (type == t_closure) + { x->cl.cl_env = 0; + x->cl.cl_envdim=0;} +@@ -107,7 +115,7 @@ DEFUN_NEW("SET-KEY-STRUCT",object,fSset_ + } + + +-#define collect(top_,next_,val_) ({object _x=MMcons(val_,Cnil);\ ++#define mcollect(top_,next_,val_) ({object _x=MMcons(val_,Cnil);\ + if (top_==Cnil) top_=next_=_x; \ + else next_=next_->c.c_cdr=_x;}) + +@@ -125,23 +133,23 @@ put_fn_procls(object sym,fixnum argd,fix + for (i=0;i>=F_TYPE_WIDTH) + switch(maxargs!=minargs ? F_object : atypes & MASK_RANGE(0,F_TYPE_WIDTH)) { + case F_object: +- collect(ta,na,def); ++ mcollect(ta,na,def); + break; + case F_int: +- collect(ta,na,sLfixnum); ++ mcollect(ta,na,sLfixnum); + break; + case F_shortfloat: +- collect(ta,na,sLshort_float); ++ mcollect(ta,na,sLshort_float); + break; + case F_double_ptr: +- collect(ta,na,sLlong_float); ++ mcollect(ta,na,sLlong_float); + break; + default: + FEerror("Bad sfn declaration",0); + break; + } + if (maxargs!=minargs) +- collect(ta,na,sLA); ++ mcollect(ta,na,sLA); + putprop(sym,ta,sSproclaimed_arg_types); + ta=na=Cnil; + if (oneval) +@@ -188,15 +196,19 @@ LISP_makefun(char *strg, void *fn, unsig + void + SI_makefunm(char *strg, void *fn, unsigned int argd) + { object sym = make_si_ordinary(strg); +- fSfset(sym, fSmakefun(sym,fn,argd)); +- put_fn_procls(sym,argd,0,Ct,Ct); ++ mv=1; ++ fSfset(sym, fSmakefun(sym,fn,argd)); ++ mv=0; ++ put_fn_procls(sym,argd,0,Ct,Ct); + } + + void + LISP_makefunm(char *strg, void *fn, unsigned int argd) + { object sym = make_ordinary(strg); +- fSfset(sym, fSmakefun(sym,fn,argd)); +- put_fn_procls(sym,argd,0,Ct,Ct); ++ mv=1; ++ fSfset(sym, fSmakefun(sym,fn,argd)); ++ mv=0; ++ put_fn_procls(sym,argd,0,Ct,Ct); + } + + +--- gcl-2.6.12.orig/o/package.d ++++ gcl-2.6.12/o/package.d +@@ -849,17 +849,19 @@ FFN(Lpackage_shadowing_symbols)() + vs_base[0] = vs_base[0]->p.p_shadowings; + } + +-LFD(Llist_all_packages)() +-{ +- struct package *p; +- int i; ++LFD(Llist_all_packages)() { ++ ++ struct package *p; ++ object x,*l; ++ int i; ++ ++ check_arg(0); ++ ++ for (l=&x,p=pack_pointer,i=0;p!=NULL;p=p->p_link,i++) ++ collect(l,make_cons((object)p,Cnil)); ++ *l=Cnil; ++ vs_push(x); + +- check_arg(0); +- for (p = pack_pointer, i = 0; p != NULL; p = p->p_link, i++) +- vs_push((object)p); +- vs_push(Cnil); +- while (i-- > 0) +- stack_cons(); + } + + @(defun intern (strng &optional (p `current_package()`) &aux sym) +--- gcl-2.6.12.orig/o/predicate.c ++++ gcl-2.6.12/o/predicate.c +@@ -425,7 +425,7 @@ eql1(register object x,register object y + + /*x and y are not == and not Cnil and not immfix*/ + +- if (valid_cdr(x)||valid_cdr(y)||x->d.t!=y->d.t) return FALSE; ++ /* if (valid_cdr(x)||valid_cdr(y)||x->d.t!=y->d.t) return FALSE; */ + + switch (x->d.t) { + +--- gcl-2.6.12.orig/o/print.d ++++ gcl-2.6.12/o/print.d +@@ -41,6 +41,8 @@ int line_length = 72; + isLower((c)&0377) || (c) == ':') + + ++#define READ_TABLE_CASE (Vreadtable->s.s_dbind->rt.rt_case) ++ + #define mod(x) ((x)%Q_SIZE) + + +@@ -619,13 +621,113 @@ object coerce_big_to_string(object,int); + static bool + potential_number_p(object,int); + ++#define CASE_OF(x_) ({int _x=(x_);isUpper(_x) ? 1 : (isLower(_x) ? -1 : 0);}) ++ ++static int ++constant_case(object x) { ++ ++ fixnum i,j,jj; ++ ++ for (i=j=0;is.s_fillp;i++,j=j ? j : jj) ++ if (j*(jj=CASE_OF(x->s.s_self[i]))==-1) ++ return 0; ++ ++ return j; ++ ++} ++ ++static int ++all_dots(object x) { ++ ++ fixnum i; ++ ++ for (i=0;is.s_fillp;i++) ++ if (x->s.s_self[i]!='.') ++ return 0; ++ ++ return 1; ++ ++} ++ ++static int ++needs_escape (object x,int pp) { ++ ++ fixnum i; ++ char ch; ++ ++ if (!PRINTescape) ++ return 0; ++ ++ for (i=0;is.s_fillp;i++) ++ switch((ch=x->s.s_self[i])) { ++ case '(': ++ case ')': ++ case ':': ++ case '`': ++ case '\'': ++ case '"': ++ case ';': ++ case ',': ++ case '\n': ++ return 1; ++ case ' ': ++ if (!i) return 1; ++ default: ++ if ((READ_TABLE_CASE==sKupcase && isLower(ch)) || ++ (READ_TABLE_CASE==sKdowncase && isUpper(ch))) ++ return 1; ++ } ++ ++ if (pp) ++ if (potential_number_p(x, PRINTbase) || all_dots(x)) ++ return 1; ++ ++ return !x->s.s_fillp; ++ ++} ++ ++#define convertible_upper(c) ((READ_TABLE_CASE==sKupcase ||READ_TABLE_CASE==sKinvert)&& isUpper(c)) ++#define convertible_lower(c) ((READ_TABLE_CASE==sKdowncase||READ_TABLE_CASE==sKinvert)&& isLower(c)) ++ ++static void ++print_symbol_name_body(object x,int pp) { ++ ++ int i,j,fc,tc,lw,k,cc; ++ ++ cc=constant_case(x); ++ k=needs_escape(x,pp); ++ ++ if (k) ++ write_ch('|'); ++ ++ for (lw=i=0;is.s_fillp;i++) { ++ j = x->s.s_self[i]; ++ if (PRINTescape && (j == '|' || j == '\\')) ++ write_ch('\\'); ++ fc=convertible_upper(j) ? 1 : ++ (convertible_lower(j) ? -1 : 0); ++ tc=(READ_TABLE_CASE==sKinvert ? -cc : ++ (PRINTcase == sKupcase ? 1 : ++ (PRINTcase == sKdowncase ? -1 : ++ (PRINTcase == sKcapitalize ? (i==lw ? 1 : -1) : 0)))); ++ if (ispunct(j)||isspace(j)) lw=i+1; ++ j+=(tc*fc && !k ? (tc-fc)>>1 : 0)*('A'-'a'); ++ write_ch(j); ++ ++ } ++ ++ if (k) ++ write_ch('|'); ++ ++} ++ + void + write_object(x, level) + object x; + int level; + { + object r, y; +- int i, j, k,lw; ++ int i, j, k; + object *vp; + + cs_check(x); +@@ -797,117 +899,49 @@ int level; + break; + + case t_symbol: +- if (!PRINTescape) { +- for (lw = 0,i = 0; i < x->s.s_fillp; i++) { +- j = x->s.s_self[i]; +- if (isUpper(j)) { +- if (PRINTcase == sKdowncase || +- (PRINTcase == sKcapitalize && i!=lw)) +- j += 'a' - 'A'; +- } else if (!isLower(j)) +- lw = i + 1; +- write_ch(j); ++ { + +- } +- break; +- } +- if (x->s.s_hpack == Cnil) { +- if (PRINTcircle) { +- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) +- if (x == *vp) { +- if (vp[1] != Cnil) { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2); +- write_ch('#'); +- return; +- } else { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2); +- write_ch('='); +- vp[1] = Ct; +- } +- } ++ if (PRINTescape) { ++ if (x->s.s_hpack == Cnil) { ++ if (PRINTcircle) { ++ for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) ++ if (x == *vp) { ++ if (vp[1] != Cnil) { ++ write_ch('#'); ++ write_decimal((vp-PRINTvs_top)/2+1); ++ write_ch('#'); ++ return; ++ } else { ++ write_ch('#'); ++ write_decimal((vp-PRINTvs_top)/2+1); ++ write_ch('='); ++ vp[1] = Ct; ++ } + } +- if (PRINTgensym) +- write_str("#:"); +- } else if (x->s.s_hpack == keyword_package) +- write_ch(':'); +- else if (PRINTpackage||find_symbol(x,current_package())!=x +- || intern_flag == 0) +- { +- k = 0; +- for (i = 0; +- i < x->s.s_hpack->p.p_name->st.st_fillp; +- i++) { +- j = x->s.s_hpack->p.p_name +- ->st.st_self[i]; +- if (to_be_escaped(j)) +- k++; +- } +- if (k > 0) +- write_ch('|'); +- for (lw = 0, i = 0; +- i < x->s.s_hpack->p.p_name->st.st_fillp; +- i++) { +- j = x->s.s_hpack->p.p_name +- ->st.st_self[i]; +- if (j == '|' || j == '\\') +- write_ch('\\'); +- if (k == 0) { +- if (isUpper(j)) { +- if (PRINTcase == sKdowncase || +- (PRINTcase == sKcapitalize && i!=lw)) +- j += 'a' - 'A'; +- } else if (!isLower(j)) +- lw = i + 1; +- } +- write_ch(j); +- } +- if (k > 0) +- write_ch('|'); +- if (find_symbol(x, x->s.s_hpack) != x) +- error("can't print symbol"); +- if (PRINTpackage || intern_flag == INTERNAL) +- write_str("::"); +- else if (intern_flag == EXTERNAL) +- write_ch(':'); +- else +- FEerror("Pathological symbol --- cannot print.", 0); + } +- k = 0; +- if (potential_number_p(x, PRINTbase)) +- k++; +- for (i = 0; i < x->s.s_fillp; i++) { +- j = x->s.s_self[i]; +- if (to_be_escaped(j)) +- k++; +- } +- for (i = 0; i < x->s.s_fillp; i++) +- if (x->s.s_self[i] != '.') +- goto NOT_DOT; +- k++; +- +- NOT_DOT: +- if (k > 0) +- write_ch('|'); +- for (lw = 0, i = 0; i < x->s.s_fillp; i++) { +- j = x->s.s_self[i]; +- if (j == '|' || j == '\\') +- write_ch('\\'); +- if (k == 0) { +- if (isUpper(j)) { +- if (PRINTcase == sKdowncase || +- (PRINTcase == sKcapitalize && i != lw)) +- j += 'a' - 'A'; +- } else if (!isLower(j)) +- lw = i + 1; +- } +- write_ch(j); +- } +- if (k > 0) +- write_ch('|'); +- break; ++ if (PRINTgensym) ++ write_str("#:"); ++ } else if (x->s.s_hpack == keyword_package) { ++ write_ch(':'); ++ } else if (PRINTpackage||find_symbol(x,current_package())!=x || !intern_flag) { ++ ++ print_symbol_name_body(x->s.s_hpack->p.p_name,0); ++ ++ if (find_symbol(x, x->s.s_hpack) != x) ++ error("can't print symbol"); ++ if (PRINTpackage || intern_flag == INTERNAL) ++ write_str("::"); ++ else if (intern_flag == EXTERNAL) ++ write_ch(':'); ++ else ++ FEerror("Pathological symbol --- cannot print.", 0); ++ ++ } + ++ } ++ print_symbol_name_body(x,1); ++ break; ++ } + case t_array: + { + int subscripts[ARANKLIM]; +--- gcl-2.6.12.orig/o/read.d ++++ gcl-2.6.12/o/read.d +@@ -695,10 +695,29 @@ BEGIN: + goto K; + else + break; +- } +- else if ('a' <= char_code(c) && char_code(c) <= 'z') +- c = code_char(char_code(c) - ('a' - 'A')); +- else if (char_code(c) == ':') { ++ } else { ++ ++ switch(char_code(c)) { ++ case '\b': ++ case '\t': ++ case '\n': ++ case '\r': ++ case '\f': ++ case ' ': ++ case '\177': ++ READER_ERROR(in,"Cannot read character"); ++ default: ++ break; ++ } ++ ++ if ('a' <= char_code(c) && char_code(c) <= 'z') { ++ if ('a' <= char_code(c) && char_code(c) <= 'z' && ++ (READtable->rt.rt_case==sKupcase || READtable->rt.rt_case==sKinvert)) ++ c = code_char(char_code(c) - ('a' - 'A')); ++ else if ('A' <= char_code(c) && char_code(c) <= 'Z' && ++ (READtable->rt.rt_case==sKdowncase || READtable->rt.rt_case==sKinvert)) ++ c = code_char(char_code(c) + ('a' - 'A')); ++ } else if (char_code(c) == ':') { + if (colon_type == 0) { + colon_type = 1; + colon = length; +@@ -707,6 +726,7 @@ BEGIN: + else + colon_type = -1; + /* Colon has appeared twice. */ ++ } + } + } + if (preserving_whitespace_flag || cat(c) != cat_whitespace) +@@ -807,46 +827,49 @@ SYMBOL: + } + + static void +-Lleft_parenthesis_reader() +-{ +- object in, x; +- object *p; ++Lleft_parenthesis_reader() { + +- check_arg(2); +- in = vs_base[0]; +- vs_head = Cnil; +- p = &vs_head; +- for (;;) { +- delimiting_char = code_char(')'); +- in_list_flag = TRUE; +- x = read_object(in); +- if (x == OBJNULL) +- goto ENDUP; +- if (dot_flag) { +- if (p == &vs_head) +- FEerror("A dot appeared after a left parenthesis.", 0); +- delimiting_char = code_char(')'); +- in_list_flag = TRUE; +- *p = SAFE_CDR(read_object(in)); +- if (dot_flag) +- FEerror("Two dots appeared consecutively.", 0); +- if (*p==OBJNULL) +- FEerror("Object missing after dot.", 0); +- delimiting_char = code_char(')'); +- in_list_flag = TRUE; +- if (read_object(in)!=OBJNULL) +- FEerror("Two objects after dot.",0); +- goto ENDUP; +- } +- vs_push(x); +- *p = make_cons(x, Cnil); +- vs_popp; +- p = &((*p)->c.c_cdr); +- } ++ object in, x; ++ object *p; ++ ++ check_arg(2); ++ in = vs_base[0]; ++ vs_top=vs_base+1; ++ p = &vs_head; ++ ++ for (;;) { ++ ++ delimiting_char = code_char(')'); ++ in_list_flag = TRUE; ++ ++ if ((x=read_object(in))==OBJNULL) { ++ *p=Cnil; ++ break; ++ } ++ ++ if (dot_flag) { ++ ++ if (p==&vs_head) READER_ERROR(in,"A dot appeared after a left parenthesis."); ++ ++ delimiting_char = code_char(')'); ++ in_list_flag = TRUE; ++ *p=SAFE_CDR(read_object(in)); ++ ++ if (dot_flag) READER_ERROR(in,"Two dots appeared consecutively."); ++ if (*p==OBJNULL) READER_ERROR(in,"Object missing after dot."); ++ ++ delimiting_char = code_char(')'); ++ in_list_flag = TRUE; ++ if (read_object(in)!=OBJNULL) READER_ERROR(in,"Two objects after dot."); ++ ++ break; ++ ++ } ++ ++ collect(p,make_cons(x,Cnil)); ++ ++ } + +-ENDUP: +- vs_base[0] = vs_pop; +- return; + } + + +@@ -959,13 +982,8 @@ static void + Lsingle_quote_reader() + { + check_arg(2); +- vs_popp; +- vs_push(sLquote); +- vs_push(read_object(vs_base[0])); +- vs_push(Cnil); +- stack_cons(); +- stack_cons(); +- vs_base[0] = vs_pop; ++ vs_base[0] = list(2,sLquote,read_object(vs_base[0])); ++ vs_top=vs_base+1; + } + + static void +@@ -1111,14 +1129,8 @@ Lsharp_single_quote_reader() + check_arg(3); + if(vs_base[2] != Cnil && !READsuppress) + extra_argument('#'); +- vs_popp; +- vs_popp; +- vs_push(sLfunction); +- vs_push(read_object(vs_base[0])); +- vs_push(Cnil); +- stack_cons(); +- stack_cons(); +- vs_base[0] = vs_pop; ++ vs_base[0] = list(2,sLfunction,read_object(vs_base[0])); ++ vs_top=vs_base+1; + } + + #define QUOTE 1 +@@ -1163,20 +1175,7 @@ Lsharp_left_parenthesis_reader() + } + goto L; + } +- vs_push(siScomma); +- vs_push(sLapply); +- vs_push(sLquote); +- vs_push(sLvector); +- vs_push(Cnil); +- stack_cons(); +- stack_cons(); +- vs_push(vs_base[2]); +- vs_push(Cnil); +- stack_cons(); +- stack_cons(); +- stack_cons(); +- stack_cons(); +- vs_base = vs_top - 1; ++ vs_base[0]=list(4,siScomma,sLapply,list(2,sLquote,sLvector),vs_base[2]); + return; + } + vsp = vs_top; +@@ -1633,6 +1632,7 @@ object from, to; + rtab[i].rte_dtab[j] + = from->rt.rt_self[i].rte_dtab[j]; + } ++ to->rt.rt_case=from->rt.rt_case; + vs_reset; + END_NO_INTERRUPT;} + return(to); +@@ -1758,8 +1758,7 @@ READ: + x = read_object_recursive(strm); + if (x == OBJNULL) + break; +- *p = make_cons(x, Cnil); +- p = &((*p)->c.c_cdr); ++ collect(p,make_cons(x,Cnil)); + } + if (recursivep == Cnil) { + if (sSAsharp_eq_contextA->s.s_dbind!=Cnil) +@@ -2181,6 +2180,18 @@ LFD(Lreadtablep)() + @(return Ct) + @) + ++DEFUN_NEW("READTABLE-CASE",object,fLreadtable_case,LISP,1,1,NONE,OO,OO,OO,OO,(object rt),"") { ++ check_type_readtable_no_default(&rt); ++ RETURN1(rt->rt.rt_case); ++} ++ ++DEFUN_NEW("SET-READTABLE-CASE",object,fSset_readtable_case,SI,2,2,NONE,OO,OO,OO,OO,(object rt,object cas),"") { ++ check_type_readtable_no_default(&rt); ++ if (cas!=sKupcase && cas!=sKdowncase && cas!=sKpreserve && cas!=sKinvert) ++ TYPE_ERROR(cas,list(5,sLmember,sKupcase,sKdowncase,sKpreserve,sKinvert)); ++ RETURN1(rt->rt.rt_case=cas); ++} ++ + @(static defun get_dispatch_macro_character (dspchr subchr + &optional (rdtbl `current_readtable()`)) + @ +@@ -2348,6 +2359,13 @@ gcl_init_read() + + gcl_init_backq(); + ++ sKupcase = make_keyword("UPCASE"); ++ sKdowncase = make_keyword("DOWNCASE"); ++ sKpreserve = make_keyword("PRESERVE"); ++ sKinvert = make_keyword("INVERT"); ++ ++ standard_readtable->rt.rt_case=sKupcase; ++ + Vreadtable + = make_special("*READTABLE*", + copy_readtable(standard_readtable, Cnil)); +--- gcl-2.6.12.orig/o/reference.c ++++ gcl-2.6.12/o/reference.c +@@ -73,18 +73,14 @@ LFD(Lsymbol_function)(void) + if (type_of(sym) != t_symbol) + not_a_symbol(sym); + if (sym->s.s_sfdef != NOT_SPECIAL) { +- vs_push(make_fixnum((long)(sym->s.s_sfdef))); +- vs_base[0] = sLspecial; +- stack_cons(); +- return; ++ vs_base[0]=make_cons(sLspecial,make_fixnum((long)(sym->s.s_sfdef))); ++ return; + } + if (sym->s.s_gfdef==OBJNULL) + FEundefined_function(sym); + if (sym->s.s_mflag) { +- vs_push(sym->s.s_gfdef); +- vs_base[0] = sSmacro; +- stack_cons(); +- return; ++ vs_base[0]=make_cons(sSmacro,sym->s.s_gfdef); ++ return; + } + vs_base[0] = sym->s.s_gfdef; + } +--- gcl-2.6.12.orig/o/sequence.d ++++ gcl-2.6.12/o/sequence.d +@@ -205,16 +205,7 @@ E: + } + if (e < 0) + @(return `copy_list(sequence)`) +- for (i = 0; i < e; i++) { +- if (type_of(sequence) != t_cons) +- goto ILLEGAL_START_END; +- vs_check_push(sequence->c.c_car); +- sequence = sequence->c.c_cdr; +- } +- vs_push(Cnil); +- while (e-- > 0) +- stack_cons(); +- x = vs_pop; ++ x=n_cons_from_x(e,sequence); + @(return x) + + case t_vector: +--- gcl-2.6.12.orig/o/sgbc.c ++++ gcl-2.6.12/o/sgbc.c +@@ -165,7 +165,7 @@ sgc_sweep_phase(void) { + tm = tm_of((enum type)v->type); + + p = pagetochar(page(v)); +- f = tm->tm_free; ++ f = FREELIST_TAIL(tm); + k = 0; + size=tm->tm_size; + +@@ -189,7 +189,7 @@ sgc_sweep_phase(void) { + + /* it is ok to free x */ + +- SET_LINK(x,f); ++ SET_LINK(f,x); + make_free(x); + #ifndef SGC_WHOLE_PAGE + if (TYPEWORD_TYPE_P(v->type)) x->d.s = SGC_RECENT; +@@ -198,7 +198,8 @@ sgc_sweep_phase(void) { + k++; + + } +- tm->tm_free = f; ++ SET_LINK(f,OBJNULL); ++ tm->tm_tail = f; + tm->tm_nfree += k; + v->in_use-=k; + +@@ -674,34 +675,38 @@ sgc_start(void) { + contain the others */ + for (i= t_start; i < t_contiguous ; i++) + if (TM_BASE_TYPE_P(i) && (np=(tm=tm_of(i))->tm_sgc)) { +- object f=tm->tm_free ,x,y,next; ++ object f=tm->tm_free,xf,yf; ++ struct freelist x,y;/*the f_link heads have to be separated on the stack*/ + fixnum count=0; +- x=y=OBJNULL; + ++ xf=PHANTOM_FREELIST(x.f_link); ++ yf=PHANTOM_FREELIST(y.f_link); + while (f!=OBJNULL) { +- next=OBJ_LINK(f); + #ifdef SDEBUG + if (!is_free(f)) + printf("Not FREE in freelist f=%d",f); + #endif + if (pageinfo(f)->sgc_flags&SGC_PAGE_FLAG) { +- SET_LINK(f,x); ++ SET_LINK(xf,f); + #ifndef SGC_WHOLE_PAGE + if (TYPEWORD_TYPE_P(pageinfo(f)->type)) f->d.s = SGC_RECENT; + #endif +- x=f; ++ xf=f; + count++; + } else { +- SET_LINK(f,y); ++ SET_LINK(yf,f); + #ifndef SGC_WHOLE_PAGE + if (TYPEWORD_TYPE_P(pageinfo(f)->type)) f->d.s = SGC_NORMAL; + #endif +- y=f; ++ yf=f; + } +- f=next; ++ f=OBJ_LINK(f); + } +- tm->tm_free = x; +- tm->tm_alt_free = y; ++ SET_LINK(xf,OBJNULL); ++ tm->tm_free = OBJ_LINK(&x); ++ tm->tm_tail = xf; ++ SET_LINK(yf,OBJNULL); ++ tm->tm_alt_free = OBJ_LINK(&y); + tm->tm_alt_nfree = tm->tm_nfree - count; + tm->tm_nfree=count; + } +@@ -853,38 +858,21 @@ sgc_quit(void) { + for (i= t_start; i < t_contiguous ; i++) + + if (TM_BASE_TYPE_P(i) && (np=(tm=tm_of(i))->tm_sgc)) { +- +- object f,y; +- +- f=tm->tm_free; +- if (f==OBJNULL) +- tm->tm_free=tm->tm_alt_free; +- else { +- /* tack the alt_free onto the end of free */ +-#ifdef SDEBUG +- fixnum count=0; +- f=tm->tm_free; +- while(y= (object) F_LINK(f)) { +- if(y->d.s != SGC_RECENT) +- printf("[bad %d]",y); +- count++; f=y; ++ ++ object n=tm->tm_free,o=tm->tm_alt_free,f=PHANTOM_FREELIST(tm->tm_free); ++ ++ for (;n!=OBJNULL && o!=OBJNULL;) ++ if (o!=OBJNULL && (n==OBJNULL || otm_alt_free) +- while(y= F_LINK(f)) { +- if(y->d.s != SGC_NORMAL) +- printf("[alt_bad %d]",y); +- count++; f=y; +- } +- +-#endif +- f=tm->tm_free; +- while((y= (object) F_LINK(f))!=OBJNULL) +- f=y; +- F_LINK(f)= (long)(tm->tm_alt_free); +- } +- /* tm->tm_free has all of the free objects */ ++ SET_LINK(f,OBJNULL); ++ tm->tm_tail=f; + tm->tm_nfree += tm->tm_alt_nfree; + tm->tm_alt_nfree = 0; + tm->tm_alt_free = OBJNULL; +--- gcl-2.6.12.orig/o/structure.c ++++ gcl-2.6.12/o/structure.c +@@ -182,22 +182,19 @@ object + structure_to_list(object x) + { + +- object *p, s; +- struct s_data *def=S_DATA(x->str.str_def); +- int i, n; +- +- s = def->slot_descriptions; +- vs_push(def->name); +- vs_push(Cnil); +- p = &vs_head; +- for (i=0, n=def->length; !endp(s)&&ic.c_cdr, i++) { +- *p = make_cons(car(s->c.c_car), Cnil); +- p = &((*p)->c.c_cdr); +- *p = make_cons(structure_ref(x,x->str.str_def,i), Cnil); +- p = &((*p)->c.c_cdr); +- } +- stack_cons(); +- return(vs_pop); ++ object *p,s,v; ++ struct s_data *def=S_DATA(x->str.str_def); ++ int i,n; ++ ++ s=def->slot_descriptions; ++ for (p=&v,i=0,n=def->length;!endp(s)&&ic.c_cdr,i++) { ++ collect(p,make_cons(car(s->c.c_car),Cnil)); ++ collect(p,make_cons(structure_ref(x,x->str.str_def,i),Cnil)); ++ } ++ *p=Cnil; ++ ++ return make_cons(def->name,v); ++ + } + + LFD(siLmake_structure)(void) +--- gcl-2.6.12.orig/o/unixfsys.c ++++ gcl-2.6.12/o/unixfsys.c +@@ -169,9 +169,8 @@ DEF_ORDINARY("DIRECTORY",sKdirectory,KEY + DEF_ORDINARY("LINK",sKlink,KEYWORD,""); + DEF_ORDINARY("FILE",sKfile,KEYWORD,""); + +-DEFUNM_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +- +- struct stat ss; ++static int ++stat_internal(object x,struct stat *ssp) { + + if (type_of(x)==t_string) { + +@@ -180,19 +179,43 @@ DEFUNM_NEW("STAT",object,fSstat,SI,1,1,N + #ifdef __MINGW32__ + {char *p=FN1+strlen(FN1)-1;for (;p>FN1 && *p=='/';p--) *p=0;} + #endif +- if (lstat(FN1,&ss)) +- RETURN1(Cnil); ++ if (lstat(FN1,ssp)) ++ return 0; + } else if ((x=file_stream(x))!=Cnil&&x->sm.sm_fp) { +- if (fstat(fileno(x->sm.sm_fp),&ss)) +- RETURN1(Cnil); ++ if (fstat(fileno(x->sm.sm_fp),ssp)) ++ return 0; + } else +- RETURN1(Cnil); ++ return 0; ++ return 1; ++} ++ ++static object ++stat_mode_key(struct stat *ssp) { + +- RETURN4(S_ISDIR(ss.st_mode) ? sKdirectory : +- (S_ISLNK(ss.st_mode) ? sKlink : sKfile), +- make_fixnum(ss.st_size), +- make_fixnum(ss.st_mtime), +- make_fixnum(ss.st_uid)); ++ return S_ISDIR(ssp->st_mode) ? sKdirectory : (S_ISLNK(ssp->st_mode) ? sKlink : sKfile); ++ ++} ++ ++DEFUN_NEW("STAT1",object,fSstat1,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ ++ struct stat ss; ++ ++ RETURN1(stat_internal(x,&ss) ? stat_mode_key(&ss) : Cnil); ++ ++} ++ ++ ++DEFUNM_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ ++ struct stat ss; ++ ++ if (stat_internal(x,&ss)) ++ RETURN4(stat_mode_key(&ss), ++ make_fixnum(ss.st_size), ++ make_fixnum(ss.st_mtime), ++ make_fixnum(ss.st_uid)); ++ else ++ RETURN1(Cnil); + + } + +--- gcl-2.6.12.orig/o/wpool.c ++++ gcl-2.6.12/o/wpool.c +@@ -3,7 +3,7 @@ + #define NO_PRELINK_UNEXEC_DIVERSION + char *rb_end=NULL,*rb_start=NULL,*heap_end=NULL; + void *data_start=NULL; +-int use_pool=1; ++int multiprocess_memory_pool=1; + + #include "include.h" + #include "page.h" +@@ -20,9 +20,9 @@ assert_error(const char *a,unsigned l,co + int + main(int argc,char * argv[],char * envp[]) { + +- int s; ++ int s=3; + +- sscanf(argv[1],"%d",&s); ++ if (argc>1) sscanf(argv[1],"%d",&s); + open_pool(); + for (;;) { + lock_pool(); +--- gcl-2.6.12.orig/pcl/sys-proclaim.lisp ++++ gcl-2.6.12/pcl/sys-proclaim.lisp +@@ -2,402 +2,1009 @@ + (COMMON-LISP::IN-PACKAGE "PCL") + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM COMMON-LISP::T) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ PCL::NON-NEGATIVE-FIXNUM) ++ PCL::CACHE-SIZE PCL::CACHE-MASK PCL::CACHE-NLINES ++ PCL::CACHE-MAX-LOCATION)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ PCL::COMPILE-LAMBDA-DEFERRED ++ PCL::EARLY-SLOT-DEFINITION-LOCATION PCL::FGEN-SYSTEM ++ PCL::EARLY-CLASS-PRECEDENCE-LIST PCL::MAKE-CLASS-EQ-PREDICATE ++ PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS PCL::USE-CACHING-DFUN-P ++ WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE ++ PCL::SFUN-P PCL::INTERN-EQL-SPECIALIZER ++ PCL::ACCESSOR-DFUN-INFO-P WALKER::ENV-WALK-FORM ++ PCL::ARG-INFO-NUMBER-OPTIONAL PCL::TWO-CLASS-ACCESSOR-TYPE ++ PCL::FREE-CACHE PCL::SHOW-DFUN-COSTS PCL::CHECKING-CACHE ++ PCL::EARLY-GF-P PCL::EARLY-COLLECT-CPL PCL::NO-METHODS-CACHE ++ PCL::EXTRACT-PARAMETERS PCL::DEFAULT-CONSTANTP ++ PCL::PARSE-SPECIALIZERS ++ PCL::MAKE-OPTIMIZED-STRUCTURE-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-NIL-FUNCTION ++ PCL::DFUN-INFO-P PCL::CLASS-PRECEDENCE-DESCRIPTION-P ++ PCL::%FBOUNDP PCL::ONE-INDEX-DFUN-INFO-INDEX ++ PCL::ONE-CLASS-CACHE PCL::DEFAULT-STRUCTURE-INSTANCE-P ++ PCL::CONSTANT-VALUE-CACHE PCL::STRUCTURE-SVUC-METHOD ++ PCL::CLASS-HAS-A-FORWARD-REFERENCED-SUPERCLASS-P ++ PCL::METHODS-CONTAIN-EQL-SPECIALIZER-P ++ PCL::STRUCTURE-SLOTD-WRITER-FUNCTION PCL::CCLOSUREP ++ PCL::COUNT-DFUN PCL::COMPUTE-STD-CPL-PHASE-2 ++ PCL::EARLY-METHOD-STANDARD-ACCESSOR-SLOT-NAME ++ PCL::EARLY-SLOT-DEFINITION-NAME PCL::MAP-SPECIALIZERS ++ PCL::MAKE-CONSTANT-FUNCTION PCL::GF-PRECOMPUTE-DFUN-AND-EMF-P ++ PCL::DEFAULT-TEST-CONVERTER ++ PCL::PROCLAIM-INCOMPATIBLE-SUPERCLASSES PCL::TWO-CLASS-INDEX ++ PCL::CACHE-P PCL::ARG-INFO-PRECEDENCE ++ PCL::STRUCTURE-SLOTD-INIT-FORM PCL::INITIAL-P ++ PCL::EXTRACT-REQUIRED-PARAMETERS PCL::%STD-INSTANCE-WRAPPER ++ PCL::FUNCTION-PRETTY-ARGLIST PCL::INTERN-FUNCTION-NAME ++ PCL::INITIALIZE-INFO-CACHED-COMBINED-INITARGS-FORM-LIST ++ PCL::FLUSH-CACHE-VECTOR-INTERNAL PCL::TWO-CLASS-P ++ PCL::CHECK-CACHE PCL::RESET-INITIALIZE-INFO ++ PCL::ONE-INDEX-DFUN-INFO-P PCL::LEGAL-CLASS-NAME-P ++ PCL::UPDATE-PV-TABLE-CACHE-INFO ++ PCL::RESET-CLASS-INITIALIZE-INFO PCL::DISPATCH-P ++ PCL::%STD-INSTANCE-SLOTS PCL::SETFBOUNDP PCL::LOOKUP-FGEN ++ PCL::MAKE-INITFUNCTION PCL::FORCE-CACHE-FLUSHES ++ PCL::COMPLICATED-INSTANCE-CREATION-METHOD ++ PCL::NET-TEST-CONVERTER WALKER::ENV-DECLARATIONS ++ SYSTEM::%STRUCTURE-NAME PCL::GMAKUNBOUND PCL::TWO-CLASS-CACHE ++ PCL::STRUCTURE-TYPE PCL::CPD-CLASS PCL::CPD-AFTER ++ PCL::FAST-METHOD-CALL-P PCL::FGEN-GENERATOR-LAMBDA ++ PCL::CHECKING-FUNCTION PCL::DEFAULT-CONSTANT-CONVERTER ++ PCL::BUILT-IN-OR-STRUCTURE-WRAPPER1 ++ PCL::GET-MAKE-INSTANCE-FUNCTION-SYMBOL PCL::EARLY-METHOD-CLASS ++ PCL::BUILT-IN-WRAPPER-OF PCL::EXPAND-SHORT-DEFCOMBIN ++ PCL::WRAPPER-OF ++ PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION ++ PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-T-FUNCTION ++ PCL::PV-TABLEP PCL::EARLY-CLASS-NAME-OF ++ PCL::GET-MAKE-INSTANCE-FUNCTION PCL::ARG-INFO-KEY/REST-P ++ PCL::MAKE-EQL-PREDICATE PCL::STRUCTURE-SLOTD-READER-FUNCTION ++ PCL::CACHING-DFUN-INFO PCL::GF-INFO-SIMPLE-ACCESSOR-TYPE ++ PCL::N-N-ACCESSOR-TYPE PCL::FAST-METHOD-CALL-PV-CELL ++ PCL::MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION ++ PCL::EXTRACT-SPECIALIZER-NAMES PCL::MAKE-TYPE-PREDICATE ++ PCL::GET-CACHE-VECTOR PCL::SORT-SLOTS ++ PCL::DEFAULT-STRUCTURE-TYPE SYSTEM::%COMPILED-FUNCTION-NAME ++ PCL::DO-STANDARD-DEFSETFS-FOR-DEFCLASS WALKER::ENV-LOCK ++ PCL::ONE-INDEX-DFUN-INFO-CACHE PCL::ONE-INDEX-P ++ PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION ++ PCL::STANDARD-SVUC-METHOD PCL::MAKE-FUNCTION-INLINE ++ PCL::ALLOCATE-CACHE-VECTOR PCL::SLOT-BOUNDP-SYMBOL ++ PCL::METHOD-CALL-P PCL::STD-INSTANCE-P ++ PCL::GET-BUILT-IN-WRAPPER-SYMBOL PCL::FUNCALLABLE-INSTANCE-P ++ PCL::ECD-CANONICAL-SLOTS PCL::GET-BUILT-IN-CLASS-SYMBOL ++ PCL::FREE-CACHE-VECTOR PCL::GF-INFO-STATIC-C-A-M-EMF ++ PCL::EARLY-GF-NAME PCL::UPDATE-CLASS-CAN-PRECEDE-P ++ PCL::USE-DEFAULT-METHOD-ONLY-DFUN-P ++ PCL::ACCESSOR-DFUN-INFO-CACHE PCL::ARG-INFO-VALID-P ++ PCL::ONE-CLASS-INDEX WALKER::GET-WALKER-TEMPLATE ++ PCL::GFS-OF-TYPE PCL::N-N-P PCL::METHOD-CALL-CALL-METHOD-ARGS ++ PCL::BOOTSTRAP-CLASS-PREDICATES PCL::MAKE-INITIAL-DFUN ++ PCL::ONE-CLASS-WRAPPER0 PCL::ECD-OTHER-INITARGS ++ PCL::TWO-CLASS-WRAPPER1 PCL::MAKE-INSTANCE-FUNCTION-SYMBOL ++ PCL::FUNCTION-RETURNING-T PCL::STRUCTURE-SLOTD-TYPE ++ PCL::ARG-INFO-APPLYP PCL::ECD-SUPERCLASS-NAMES ++ PCL::EARLY-ACCESSOR-METHOD-SLOT-NAME ++ PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION ++ PCL::FGEN-GENSYMS PCL::EARLY-METHOD-STANDARD-ACCESSOR-P ++ PCL::DEFAULT-METHOD-ONLY-CACHE WALKER::ENV-LEXICAL-VARIABLES ++ PCL::ECD-CLASS-NAME PCL::GET-MAKE-INSTANCE-FUNCTIONS ++ PCL::EARLY-CLASS-DEFINITION PCL::ECD-METACLASS ++ PCL::UNDEFMETHOD-1 PCL::MAKE-CALL-METHODS ++ PCL::METHOD-LL->GENERIC-FUNCTION-LL PCL::SORT-CALLS ++ ITERATE::VARIABLES-FROM-LET PCL::GF-LAMBDA-LIST ++ PCL::INITIALIZE-INFO-KEY PCL::EARLY-CLASS-DIRECT-SUBCLASSES ++ PCL::ACCESSOR-DFUN-INFO-ACCESSOR-TYPE ++ PCL::MAKE-PERMUTATION-VECTOR PCL::EXTRACT-LAMBDA-LIST ++ PCL::CONSTANT-VALUE-DFUN-INFO PCL::DNET-METHODS-P ++ PCL::STRUCTURE-TYPE-INCLUDED-TYPE-NAME ++ PCL::UPDATE-GFS-OF-CLASS PCL::SLOT-VECTOR-SYMBOL ++ PCL::COMPUTE-MCASE-PARAMETERS PCL::GBOUNDP ++ PCL::SLOT-INITARGS-FROM-STRUCTURE-SLOTD PCL::CONSTANT-SYMBOL-P ++ PCL::CPD-SUPERS PCL::DEFAULT-METHOD-ONLY-P ++ PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::CACHE-OWNER PCL::FAST-INSTANCE-BOUNDP-P ++ PCL::INITIALIZE-INFO-WRAPPER ++ PCL::INITIALIZE-INFO-CACHED-VALID-P PCL::EVAL-FORM ++ PCL::DEFAULT-STRUCTUREP PCL::FUNCTION-RETURNING-NIL ++ PCL::ONE-CLASS-P PCL::ARG-INFO-KEYWORDS ++ PCL::EARLY-CLASS-SLOTDS PCL::GET-PV-CELL-FOR-CLASS ++ PCL::ONE-CLASS-ACCESSOR-TYPE PCL::GENERIC-CLOBBERS-FUNCTION ++ PCL::DFUN-INFO-CACHE PCL::MAKE-PV-TABLE-TYPE-DECLARATION ++ PCL::RESET-CLASS-INITIALIZE-INFO-1 PCL::CLASS-FROM-TYPE ++ PCL::FTYPE-DECLARATION-FROM-LAMBDA-LIST ++ PCL::EARLY-METHOD-LAMBDA-LIST ++ PCL::EARLY-COLLECT-DEFAULT-INITARGS ++ PCL::COMPILE-LAMBDA-UNCOMPILED ++ PCL::INITIALIZE-INFO-CACHED-RI-VALID-P PCL::STRUCTURE-TYPE-P ++ PCL::%SYMBOL-FUNCTION PCL::MAKE-CALLS-TYPE-DECLARATION ++ PCL::SLOT-READER-SYMBOL PCL::KEYWORD-SPEC-NAME ++ PCL::FIND-CYCLE-REASONS PCL::UPDATE-ALL-C-A-M-GF-INFO ++ PCL::INITIALIZE-INFO-P ++ PCL::METHOD-FUNCTION-NEEDS-NEXT-METHODS-P ++ PCL::INITIAL-DISPATCH-CACHE PCL::CACHING-CACHE ++ PCL::INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS ++ PCL::INITIALIZE-INFO-CACHED-INITARGS-FORM-LIST ++ PCL::STRUCTURE-TYPE-INTERNAL-SLOTDS PCL::CONSTANT-VALUE-P ++ PCL::FAST-METHOD-CALL-NEXT-METHOD-CALL PCL::EARLY-CLASS-SLOTS ++ PCL::UPDATE-C-A-M-GF-INFO PCL::GDEFINITION ++ PCL::ARG-INFO-LAMBDA-LIST PCL::STRUCTURE-SLOTD-ACCESSOR-SYMBOL ++ PCL::DEFAULT-SECONDARY-DISPATCH-FUNCTION ++ PCL::MAKE-PV-TYPE-DECLARATION ++ PCL::COMPUTE-APPLICABLE-METHODS-EMF-STD-P PCL::DISPATCH-CACHE ++ PCL::ONE-INDEX-ACCESSOR-TYPE ++ PCL::INITIALIZE-INFO-CACHED-CONSTANTS PCL::NO-METHODS-P ++ PCL::INITIALIZE-INFO-CACHED-COMBINED-INITIALIZE-FUNCTION ++ PCL::CACHING-DFUN-COST PCL::ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE ++ PCL::COMPUTE-CLASS-SLOTS PCL::UPDATE-GF-SIMPLE-ACCESSOR-TYPE ++ PCL::GF-INFO-FAST-MF-P PCL::GF-INFO-C-A-M-EMF-STD-P ++ PCL::FGEN-TEST PCL::STRUCTURE-SLOTD-NAME PCL::CLASS-PREDICATE ++ PCL::STRUCTURE-SLOT-BOUNDP PCL::EARLY-CLASS-NAME ++ PCL::LIST-LARGE-CACHE PCL::ONE-INDEX-CACHE ++ PCL::SYMBOL-PKG-NAME PCL::INITIAL-CACHE ++ PCL::UNENCAPSULATED-FDEFINITION PCL::STORE-FGEN ++ PCL::FINAL-ACCESSOR-DFUN-TYPE ++ PCL::INITIALIZE-INFO-CACHED-NEW-KEYS PCL::TYPE-CLASS ++ PCL::%CCLOSURE-ENV PCL::INITIALIZE-INFO-BOUND-SLOTS ++ PCL::GF-DFUN-CACHE PCL::EXPAND-LONG-DEFCOMBIN ++ PCL::FGEN-GENERATOR PCL::DFUN-ARG-SYMBOL ++ PCL::STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST ++ PCL::EARLY-METHOD-QUALIFIERS ++ WALKER::VARIABLE-GLOBALLY-SPECIAL-P COMMON-LISP::CLASS-OF ++ PCL::INITIALIZE-INFO-CACHED-DEFAULT-INITARGS-FUNCTION ++ PCL::GET-SETF-FUNCTION-NAME PCL::ARG-INFO-P ++ WALKER::ENV-WALK-FUNCTION PCL::LIST-DFUN ++ PCL::CHECK-WRAPPER-VALIDITY PCL::ARG-INFO-METATYPES ++ PCL::EXPAND-MAKE-INSTANCE-FORM PCL::STRUCTURE-OBJECT-P ++ PCL::COMPUTE-LINE-SIZE PCL::CANONICAL-SLOT-NAME ++ PCL::INITIAL-DISPATCH-P PCL::NEXT-WRAPPER-FIELD ++ PCL::WRAPPER-FIELD PCL::WRAPPER-FOR-STRUCTURE ++ PCL::METHOD-FUNCTION-PV-TABLE PCL::COPY-CACHE PCL::ECD-SOURCE ++ PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION-SYMBOL ++ PCL::UNPARSE-SPECIALIZERS PCL::CHECKING-P ++ PCL::FORMAT-CYCLE-REASONS PCL::N-N-CACHE ++ PCL::MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION ++ PCL::MAP-ALL-GENERIC-FUNCTIONS PCL::METHOD-FUNCTION-METHOD ++ PCL::UPDATE-GF-INFO PCL::ARG-INFO-NKEYS ++ PCL::TWO-CLASS-WRAPPER0 PCL::GF-DFUN-INFO PCL::ONE-INDEX-INDEX ++ PCL::EARLY-COLLECT-SLOTS PCL::CACHING-P ++ PCL::METHOD-FUNCTION-PLIST PCL::SLOT-WRITER-SYMBOL ++ PCL::FAST-METHOD-CALL-ARG-INFO PCL::INTERNED-SYMBOL-P ++ ITERATE::SEQUENCE-ACCESSOR)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++ PCL::LIST-LARGE-CACHES ++ PCL::UPDATE-MAKE-INSTANCE-FUNCTION-TABLE PCL::UNTRACE-METHOD ++ COMMON-LISP::INVALID-METHOD-ERROR ++ COMMON-LISP::METHOD-COMBINATION-ERROR)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++ PCL::|__si::MAKE-CLASS-PRECEDENCE-DESCRIPTION| ++ PCL::|__si::MAKE-TWO-CLASS| PCL::FALSE PCL::MAKE-PV-TABLE ++ PCL::|__si::MAKE-DISPATCH| PCL::MAKE-INITIALIZE-INFO ++ PCL::|__si::MAKE-PV-TABLE| PCL::MAKE-FAST-INSTANCE-BOUNDP ++ PCL::|__si::MAKE-DEFAULT-METHOD-ONLY| ++ WALKER::UNBOUND-LEXICAL-FUNCTION ++ PCL::|__si::MAKE-ACCESSOR-DFUN-INFO| PCL::|__si::MAKE-N-N| ++ PCL::USE-PACKAGE-PCL PCL::|__si::MAKE-CHECKING| ++ PCL::|STRUCTURE-OBJECT class constructor| ++ PCL::|__si::MAKE-CONSTANT-VALUE| ++ PCL::CALLED-FIN-WITHOUT-FUNCTION PCL::|__si::MAKE-INITIAL| ++ PCL::|__si::MAKE-CACHE| PCL::|__si::MAKE-ONE-INDEX| ++ PCL::MAKE-PROGN PCL::TRUE PCL::MAKE-FAST-METHOD-CALL ++ PCL::|__si::MAKE-ARG-INFO| PCL::INTERN-PV-TABLE ++ PCL::|__si::MAKE-DFUN-INFO| PCL::|__si::MAKE-STD-INSTANCE| ++ PCL::|__si::MAKE-CACHING| PCL::|__si::MAKE-ONE-CLASS| ++ PCL::PV-WRAPPERS-FROM-PV-ARGS PCL::ZERO ++ PCL::|__si::MAKE-INITIAL-DISPATCH| ++ PCL::|__si::MAKE-NO-METHODS| PCL::STRING-APPEND ++ PCL::|__si::MAKE-ONE-INDEX-DFUN-INFO| PCL::MAKE-METHOD-CALL ++ PCL::FIX-EARLY-GENERIC-FUNCTIONS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++ PCL::METHOD-PROTOTYPE-FOR-GF PCL::SPECIALIZER-FROM-TYPE ++ PCL::EMIT-ONE-INDEX-WRITERS PCL::*NORMALIZE-TYPE ++ PCL::COMPUTE-APPLICABLE-METHODS-EMF PCL::ANALYZE-LAMBDA-LIST ++ PCL::PARSE-DEFMETHOD PCL::GET-DISPATCH-FUNCTION ++ PCL::PROTOTYPES-FOR-MAKE-METHOD-LAMBDA ++ PCL::EMIT-CONSTANT-VALUE PCL::FIND-WRAPPER ++ PCL::MAKE-FINAL-DISPATCH-DFUN PCL::EARLY-COLLECT-INHERITANCE ++ PCL::GENERIC-FUNCTION-NAME-P PCL::EMIT-TWO-CLASS-READER ++ PCL::PARSE-METHOD-GROUP-SPECIFIER PCL::EMIT-ONE-CLASS-READER ++ PCL::FIND-STRUCTURE-CLASS PCL::EMIT-TWO-CLASS-WRITER ++ PCL::CONVERT-TO-SYSTEM-TYPE PCL::TYPE-FROM-SPECIALIZER ++ PCL::EMIT-ONE-CLASS-WRITER PCL::EARLY-METHOD-FUNCTION ++ PCL::MAKE-DISPATCH-DFUN PCL::NET-CODE-CONVERTER ++ PCL::GET-GENERIC-FUNCTION-INFO PCL::DEFAULT-CODE-CONVERTER ++ PCL::COMPILE-IIS-FUNCTIONS PCL::EMIT-ONE-INDEX-READERS ++ PCL::STRUCTURE-WRAPPER PCL::CLASS-EQ-TYPE ++ PCL::EMIT-IN-CHECKING-CACHE-P PCL::PCL-DESCRIBE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- PCL::%CCLOSURE-ENV-NTHCDR)) ++ ITERATE::RENAME-AND-CAPTURE-VARIABLES ++ PCL::|(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| ++ WALKER::WALK-PROG PCL::INVALIDATE-WRAPPER ++ PCL::COMPUTE-PRECEDENCE ++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| ++ WALKER::WALK-LAMBDA PCL::STANDARD-COMPUTE-EFFECTIVE-METHOD ++ PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| ++ WALKER::WALK-MULTIPLE-VALUE-BIND ++ PCL::|(FAST-METHOD SPECIALIZER-CLASS (CLASS))| ++ PCL::|(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| ++ PCL::NOTE-PV-TABLE-REFERENCE ++ PCL::|(FAST-METHOD CLASS-PREDICATE-NAME (T))| ++ PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| ++ WALKER::WALK-MULTIPLE-VALUE-SETQ PCL::CONVERT-TABLE ++ WALKER::WALK-LET ++ PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| ++ PCL::|(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| ++ PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| ++ PCL::SKIP-FAST-SLOT-ACCESS-P ++ PCL::|(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| ++ PCL::OPTIMIZE-SLOT-BOUNDP PCL::TRACE-EMF-CALL-INTERNAL ++ ITERATE::SIMPLE-EXPAND-GATHERING-FORM ++ PCL::MAKE-OPTIMIZED-STD-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ WALKER::WALK-FLET PCL::ONE-CLASS-DFUN-INFO ++ WALKER::WALK-COMPILER-LET ++ PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| ++ PCL::FIRST-FORM-TO-LISP WALKER::WALK-DO* ++ PCL::|(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| ++ PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| ++ PCL::|(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| ++ PCL::|(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| ++ PCL::PRINT-STD-INSTANCE ++ PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++ WALKER::WALK-MACROLET PCL::GET-FUNCTION-GENERATOR ++ PCL::INITIALIZE-INTERNAL-SLOT-GFS* ++ PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| ++ PCL::COMPUTE-EFFECTIVE-METHOD PCL::EXPAND-DEFGENERIC ++ PCL::OBSOLETE-INSTANCE-TRAP WALKER::WALK-TAGBODY-1 ++ PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL ++ PCL::GET-NEW-FUNCTION-GENERATOR PCL::SORT-METHODS ++ WALKER::WALK-DO PCL::MAKE-DFUN-CALL ++ PCL::OPTIMIZE-GF-CALL-INTERNAL ++ PCL::|(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| ++ PCL::OPTIMIZE-SET-SLOT-VALUE ++ PCL::|(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| ++ PCL::ENTRY-IN-CACHE-P ++ PCL::|(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| ++ WALKER::WALK-IF PCL::MAKE-METHOD-SPEC PCL::SET-FUNCTION-NAME-1 ++ WALKER::WALK-SETQ ++ PCL::|(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| ++ PCL::|(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| ++ PCL::DECLARE-STRUCTURE PCL::EMIT-BOUNDP-CHECK ++ WALKER::WALK-LOCALLY ++ PCL::MAKE-OPTIMIZED-STD-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION ++ PCL::CAN-OPTIMIZE-ACCESS PCL::|SETF PCL PLIST-VALUE| ++ WALKER::WALK-LABELS PCL::EMIT-1-T-DLAP ++ PCL::|(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| ++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| ++ PCL::|(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| ++ PCL::SORT-APPLICABLE-METHODS ++ PCL::|(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++ WALKER::WALK-NAMED-LAMBDA ITERATE::OPTIMIZE-ITERATE-FORM ++ PCL::MAP-ALL-ORDERS ++ PCL::|(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| ++ ITERATE::OPTIMIZE-GATHERING-FORM ++ PCL::|(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| ++ PCL::ONE-INDEX-DFUN-INFO ++ PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++ PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| ++ PCL::FLUSH-CACHE-TRAP WALKER::WALK-PROG* ++ ITERATE::VARIABLE-SAME-P PCL::EMIT-SLOT-READ-FORM ++ PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| ++ PCL::EMIT-GREATER-THAN-1-DLAP ++ PCL::|(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| ++ PCL::WRAP-METHOD-GROUP-SPECIFIER-BINDINGS WALKER::WALK-LET* ++ WALKER::WALK-SYMBOL-MACROLET WALKER::VARIABLE-DECLARATION ++ PCL::|(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| ++ WALKER::RECONS ++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| ++ PCL::OPTIMIZE-SLOT-VALUE WALKER::RELIST-INTERNAL ++ PCL::MAKE-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| ++ PCL::|SETF PCL METHOD-FUNCTION-GET| WALKER::WALK-TAGBODY ++ WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL ++ PCL::|(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| ++ PCL::PRINT-CACHE PCL::MAKE-TOP-LEVEL-FORM ++ PCL::FIX-SLOT-ACCESSORS WALKER::WALK-UNEXPECTED-DECLARE ++ PCL::SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P ++ PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))|)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::FIXNUM) +- PCL::GET-WRAPPER-CACHE-NUMBER)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::GET-DECLARATION ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE ++ PCL::EXPAND-EFFECTIVE-METHOD-FUNCTION ++ PCL::GET-METHOD-FUNCTION-PV-CELL ++ PCL::NAMED-OBJECT-PRINT-FUNCTION ++ PCL::FIND-CLASS-PREDICATE-FROM-CELL ++ PCL::GET-EFFECTIVE-METHOD-FUNCTION1 PCL::RECORD-DEFINITION ++ PCL::PROBE-CACHE PCL::INITIALIZE-INFO PCL::EMIT-MISS ++ PCL::REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION ++ PCL::FIND-CLASS-FROM-CELL PCL::PRECOMPUTE-EFFECTIVE-METHODS ++ PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION1 ++ PCL::METHOD-FUNCTION-GET PCL::MAP-CACHE ++ WALKER::CONVERT-MACRO-TO-LAMBDA PCL::MAKE-EMF-FROM-METHOD ++ PCL::ENSURE-GENERIC-FUNCTION-USING-CLASS ++ PCL::REAL-ENSURE-GF-USING-CLASS--NULL)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- PCL::NON-NEGATIVE-FIXNUM) +- PCL::CACHE-NLINES PCL::CACHE-MASK PCL::CACHE-SIZE +- PCL::CACHE-MAX-LOCATION)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::T) ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-INTERNAL ++ PCL::BOOTSTRAP-SET-SLOT ++ PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| ++ PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (T T))| ++ PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++ WALKER::WALK-TEMPLATE ++ PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| ++ PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| ++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| ++ PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| ++ PCL::|(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| ++ PCL::OPTIMIZE-WRITER ++ PCL::|(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| ++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| ++ PCL::|(FAST-METHOD DOCUMENTATION (T))| ++ PCL::|(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| ++ PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION1 ++ PCL::|(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| ++ PCL::LOAD-PRECOMPILED-IIS-ENTRY PCL::ADJUST-CACHE ++ WALKER::WALK-PROG/PROG* ++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| ++ PCL::|(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| ++ PCL::OPTIMIZE-READER ++ PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++ PCL::|(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| ++ WALKER::WALK-BINDINGS-2 PCL::MEMF-TEST-CONVERTER ++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| ++ PCL::|(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++ PCL::LOAD-PRECOMPILED-DFUN-CONSTRUCTOR ++ PCL::|(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| ++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| ++ PCL::|(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| ++ PCL::MAKE-DISPATCH-LAMBDA ++ PCL::|(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| ++ PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++ PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ PCL::|(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++ PCL::|(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++ WALKER::WALK-DO/DO* PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-TYPE ++ PCL::|(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| ++ PCL::GET-WRAPPERS-FROM-CLASSES ++ PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| ++ PCL::EXPAND-CACHE ++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| ++ PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| ++ PCL::|(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| ++ PCL::EXPAND-SYMBOL-MACROLET-INTERNAL ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| ++ PCL::|(FAST-METHOD MAKE-INSTANCE (CLASS))| ++ WALKER::WALK-LET/LET* ++ PCL::|(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| ++ PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ PCL::|(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (CLASS T))| ++ PCL::|(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| ++ PCL::EXPAND-DEFCLASS PCL::INITIALIZE-INSTANCE-SIMPLE ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))| ++ PCL::|(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| ++ PCL::MAYBE-EXPAND-ACCESSOR-FORM ++ PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| ++ PCL::FILL-CACHE-P ++ PCL::|(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| ++ PCL::|(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| ++ PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| ++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| ++ PCL::EMIT-CHECKING-OR-CACHING-FUNCTION-PRELIMINARY ++ PCL::TWO-CLASS-DFUN-INFO)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- COMMON-LISP::SIMPLE-VECTOR) +- PCL::CACHE-VECTOR)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ PCL::EXPAND-EMF-CALL-METHOD ++ PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| ++ PCL::BOOTSTRAP-MAKE-SLOT-DEFINITIONS ++ PCL::|(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| ++ PCL::MAKE-INSTANCE-FUNCTION-COMPLEX ++ PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| ++ PCL::UPDATE-SLOTS-IN-PV ++ PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD SLOT-UNBOUND (T T T))| ++ PCL::MAKE-PARAMETER-REFERENCES ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| ++ PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS1 ++ PCL::OPTIMIZE-INSTANCE-ACCESS PCL::OPTIMIZE-ACCESSOR-CALL ++ PCL::OPTIMIZE-GENERIC-FUNCTION-CALL ++ PCL::REAL-MAKE-METHOD-INITARGS-FORM ++ PCL::|(FAST-METHOD REMOVE-NAMED-METHOD (T T))| ++ PCL::|(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| ++ PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| ++ PCL::COMPUTE-PV-SLOT PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL1 ++ PCL::LOAD-FUNCTION-GENERATOR ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| ++ PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::GET-MAKE-INSTANCE-FUNCTION-INTERNAL ++ PCL::|(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T T))| ++ PCL::MAKE-FINAL-ORDINARY-DFUN-INTERNAL ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| ++ WALKER::WALK-BINDINGS-1 PCL::MAKE-INSTANCE-FUNCTION-SIMPLE ++ PCL::MAKE-FGEN WALKER::WALK-TEMPLATE-HANDLE-REPEAT ++ PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| ++ PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| ++ PCL::MAKE-EMF-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 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::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ PCL::REAL-LOAD-DEFCLASS PCL::LOAD-DEFCLASS ++ PCL::OPTIMIZE-GF-CALL PCL::MAKE-EARLY-CLASS-DEFINITION ++ WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1 PCL::EMIT-SLOT-ACCESS ++ PCL::BOOTSTRAP-MAKE-SLOT-DEFINITION ++ PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::SET-ARG-INFO1)) ++(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::REAL-GET-METHOD PCL::MAKE-EMF-CALL ++ PCL::EMIT-FETCH-WRAPPER PCL::CHECK-INITARGS-1 ++ PCL::CAN-OPTIMIZE-ACCESS1 PCL::CHECK-INITARGS-2-PLIST ++ PCL::CHECK-INITARGS-2-LIST WALKER::WALK-ARGLIST ++ PCL::GET-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::*) ++ COMMON-LISP::T) ++ PCL::GET-SECONDARY-DISPATCH-FUNCTION1 PCL::EMIT-DLAP)) ++(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::FILL-DFUN-CACHE PCL::EARLY-ADD-NAMED-METHOD ++ 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::*) +- PCL::ACCESSOR-VALUES-INTERNAL ++ PCL::ACCESSOR-VALUES1 PCL::CHECK-METHOD-ARG-INFO ++ PCL::EMIT-READER/WRITER PCL::OPTIMIZE-SLOT-VALUE-BY-CLASS-P ++ PCL::|(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| ++ PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION ++ PCL::CACHE-MISS-VALUES ++ PCL::GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::MAKE-FINAL-CACHING-DFUN + PCL::MAKE-OPTIMIZED-STD-READER-METHOD-FUNCTION ++ PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| ++ PCL::MAKE-FINAL-CONSTANT-VALUE-DFUN ++ PCL::|(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| + PCL::|(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| +- PCL::MAKE-FINAL-N-N-ACCESSOR-DFUN +- PCL::|(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| +- PCL::CHECK-METHOD-ARG-INFO +- PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| +- PCL::GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION +- PCL::GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +- PCL::|(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| ++ PCL::ACCESSOR-VALUES-INTERNAL ITERATE::EXPAND-INTO-LET + PCL::MAKE-OPTIMIZED-STD-BOUNDP-METHOD-FUNCTION +- PCL::OPTIMIZE-SLOT-VALUE-BY-CLASS-P +- ITERATE::WALK-GATHERING-BODY ++ PCL::CONSTANT-VALUE-MISS ++ PCL::GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION ++ WALKER::WALK-LET-IF ITERATE::WALK-GATHERING-BODY + PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER +- PCL::|(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| +- PCL::SLOT-BOUNDP-USING-CLASS-DFUN WALKER::WALK-FORM-INTERNAL +- PCL::LOAD-LONG-DEFCOMBIN PCL::MAKE-FINAL-CACHING-DFUN +- PCL::EMIT-READER/WRITER +- PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION +- PCL::SLOT-VALUE-USING-CLASS-DFUN PCL::CACHING-MISS +- PCL::|(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| +- PCL::EMIT-READER/WRITER-FUNCTION PCL::ACCESSOR-VALUES1 +- PCL::GENERATING-LISP PCL::GET-CLASS-SLOT-VALUE-1 +- PCL::MAKE-FINAL-CONSTANT-VALUE-DFUN PCL::CACHE-MISS-VALUES +- WALKER::WALK-LET-IF + PCL::|(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| +- PCL::|(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| +- PCL::CHECKING-MISS ITERATE::EXPAND-INTO-LET ++ PCL::CHECKING-MISS PCL::MAKE-FINAL-N-N-ACCESSOR-DFUN ++ PCL::GENERATING-LISP ITERATE::RENAME-VARIABLES ++ PCL::|(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| ++ PCL::CONVERT-METHODS PCL::SLOT-VALUE-USING-CLASS-DFUN ++ PCL::EMIT-READER/WRITER-FUNCTION ++ PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| ++ PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| ++ PCL::CACHING-MISS + PCL::MAKE-OPTIMIZED-STD-WRITER-METHOD-FUNCTION +- PCL::CONSTANT-VALUE-MISS ITERATE::RENAME-VARIABLES +- PCL::|(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| ++ PCL::GET-CLASS-SLOT-VALUE-1 WALKER::WALK-FORM-INTERNAL ++ PCL::SLOT-BOUNDP-USING-CLASS-DFUN PCL::LOAD-LONG-DEFCOMBIN ++ PCL::|(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| ++ PCL::|(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| + PCL::SET-SLOT-VALUE +- PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| +- PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| + PCL::|(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| +- PCL::CONVERT-METHODS)) +-(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 ADD-READER-METHOD (SLOT-CLASS T T))| +- PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| +- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| +- PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- PCL::|(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| +- PCL::|(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| +- PCL::MAKE-TWO-CLASS-ACCESSOR-DFUN +- PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| +- PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| +- PCL::ADD-METHOD-DECLARATIONS +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| +- PCL::|(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| +- PCL::WALK-METHOD-LAMBDA +- PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- PCL::COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL +- PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))|)) ++ PCL::|(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))|)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T) + COMMON-LISP::*) +- PCL::GET-ACCESSOR-METHOD-FUNCTION +- PCL::|(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| ++ PCL::SETF-SLOT-VALUE-USING-CLASS-DFUN ++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| ++ PCL::ORDER-SPECIALIZERS ++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| ++ PCL::EMIT-CHECKING-OR-CACHING ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| ++ PCL::|(FAST-METHOD MAKE-INSTANCE (SYMBOL))| + PCL::|(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| ++ PCL::GENERATE-DISCRIMINATION-NET ++ PCL::|(FAST-METHOD CHANGE-CLASS (T SYMBOL))| + PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| +- PCL::MAKE-ONE-CLASS-ACCESSOR-DFUN ++ PCL::|(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| ++ PCL::GET-ACCESSOR-METHOD-FUNCTION + PCL::|(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| +- PCL::GENERATE-DISCRIMINATION-NET + PCL::|(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| +- PCL::LOAD-SHORT-DEFCOMBIN +- PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| +- PCL::|(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| +- PCL::REAL-MAKE-METHOD-LAMBDA PCL::SET-CLASS-SLOT-VALUE-1 +- PCL::BOOTSTRAP-ACCESSOR-DEFINITION + PCL::MAKE-FINAL-ONE-INDEX-ACCESSOR-DFUN +- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| +- PCL::ACCESSOR-MISS PCL::|(FAST-METHOD MAKE-INSTANCE (SYMBOL))| +- PCL::ACCESSOR-VALUES ++ PCL::EMIT-CHECKING-OR-CACHING-FUNCTION PCL::ACCESSOR-MISS ++ PCL::|(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| ++ PCL::LOAD-SHORT-DEFCOMBIN PCL::MAKE-FINAL-CHECKING-DFUN ++ PCL::|(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| ++ PCL::MAKE-SHARED-INITIALIZE-FORM-LIST + PCL::|(FAST-METHOD DESCRIBE-OBJECT (T T))| +- PCL::|(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| +- PCL::EMIT-CHECKING-OR-CACHING-FUNCTION + PCL::INITIALIZE-INSTANCE-SIMPLE-FUNCTION +- PCL::MAKE-FINAL-CHECKING-DFUN +- PCL::MAKE-SHARED-INITIALIZE-FORM-LIST +- PCL::|(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| +- PCL::EMIT-CHECKING-OR-CACHING +- PCL::|(FAST-METHOD CHANGE-CLASS (T SYMBOL))| +- PCL::|(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| +- PCL::|(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| + PCL::|(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| +- PCL::SETF-SLOT-VALUE-USING-CLASS-DFUN ++ PCL::ACCESSOR-VALUES PCL::REAL-MAKE-METHOD-LAMBDA ++ PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))| ++ PCL::BOOTSTRAP-ACCESSOR-DEFINITION ++ PCL::|(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| ++ PCL::MAKE-ONE-CLASS-ACCESSOR-DFUN + PCL::GET-ACCESSOR-FROM-SVUC-METHOD-FUNCTION + PCL::|(FAST-METHOD NO-APPLICABLE-METHOD (T))| +- PCL::ORDER-SPECIALIZERS +- PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| +- PCL::|(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))|)) ++ PCL::SET-CLASS-SLOT-VALUE-1)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::*) +- PCL::MAKE-N-N-ACCESSOR-DFUN +- PCL::GET-SIMPLE-INITIALIZATION-FUNCTION +- PCL::MAKE-FINAL-ACCESSOR-DFUN +- PCL::GET-EFFECTIVE-METHOD-FUNCTION PCL::MAKE-ACCESSOR-TABLE +- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION PCL::MAKE-CHECKING-DFUN +- PCL::GET-COMPLEX-INITIALIZATION-FUNCTIONS +- PCL::MAKE-DEFAULT-INITARGS-FORM-LIST PCL::REAL-ADD-METHOD +- PCL::SLOT-VALUE-OR-DEFAULT PCL::LOAD-DEFGENERIC PCL::CPL-ERROR +- WALKER::NESTED-WALK-FORM PCL::TYPES-FROM-ARGUMENTS +- PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION)) ++ PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| ++ PCL::|(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| ++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| ++ PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::WALK-METHOD-LAMBDA ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| ++ PCL::COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL ++ PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| ++ PCL::|(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| ++ PCL::MAKE-TWO-CLASS-ACCESSOR-DFUN ++ PCL::|(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD 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 SHARED-INITIALIZE :BEFORE (CLASS T))| ++ PCL::ADD-METHOD-DECLARATIONS ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))|)) ++(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::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::*) +- PCL::MAKE-LONG-METHOD-COMBINATION-FUNCTION +- PCL::GENERATE-DISCRIMINATION-NET-INTERNAL +- PCL::CACHE-MISS-VALUES-INTERNAL +- PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- PCL::DO-SHORT-METHOD-COMBINATION PCL::MEMF-CODE-CONVERTER)) ++ PCL::MAKE-DEFAULT-INITARGS-FORM-LIST ++ PCL::GET-EFFECTIVE-METHOD-FUNCTION PCL::LOAD-DEFGENERIC ++ PCL::GET-COMPLEX-INITIALIZATION-FUNCTIONS ++ PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION ++ PCL::SLOT-VALUE-OR-DEFAULT PCL::MAKE-CHECKING-DFUN ++ PCL::MAKE-FINAL-ACCESSOR-DFUN WALKER::NESTED-WALK-FORM ++ PCL::MAKE-ACCESSOR-TABLE PCL::REAL-ADD-METHOD ++ PCL::TYPES-FROM-ARGUMENTS ++ PCL::GET-SIMPLE-INITIALIZATION-FUNCTION PCL::CPL-ERROR ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION ++ PCL::MAKE-N-N-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::T COMMON-LISP::T + COMMON-LISP::*) + COMMON-LISP::*) +- PCL::MAKE-ONE-INDEX-ACCESSOR-DFUN WALKER::WALK-DECLARATIONS +- PCL::GET-SECONDARY-DISPATCH-FUNCTION)) ++ PCL::REAL-MAKE-A-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::*) +- PCL::|(FAST-METHOD SLOT-MISSING (T T T T))| +- PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| +- ITERATE::ITERATE-TRANSFORM-BODY)) ++ COMMON-LISP::T) ++ PCL::LOAD-DEFMETHOD-INTERNAL PCL::EXPAND-DEFMETHOD)) + (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::*) +- ITERATE::RENAME-LET-BINDINGS +- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1)) ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::EARLY-MAKE-A-METHOD PCL::LOAD-DEFMETHOD ++ PCL::MAKE-DEFMETHOD-FORM 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::*) ++ COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::*) +- PCL::REAL-MAKE-A-METHOD)) +-(COMMON-LISP::MAPC +- (COMMON-LISP::LAMBDA (COMPILER::X) +- (COMMON-LISP::SETF +- (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) +- COMMON-LISP::T)) +- '(PCL::REDEFINE-FUNCTION PCL::DO-STANDARD-DEFSETF-1 +- PCL::TRACE-METHOD-INTERNAL PCL::FDEFINE-CAREFULLY)) ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1 ++ ITERATE::RENAME-LET-BINDINGS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) +- PCL::ANALYZE-LAMBDA-LIST PCL::GET-DISPATCH-FUNCTION +- PCL::PARSE-DEFMETHOD PCL::MAKE-DISPATCH-DFUN +- PCL::EMIT-IN-CHECKING-CACHE-P PCL::EMIT-ONE-INDEX-READERS +- PCL::METHOD-PROTOTYPE-FOR-GF PCL::EMIT-ONE-CLASS-READER +- PCL::GENERIC-FUNCTION-NAME-P PCL::DEFAULT-CODE-CONVERTER +- PCL::CLASS-EQ-TYPE PCL::CONVERT-TO-SYSTEM-TYPE +- PCL::COMPILE-IIS-FUNCTIONS PCL::EMIT-CONSTANT-VALUE +- PCL::GET-GENERIC-FUNCTION-INFO PCL::EARLY-METHOD-FUNCTION +- PCL::FIND-STRUCTURE-CLASS PCL::PCL-DESCRIBE +- PCL::NET-CODE-CONVERTER PCL::PARSE-METHOD-GROUP-SPECIFIER +- PCL::TYPE-FROM-SPECIALIZER PCL::EMIT-TWO-CLASS-WRITER +- PCL::COMPUTE-APPLICABLE-METHODS-EMF PCL::EMIT-ONE-CLASS-WRITER +- PCL::PROTOTYPES-FOR-MAKE-METHOD-LAMBDA +- PCL::SPECIALIZER-FROM-TYPE PCL::EARLY-COLLECT-INHERITANCE +- PCL::EMIT-TWO-CLASS-READER PCL::FIND-WRAPPER +- PCL::*NORMALIZE-TYPE PCL::EMIT-ONE-INDEX-WRITERS +- PCL::STRUCTURE-WRAPPER PCL::MAKE-FINAL-DISPATCH-DFUN)) ++ (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::GENERATE-DISCRIMINATION-NET-INTERNAL ++ PCL::CACHE-MISS-VALUES-INTERNAL ++ PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::MEMF-CODE-CONVERTER ++ PCL::MAKE-LONG-METHOD-COMBINATION-FUNCTION)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +- PCL::|__si::MAKE-INITIAL| PCL::|__si::MAKE-ARG-INFO| +- PCL::STRING-APPEND PCL::|__si::MAKE-ONE-INDEX| +- PCL::MAKE-INITIALIZE-INFO PCL::MAKE-FAST-METHOD-CALL +- PCL::|__si::MAKE-STD-INSTANCE| +- PCL::|__si::MAKE-ONE-INDEX-DFUN-INFO| +- PCL::|__si::MAKE-CONSTANT-VALUE| PCL::|__si::MAKE-N-N| +- PCL::FIX-EARLY-GENERIC-FUNCTIONS PCL::INTERN-PV-TABLE +- PCL::FALSE PCL::|__si::MAKE-DFUN-INFO| +- PCL::|__si::MAKE-CACHING| PCL::MAKE-PV-TABLE +- PCL::MAKE-METHOD-CALL PCL::TRUE PCL::MAKE-PROGN +- PCL::|__si::MAKE-CACHE| +- PCL::|STRUCTURE-OBJECT class constructor| +- PCL::|__si::MAKE-CLASS-PRECEDENCE-DESCRIPTION| +- PCL::|__si::MAKE-NO-METHODS| PCL::|__si::MAKE-ONE-CLASS| +- PCL::|__si::MAKE-PV-TABLE| PCL::PV-WRAPPERS-FROM-PV-ARGS +- WALKER::UNBOUND-LEXICAL-FUNCTION PCL::|__si::MAKE-TWO-CLASS| +- PCL::|__si::MAKE-ACCESSOR-DFUN-INFO| +- PCL::|__si::MAKE-DEFAULT-METHOD-ONLY| +- PCL::MAKE-FAST-INSTANCE-BOUNDP +- PCL::CALLED-FIN-WITHOUT-FUNCTION PCL::USE-PACKAGE-PCL +- PCL::|__si::MAKE-CHECKING| PCL::|__si::MAKE-INITIAL-DISPATCH| +- PCL::|__si::MAKE-DISPATCH|)) ++ (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::FUNCTION) +- PCL::METHOD-CALL-FUNCTION PCL::FAST-METHOD-CALL-FUNCTION +- PCL::CACHE-LIMIT-FN)) ++ (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::BOOLEAN) +- PCL::CACHE-VALUEP)) ++ (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::INTEGER 1 255)) +- PCL::CACHE-NKEYS)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::T) ++ PCL::COMPUTE-STD-CPL-PHASE-3)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- (COMMON-LISP::INTEGER 1 256)) +- PCL::CACHE-LINE-SIZE)) ++ (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::T COMMON-LISP::*) +- (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) +- PCL::SYMBOL-APPEND)) ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::FIXNUM) ++ PCL::GET-WRAPPER-CACHE-NUMBER)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +- (COMMON-LISP::*)) +- PCL::SORT-APPLICABLE-METHODS PCL::SORT-METHODS)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FUNCTION) ++ PCL::METHOD-CALL-FUNCTION PCL::FAST-METHOD-CALL-FUNCTION ++ PCL::CACHE-LIMIT-FN)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- PCL::COMPUTE-CALLS PCL::SET-STRUCTURE-SVUC-METHOD +- PCL::UPDATE-STD-OR-STR-METHODS PCL::SET-METHODS +- WALKER::NOTE-LEXICAL-BINDING ++ PCL::MEC-ALL-CLASS-LISTS PCL::REMOVE-SLOT-ACCESSORS ++ PCL::PARSE-GSPEC PCL::STANDARD-INSTANCE-ACCESS ++ PCL::DOCTOR-DFUN-FOR-THE-DEBUGGER ++ PCL::UPDATE-STD-OR-STR-METHODS PCL::CLASS-MIGHT-PRECEDE-P ++ PCL::ACCESSOR-SET-SLOT-VALUE PCL::DOPLIST ++ PCL::ADD-SLOT-ACCESSORS PCL::DFUN-MISS ++ PCL::FSC-INSTANCE-WRAPPER PCL::CLASS-EQ-TEST ++ PCL::MAKE-INTERNAL-READER-METHOD-FUNCTION ++ PCL::MAKE-EARLY-ACCESSOR WALKER::ENVIRONMENT-MACRO ++ PCL::WITH-DFUN-WRAPPERS PCL::WRAPPER-STATE ++ PCL::DFUN-INFO-WRAPPER0 ++ WALKER::WITH-NEW-DEFINITION-IN-ENVIRONMENT PCL::IF* ++ PCL::CHECK-WRAPPER-VALIDITY1 ++ PCL::INITIALIZE-INFO-MAKE-INSTANCE-FUNCTION-SYMBOL ++ PCL::BUILT-IN-OR-STRUCTURE-WRAPPER ++ PCL::FIND-CLASS-CELL-PREDICATE PCL::CLASS-CAN-PRECEDE-P ++ COMMON-LISP::CALL-METHOD PCL::NET-CONSTANT-CONVERTER ++ PCL::UPDATE-INITIALIZE-INFO-INTERNAL ++ PCL::GET-CACHE-VECTOR-LOCK-COUNT PCL::UNDEFMETHOD ++ PCL::%SET-SVREF PCL::PV-WRAPPERS-FROM-ALL-WRAPPERS ++ PCL::WRAPPER-NO-OF-INSTANCE-SLOTS PCL::CACHE-VECTOR-LOCK-COUNT ++ WALKER::VARIABLE-LEXICAL-P PCL::FIN-LAMBDA-FN ++ PCL::INITIAL-CLASSES-AND-WRAPPERS PCL::MLOOKUP ++ PCL::RAISE-METATYPE ITERATE::WHILE PCL::EARLY-GF-ARG-INFO ++ PCL::INVALID-WRAPPER-P WALKER::VARIABLE-SPECIAL-P ++ PCL::EMIT-N-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION ++ PCL::EMIT-CHECKING-OR-CACHING-FUNCTION-PRECOMPILED ++ PCL::INSTANCE-WRITE-INTERNAL WALKER::WALK-REPEAT-EVAL ++ WALKER::GET-WALKER-TEMPLATE-INTERNAL ITERATE::PLIST-ELEMENTS ++ PCL::MAKE-FIND-CLASS-CELL COMMON-LISP::WITH-ACCESSORS ++ PCL::MAKE-METHOD-FUNCTION PCL::SIMPLE-LEXICAL-METHOD-FUNCTIONS ++ PCL::CANONICALIZE-DEFCLASS-OPTION PCL::UPDATE-INITS PCL::SCASE ++ PCL::INSTANCE-BOUNDP-INTERNAL PCL::FMC-FUNCALL ++ PCL::SET-METHODS PCL::CACHE-LOCK-COUNT PCL::GET-WRAPPER ++ PCL::INVOKE-METHOD-CALL1 PCL::MAKE-CLASS-PREDICATE ++ PCL::PRINTING-RANDOM-THING PCL::UPDATE-SLOTS ++ PCL::FUNCTION-APPLY PCL::AUGMENT-TYPE ITERATE::WITH-GATHERING ++ PCL::CHECKING-DFUN-INFO PCL::LIST-EQ PCL::CACHE-VECTOR-SIZE ++ PCL::DESCRIBE-PACKAGE PCL::WRAPPER-REF PCL::PLIST-VALUE ++ PCL::%INSTANCE-REF WALKER::NOTE-DECLARATION ++ PCL::MAKE-STD-READER-METHOD-FUNCTION ++ PCL::EMIT-READER/WRITER-MACRO WALKER::ENVIRONMENT-FUNCTION ++ PCL::N-N-DFUN-INFO ++ PCL::FIND-CLASS-CELL-MAKE-INSTANCE-FUNCTION-KEYS ++ PCL::DEFCONSTRUCTOR PCL::INSTANCE-SLOT-INDEX ++ PCL::CLASS-NO-OF-INSTANCE-SLOTS ITERATE::ELEMENTS ++ PCL::NEXT-WRAPPER-CACHE-NUMBER-INDEX ++ PCL::INITIALIZE-INFO-COMBINED-INITARGS-FORM-LIST ++ COMMON-LISP::DEFINE-METHOD-COMBINATION PCL::MDOTIMES ++ PCL::REMOVE-DIRECT-SUBCLASSES PCL::MAKE-WRAPPER-INTERNAL ++ ITERATE::MAXIMIZING PCL::PV-OFFSET ++ PCL::DEAL-WITH-ARGUMENTS-OPTION PCL::INSTANCE-READER ++ PCL::ALLOCATE-STANDARD-INSTANCE--MACRO PCL::DEFINE-INLINES ++ PCL::WRAPPER-CACHE-NUMBER-VECTOR PCL::GATHERING1 ++ PCL::FIND-CLASS-CELL-CLASS PCL::SWAP-WRAPPERS-AND-SLOTS ++ PCL::COMPUTE-APPLICABLE-METHODS-FUNCTION PCL::PV-TABLE-LOOKUP ++ PCL::WRAPPER-INSTANCE-SLOTS-LAYOUT ++ WALKER::WALKER-ENVIRONMENT-BIND PCL::COPY-SLOTS PCL::MCASE ++ PCL::ADD-TO-CVECTOR PCL::ADD-DIRECT-SUBCLASSES ++ PCL::%SET-CCLOSURE-ENV PCL::PRECOMPILE-RANDOM-CODE-SEGMENTS ++ PCL::UPDATE-CLASS PCL::SLOT-SYMBOL PCL::VALUE-FOR-CACHING ++ PCL::EXPANDING-MAKE-INSTANCE-TOP-LEVEL PCL::REMTAIL ++ PCL::MAKE-DISCRIMINATING-FUNCTION-ARGLIST ++ PCL::CLASSES-HAVE-COMMON-SUBCLASS-P ++ PCL::FIRST-WRAPPER-CACHE-NUMBER-INDEX ++ PCL::INITIALIZE-INFO-INITARGS-FORM-LIST ++ PCL::WITH-MAKE-INSTANCE-FUNCTION-VALID-P-CHECK ++ PCL::FUNCALLABLE-INSTANCE-DATA-1 PCL::SAUT-NOT-EQL ++ PCL::EARLY-GF-METHODS ITERATE::EXTRACT-SPECIAL-BINDINGS ++ PCL::MEMQ PCL::DFUN-UPDATE ++ PCL::MAKE-CHECKING-OR-CACHING-FUNCTION-LIST PCL::ONCE-ONLY ++ PCL::GET-INSTANCE-WRAPPER-OR-NIL PCL::SYMBOL-LESSP ++ PCL::|SETF PCL FIND-CLASS| PCL::PARSE-QUALIFIER-PATTERN + ITERATE::SIMPLE-EXPAND-ITERATE-FORM +- PCL::|SETF PCL METHOD-FUNCTION-PLIST| PCL::SAUT-NOT-PROTOTYPE +- PCL::VALUE-FOR-CACHING PCL::PROCLAIM-DEFMETHOD +- PCL::MAKE-FAST-METHOD-CALL-LAMBDA-LIST +- PCL::MAKE-STD-BOUNDP-METHOD-FUNCTION PCL::METHODS-CONVERTER +- PCL::DEAL-WITH-ARGUMENTS-OPTION +- PCL::UPDATE-ALL-PV-TABLE-CACHES +- PCL::MAP-PV-TABLE-REFERENCES-OF PCL::UPDATE-CLASS +- PCL::FIND-STANDARD-II-METHOD +- PCL::METHOD-FUNCTION-RETURNING-NIL +- PCL::REDIRECT-EARLY-FUNCTION-INTERNAL PCL::UPDATE-CPL +- PCL::QUALIFIER-CHECK-RUNTIME PCL::COMPUTE-STD-CPL +- PCL::COMPUTE-CONSTANTS PCL::ADD-FORMS PCL::AUGMENT-TYPE +- PCL::MEMF-CONSTANT-CONVERTER PCL::SWAP-WRAPPERS-AND-SLOTS +- PCL::SET-WRAPPER PCL::GET-KEY-ARG PCL::MAKE-PLIST +- PCL::MAKE-PV-TABLE-INTERNAL ITERATE::EXTRACT-SPECIAL-BINDINGS +- PCL::SAUT-NOT-EQL WALKER::VARIABLE-SYMBOL-MACRO-P +- PCL::EMIT-1-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION +- PCL::SET-FUNCTION-PRETTY-ARGLIST +- PCL::GF-MAKE-FUNCTION-FROM-EMF PCL::FIND-SLOT-DEFINITION +- PCL::SET-STANDARD-SVUC-METHOD PCL::ADD-TO-CVECTOR +- PCL::PV-WRAPPERS-FROM-ALL-WRAPPERS COMMON-LISP::REMOVE-METHOD +- PCL::CHECKING-DFUN-INFO PCL::PARSE-QUALIFIER-PATTERN +- PCL::%SET-CCLOSURE-ENV PCL::MAKE-CDXR +- PCL::FUNCALLABLE-STANDARD-INSTANCE-ACCESS +- PCL::NET-CONSTANT-CONVERTER PCL::|SETF PCL FIND-CLASS| ++ PCL::INITIALIZE-INFO-SHARED-INITIALIZE-T-FUNCTION ++ PCL::RESET-INITIALIZE-INFO-INTERNAL ++ PCL::INITIALIZE-INFO-DEFAULT-INITARGS-FUNCTION ++ PCL::DESTRUCTURE-INTERNAL PCL::DFUN-INFO-INDEX ++ PCL::PRECOMPILE-IIS-FUNCTIONS PCL::INSTANCE-WRITE ++ COMMON-LISP::DEFCLASS PCL::UPDATE-ALL-PV-TABLE-CACHES ++ PCL::WRAPPER-CACHE-NUMBER-VECTOR-REF ++ PCL::INITIALIZE-INFO-COMBINED-INITIALIZE-FUNCTION ++ PCL::MODIFY-CACHE PCL::BOOTSTRAP-SLOT-INDEX ++ PCL::SET-FUNCTION-PRETTY-ARGLIST PCL::COMPUTE-LAYOUT ++ PCL::CALL-METHOD-LIST PCL::GET-KEY-ARG ITERATE::LIST-TAILS ++ PCL::INITIALIZE-INFO-MAKE-INSTANCE-FUNCTION ITERATE::EACHTIME ++ PCL::INSTANCE-REF PCL::WITH-EQ-HASH-TABLE ++ PCL::QUALIFIER-CHECK-RUNTIME PCL::CALLSREF ITERATE::MV-SETQ ++ PCL::PRINTING-RANDOM-THING-INTERNAL PCL::CHECK-MEMBER ++ PCL::INSTANCE-WRITER PCL::CANONICALIZE-SLOT-SPECIFICATION ++ PCL::BIND-LEXICAL-METHOD-FUNCTIONS ITERATE::LIST-ELEMENTS ++ PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST ++ PCL::INVOKE-METHOD-CALL PCL::INITIALIZE-INFO-RI-VALID-P ++ PCL::SET-WRAPPER PCL::STD-INSTANCE-CLASS ++ PCL::EXPANDING-MAKE-INSTANCE PCL::BIND-ARGS ++ PCL::INITIALIZE-INFO-VALID-P PCL::STD-INSTANCE-WRAPPER ++ PCL::FSC-INSTANCE-SLOTS PCL::REAL-ENSURE-GF-INTERNAL PCL::NEQ ++ PCL::PRECOMPILE-DFUN-CONSTRUCTORS PCL::MAKE-DLAP-LAMBDA-LIST ++ PCL::FIND-SLOT-DEFINITION ++ PCL::BIND-SIMPLE-LEXICAL-METHOD-MACROS ++ PCL::ACCESSOR-SLOT-VALUE PCL::METHOD-FUNCTION-RETURNING-NIL ++ PCL::MAKE-DFUN-LAMBDA-LIST WALKER::VARIABLE-SYMBOL-MACRO-P ++ PCL::DFUN-INFO-FUNCTION COMMON-LISP::WITH-SLOTS ++ PCL::FUNCTION-FUNCALL PCL::EQL-TEST ++ PCL::INITIALIZE-INFO-CONSTANTS PCL::POSQ PCL::DOLIST-CAREFULLY ++ PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER-MACRO PCL::MAKE-CAXR ++ ITERATE::ITERATE PCL::DEFINE-INITIALIZE-INFO PCL::ALIST-ENTRY ++ PCL::WITH-LOCAL-CACHE-FUNCTIONS PCL::WRAPPER-OF-MACRO ++ PCL::RASSQ PCL::SUPERCLASSES-COMPATIBLE-P + PCL::METHOD-FUNCTION-RETURNING-T PCL::CHANGE-CLASS-INTERNAL +- PCL::MAKE-DFUN-ARG-LIST PCL::DOCTOR-DFUN-FOR-THE-DEBUGGER +- PCL::MAKE-STD-WRITER-METHOD-FUNCTION ITERATE::MV-SETQ +- PCL::MAKE-EARLY-ACCESSOR PCL::GET-KEY-ARG1 +- PCL::ADD-DIRECT-SUBCLASSES PCL::DO-SATISFIES-DEFTYPE +- PCL::N-N-DFUN-INFO PCL::CLASSES-HAVE-COMMON-SUBCLASS-P +- PCL::SAUT-NOT-CLASS PCL::CANONICALIZE-DEFCLASS-OPTION +- PCL::MAKE-DISCRIMINATING-FUNCTION-ARGLIST +- WALKER::VARIABLE-LEXICAL-P WALKER::ENVIRONMENT-FUNCTION +- PCL::PV-TABLE-LOOKUP PCL::DESTRUCTURE-INTERNAL +- PCL::MAKE-INTERNAL-READER-METHOD-FUNCTION +- PCL::REMOVE-SLOT-ACCESSORS ++ PCL::PRECOMPILE-FUNCTION-GENERATORS ++ WALKER::DEFINE-WALKER-TEMPLATE PCL::CACHE-VECTOR-REF ++ PCL::GET-SLOTS PCL::MEC-ALL-CLASSES-INTERNAL ++ COMMON-LISP::SLOT-EXISTS-P PCL::WITHOUT-INTERRUPTS ++ PCL::MAKE-UNORDERED-METHODS-EMF PCL::GET-KEY-ARG1 ++ PCL::MAKE-STD-WRITER-METHOD-FUNCTION PCL::COMPUTE-CONSTANTS ++ PCL::BOOTSTRAP-GET-SLOT PCL::DEFINE-GF-PREDICATE ++ PCL::REDIRECT-EARLY-FUNCTION-INTERNAL ++ PCL::SET-STRUCTURE-SVUC-METHOD PCL::WRAPPER-CLASS ++ ITERATE::UNTIL PCL::PV-BINDING1 PCL::UPDATE-CPL PCL::PV-ENV ++ PCL::PV-BINDING PCL::INSTANCE-READ-INTERNAL ++ COMMON-LISP::DEFGENERIC ITERATE::COLLECTING ++ WALKER::NOTE-LEXICAL-BINDING PCL::ORIGINAL-DEFINITION ++ PCL::COLLECTING-ONCE PCL::GET-SLOTS-OR-NIL PCL::TRACE-EMF-CALL ++ PCL::WITH-HASH-TABLE PCL::FUNCALLABLE-INSTANCE-MARKER ++ PCL::INITIALIZE-INFO-NEW-KEYS PCL::STD-INSTANCE-SLOTS ++ PCL::ACCESSOR-SLOT-BOUNDP PCL::SAUT-NOT-PROTOTYPE ++ PCL::MAP-PV-TABLE-REFERENCES-OF COMMON-LISP::ADD-METHOD ++ PCL::MAKE-CDXR PCL::CALL-INITIALIZE-FUNCTION PCL::ASV-FUNCALL ++ PCL::MAKE-STD-BOUNDP-METHOD-FUNCTION PCL::IIS-BODY ++ COMMON-LISP::DEFMETHOD PCL::SYMBOL-OR-CONS-LESSP ++ PCL::SAUT-NOT-CLASS-EQ PCL::METHODS-CONVERTER PCL::PVREF ++ PCL::EMIT-1-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION ++ PCL::EMIT-CHECKING-OR-CACHING-MACRO ITERATE::SUMMING ++ PCL::|SETF PCL GDEFINITION| PCL::ESETF PCL::COPY-PV ++ PCL::WRAPPER-CLASS* COMMON-LISP::REMOVE-METHOD + PCL::|SETF PCL FIND-CLASS-PREDICATE| +- PCL::|SETF PCL GDEFINITION| PCL::MAKE-DFUN-LAMBDA-LIST +- PCL::CANONICALIZE-SLOT-SPECIFICATION WALKER::WALK-REPEAT-EVAL +- PCL::STANDARD-INSTANCE-ACCESS +- PCL::PRINTING-RANDOM-THING-INTERNAL PCL::REMTAIL +- PCL::ACCESSOR-MISS-FUNCTION PCL::COMPUTE-LAYOUT +- PCL::CLASS-MIGHT-PRECEDE-P +- PCL::EMIT-N-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION +- SYSTEM::%SET-COMPILED-FUNCTION-NAME PCL::PLIST-VALUE +- PCL::MAKE-CAXR PCL::MAKE-DLAP-LAMBDA-LIST +- PCL::MAKE-STD-READER-METHOD-FUNCTION WALKER::ENVIRONMENT-MACRO +- PCL::UPDATE-SLOTS PCL::VARIABLE-CLASS +- PCL::SET-FUNCALLABLE-INSTANCE-FUNCTION PCL::LIST-EQ +- PCL::ADD-SLOT-ACCESSORS PCL::SAUT-NOT-CLASS-EQ PCL::COMPUTE-PV +- PCL::PV-WRAPPERS-FROM-ALL-ARGS PCL::UPDATE-INITS +- PCL::MEC-ALL-CLASS-LISTS PCL::RAISE-METATYPE +- WALKER::NOTE-DECLARATION PCL::EMIT-1-NIL-DLAP +- PCL::BOOTSTRAP-SLOT-INDEX PCL::SUPERCLASSES-COMPATIBLE-P +- PCL::MEC-ALL-CLASSES-INTERNAL COMMON-LISP::SLOT-EXISTS-P +- PCL::DESCRIBE-PACKAGE PCL::NO-SLOT PCL::PROCLAIM-DEFGENERIC +- COMMON-LISP::ADD-METHOD PCL::MAKE-UNORDERED-METHODS-EMF +- PCL::MEC-ALL-CLASSES PCL::SYMBOL-OR-CONS-LESSP +- PCL::UPDATE-INITIALIZE-INFO-INTERNAL PCL::CLASS-CAN-PRECEDE-P +- PCL::SYMBOL-LESSP PCL::COMPUTE-APPLICABLE-METHODS-FUNCTION +- PCL::MAKE-CLASS-PREDICATE WALKER::VARIABLE-SPECIAL-P +- PCL::REMOVE-DIRECT-SUBCLASSES)) ++ PCL::ACCESSOR-MISS-FUNCTION PCL::MEMF-CONSTANT-CONVERTER ++ PCL::DELQ PCL::VECTORIZING PCL::MAKE-DFUN-ARG-LIST ++ PCL::VARIABLE-CLASS PCL::INSTANCE-ACCESSOR-PARAMETER ++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE-SLOTS ++ PCL::EMIT-DEFAULT-ONLY-MACRO PCL::NO-SLOT ++ PCL::MAYBE-CHECK-CACHE PCL::FUNCALLABLE-INSTANCE-DATA-POSITION ++ PCL::MAKE-FAST-METHOD-CALL-LAMBDA-LIST ++ PCL::DO-STANDARD-DEFSETF PCL::SAUT-NOT-CLASS ++ PCL::DFUN-INFO-ACCESSOR-TYPE PCL::DEFINE-CACHED-READER ++ PCL::SET-STANDARD-SVUC-METHOD PCL::CLASS-TEST ++ PCL::MAKE-PV-TABLE-INTERNAL PCL::PROCLAIM-DEFGENERIC ++ PCL::GF-MAKE-FUNCTION-FROM-EMF PCL::COMPUTE-PV ++ PCL::EMIT-1-NIL-DLAP PCL::FIND-STANDARD-II-METHOD ++ PCL::BIND-FAST-LEXICAL-METHOD-MACROS PCL::DO-SATISFIES-DEFTYPE ++ PCL::FAST-LEXICAL-METHOD-FUNCTIONS PCL::COMPUTE-CALLS ++ PCL::COPY-INSTANCE-INTERNAL COMMON-LISP::SYMBOL-MACROLET ++ PCL::FSC-INSTANCE-P PCL::MAKE-PLIST PCL::%SVREF ++ PCL::PCL-DESTRUCTURING-BIND ++ SYSTEM::%SET-COMPILED-FUNCTION-NAME ITERATE::JOINING ++ ITERATE::MINIMIZING PCL::METHOD-FUNCTION-CLOSURE-GENERATOR ++ PCL::PV-WRAPPERS-FROM-ALL-ARGS PCL::*LIST-ELEMENTS ++ PCL::ADD-FORMS ++ PCL::INITIALIZE-INFO-SHARED-INITIALIZE-NIL-FUNCTION ++ ITERATE::INTERVAL PCL::INSTANCE-BOUNDP PCL::FSC-INSTANCE-CLASS ++ WALKER::WITH-AUGMENTED-ENVIRONMENT ++ PCL::CACHE-NUMBER-VECTOR-REF ++ PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION PCL::ASSQ ++ PCL::SET-FUNCALLABLE-INSTANCE-FUNCTION ++ PCL::WRAPPER-CLASS-SLOTS PCL::MEC-ALL-CLASSES ++ ITERATE::GATHERING PCL::INSTANCE-READ PCL::COMPUTE-STD-CPL ++ PCL::PROCLAIM-DEFMETHOD ++ PCL::%ALLOCATE-STATIC-SLOT-STORAGE--CLASS PCL::*LIST-TAILS ++ PCL::|SETF PCL METHOD-FUNCTION-PLIST| ++ PCL::FUNCALLABLE-STANDARD-INSTANCE-ACCESS ++ PCL::DFUN-INFO-WRAPPER1 PCL::INVOKE-FAST-METHOD-CALL)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::*) ++ PCL::COMPILE-LAMBDA PCL::COERCE-TO-CLASS + PCL::MAKE-METHOD-FUNCTION-INTERNAL +- PCL::MAKE-FINAL-DFUN-INTERNAL WALKER::MACROEXPAND-ALL +- COMMON-LISP::ENSURE-GENERIC-FUNCTION +- PCL::MAKE-METHOD-LAMBDA-INTERNAL PCL::MAKE-CONSTANT-VALUE-DFUN +- PCL::GET-FUNCTION PCL::EXTRACT-DECLARATIONS +- PCL::COERCE-TO-CLASS PCL::PARSE-METHOD-OR-SPEC +- PCL::DISPATCH-DFUN-COST PCL::PARSE-SPECIALIZED-LAMBDA-LIST +- PCL::MAP-ALL-CLASSES PCL::COMPILE-LAMBDA PCL::ENSURE-CLASS +- PCL::GET-METHOD-FUNCTION WALKER::WALK-FORM +- PCL::ALLOCATE-STRUCTURE-INSTANCE PCL::GET-FUNCTION1 ++ PCL::MAKE-CONSTANT-VALUE-DFUN PCL::GET-FUNCTION + PCL::MAKE-CACHING-DFUN PCL::MAKE-INSTANCE-1 +- PCL::GET-DFUN-CONSTRUCTOR)) ++ PCL::MAKE-FINAL-DFUN-INTERNAL WALKER::MACROEXPAND-ALL ++ COMMON-LISP::ENSURE-GENERIC-FUNCTION PCL::MAP-ALL-CLASSES ++ PCL::GET-METHOD-FUNCTION PCL::MAKE-METHOD-LAMBDA-INTERNAL ++ PCL::PARSE-SPECIALIZED-LAMBDA-LIST PCL::GET-FUNCTION1 ++ WALKER::WALK-FORM PCL::ALLOCATE-STRUCTURE-INSTANCE ++ PCL::ENSURE-CLASS PCL::GET-DFUN-CONSTRUCTOR ++ PCL::EXTRACT-DECLARATIONS PCL::DISPATCH-DFUN-COST ++ PCL::PARSE-METHOD-OR-SPEC)) + (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::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ PCL::SDFUN-FOR-CACHING PCL::SAUT-AND PCL::EMIT-CHECKING ++ PCL::SPLIT-DECLARATIONS ++ PCL::COMPUTE-APPLICABLE-METHODS-USING-TYPES PCL::COMPUTE-CODE ++ PCL::*SUBTYPEP ITERATE::PARSE-DECLARATIONS ++ PCL::GENERATE-FAST-CLASS-SLOT-ACCESS-P ++ PCL::SLOT-NAME-LISTS-FROM-SLOTS COMMON-LISP::SLOT-VALUE ++ PCL::COMPUTE-STD-CPL-PHASE-1 PCL::SAUT-CLASS ++ PCL::FORM-LIST-TO-LISP PCL::INITIAL-DFUN ++ PCL::FIND-SUPERCLASS-CHAIN PCL::EMIT-CACHING PCL::SAUT-NOT ++ PCL::CHECK-INITARGS-VALUES PCL::REAL-REMOVE-METHOD ++ PCL::CPL-INCONSISTENT-ERROR COMMON-LISP::SLOT-BOUNDP ++ PCL::SPECIALIZER-APPLICABLE-USING-TYPE-P ++ PCL::MAKE-INSTANCE-FUNCTION-TRAP PCL::SAUT-CLASS-EQ ++ PCL::SLOT-UNBOUND-INTERNAL PCL::SAUT-PROTOTYPE ++ PCL::CPL-FORWARD-REFERENCED-CLASS-ERROR ++ PCL::GET-NEW-FUNCTION-GENERATOR-INTERNAL ++ PCL::EMIT-DEFAULT-ONLY PCL::CLASS-APPLICABLE-USING-CLASS-P ++ PCL::COMPUTE-TEST PCL::MUTATE-SLOTS-AND-CALLS ++ PCL::EMIT-DEFAULT-ONLY-FUNCTION PCL::ENSURE-CLASS-VALUES ++ PCL::INVOKE-EMF COMMON-LISP::SLOT-MAKUNBOUND ++ PCL::MAKE-DIRECT-SLOTD PCL::INSURE-DFUN PCL::SET-FUNCTION-NAME ++ PCL::DESTRUCTURE PCL::SAUT-EQL PCL::UPDATE-SLOT-VALUE-GF-INFO)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +- (COMMON-LISP::VECTOR COMMON-LISP::CHARACTER +- COMMON-LISP::*)) +- PCL::CAPITALIZE-WORDS)) ++ COMMON-LISP::T) ++ WALKER::RELIST* PCL::UPDATE-DFUN ++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE PCL::MAKE-SPECIALIZABLE ++ PCL::TRACE-METHOD PCL::ALLOCATE-STANDARD-INSTANCE ++ WALKER::RELIST COMMON-LISP::FIND-CLASS PCL::MAKE-WRAPPER ++ PCL::PV-TABLE-LOOKUP-PV-ARGS ITERATE::FUNCTION-LAMBDA-P ++ PCL::SET-DFUN PCL::EARLY-METHOD-SPECIALIZERS ++ WALKER::WALKER-ENVIRONMENT-BIND-1 ++ PCL::INITIALIZE-METHOD-FUNCTION PCL::MAKE-TYPE-PREDICATE-NAME ++ PCL::MAKE-FINAL-DFUN PCL::FIND-CLASS-CELL ++ PCL::INITIALIZE-INTERNAL-SLOT-GFS PCL::MAKE-EARLY-GF ++ PCL::USE-DISPATCH-DFUN-P ITERATE::MAYBE-WARN ++ PCL::USE-CONSTANT-VALUE-DFUN-P PCL::FIND-CLASS-PREDICATE ++ PCL::SET-ARG-INFO PCL::CAPITALIZE-WORDS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +- PCL::ALLOCATE-FUNCALLABLE-INSTANCE-1 PCL::SHOW-EMF-CALL-TRACE +- PCL::CACHES-TO-ALLOCATE PCL::MAKE-CACHE +- PCL::SHOW-FREE-CACHE-VECTORS PCL::MAKE-ARG-INFO +- PCL::NO-METHODS-DFUN-INFO PCL::STRUCTURE-FUNCTIONS-EXIST-P +- PCL::INITIALIZE-CHECKING-OR-CACHING-FUNCTION-LIST +- PCL::BOOTSTRAP-BUILT-IN-CLASSES +- PCL::%%ALLOCATE-INSTANCE--CLASS PCL::DISPATCH-DFUN-INFO +- PCL::INITIAL-DISPATCH-DFUN-INFO PCL::BOOTSTRAP-META-BRAID +- PCL::UPDATE-DISPATCH-DFUNS PCL::LIST-ALL-DFUNS +- PCL::DEFAULT-METHOD-ONLY-DFUN-INFO PCL::RENEW-SYS-FILES +- PCL::IN-THE-COMPILER-P PCL::GET-EFFECTIVE-METHOD-GENSYM +- PCL::MAKE-CPD PCL::INITIAL-DFUN-INFO +- PCL::SHOW-DFUN-CONSTRUCTORS +- PCL::ALLOCATE-FUNCALLABLE-INSTANCE-2)) ++ (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::*) COMMON-LISP::FIXNUM) +- PCL::ZERO)) ++ (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::STREAM COMMON-LISP::T) +- COMMON-LISP::T) +- PCL::PRINT-DFUN-INFO)) ++ (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::OR PCL::CACHE COMMON-LISP::NULL)) ++ PCL::PV-TABLE-CACHE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -412,70 +1019,11 @@ + PCL::COMPUTE-CACHE-PARAMETERS)) + (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::T COMMON-LISP::*) +- COMMON-LISP::T) +- PCL::MAKE-FINAL-DFUN PCL::SET-ARG-INFO PCL::TRACE-METHOD +- PCL::MAKE-SPECIALIZABLE WALKER::WALKER-ENVIRONMENT-BIND-1 +- ITERATE::FUNCTION-LAMBDA-P COMMON-LISP::FIND-CLASS +- PCL::MAKE-WRAPPER PCL::UPDATE-DFUN +- PCL::MAKE-TYPE-PREDICATE-NAME PCL::PV-TABLE-LOOKUP-PV-ARGS +- PCL::USE-CONSTANT-VALUE-DFUN-P WALKER::RELIST +- PCL::MAKE-EARLY-GF PCL::INITIALIZE-METHOD-FUNCTION +- PCL::FIND-CLASS-CELL PCL::USE-DISPATCH-DFUN-P +- PCL::FIND-CLASS-PREDICATE PCL::ALLOCATE-STANDARD-INSTANCE +- PCL::INITIALIZE-INTERNAL-SLOT-GFS ITERATE::MAYBE-WARN +- PCL::ALLOCATE-FUNCALLABLE-INSTANCE +- PCL::EARLY-METHOD-SPECIALIZERS WALKER::RELIST* PCL::SET-DFUN)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::*) +- PCL::SLOT-UNBOUND-INTERNAL ITERATE::PARSE-DECLARATIONS +- PCL::EMIT-CACHING PCL::COMPUTE-STD-CPL-PHASE-1 +- PCL::INITIAL-DFUN PCL::INSURE-DFUN PCL::EMIT-CHECKING +- PCL::COMPUTE-TEST PCL::COMPUTE-CODE PCL::MAKE-DIRECT-SLOTD +- PCL::SAUT-CLASS COMMON-LISP::SLOT-MAKUNBOUND +- PCL::CPL-FORWARD-REFERENCED-CLASS-ERROR PCL::INVOKE-EMF +- PCL::*SUBTYPEP PCL::SPECIALIZER-APPLICABLE-USING-TYPE-P +- PCL::COMPUTE-APPLICABLE-METHODS-USING-TYPES +- PCL::REAL-REMOVE-METHOD PCL::SAUT-PROTOTYPE +- PCL::MUTATE-SLOTS-AND-CALLS PCL::FIND-SUPERCLASS-CHAIN +- COMMON-LISP::SLOT-BOUNDP PCL::FORM-LIST-TO-LISP +- PCL::CPL-INCONSISTENT-ERROR PCL::EMIT-DEFAULT-ONLY-FUNCTION +- PCL::ENSURE-CLASS-VALUES PCL::CHECK-INITARGS-VALUES +- PCL::SAUT-EQL PCL::SPLIT-DECLARATIONS +- PCL::UPDATE-SLOT-VALUE-GF-INFO PCL::SAUT-AND +- PCL::SLOT-NAME-LISTS-FROM-SLOTS +- PCL::MAKE-INSTANCE-FUNCTION-TRAP PCL::EMIT-DEFAULT-ONLY +- PCL::SAUT-NOT PCL::SAUT-CLASS-EQ COMMON-LISP::SLOT-VALUE +- PCL::DESTRUCTURE PCL::GENERATE-FAST-CLASS-SLOT-ACCESS-P +- PCL::GET-NEW-FUNCTION-GENERATOR-INTERNAL +- PCL::CLASS-APPLICABLE-USING-CLASS-P PCL::SDFUN-FOR-CACHING +- PCL::SET-FUNCTION-NAME)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) +- PCL::ARG-INFO-NUMBER-REQUIRED PCL::CACHING-LIMIT-FN +- PCL::PV-CACHE-LIMIT-FN PCL::ONE-INDEX-LIMIT-FN +- PCL::PV-TABLE-PV-SIZE PCL::CACHE-COUNT PCL::DEFAULT-LIMIT-FN +- PCL::CPD-COUNT PCL::CHECKING-LIMIT-FN +- PCL::N-N-ACCESSORS-LIMIT-FN PCL::EARLY-CLASS-SIZE +- 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::FIXNUM COMMON-LISP::*) + COMMON-LISP::T) +- PCL::GET-CACHE-FROM-CACHE)) ++ PCL::GET-CACHE-FROM-CACHE ++ PCL::COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -484,544 +1032,81 @@ + PCL::COMPUTE-PRIMARY-CACHE-LOCATION)) + (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::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::T) +- COMMON-LISP::T) +- PCL::|(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| +- WALKER::WALK-TEMPLATE PCL::|(FAST-METHOD PRINT-OBJECT (T T))| +- WALKER::WALK-DO/DO* PCL::LOAD-PRECOMPILED-DFUN-CONSTRUCTOR +- PCL::|(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| +- WALKER::WALK-LET/LET* +- PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| +- PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| +- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-TYPE +- PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| +- PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| +- PCL::|(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| +- PCL::INITIALIZE-INSTANCE-SIMPLE +- PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| +- PCL::EXPAND-SYMBOL-MACROLET-INTERNAL +- PCL::|(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| +- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION1 +- PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| +- PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| +- PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +- PCL::|(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| +- PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +- PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +- PCL::|(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| +- PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +- PCL::|(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +- PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| +- PCL::|(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| +- PCL::|(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| +- PCL::|(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| +- PCL::|(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| +- PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| +- PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| +- PCL::|(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| +- PCL::|(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| +- PCL::MAKE-DISPATCH-LAMBDA +- PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| +- PCL::EXPAND-DEFCLASS +- PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| +- PCL::|(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| +- PCL::OPTIMIZE-WRITER +- PCL::|(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| +- PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| +- PCL::|(FAST-METHOD DOCUMENTATION (T))| +- PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| +- PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| +- PCL::OPTIMIZE-READER WALKER::WALK-PROG/PROG* +- PCL::BOOTSTRAP-SET-SLOT +- PCL::EMIT-CHECKING-OR-CACHING-FUNCTION-PRELIMINARY +- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| +- PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +- PCL::TWO-CLASS-DFUN-INFO +- PCL::|(FAST-METHOD MAKE-INSTANCE (CLASS))| +- PCL::|(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +- PCL::ADJUST-CACHE +- PCL::|(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| +- PCL::|(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| +- PCL::EXPAND-CACHE +- PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| +- PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| +- PCL::|(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| +- PCL::|(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| +- PCL::|(FAST-METHOD PRINT-OBJECT (CLASS T))| +- PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| +- PCL::|(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +- PCL::|(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +- PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| +- PCL::|(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| +- PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| +- PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| +- PCL::|(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| +- PCL::GET-WRAPPERS-FROM-CLASSES +- PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| +- PCL::MAYBE-EXPAND-ACCESSOR-FORM WALKER::WALK-BINDINGS-2 +- PCL::FILL-CACHE-P PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-INTERNAL +- PCL::|(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| +- PCL::|(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| +- PCL::|(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| +- PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| +- PCL::LOAD-PRECOMPILED-IIS-ENTRY PCL::MEMF-TEST-CONVERTER +- PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))|)) +-(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::REAL-ADD-NAMED-METHOD PCL::EARLY-ADD-NAMED-METHOD +- PCL::FILL-DFUN-CACHE)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::T) +- PCL::OBSOLETE-INSTANCE-TRAP +- PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| +- WALKER::WALK-TAGBODY +- PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| +- PCL::ENTRY-IN-CACHE-P WALKER::WALK-COMPILER-LET +- PCL::|(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| +- PCL::NOTE-PV-TABLE-REFERENCE PCL::COMPUTE-EFFECTIVE-METHOD +- PCL::MAKE-DFUN-CALL PCL::|SETF PCL PLIST-VALUE| +- PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| +- PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| +- PCL::|(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| +- PCL::|(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +- WALKER::WALK-UNEXPECTED-DECLARE +- PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL +- PCL::SKIP-FAST-SLOT-ACCESS-P PCL::SET-FUNCTION-NAME-1 +- WALKER::WALK-DO PCL::EMIT-1-T-DLAP PCL::PRINT-STD-INSTANCE +- PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| +- WALKER::WALK-LAMBDA PCL::MAKE-METHOD-SPEC +- PCL::|(FAST-METHOD CLASS-PREDICATE-NAME (T))| +- PCL::|(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| +- PCL::OPTIMIZE-SET-SLOT-VALUE +- PCL::MAKE-OPTIMIZED-STD-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +- PCL::EXPAND-DEFGENERIC WALKER::VARIABLE-DECLARATION +- ITERATE::RENAME-AND-CAPTURE-VARIABLES +- PCL::|(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| +- PCL::MAP-ALL-ORDERS +- PCL::|(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| +- PCL::DECLARE-STRUCTURE WALKER::WALK-PROG +- PCL::|(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| +- PCL::OPTIMIZE-SLOT-VALUE WALKER::WALK-MULTIPLE-VALUE-BIND +- PCL::|(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| +- PCL::STANDARD-COMPUTE-EFFECTIVE-METHOD WALKER::WALK-LOCALLY +- PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| +- WALKER::WALK-DO* +- PCL::|(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| +- PCL::MAKE-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +- PCL::EMIT-BOUNDP-CHECK WALKER::RECONS +- PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| +- PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| +- WALKER::WALK-LET* WALKER::WALK-TAGBODY-1 PCL::FLUSH-CACHE-TRAP +- WALKER::WALK-FLET +- PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| +- PCL::|(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| +- PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| +- PCL::PRINT-CACHE +- PCL::|(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| +- PCL::INVALIDATE-WRAPPER PCL::GET-NEW-FUNCTION-GENERATOR +- ITERATE::OPTIMIZE-ITERATE-FORM WALKER::RELIST-INTERNAL +- PCL::CAN-OPTIMIZE-ACCESS PCL::MAKE-TOP-LEVEL-FORM +- PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| +- WALKER::WALK-MULTIPLE-VALUE-SETQ WALKER::WALK-LABELS +- PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| +- PCL::|(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| +- PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| +- WALKER::WALK-SETQ WALKER::WALK-LET +- PCL::|SETF PCL METHOD-FUNCTION-GET| WALKER::WALK-IF +- PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| +- ITERATE::SIMPLE-EXPAND-GATHERING-FORM +- PCL::|(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| +- WALKER::WALK-NAMED-LAMBDA PCL::FIRST-FORM-TO-LISP +- PCL::ONE-CLASS-DFUN-INFO +- WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL +- PCL::EMIT-GREATER-THAN-1-DLAP PCL::CONVERT-TABLE +- PCL::|(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| +- PCL::INITIALIZE-INTERNAL-SLOT-GFS* +- ITERATE::OPTIMIZE-GATHERING-FORM +- PCL::|(FAST-METHOD SPECIALIZER-CLASS (CLASS))| +- PCL::OPTIMIZE-SLOT-BOUNDP +- PCL::|(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| +- PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| +- PCL::WRAP-METHOD-GROUP-SPECIFIER-BINDINGS +- WALKER::WALK-SYMBOL-MACROLET ITERATE::VARIABLE-SAME-P +- PCL::EMIT-SLOT-READ-FORM +- PCL::SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P +- PCL::|(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| +- PCL::GET-FUNCTION-GENERATOR +- PCL::MAKE-OPTIMIZED-STD-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION +- PCL::FIX-SLOT-ACCESSORS +- PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| +- PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| +- PCL::OPTIMIZE-GF-CALL-INTERNAL +- PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| +- PCL::|(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| +- PCL::|(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| +- PCL::|(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| +- PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| +- PCL::|(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +- WALKER::WALK-PROG* PCL::ONE-INDEX-DFUN-INFO +- PCL::COMPUTE-PRECEDENCE PCL::TRACE-EMF-CALL-INTERNAL +- WALKER::WALK-MACROLET)) +-(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::MAKE-DEFMETHOD-FORM-INTERNAL PCL::LOAD-DEFMETHOD +- PCL::EARLY-MAKE-A-METHOD PCL::MAKE-DEFMETHOD-FORM)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::T) +- PCL::GET-EFFECTIVE-METHOD-FUNCTION1 +- PCL::ENSURE-GENERIC-FUNCTION-USING-CLASS +- PCL::MAKE-EMF-FROM-METHOD +- PCL::REAL-ENSURE-GF-USING-CLASS--NULL PCL::PROBE-CACHE +- PCL::MAP-CACHE PCL::GET-DECLARATION +- PCL::REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION +- WALKER::CONVERT-MACRO-TO-LAMBDA +- PCL::EXPAND-EFFECTIVE-METHOD-FUNCTION PCL::EMIT-MISS +- PCL::GET-METHOD-FUNCTION-PV-CELL PCL::METHOD-FUNCTION-GET +- PCL::FIND-CLASS-FROM-CELL PCL::RECORD-DEFINITION +- PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION1 +- PCL::FIND-CLASS-PREDICATE-FROM-CELL +- PCL::NAMED-OBJECT-PRINT-FUNCTION +- PCL::PRECOMPUTE-EFFECTIVE-METHODS PCL::INITIALIZE-INFO +- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE)) +-(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::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| +- PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL1 +- PCL::GET-MAKE-INSTANCE-FUNCTION-INTERNAL +- PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS1 PCL::MAKE-EMF-CACHE +- PCL::|(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| +- PCL::MAKE-FGEN +- PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| +- PCL::BOOTSTRAP-MAKE-SLOT-DEFINITIONS +- PCL::|(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| +- PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- PCL::OPTIMIZE-ACCESSOR-CALL +- PCL::MAKE-INSTANCE-FUNCTION-COMPLEX PCL::UPDATE-SLOTS-IN-PV +- PCL::COMPUTE-PV-SLOT +- PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| +- PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| +- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| +- PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T T))| +- PCL::OPTIMIZE-INSTANCE-ACCESS +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| +- PCL::MAKE-INSTANCE-FUNCTION-SIMPLE +- PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- PCL::OPTIMIZE-GENERIC-FUNCTION-CALL +- PCL::LOAD-FUNCTION-GENERATOR WALKER::WALK-BINDINGS-1 +- PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| +- PCL::REAL-MAKE-METHOD-INITARGS-FORM +- PCL::|(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| +- PCL::|(FAST-METHOD REMOVE-NAMED-METHOD (T T))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| +- WALKER::WALK-TEMPLATE-HANDLE-REPEAT +- PCL::MAKE-PARAMETER-REFERENCES +- PCL::|(FAST-METHOD SLOT-UNBOUND (T T T))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| +- PCL::EXPAND-EMF-CALL-METHOD +- PCL::|(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| +- PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| +- 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::|(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| +- PCL::MAKE-FINAL-ORDINARY-DFUN-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::GET-METHOD WALKER::WALK-ARGLIST PCL::REAL-GET-METHOD +- PCL::EMIT-FETCH-WRAPPER PCL::CHECK-INITARGS-2-LIST +- PCL::FILL-CACHE PCL::CHECK-INITARGS-2-PLIST PCL::MAKE-EMF-CALL +- PCL::CHECK-INITARGS-1 PCL::CAN-OPTIMIZE-ACCESS1)) +-(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::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) ++ PCL::EMIT-N-N-WRITERS PCL::COUNT-ALL-DFUNS ++ PCL::EMIT-N-N-READERS)) + (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::REAL-LOAD-DEFCLASS PCL::LOAD-DEFCLASS PCL::SET-ARG-INFO1 +- PCL::BOOTSTRAP-MAKE-SLOT-DEFINITION PCL::EMIT-SLOT-ACCESS +- WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1 PCL::OPTIMIZE-GF-CALL +- PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- PCL::MAKE-EARLY-CLASS-DEFINITION)) ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++ PCL::GET-EFFECTIVE-METHOD-GENSYM PCL::RENEW-SYS-FILES ++ PCL::UPDATE-DISPATCH-DFUNS PCL::IN-THE-COMPILER-P ++ PCL::SHOW-FREE-CACHE-VECTORS PCL::BOOTSTRAP-BUILT-IN-CLASSES ++ PCL::MAKE-CACHE PCL::ALLOCATE-FUNCALLABLE-INSTANCE-2 ++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE-1 ++ PCL::STRUCTURE-FUNCTIONS-EXIST-P PCL::NO-METHODS-DFUN-INFO ++ PCL::SHOW-EMF-CALL-TRACE PCL::INITIAL-DFUN-INFO ++ PCL::DISPATCH-DFUN-INFO PCL::MAKE-ARG-INFO ++ PCL::INITIALIZE-CHECKING-OR-CACHING-FUNCTION-LIST ++ PCL::%%ALLOCATE-INSTANCE--CLASS ++ PCL::INITIAL-DISPATCH-DFUN-INFO PCL::CACHES-TO-ALLOCATE ++ PCL::MAKE-CPD PCL::LIST-ALL-DFUNS PCL::SHOW-DFUN-CONSTRUCTORS ++ PCL::BOOTSTRAP-META-BRAID PCL::DEFAULT-METHOD-ONLY-DFUN-INFO)) + (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::GET-CACHE PCL::FILL-CACHE-FROM-CACHE-P)) ++ (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::FIXNUM COMMON-LISP::*) +- COMMON-LISP::FIXNUM) +- PCL::COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION)) ++ (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::T) +- PCL::EVAL-FORM PCL::EARLY-CLASS-NAME-OF PCL::DFUN-INFO-CACHE +- PCL::MAKE-CONSTANT-FUNCTION PCL::EXPAND-SHORT-DEFCOMBIN +- PCL::COPY-CACHE PCL::PROCLAIM-INCOMPATIBLE-SUPERCLASSES +- PCL::MAKE-INITIAL-DFUN PCL::ECD-METACLASS +- PCL::EXTRACT-SPECIALIZER-NAMES PCL::GBOUNDP +- PCL::GET-SETF-FUNCTION-NAME PCL::USE-CACHING-DFUN-P +- PCL::INITIALIZE-INFO-CACHED-CONSTANTS +- PCL::STRUCTURE-TYPE-INTERNAL-SLOTDS COMMON-LISP::CLASS-OF +- PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-NIL-FUNCTION +- PCL::ARG-INFO-KEY/REST-P PCL::METHOD-CALL-CALL-METHOD-ARGS +- PCL::FGEN-GENSYMS PCL::EARLY-CLASS-PRECEDENCE-LIST +- PCL::EARLY-SLOT-DEFINITION-LOCATION +- PCL::EXPAND-MAKE-INSTANCE-FORM PCL::INTERN-EQL-SPECIALIZER +- PCL::METHOD-FUNCTION-METHOD PCL::FGEN-GENERATOR-LAMBDA +- PCL::SLOT-READER-SYMBOL PCL::CACHING-P +- PCL::EARLY-METHOD-QUALIFIERS +- PCL::EARLY-COLLECT-DEFAULT-INITARGS PCL::KEYWORD-SPEC-NAME +- PCL::ONE-INDEX-P PCL::COMPLICATED-INSTANCE-CREATION-METHOD +- PCL::DFUN-ARG-SYMBOL PCL::N-N-CACHE +- PCL::ONE-INDEX-DFUN-INFO-INDEX PCL::INITIAL-DISPATCH-CACHE +- PCL::CPD-CLASS PCL::FAST-METHOD-CALL-ARG-INFO +- PCL::MAKE-PV-TYPE-DECLARATION PCL::COMPUTE-STD-CPL-PHASE-2 +- PCL::GET-BUILT-IN-CLASS-SYMBOL +- PCL::INITIALIZE-INFO-CACHED-RI-VALID-P +- PCL::UPDATE-GFS-OF-CLASS PCL::STRUCTURE-SVUC-METHOD +- PCL::SLOT-BOUNDP-SYMBOL PCL::FGEN-SYSTEM +- PCL::FIND-CYCLE-REASONS ITERATE::SEQUENCE-ACCESSOR +- PCL::GF-INFO-C-A-M-EMF-STD-P PCL::STRUCTURE-TYPE-P +- PCL::TWO-CLASS-CACHE PCL::METHOD-LL->GENERIC-FUNCTION-LL +- PCL::ONE-CLASS-ACCESSOR-TYPE PCL::WRAPPER-FOR-STRUCTURE +- PCL::ACCESSOR-DFUN-INFO-CACHE PCL::%SYMBOL-FUNCTION +- PCL::STRUCTURE-TYPE PCL::NET-TEST-CONVERTER +- PCL::CONSTANT-SYMBOL-P PCL::GMAKUNBOUND PCL::INITIAL-P +- PCL::GF-DFUN-CACHE PCL::STRUCTURE-SLOTD-TYPE +- PCL::%STD-INSTANCE-WRAPPER PCL::INITIALIZE-INFO-P +- PCL::CACHING-DFUN-INFO +- PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +- PCL::FAST-METHOD-CALL-P PCL::GF-DFUN-INFO +- PCL::INITIALIZE-INFO-BOUND-SLOTS PCL::ECD-CLASS-NAME +- PCL::MAKE-INSTANCE-FUNCTION-SYMBOL +- PCL::INITIALIZE-INFO-CACHED-DEFAULT-INITARGS-FUNCTION +- PCL::STD-INSTANCE-P PCL::EXTRACT-PARAMETERS +- WALKER::GET-WALKER-TEMPLATE PCL::SYMBOL-PKG-NAME +- PCL::CCLOSUREP PCL::LOOKUP-FGEN PCL::CPD-SUPERS +- PCL::ARG-INFO-KEYWORDS PCL::DISPATCH-P +- PCL::INITIALIZE-INFO-CACHED-NEW-KEYS +- PCL::MAKE-CALLS-TYPE-DECLARATION PCL::INITIALIZE-INFO-WRAPPER +- PCL::%FBOUNDP PCL::DEFAULT-STRUCTURE-INSTANCE-P +- WALKER::ENV-WALK-FORM PCL::EARLY-CLASS-DEFINITION +- PCL::SORT-CALLS PCL::EARLY-METHOD-STANDARD-ACCESSOR-SLOT-NAME +- PCL::DISPATCH-CACHE PCL::INITIALIZE-INFO-KEY +- PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION +- PCL::ARG-INFO-METATYPES PCL::GF-LAMBDA-LIST +- WALKER::ENV-LEXICAL-VARIABLES PCL::ACCESSOR-DFUN-INFO-P +- PCL::GF-PRECOMPUTE-DFUN-AND-EMF-P PCL::COMPUTE-LINE-SIZE +- PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-T-FUNCTION +- PCL::FORCE-CACHE-FLUSHES PCL::TWO-CLASS-P PCL::DFUN-INFO-P +- PCL::MAP-SPECIALIZERS PCL::MAKE-PERMUTATION-VECTOR +- WALKER::ENV-LOCK PCL::CPD-AFTER PCL::EARLY-CLASS-SLOTS +- PCL::GET-PV-CELL-FOR-CLASS PCL::ARG-INFO-P +- PCL::EXTRACT-REQUIRED-PARAMETERS +- PCL::STRUCTURE-SLOTD-READER-FUNCTION PCL::COMPUTE-CLASS-SLOTS +- PCL::INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS +- PCL::TWO-CLASS-WRAPPER0 +- PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION-SYMBOL +- PCL::COMPILE-LAMBDA-UNCOMPILED PCL::EARLY-CLASS-NAME +- PCL::SFUN-P PCL::EXTRACT-LAMBDA-LIST PCL::UNDEFMETHOD-1 +- PCL::ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE PCL::WRAPPER-OF +- PCL::ARG-INFO-LAMBDA-LIST PCL::LIST-DFUN +- PCL::NEXT-WRAPPER-FIELD PCL::CHECK-WRAPPER-VALIDITY +- PCL::STRUCTURE-SLOTD-NAME PCL::BUILT-IN-WRAPPER-OF +- PCL::GET-MAKE-INSTANCE-FUNCTIONS +- PCL::GENERIC-CLOBBERS-FUNCTION PCL::NO-METHODS-P +- PCL::CONSTANT-VALUE-P WALKER::ENV-WALK-FUNCTION +- PCL::INITIAL-CACHE PCL::SLOT-INITARGS-FROM-STRUCTURE-SLOTD +- PCL::MAKE-CLASS-EQ-PREDICATE +- PCL::GET-MAKE-INSTANCE-FUNCTION-SYMBOL +- PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS +- PCL::FUNCTION-PRETTY-ARGLIST +- PCL::MAKE-OPTIMIZED-STRUCTURE-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +- PCL::FTYPE-DECLARATION-FROM-LAMBDA-LIST PCL::TYPE-CLASS +- PCL::CHECK-CACHE PCL::STANDARD-SVUC-METHOD +- PCL::STRUCTURE-SLOTD-ACCESSOR-SYMBOL PCL::GF-INFO-FAST-MF-P +- PCL::STRUCTURE-SLOTD-WRITER-FUNCTION +- PCL::BOOTSTRAP-CLASS-PREDICATES PCL::DEFAULT-METHOD-ONLY-CACHE +- PCL::GET-CACHE-VECTOR PCL::SLOT-WRITER-SYMBOL +- PCL::FGEN-GENERATOR PCL::DNET-METHODS-P +- PCL::DEFAULT-STRUCTURE-TYPE +- PCL::INITIALIZE-INFO-CACHED-COMBINED-INITARGS-FORM-LIST +- PCL::N-N-ACCESSOR-TYPE +- PCL::STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST +- WALKER::ENV-DECLARATIONS WALKER::VARIABLE-GLOBALLY-SPECIAL-P +- PCL::ONE-INDEX-INDEX PCL::ONE-INDEX-DFUN-INFO-CACHE +- PCL::EARLY-ACCESSOR-METHOD-SLOT-NAME PCL::EARLY-CLASS-SLOTDS +- PCL::CANONICAL-SLOT-NAME PCL::EARLY-COLLECT-CPL +- PCL::RESET-CLASS-INITIALIZE-INFO-1 +- PCL::BUILT-IN-OR-STRUCTURE-WRAPPER1 PCL::ONE-INDEX-CACHE +- PCL::MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION +- PCL::MAKE-TYPE-PREDICATE PCL::FREE-CACHE +- ITERATE::VARIABLES-FROM-LET +- PCL::EARLY-METHOD-STANDARD-ACCESSOR-P +- PCL::DEFAULT-CONSTANT-CONVERTER PCL::CLASS-PREDICATE +- PCL::CHECKING-CACHE PCL::ARG-INFO-PRECEDENCE +- PCL::METHOD-FUNCTION-NEEDS-NEXT-METHODS-P +- PCL::DEFAULT-METHOD-ONLY-P +- PCL::COMPUTE-APPLICABLE-METHODS-EMF-STD-P +- PCL::STRUCTURE-SLOT-BOUNDP PCL::ONE-INDEX-ACCESSOR-TYPE +- PCL::TWO-CLASS-ACCESSOR-TYPE +- PCL::USE-DEFAULT-METHOD-ONLY-DFUN-P PCL::METHOD-CALL-P +- PCL::UPDATE-CLASS-CAN-PRECEDE-P PCL::CONSTANT-VALUE-DFUN-INFO +- PCL::COMPILE-LAMBDA-DEFERRED PCL::SETFBOUNDP +- PCL::CLASS-HAS-A-FORWARD-REFERENCED-SUPERCLASS-P +- PCL::PV-TABLEP PCL::STRUCTURE-OBJECT-P PCL::TWO-CLASS-INDEX +- PCL::METHOD-FUNCTION-PV-TABLE PCL::ECD-OTHER-INITARGS +- WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE +- PCL::EARLY-GF-P PCL::STRUCTURE-SLOTD-INIT-FORM +- PCL::FUNCALLABLE-INSTANCE-P PCL::CHECKING-FUNCTION +- PCL::FUNCTION-RETURNING-NIL PCL::FUNCTION-RETURNING-T +- PCL::UPDATE-C-A-M-GF-INFO PCL::COUNT-DFUN +- PCL::UNPARSE-SPECIALIZERS PCL::CACHE-OWNER +- PCL::EARLY-METHOD-CLASS +- PCL::INITIALIZE-INFO-CACHED-COMBINED-INITIALIZE-FUNCTION +- PCL::EARLY-SLOT-DEFINITION-NAME +- PCL::GET-MAKE-INSTANCE-FUNCTION +- PCL::STRUCTURE-TYPE-INCLUDED-TYPE-NAME +- PCL::ECD-SUPERCLASS-NAMES PCL::GFS-OF-TYPE PCL::SORT-SLOTS +- PCL::DO-STANDARD-DEFSETFS-FOR-DEFCLASS +- PCL::COMPUTE-MCASE-PARAMETERS PCL::METHOD-FUNCTION-PLIST +- PCL::ARG-INFO-NKEYS PCL::FINAL-ACCESSOR-DFUN-TYPE +- PCL::EARLY-COLLECT-SLOTS PCL::EARLY-METHOD-LAMBDA-LIST +- PCL::FAST-INSTANCE-BOUNDP-P PCL::GDEFINITION +- PCL::%CCLOSURE-ENV SYSTEM::%COMPILED-FUNCTION-NAME +- PCL::RESET-INITIALIZE-INFO PCL::ARG-INFO-NUMBER-OPTIONAL +- PCL::RESET-CLASS-INITIALIZE-INFO +- PCL::INITIALIZE-INFO-CACHED-VALID-P PCL::INTERNED-SYMBOL-P +- PCL::EARLY-GF-NAME PCL::FGEN-TEST PCL::MAKE-INITFUNCTION +- PCL::MAP-ALL-GENERIC-FUNCTIONS PCL::SHOW-DFUN-COSTS +- PCL::CLASS-FROM-TYPE PCL::EXPAND-LONG-DEFCOMBIN +- PCL::MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION +- PCL::FREE-CACHE-VECTOR PCL::%STD-INSTANCE-SLOTS +- PCL::ALLOCATE-CACHE-VECTOR PCL::ONE-CLASS-P +- PCL::CLASS-PRECEDENCE-DESCRIPTION-P PCL::SLOT-VECTOR-SYMBOL +- PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION +- PCL::ONE-CLASS-WRAPPER0 PCL::N-N-P +- PCL::UPDATE-ALL-C-A-M-GF-INFO PCL::CHECKING-P +- PCL::TWO-CLASS-WRAPPER1 PCL::PARSE-SPECIALIZERS +- PCL::FORMAT-CYCLE-REASONS PCL::FLUSH-CACHE-VECTOR-INTERNAL +- PCL::UNENCAPSULATED-FDEFINITION PCL::ONE-CLASS-INDEX +- PCL::DEFAULT-CONSTANTP PCL::UPDATE-GF-INFO +- PCL::ACCESSOR-DFUN-INFO-ACCESSOR-TYPE +- PCL::INITIALIZE-INFO-CACHED-INITARGS-FORM-LIST +- PCL::MAKE-EQL-PREDICATE PCL::ARG-INFO-VALID-P +- PCL::CACHING-CACHE PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION +- PCL::FAST-METHOD-CALL-NEXT-METHOD-CALL +- PCL::DEFAULT-SECONDARY-DISPATCH-FUNCTION +- PCL::MAKE-FUNCTION-INLINE PCL::STORE-FGEN +- PCL::LIST-LARGE-CACHE PCL::METHODS-CONTAIN-EQL-SPECIALIZER-P +- PCL::ARG-INFO-APPLYP SYSTEM::%STRUCTURE-NAME +- PCL::GF-INFO-SIMPLE-ACCESSOR-TYPE PCL::ECD-SOURCE +- PCL::EARLY-CLASS-DIRECT-SUBCLASSES +- PCL::UPDATE-PV-TABLE-CACHE-INFO PCL::DEFAULT-TEST-CONVERTER +- PCL::MAKE-CALL-METHODS PCL::GET-BUILT-IN-WRAPPER-SYMBOL +- PCL::GF-INFO-STATIC-C-A-M-EMF PCL::DEFAULT-STRUCTUREP +- PCL::CONSTANT-VALUE-CACHE PCL::INITIAL-DISPATCH-P +- PCL::ECD-CANONICAL-SLOTS PCL::WRAPPER-FIELD +- PCL::UPDATE-GF-SIMPLE-ACCESSOR-TYPE PCL::ONE-CLASS-CACHE +- PCL::CACHING-DFUN-COST PCL::LEGAL-CLASS-NAME-P +- PCL::INTERN-FUNCTION-NAME PCL::FAST-METHOD-CALL-PV-CELL +- PCL::CACHE-P PCL::ONE-INDEX-DFUN-INFO-P +- PCL::MAKE-PV-TABLE-TYPE-DECLARATION PCL::NO-METHODS-CACHE)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++ PCL::ONE-INDEX-LIMIT-FN PCL::EARLY-CLASS-SIZE PCL::CACHE-COUNT ++ PCL::PV-TABLE-PV-SIZE PCL::DEFAULT-LIMIT-FN ++ PCL::CHECKING-LIMIT-FN PCL::CACHING-LIMIT-FN ++ PCL::N-N-ACCESSORS-LIMIT-FN PCL::CPD-COUNT ++ PCL::FAST-INSTANCE-BOUNDP-INDEX PCL::ARG-INFO-NUMBER-REQUIRED ++ PCL::PV-CACHE-LIMIT-FN)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) +- PCL::UPDATE-MAKE-INSTANCE-FUNCTION-TABLE PCL::UNTRACE-METHOD +- COMMON-LISP::METHOD-COMBINATION-ERROR +- COMMON-LISP::INVALID-METHOD-ERROR PCL::LIST-LARGE-CACHES)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) ++ PCL::POWER-OF-TWO-CEILING)) ++(COMMON-LISP::MAPC ++ (COMMON-LISP::LAMBDA (COMPILER::X) ++ (COMMON-LISP::SETF ++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) ++ COMMON-LISP::T)) ++ '(PCL::TRACE-METHOD-INTERNAL PCL::FDEFINE-CAREFULLY ++ PCL::REDEFINE-FUNCTION PCL::DO-STANDARD-DEFSETF-1)) + (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::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::INTEGER -9223372036854775808 +- 9223372036854775807)) +- COMMON-LISP::T) +- PCL::COMPUTE-STD-CPL-PHASE-3)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ (COMMON-LISP::INTEGER 1 255)) ++ PCL::CACHE-NKEYS)) + (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::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::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::FUNCTION (COMMON-LISP::FIXNUM COMMON-LISP::T) + COMMON-LISP::T) +- PCL::BOOTSTRAP-INITIALIZE-CLASS)) +-(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)) ++ PCL::%CCLOSURE-ENV-NTHCDR)) + (IN-PACKAGE "PCL") + +-(DOLIST (V '(|(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-METHODS)| ++(DOLIST (V '(|(FAST-WRITER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-METHODS)| + |(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 FROM-DEFCLASS-P)| + |(FAST-WRITER-METHOD SLOT-OBJECT METHODS)| + |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHODS)| + |(FAST-WRITER-METHOD SLOT-OBJECT OPTIONS)| +@@ -1063,16 +1148,17 @@ + COMPATIBLE-META-CLASS-CHANGE-P + |(FAST-READER-METHOD SLOT-OBJECT CLASS-EQ-SPECIALIZER)| + |(FAST-READER-METHOD CLASS CLASS-EQ-SPECIALIZER)| +- |(BOUNDP READER-FUNCTION)| |(BOUNDP PREDICATE-NAME)| +- |(BOUNDP READERS)| UPDATE-GF-DFUN +- |(BOUNDP CLASS-PRECEDENCE-LIST)| ++ |(BOUNDP READER-FUNCTION)| TRACE-METHOD-INTERNAL ++ |(BOUNDP PREDICATE-NAME)| |(BOUNDP READERS)| ++ UPDATE-GF-DFUN |(BOUNDP CLASS-PRECEDENCE-LIST)| + |(BOUNDP ACCESSOR-FLAGS)| |(BOUNDP LOCATION)| + |(BOUNDP DOCUMENTATION)| SPECIALIZER-OBJECT + |(BOUNDP INCOMPATIBLE-SUPERCLASS-LIST)| + ACCESSOR-METHOD-SLOT-NAME |(BOUNDP SPECIALIZERS)| + |(BOUNDP IDENTITY-WITH-ONE-ARGUMENT)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)| +- SPECIALIZER-CLASS |(BOUNDP PRETTY-ARGLIST)| ++ REDEFINE-FUNCTION SPECIALIZER-CLASS ++ |(BOUNDP PRETTY-ARGLIST)| + |PCL::PCL-CLASS class predicate| + |PCL::STD-CLASS class predicate| + |(BOUNDP DEFSTRUCT-FORM)| +@@ -1110,104 +1196,104 @@ + |(BOUNDP OPTIONS)| |(WRITER METHOD)| + |PCL::DEPENDENT-UPDATE-MIXIN class predicate| + GENERIC-FUNCTION-PRETTY-ARGLIST |(WRITER SOURCE)| +- |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| +- |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| + |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| +- |(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| ++ |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (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 SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| + |(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| +- |(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| +- |(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| +- |(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| + |(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| +- |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| ++ |(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| ++ |(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| ++ |(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| + MAKE-BOUNDP-METHOD-FUNCTION + |(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| + |(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| + |PCL::METAOBJECT class predicate| +- |(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| +- |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| +- |(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| +- |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| +- |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| ++ |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD SLOT-BOUNDP-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-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| ++ |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| ++ |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| + |(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| +- |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| +- |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| +- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +- |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| + |(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| +- |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| +- |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| + |(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| ++ |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| + |(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| +- |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| +- |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| +- |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| +- |(FAST-METHOD CHANGE-CLASS (T SYMBOL))| +- |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| + |(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +- |(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +- |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| ++ |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| + |(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| ++ |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| ++ |(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| ++ |(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| ++ |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| ++ |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| ++ |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| ++ |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| ++ |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| ++ |(FAST-METHOD METHOD-PRETTY-ARGLIST (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 DOCUMENTATION (STANDARD-SLOT-DEFINITION))| +- |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| +- |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD MAKE-INSTANCE (SYMBOL))| +- |(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 DOCUMENTATION (STANDARD-SLOT-DEFINITION))| ++ |(FAST-METHOD CHANGE-CLASS (T SYMBOL))| + |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T 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-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD SPECIALIZER-CLASS (CLASS))| +- |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| +- |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| +- |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| +- |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| +- |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| + |(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +- |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| +- |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| +- |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| + |(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| +- |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| +- |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| +- |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| +- |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| +- |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| +- |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| +- |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| ++ |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| ++ |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| + |(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| +- |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| ++ |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| ++ |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| ++ |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| ++ |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| ++ |(FAST-METHOD SPECIALIZER-CLASS (CLASS))| ++ |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| ++ |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| + |(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| +- |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| ++ |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| ++ |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| ++ |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| ++ |(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| ++ |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| + |(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| ++ |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| + |(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| +- |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| +- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| +- |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| +- |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| +- |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| +- |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| ++ |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| ++ |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| ++ |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| ++ |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++ |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| ++ |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| ++ |(FAST-METHOD MAKE-INSTANCE (CLASS))| ++ |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| + |(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| + |(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| +- |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| +- |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| +- |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| +- |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| +- |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| ++ |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| ++ |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| ++ |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| ++ |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| ++ |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| ++ |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| + |(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| +- |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| +- |(FAST-METHOD MAKE-INSTANCE (CLASS))| ++ |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| + |(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| +- |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| +- |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| +- |(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| +- |(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| ++ |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| + CLASS-PREDICATE-NAME + |PCL::STRUCTURE-SLOT-DEFINITION class predicate| + |PCL::STRUCTURE-DIRECT-SLOT-DEFINITION class predicate| +@@ -1233,8 +1319,8 @@ + |(WRITER PREDICATE-NAME)| |(WRITER READERS)| + |(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 LOCATION)| + |(WRITER DOCUMENTATION)| +@@ -1248,11 +1334,11 @@ + |(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| +- |(WRITER DEFSTRUCT-FORM)| |(READER FUNCTION)| +- |(READER GENERIC-FUNCTION)| |(READER LAMBDA-LIST)| +- |(READER SLOT-DEFINITION)| ++ |(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 SLOT-DEFINITION-INITFORM| + |SETF PCL CLASS-DEFSTRUCT-FORM| +@@ -1273,17 +1359,16 @@ + |SETF PCL SLOT-DEFINITION-ALLOCATION| + |SETF PCL SLOT-DEFINITION-INITFUNCTION| + |(WRITER SLOT-NAME)| |(BOUNDP NAME)| +- |(WRITER ALLOCATION)| |(READER FAST-FUNCTION)| ++ |(READER FAST-FUNCTION)| |(WRITER ALLOCATION)| + |(READER METHOD-CLASS)| |(SETF OBJECT-PLIST)| + |(READER INTERNAL-WRITER-FUNCTION)| + |(READER INTERNAL-READER-FUNCTION)| + |(READER METHOD-COMBINATION)| + METHOD-COMBINATION-OPTIONS |(READER DIRECT-SLOTS)| + |(READER DIRECT-METHODS)| +- |SETF PCL SLOT-DEFINITION-READERS| +- |(READER BOUNDP-FUNCTION)| |(WRITER FUNCTION)| +- |(WRITER GENERIC-FUNCTION)| |SETF PCL DOCUMENTATION| +- |(READER DIRECT-SUBCLASSES)| ++ |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)| +@@ -1294,7 +1379,7 @@ + |SETF PCL SLOT-VALUE-USING-CLASS| + |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)| + |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)| +- |(WRITER PROTOTYPE)| |(BOUNDP OBJECT)| |(BOUNDP TYPE)| ++ |(WRITER PROTOTYPE)| |(BOUNDP TYPE)| |(BOUNDP OBJECT)| + CLASS-CAN-PRECEDE-LIST |SETF PCL CLASS-DIRECT-SLOTS| + |SETF PCL CLASS-SLOTS| SLOT-ACCESSOR-FUNCTION + |(BOUNDP PLIST)| +@@ -1309,11 +1394,11 @@ + |(FAST-WRITER-METHOD SLOT-OBJECT ARG-INFO)| + |PCL::PLIST-MIXIN class predicate| + |(WRITER FAST-FUNCTION)| |(WRITER METHOD-CLASS)| +- |(FAST-WRITER-METHOD SLOT-OBJECT WRAPPER)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT WRAPPER)| GET-METHOD + |(WRITER INTERNAL-WRITER-FUNCTION)| + |(WRITER INTERNAL-READER-FUNCTION)| +- |(WRITER METHOD-COMBINATION)| GET-METHOD +- |(WRITER DIRECT-SLOTS)| |(WRITER DIRECT-METHODS)| ++ |(WRITER METHOD-COMBINATION)| |(WRITER DIRECT-SLOTS)| ++ |(WRITER DIRECT-METHODS)| + |(FAST-WRITER-METHOD SLOT-OBJECT INITARGS)| + |(FAST-WRITER-METHOD SLOT-DEFINITION INITARGS)| + |(FAST-WRITER-METHOD SLOT-OBJECT OPERATOR)| +@@ -1383,18 +1468,18 @@ + |(FAST-READER-METHOD SLOT-DEFINITION READERS)| + |(FAST-READER-METHOD SLOT-OBJECT SPECIALIZERS)| + |(FAST-READER-METHOD STANDARD-METHOD SPECIALIZERS)| +- |(FAST-READER-METHOD SHORT-METHOD-COMBINATION IDENTITY-WITH-ONE-ARGUMENT)| +- |(FAST-READER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| + |(FAST-READER-METHOD SPECIALIZER TYPE)| + |(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-DEFINITION TYPE)| +- |(FAST-READER-METHOD SLOT-OBJECT TYPE)| +- |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION TYPE)| + |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| + |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)| + |(FAST-READER-METHOD SLOT-OBJECT INITFORM)| +@@ -1416,11 +1501,11 @@ + |(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 FROM-DEFCLASS-P)| + |(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)| +@@ -1458,8 +1543,8 @@ + |(FAST-BOUNDP-METHOD SLOT-OBJECT READERS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT SPECIALIZERS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT PROTOTYPE)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT OBJECT)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT TYPE)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT OBJECT)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT INITFORM)| + |(SETF SLOT-VALUE-USING-CLASS)| +@@ -1485,10 +1570,10 @@ + |(SETF SLOT-DEFINITION-TYPE)| + |(SETF SLOT-DEFINITION-INITFORM)| + |(BOUNDP INITIALIZE-INFO)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| + |(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 FROM-DEFCLASS-P)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT METHODS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT OPTIONS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)| +@@ -1498,94 +1583,94 @@ + GENERIC-FUNCTION-P + |PCL::SLOT-DEFINITION class predicate| |(READER NAME)| + |(READER CLASS)| +- |(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| +- |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| +- |(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| +- |(FAST-METHOD DESCRIBE-OBJECT (T T))| +- |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| ++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| ++ |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| ++ |(FAST-METHOD SLOT-UNBOUND (T T T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| ++ |(FAST-METHOD REMOVE-NAMED-METHOD (T T))| ++ |(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| ++ |(FAST-METHOD (SETF DOCUMENTATION) (T T))| + |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| ++ |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| ++ |(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| ++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| + |(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| +- |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| +- |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| +- |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| +- |(FAST-METHOD REMOVE-NAMED-METHOD (T T))| +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| +- |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| ++ |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| + |(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| +- |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| +- |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| +- |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| +- |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| +- |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| +- |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| ++ |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| ++ |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| ++ |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| ++ |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ |(FAST-METHOD PRINT-OBJECT (CLASS T))| ++ |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| + |(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| ++ |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| ++ |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| ++ |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| ++ |(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++ |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| + |(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| + |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| +- |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| +- |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| +- |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| +- |(FAST-METHOD PRINT-OBJECT (CLASS T))| +- |(FAST-METHOD PRINT-OBJECT (T T))| +- |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +- |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++ |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| ++ |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| ++ |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++ |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++ |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| ++ |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| ++ |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| ++ |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| + |(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| +- |(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++ |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| + |(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| +- |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| +- |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| +- |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| +- |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| +- |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| +- |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| ++ |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| ++ |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| + |(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| +- |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| +- |(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| +- |(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| +- |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| ++ |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| ++ |(FAST-METHOD PRINT-OBJECT (T T))| ++ |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| + |(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| +- |(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| +- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| +- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| +- |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +- |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| +- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| +- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| +- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| +- |(FAST-METHOD (SETF DOCUMENTATION) (T T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| +- |(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| +- |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| +- |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| ++ |(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| ++ |(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| ++ |(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| + |(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION 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 (CLASS T))| ++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| ++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| ++ |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| ++ |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| ++ |(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| ++ |(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| + |(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| +- |(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| +- |(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| ++ |(FAST-METHOD DESCRIBE-OBJECT (T T))| + |(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| +- |(FAST-METHOD SLOT-UNBOUND (T T T))| ++ |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| ++ |(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| ++ |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| + |(FAST-METHOD SLOT-MISSING (T T T T))| +- |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| +- |(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| +- LEGAL-SLOT-NAME-P |(READER OBJECT)| |(READER TYPE)| ++ |(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| ++ LEGAL-SLOT-NAME-P |(READER TYPE)| |(READER OBJECT)| + CLASS-WRAPPER |(READER PLIST)| + |(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| +@@ -1625,10 +1710,10 @@ + |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)| |(READER OPERATOR)| +- |(CALL REAL-GET-METHOD)| |(CALL REAL-REMOVE-METHOD)| +- |(CALL REAL-ADD-METHOD)| |(READER ARG-INFO)| +- METHOD-COMBINATION-TYPE ++ |(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)| +@@ -1637,8 +1722,8 @@ + |(WRITER DEFSTRUCT-ACCESSOR-SYMBOL)| + COMPUTE-SLOT-ACCESSOR-INFO |(READER INITARGS)| + |(WRITER CLASS-EQ-SPECIALIZER)| +- STANDARD-BOUNDP-METHOD-P |(SETF DOCUMENTATION)| +- RAW-INSTANCE-ALLOCATOR ++ STANDARD-BOUNDP-METHOD-P FDEFINE-CAREFULLY ++ |(SETF DOCUMENTATION)| RAW-INSTANCE-ALLOCATOR + |SETF PCL SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL| + |SETF PCL CLASS-INITIALIZE-INFO| |(WRITER OPERATOR)| + |(WRITER ARG-INFO)| +@@ -1651,9 +1736,8 @@ + METHOD-COMBINATION-DOCUMENTATION + |SETF PCL SLOT-DEFINITION-INITARGS| + REMOVE-BOUNDP-METHOD ADD-NAMED-METHOD +- |(WRITER INITARGS)| + |SETF PCL CLASS-DEFSTRUCT-CONSTRUCTOR| +- |(BOUNDP METHOD)| ++ |(WRITER INITARGS)| |(BOUNDP METHOD)| + |(FAST-WRITER-METHOD SLOT-OBJECT PREDICATE-NAME)| + |(FAST-WRITER-METHOD CLASS NAME)| + |(FAST-WRITER-METHOD SLOT-DEFINITION NAME)| +@@ -1699,11 +1783,11 @@ + |(FAST-WRITER-METHOD SLOT-OBJECT READERS)| + |(FAST-WRITER-METHOD SLOT-DEFINITION READERS)| + |(FAST-WRITER-METHOD SLOT-OBJECT SPECIALIZERS)| +- |(FAST-WRITER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| + |(FAST-WRITER-METHOD SLOT-OBJECT PROTOTYPE)| +- |(FAST-WRITER-METHOD SLOT-OBJECT OBJECT)| + |(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-OBJECT DEFSTRUCT-FORM)| + |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)| +@@ -1756,5 +1840,6 @@ + ENSURE-CLASS-USING-CLASS NO-APPLICABLE-METHOD + SLOT-DEFINITION-WRITERS + COMPUTE-APPLICABLE-METHODS-USING-CLASSES +- CLASS-PRECEDENCE-LIST DESCRIBE-OBJECT)) ++ CLASS-PRECEDENCE-LIST DISASSEMBLE DESCRIBE-OBJECT ++ COMPILE)) + (SETF (GET V 'COMPILER::PROCLAIMED-CLOSURE) T)) +--- gcl-2.6.12.orig/unixport/sys_init.lsp.in ++++ gcl-2.6.12/unixport/sys_init.lsp.in +@@ -79,7 +79,7 @@ + #+ansi-cl (use-package :pcl :user) + + (import 'si::(clines defentry defcfun object void int double quit bye gbc system +- *lib-directory* *system-directory*) :user) ++ *lib-directory* *system-directory* while) :user) + + (let* ((i 4096)(j (si::equal-tail-recursion-check i))) + (unless (<= (ash i -1) j) diff --git a/patches/list_order.11 b/patches/list_order.11 new file mode 100644 index 00000000..b97390c9 --- /dev/null +++ b/patches/list_order.11 @@ -0,0 +1,600 @@ +Description: + 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-53) unstable; urgency=medium + . + * list_order.9 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-08-23 + +--- gcl-2.6.12.orig/o/print.d ++++ gcl-2.6.12/o/print.d +@@ -35,12 +35,6 @@ int line_length = 72; + #define WRITEC_NEWLINE(strm) (writec_stream('\n',strm)) + #endif + +-#define to_be_escaped(c) \ +- (standard_readtable->rt.rt_self[(c)&0377].rte_chattrib \ +- != cat_constituent || \ +- isLower((c)&0377) || (c) == ':') +- +- + #define READ_TABLE_CASE (Vreadtable->s.s_dbind->rt.rt_case) + + #define mod(x) ((x)%Q_SIZE) +@@ -637,50 +631,31 @@ constant_case(object x) { + } + + static int +-all_dots(object x) { +- +- fixnum i; +- +- for (i=0;is.s_fillp;i++) +- if (x->s.s_self[i]!='.') +- return 0; ++needs_escape (object x) { + +- return 1; +- +-} +- +-static int +-needs_escape (object x,int pp) { +- +- fixnum i; +- char ch; ++ fixnum i,all_dots=1; ++ int ch; + + if (!PRINTescape) + return 0; + + for (i=0;is.s_fillp;i++) + switch((ch=x->s.s_self[i])) { +- case '(': +- case ')': + case ':': +- case '`': +- case '\'': +- case '"': +- case ';': +- case ',': +- case '\n': + return 1; +- case ' ': +- if (!i) return 1; ++ case '.': ++ break; + default: ++ all_dots=0; ++ if (Vreadtable->s.s_dbind->rt.rt_self[ch].rte_chattrib!=cat_constituent) ++ return 1; + if ((READ_TABLE_CASE==sKupcase && isLower(ch)) || + (READ_TABLE_CASE==sKdowncase && isUpper(ch))) + return 1; + } + +- if (pp) +- if (potential_number_p(x, PRINTbase) || all_dots(x)) +- return 1; ++ if (potential_number_p(x, PRINTbase) || all_dots) ++ return 1; + + return !x->s.s_fillp; + +@@ -690,19 +665,21 @@ needs_escape (object x,int pp) { + #define convertible_lower(c) ((READ_TABLE_CASE==sKdowncase||READ_TABLE_CASE==sKinvert)&& isLower(c)) + + static void +-print_symbol_name_body(object x,int pp) { ++print_symbol_name_body(object x) { + + int i,j,fc,tc,lw,k,cc; + + cc=constant_case(x); +- k=needs_escape(x,pp); ++ k=needs_escape(x); + + if (k) + write_ch('|'); + + for (lw=i=0;is.s_fillp;i++) { + j = x->s.s_self[i]; +- if (PRINTescape && (j == '|' || j == '\\')) ++ if (PRINTescape && ++ (Vreadtable->s.s_dbind->rt.rt_self[j].rte_chattrib==cat_single_escape || ++ Vreadtable->s.s_dbind->rt.rt_self[j].rte_chattrib==cat_multiple_escape)) + write_ch('\\'); + fc=convertible_upper(j) ? 1 : + (convertible_lower(j) ? -1 : 0); +@@ -711,7 +688,7 @@ print_symbol_name_body(object x,int pp) + (PRINTcase == sKdowncase ? -1 : + (PRINTcase == sKcapitalize ? (i==lw ? 1 : -1) : 0)))); + if (ispunct(j)||isspace(j)) lw=i+1; +- j+=(tc*fc && !k ? (tc-fc)>>1 : 0)*('A'-'a'); ++ j+=(tc && fc && !k ? (tc-fc)>>1 : 0)*('A'-'a'); + write_ch(j); + + } +@@ -721,6 +698,42 @@ print_symbol_name_body(object x,int pp) + + } + ++#define DONE 1 ++#define FOUND -1 ++ ++static int ++write_sharp_eq(object *vp,bool dot) { ++ ++ bool defined=vp[1]!=Cnil; ++ ++ if (dot) { ++ write_str(" . "); ++ if (!defined) return FOUND; ++ } ++ ++ vp[1]=Ct; ++ write_ch('#'); ++ write_decimal((vp-PRINTvs_top)/2); ++ write_ch(defined ? '#' : '='); ++ ++ return defined ? DONE : FOUND; ++ ++} ++ ++static int ++write_sharp_eqs(object x,bool dot) { ++ ++ object *vp; ++ ++ for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) ++ if (x == *vp) ++ return write_sharp_eq(vp,dot); ++ ++ return 0; ++ ++} ++ ++ + void + write_object(x, level) + object x; +@@ -728,7 +741,6 @@ int level; + { + object r, y; + int i, j, k; +- object *vp; + + cs_check(x); + +@@ -903,29 +915,15 @@ int level; + + if (PRINTescape) { + if (x->s.s_hpack == Cnil) { +- if (PRINTcircle) { +- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) +- if (x == *vp) { +- if (vp[1] != Cnil) { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2+1); +- write_ch('#'); +- return; +- } else { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2+1); +- write_ch('='); +- vp[1] = Ct; +- } +- } +- } ++ if (PRINTcircle) ++ if (write_sharp_eqs(x,FALSE)==DONE) return; + if (PRINTgensym) + write_str("#:"); + } else if (x->s.s_hpack == keyword_package) { + write_ch(':'); + } else if (PRINTpackage||find_symbol(x,current_package())!=x || !intern_flag) { + +- print_symbol_name_body(x->s.s_hpack->p.p_name,0); ++ print_symbol_name_body(x->s.s_hpack->p.p_name); + + if (find_symbol(x, x->s.s_hpack) != x) + error("can't print symbol"); +@@ -939,7 +937,7 @@ int level; + } + + } +- print_symbol_name_body(x,1); ++ print_symbol_name_body(x); + break; + } + case t_array: +@@ -953,23 +951,8 @@ int level; + write_str(">"); + break; + } +- if (PRINTcircle) { +- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) +- if (x == *vp) { +- if (vp[1] != Cnil) { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2); +- write_ch('#'); +- return; +- } else { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2); +- write_ch('='); +- vp[1] = Ct; +- break; +- } +- } +- } ++ if (PRINTcircle) ++ if (write_sharp_eqs(x,FALSE)==DONE) return; + if (PRINTlevel >= 0 && level >= PRINTlevel) { + write_ch('#'); + break; +@@ -1044,23 +1027,8 @@ int level; + write_str(">"); + break; + } +- if (PRINTcircle) { +- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) +- if (x == *vp) { +- if (vp[1] != Cnil) { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2); +- write_ch('#'); +- return; +- } else { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2); +- write_ch('='); +- vp[1] = Ct; +- break; +- } +- } +- } ++ if (PRINTcircle) ++ if (write_sharp_eqs(x,FALSE)==DONE) return; + if (PRINTlevel >= 0 && level >= PRINTlevel) { + write_ch('#'); + break; +@@ -1130,23 +1098,8 @@ int level; + write_object(x->c.c_cdr, level); + break; + } +- if (PRINTcircle) { +- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) +- if (x == *vp) { +- if (vp[1] != Cnil) { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2); +- write_ch('#'); +- return; +- } else { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2); +- write_ch('='); +- vp[1] = Ct; +- break; +- } +- } +- } ++ if (PRINTcircle) ++ if (write_sharp_eqs(x,FALSE)==DONE) return; + if (PRINTpretty) { + if (x->c.c_car == sLquote && + type_of(x->c.c_cdr) == t_cons && +@@ -1192,22 +1145,15 @@ int level; + } + break; + } +- if (PRINTcircle) { +- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) +- if (x == *vp) { +- if (vp[1] != Cnil) { +- write_str(" . #"); +- write_decimal((vp-PRINTvs_top)/2); +- write_ch('#'); +- goto RIGHT_PAREN; +- } else { +- write_ch(INDENT); +- write_str(". "); +- write_object(x, level); +- goto RIGHT_PAREN; +- } +- } +- } ++ if (PRINTcircle) ++ switch (write_sharp_eqs(x,TRUE)) { ++ case FOUND: ++ write_object(x, level); ++ case DONE: ++ goto RIGHT_PAREN; ++ default: ++ break; ++ } + if (i == 0 && y != OBJNULL && type_of(y) == t_symbol) + write_ch(INDENT1); + else +@@ -1369,23 +1315,8 @@ int level; + break; + + case t_structure: +- if (PRINTcircle) { +- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) +- if (x == *vp) { +- if (vp[1] != Cnil) { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2); +- write_ch('#'); +- return; +- } else { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2); +- write_ch('='); +- vp[1] = Ct; +- break; +- } +- } +- } ++ if (PRINTcircle) ++ if (write_sharp_eqs(x,FALSE)==DONE) return; + if (PRINTlevel >= 0 && level >= PRINTlevel) { + write_ch('#'); + break; +@@ -1468,48 +1399,73 @@ static int dgs; + + #include "page.h" + ++#define travel_seen(x) x->d.m ++#define travel_pushed(x) x->d.f ++#define travel_bits(x) x->md.mf ++ + static void +-travel_push_new(object x) { ++travel_push(object x) { + +- object y; + int i; + +- BEGIN: +- if (NULL_OR_ON_C_STACK(x)) return; +- if (is_marked(x)) { +- vs_check_push(x); +- vs_check_push(Cnil); ++ if (NULL_OR_ON_C_STACK(x)) ++ return; ++ ++ if (travel_seen(x)) { ++ ++ if (!travel_pushed(x)) { ++ vs_check_push(x); ++ vs_check_push(Cnil); ++ travel_pushed(x)=1; ++ } ++ + return; ++ + } ++ + switch (type_of(x)) { ++ + case t_symbol: +- if (dgs && x->s.s_hpack==Cnil) {mark(x);} ++ ++ if (dgs && x->s.s_hpack==Cnil) ++ travel_seen(x)=1; + break; ++ + case t_cons: +- y=x->c.c_cdr; +- mark(x); +- travel_push_new(x->c.c_car); +- x=y; +- goto BEGIN; ++ ++ { ++ object y=x->c.c_cdr; ++ travel_seen(x)=1; ++ travel_push(x->c.c_car); ++ travel_push(y); ++ } + break; ++ + case t_array: +- mark(x); ++ ++ travel_seen(x)=1; + if ((enum aelttype)x->a.a_elttype == aet_object) + for (i=0;ia.a_dim;i++) +- travel_push_new(x->a.a_self[i]); ++ travel_push(x->a.a_self[i]); + break; ++ + case t_vector: +- mark(x); ++ ++ travel_seen(x)=1; + if ((enum aelttype)x->v.v_elttype == aet_object) + for (i=0;iv.v_fillp;i++) +- travel_push_new(x->v.v_self[i]); ++ travel_push(x->v.v_self[i]); + break; ++ + case t_structure: +- mark(x); ++ ++ travel_seen(x)=1; + for (i = 0; i < S_DATA(x->str.str_def)->length; i++) +- travel_push_new(structure_ref(x,x->str.str_def,i)); ++ travel_push(structure_ref(x,x->str.str_def,i)); + break; ++ + default: ++ + break; + + } +@@ -1518,34 +1474,45 @@ travel_push_new(object x) { + + + static void +-travel_clear_new(object x) { ++travel_clear(object x) { + + int i; + +- BEGIN: +- if (NULL_OR_ON_C_STACK(x) || !is_marked(x)) return; +- unmark(x); ++ if (NULL_OR_ON_C_STACK(x) || !travel_bits(x)) ++ return; ++ ++ travel_bits(x)=0; ++ + switch (type_of(x)) { ++ + case t_cons: +- travel_clear_new(x->c.c_car); +- x=x->c.c_cdr; +- goto BEGIN; ++ ++ travel_clear(x->c.c_car); ++ travel_clear(x->c.c_cdr); + break; ++ + case t_array: ++ + if ((enum aelttype)x->a.a_elttype == aet_object) + for (i=0;ia.a_dim;i++) +- travel_clear_new(x->a.a_self[i]); ++ travel_clear(x->a.a_self[i]); + break; ++ + case t_vector: ++ + if ((enum aelttype)x->v.v_elttype == aet_object) + for (i=0;iv.v_fillp;i++) +- travel_clear_new(x->v.v_self[i]); ++ travel_clear(x->v.v_self[i]); + break; ++ + case t_structure: ++ + for (i = 0; i < S_DATA(x->str.str_def)->length; i++) +- travel_clear_new(structure_ref(x,x->str.str_def,i)); ++ travel_clear(structure_ref(x,x->str.str_def,i)); + break; ++ + default: ++ + break; + + } +@@ -1558,74 +1525,14 @@ setupPRINTcircle(object x,int dogensyms) + + BEGIN_NO_INTERRUPT; + dgs=dogensyms; +- travel_push_new(x); ++ travel_push(x); + dgs=0; + PRINTvs_limit = vs_top; +- travel_clear_new(x); ++ travel_clear(x); + END_NO_INTERRUPT; + + } + +-/* char travel_push_type[32]; */ +- +-/* static void */ +-/* travel_push_object(x) */ +-/* object x; */ +-/* { */ +-/* enum type t; */ +-/* int i; */ +-/* object *vp; */ +- +-/* cs_check(x); */ +- +-/* BEGIN: */ +-/* t = type_of(x); */ +-/* if(travel_push_type[(int)t]==0) return; */ +-/* if(t==t_symbol && x->s.s_hpack != Cnil) return; */ +- +-/* for (vp = PRINTvs_top; vp < vs_top; vp += 2) */ +-/* if (x == *vp) { */ +-/* if (vp[1] != Cnil) */ +-/* return; */ +-/* vp[1] = Ct; */ +-/* return; */ +-/* } */ +-/* vs_check_push(x); */ +-/* vs_check_push(Cnil); */ +-/* if (t == t_array && (enum aelttype)x->a.a_elttype == aet_object) */ +-/* for (i = 0; i < x->a.a_dim; i++) */ +-/* travel_push_object(x->a.a_self[i]); */ +-/* else if (t == t_vector && (enum aelttype)x->v.v_elttype == aet_object) */ +-/* for (i = 0; i < x->v.v_fillp; i++) */ +-/* travel_push_object(x->v.v_self[i]); */ +-/* else if (t == t_cons) { */ +-/* travel_push_object(x->c.c_car); */ +-/* x = x->c.c_cdr; */ +-/* goto BEGIN; */ +-/* } else if (t == t_structure) { */ +-/* for (i = 0; i < S_DATA(x->str.str_def)->length; i++) */ +-/* travel_push_object(structure_ref(x,x->str.str_def,i)); */ +-/* } */ +-/* } */ +- +-/* static void */ +-/* setupPRINTcircle(x,dogensyms) */ +-/* object x; */ +-/* int dogensyms; */ +-/* { object *vp,*vq; */ +-/* travel_push_type[(int)t_symbol]=dogensyms; */ +-/* travel_push_type[(int)t_array]= */ +-/* (travel_push_type[(int)t_vector]=PRINTarray); */ +-/* travel_push_object(x); */ +-/* for (vp = vq = PRINTvs_top; vp < vs_top; vp += 2) */ +-/* if (vp[1] != Cnil) { */ +-/* vq[0] = vp[0]; */ +-/* vq[1] = Cnil; */ +-/* vq += 2; */ +-/* } */ +-/* PRINTvs_limit = vs_top = vq; */ +-/* } */ +- + void + setupPRINTdefault(x) + object x; +@@ -1640,8 +1547,8 @@ object x; + vs_push(PRINTstream); + FEwrong_type_argument(sLstream, PRINTstream); + } +- PRINTescape = symbol_value(sLAprint_escapeA) != Cnil; + PRINTreadably = symbol_value(sLAprint_readablyA) != Cnil; ++ PRINTescape = PRINTreadably || symbol_value(sLAprint_escapeA) != Cnil; + PRINTpretty = symbol_value(sLAprint_prettyA) != Cnil; + PRINTcircle = symbol_value(sLAprint_circleA) != Cnil; + y = symbol_value(sLAprint_baseA); diff --git a/patches/list_order.12 b/patches/list_order.12 new file mode 100644 index 00000000..e5991588 --- /dev/null +++ b/patches/list_order.12 @@ -0,0 +1,50 @@ +Description: + 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-55) unstable; urgency=medium + . + * disable gprof on aarch64 + * Bug fix: "gcl FTBFS on arm64: Unrecoverable error: Segmentation + violation..", thanks to Adrian Bunk (Closes: #873052). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/873052 + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-08-24 + +--- gcl-2.6.12.orig/o/regexpr.c ++++ gcl-2.6.12/o/regexpr.c +@@ -66,6 +66,7 @@ DEFUN_NEW("COMPILE-REGEXP",object,fScomp + + char *tmp; + object res; ++ ufixnum i=0; + + if (type_of(p)!= t_string && type_of(p)!=t_symbol) + not_a_string_or_symbol(p); +@@ -82,9 +83,9 @@ DEFUN_NEW("COMPILE-REGEXP",object,fScomp + res->v.v_adjustable=0; + res->v.v_offset=0; + res->v.v_self=NULL; +- if (!(res->v.v_self=(void *)regcomp(tmp,&res->v.v_dim))) ++ if (!(res->v.v_self=(void *)regcomp(tmp,&i))) + FEerror("regcomp failure",0); +- res->v.v_fillp=res->v.v_dim; ++ res->v.v_fillp=res->v.v_dim=i; + + RETURN1(res); + diff --git a/patches/list_order.13 b/patches/list_order.13 new file mode 100644 index 00000000..3a95b63a --- /dev/null +++ b/patches/list_order.13 @@ -0,0 +1,36 @@ +Description: + 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-57) unstable; urgency=medium + . + * list_order.13 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-08-29 + +--- gcl-2.6.12.orig/h/elf32_mips_reloc.h ++++ gcl-2.6.12/h/elf32_mips_reloc.h +@@ -35,7 +35,7 @@ + if (a) add_vals(where,MASK(16),(s>>16)+a); + break; + case R_MIPS_LO16: +- if (sym->st_other) s=gpd; ++ if (sym->st_other) s=gpd ? gpd : ({massert(sym->st_other==2);(ul)got;}); + a=*where&MASK(16); + if (a&0x8000) a|=0xffff0000; + a+=s&MASK(16); diff --git a/patches/list_order.16 b/patches/list_order.16 new file mode 100644 index 00000000..d4b69556 --- /dev/null +++ b/patches/list_order.16 @@ -0,0 +1,412 @@ +Description: + 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-58) unstable; urgency=medium + . + * list_order.14 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-01-12 + +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1964,3 +1964,9 @@ vsystem(const char *); + + object + n_cons_from_x(fixnum,object); ++ ++int ++seek_to_end_ofile(FILE *); ++ ++void ++travel_find_sharing(object,object); +--- gcl-2.6.12.orig/o/fasdump.c ++++ gcl-2.6.12/o/fasdump.c +@@ -976,100 +976,13 @@ fasd_patch_sharp(object x, int depth) + } + + object sharing_table; +-static enum circ_ind +-is_it_there(object x) +-{ struct htent *e; +- object table=sharing_table; +- switch(type_of(x)){ +- case t_cons: +- case t_symbol: +- case t_structure: +- case t_array: +- case t_vector: +- case t_package: +- e= gethash(x,table); +- if (e->hte_key ==OBJNULL) +- {sethash(x,table,make_fixnum(-1)); +- return FIRST_INDEX; +- } +- else +- {int n=fix(e->hte_value); +- if (n <0) +- e->hte_value=make_fixnum(n-1); +- return LATER_INDEX;} +- break; +- default: +- return NOT_INDEXED;}} + +- +- +-static void +-find_sharing(object x) +-{ +- cs_check(x); +- BEGIN: +- if(is_it_there(x)!=FIRST_INDEX) return; +- +- switch (type_of(x)) { +- +- case DP(t_cons:) +- +- find_sharing(x->c.c_car); +- x=x->c.c_cdr; +- goto BEGIN; +- +- break; +- +- case DP(t_vector:) +- { +- int i; +- +- if ((enum aelttype)x->v.v_elttype != aet_object) +- break; +- +- for (i = 0; i < x->v.v_fillp; i++) +- find_sharing(x->v.v_self[i]); +- break; +- } +- case DP(t_array:) +- { +- int i, j; +- +- if ((enum aelttype)x->a.a_elttype != aet_object) +- break; +- +- for (i = 0, j = 1; i < x->a.a_rank; i++) +- j *= x->a.a_dims[i]; +- for (i = 0; i < j; i++) +- find_sharing(x->a.a_self[i]); +- break; +- } +- case DP(t_structure:) +- {object def = x->str.str_def; +- int i; +- i=S_DATA(def)->length; +- while (i--> 0) +- find_sharing(structure_ref(x,def,i)); +- break; +- } +- default: +- break; +- } +- return; +-} +- +-DEFUN_NEW("FIND-SHARING-TOP",object,fSfind_sharing_top,SI,2,2,NONE,OO,OO,OO,OO,(object x, object table),"") +-/* static object */ +-/* FFN(find_sharing_top)(object x, object table) */ +-{sharing_table=table; +- find_sharing(x); +- return Ct; ++DEFUN_NEW("FIND-SHARING-TOP",object,fSfind_sharing_top,SI,2,2,NONE,OO,OO,OO,OO,(object x, object table),"") { ++ sharing_table=table; ++ travel_find_sharing(x,table); ++ return Ct; + } + +- +- +- +- + /* static object */ + /* read_fasd(int i) */ + /* {object tem; */ +--- gcl-2.6.12.orig/o/print.d ++++ gcl-2.6.12/o/print.d +@@ -490,7 +490,6 @@ int level; + void (*wf)(int) = write_ch_fun; + + object *vt = PRINTvs_top; +- object *vl = PRINTvs_limit; + bool e = PRINTescape; + bool ra = PRINTreadably; + bool r = PRINTradix; +@@ -599,7 +598,6 @@ L: + PRINTradix = r; + PRINTescape = e; + PRINTreadably = ra; +- PRINTvs_limit = vl; + PRINTvs_top = vt; + + write_ch_fun = wf; +@@ -702,18 +700,19 @@ print_symbol_name_body(object x) { + #define FOUND -1 + + static int +-do_write_sharp_eq(object x,bool dot) { ++do_write_sharp_eq(struct htent *e,bool dot) { + +- bool defined=x->c.c_cdr!=Cnil; ++ fixnum val=fix(e->hte_value); ++ bool defined=val&1; + + if (dot) { + write_str(" . "); + if (!defined) return FOUND; + } + +- x->c.c_cdr=Ct; ++ if (!defined) e->hte_value=make_fixnum(val|1); + write_ch('#'); +- write_decimal(fix(x->c.c_car)); ++ write_decimal(val>>1); + write_ch(defined ? '#' : '='); + + return defined ? DONE : FOUND; +@@ -726,7 +725,7 @@ write_sharp_eq(object x,bool dot) { + struct htent *e; + + return PRINTvs_top[0]!=Cnil && (e=gethash(x,PRINTvs_top[0]))->hte_key!=OBJNULL ? +- do_write_sharp_eq(e->hte_value,dot) : 0; ++ do_write_sharp_eq(e,dot) : 0; + + } + +@@ -1392,79 +1391,65 @@ int level; + } + } + +-static int dgs; ++static int dgs,dga; + + #include "page.h" + +-#define travel_seen(x) x->d.m +-#define travel_pushed(x) x->d.f +-#define travel_bits(x) x->md.mf +- + static void + travel_push(object x) { + + int i; + +- if (NULL_OR_ON_C_STACK(x)) ++ if (is_imm_fixnum(x)) + return; + +- if (travel_seen(x)) { ++ if (is_marked(x)) { + +- if (!travel_pushed(x)) { ++ if (imcdr(x) || !x->d.f) + vs_check_push(x); +- travel_pushed(x)=1; +- } +- +- return; ++ if (!imcdr(x)) ++ x->d.f=1; + +- } +- +- switch (type_of(x)) { ++ } else switch (type_of(x)) { + +- case t_symbol: ++ case t_symbol: + +- if (dgs && x->s.s_hpack==Cnil) +- travel_seen(x)=1; +- break; +- +- case t_cons: +- +- { +- object y=x->c.c_cdr; +- travel_seen(x)=1; +- travel_push(x->c.c_car); +- travel_push(y); +- } +- break; ++ if (dgs && x->s.s_hpack==Cnil) { ++ mark(x); ++ } ++ break; + +- case t_array: ++ case t_cons: + +- travel_seen(x)=1; +- if ((enum aelttype)x->a.a_elttype == aet_object) +- for (i=0;ia.a_dim;i++) +- travel_push(x->a.a_self[i]); +- break; ++ { ++ object y=x->c.c_cdr; ++ mark(x); ++ travel_push(x->c.c_car); ++ travel_push(y); ++ } ++ break; + +- case t_vector: ++ case t_vector: ++ case t_array: + +- travel_seen(x)=1; +- if ((enum aelttype)x->v.v_elttype == aet_object) +- for (i=0;iv.v_fillp;i++) +- travel_push(x->v.v_self[i]); +- break; ++ mark(x); ++ if (dga && (enum aelttype)x->a.a_elttype==aet_object) ++ for (i=0;ia.a_dim;i++) ++ travel_push(x->a.a_self[i]); ++ break; + +- case t_structure: ++ case t_structure: + +- travel_seen(x)=1; +- for (i = 0; i < S_DATA(x->str.str_def)->length; i++) +- travel_push(structure_ref(x,x->str.str_def,i)); +- break; ++ mark(x); ++ for (i = 0; i < S_DATA(x->str.str_def)->length; i++) ++ travel_push(structure_ref(x,x->str.str_def,i)); ++ break; + +- default: ++ default: + +- break; ++ break; + +- } ++ } + + } + +@@ -1474,10 +1459,15 @@ travel_clear(object x) { + + int i; + +- if (NULL_OR_ON_C_STACK(x) || !travel_bits(x)) ++ if (is_imm_fixnum(x)) ++ return; ++ ++ if (!is_marked(x)) + return; + +- travel_bits(x)=0; ++ unmark(x); ++ if (!imcdr(x)) ++ x->d.f=0; + + switch (type_of(x)) { + +@@ -1487,20 +1477,14 @@ travel_clear(object x) { + travel_clear(x->c.c_cdr); + break; + ++ case t_vector: + case t_array: + +- if ((enum aelttype)x->a.a_elttype == aet_object) ++ if (dga && (enum aelttype)x->a.a_elttype == aet_object) + for (i=0;ia.a_dim;i++) + travel_clear(x->a.a_self[i]); + break; + +- case t_vector: +- +- if ((enum aelttype)x->v.v_elttype == aet_object) +- for (i=0;iv.v_fillp;i++) +- travel_clear(x->v.v_self[i]); +- break; +- + case t_structure: + + for (i = 0; i < S_DATA(x->str.str_def)->length; i++) +@@ -1515,26 +1499,47 @@ travel_clear(object x) { + + } + +-object sLeq; +- + static void +-setupPRINTcircle(object x,int dogensyms) { +- +- object *xp; ++travel(object x,int mdgs,int mdga) { + + BEGIN_NO_INTERRUPT; +- dgs=dogensyms; ++ dgs=mdgs; ++ dga=mdga; + travel_push(x); +- dgs=0; +- PRINTvs_limit = vs_top; + travel_clear(x); + END_NO_INTERRUPT; + +- vs_check_push(PRINTvs_limit>PRINTvs_top ? funcall_cfun(Lmake_hash_table,2,sKtest,sLeq) : Cnil); +- for (xp=PRINTvs_top;xpvp ? funcall_cfun(Lmake_hash_table,2,sKtest,sLeq) : Cnil; ++ for (j=0;vhte_key==OBJNULL) ++ sethash(*v,h,make_fixnum((j++)<<1)); ++ ++ vs_top=vp; ++ vs_push(h); ++ ++} ++ ++void ++travel_find_sharing(object x,object table) { ++ ++ object *vp=vs_top; ++ ++ travel(x,1,1); ++ ++ for (;vs_top>vp;vs_top--) ++ sethash(vs_head,table,make_fixnum(-2)); + + } + diff --git a/patches/list_order.17 b/patches/list_order.17 new file mode 100644 index 00000000..02a38973 --- /dev/null +++ b/patches/list_order.17 @@ -0,0 +1,1136 @@ +Description: + 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-59) unstable; urgency=medium + . + * list_order.16 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-01-23 + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -98,7 +98,9 @@ + (defvar *default-c-file* nil) + (defvar *default-h-file* nil) + (defvar *default-data-file* nil) ++(defvar *default-prof-p* nil) + (defvar *keep-gaz* nil) ++(defvar *prof-p* nil) + + ;; (list section-length split-file-names next-section-start-file-position) + ;; Many c compilers cannot handle the large C files resulting from large lisp files. +@@ -167,10 +169,12 @@ + (data-file *default-data-file*) + (c-debug nil) + (system-p *default-system-p*) ++ (prof-p *default-prof-p*) + (print nil) + (load nil) + &aux (*standard-output* *standard-output*) +- (*error-output* *error-output*) ++ (*prof-p* prof-p) ++ (*error-output* *error-output*) + (*compiler-in-use* *compiler-in-use*) + (*c-debug* c-debug) + (*compile-print* (or print *compile-print*)) +@@ -488,8 +492,9 @@ Cannot compile ~a.~%" + (t (setq dir "."))) + (setq na (namestring + (make-pathname :name name :type (pathname-type(first args))))) +- (format nil "~a -I~a ~a ~a -c ~a -o ~a ~a" ++ (format nil "~a ~a -I~a ~a ~a -c ~a -o ~a ~a" + *cc* ++ (if *prof-p* " -pg " "") + (concatenate 'string si::*system-directory* "../h") + (if (and (boundp '*c-debug*) *c-debug*) " -g " "") + (case *speed* +--- gcl-2.6.12.orig/cmpnew/gcl_cmpwt.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpwt.lsp +@@ -124,6 +124,7 @@ + x)) + + (defun wt-data-file () ++ (when *prof-p* (add-init `(si::mark-memory-as-profiling))) + (verify-data-vector (data-vector)) + (let* ((vec (coerce (nreverse (data-inits)) 'vector))) + (verify-data-vector vec) +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4131,30 +4131,11 @@ $as_echo "disabled" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5 + $as_echo "ok" >&6; } +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for text start" >&5 +-$as_echo_n "checking for text start... " >&6; } +- echo 'int main () {return(0);}' >foo.c +- $CC foo.c -o foo +- GCL_GPROF_START=`nm foo | $AWK '/ *[TD] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc +- rm -f foo.c foo +- if test "$GCL_GPROF_START" != "" ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GCL_GPROF_START" >&5 +-$as_echo "$GCL_GPROF_START" >&6; } +- +-cat >>confdefs.h <<_ACEOF +-#define GCL_GPROF_START $GCL_GPROF_START +-_ACEOF +- +- assert_arg_to_cflags -pg +- case $use in +- s390*) ;; # relocation truncation bug in gcc +- *) TLIBS="$TLIBS -pg";; +- esac +- TFPFLAG="" ++ assert_arg_to_cflags -pg ++ TFPFLAG="" + + $as_echo "#define GCL_GPROF 1" >>confdefs.h + +- fi + fi + fi + fi +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -342,22 +342,25 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof + AC_MSG_RESULT([disabled]) + else + AC_MSG_RESULT([ok]) +- AC_MSG_CHECKING([for text start]) +- echo 'int main () {return(0);}' >foo.c +- $CC foo.c -o foo +- GCL_GPROF_START=`nm foo | $AWK '/ *[[TD]] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc +- rm -f foo.c foo +- if test "$GCL_GPROF_START" != "" ; then +- AC_MSG_RESULT($GCL_GPROF_START) +- AC_DEFINE_UNQUOTED(GCL_GPROF_START,$GCL_GPROF_START,[starting address for gprof]) +- assert_arg_to_cflags -pg +- case $use in +- s390*) ;; # relocation truncation bug in gcc +- *) TLIBS="$TLIBS -pg";; +- esac +- TFPFLAG="" +- AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) +- fi ++ assert_arg_to_cflags -pg ++ TFPFLAG="" ++ AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) ++dnl AC_MSG_CHECKING([for text start]) ++dnl echo 'int main () {return(0);}' >foo.c ++dnl $CC foo.c -o foo ++dnl GCL_GPROF_START=`nm foo | $AWK '/ *[[TD]] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc ++dnl rm -f foo.c foo ++dnl if test "$GCL_GPROF_START" != "" ; then ++dnl AC_MSG_RESULT($GCL_GPROF_START) ++dnl AC_DEFINE_UNQUOTED(GCL_GPROF_START,$GCL_GPROF_START,[starting address for gprof]) ++dnl assert_arg_to_cflags -pg ++dnl # case $use in ++dnl # s390*) ;; # relocation truncation bug in gcc ++dnl # *) TLIBS="$TLIBS -pg";; ++dnl # esac ++dnl TFPFLAG="" ++dnl AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) ++dnl fi + fi + fi]) + +--- gcl-2.6.12.orig/h/gclincl.h.in ++++ gcl-2.6.12/h/gclincl.h.in +@@ -53,9 +53,6 @@ + /* use gprof profiling */ + #undef GCL_GPROF + +-/* starting address for gprof */ +-#undef GCL_GPROF_START +- + /* No gettimeofday call -- fixme */ + #undef GETTOD_NOT_DECLARED + +@@ -153,6 +150,9 @@ + /* use libbfd */ + #undef HAVE_LIBBFD + ++/* Define to 1 if you have the `dl' library (-ldl). */ ++#undef HAVE_LIBDL ++ + /* Define to 1 if you have the `opcodes' library (-lopcodes). */ + #undef HAVE_LIBOPCODES + +@@ -255,9 +255,6 @@ + /* using xgcl */ + #undef HAVE_XGCL + +-/* number of pages to use for hole */ +-#undef HOLEPAGE +- + /* Host cpu */ + #undef HOST_CPU + +@@ -267,9 +264,6 @@ + /* Host system */ + #undef HOST_SYSTEM + +-/* time system constant */ +-#undef HZ +- + /* invocation history stack size */ + #undef IHSSIZE + +@@ -321,7 +315,7 @@ + /* can use C extension for object alignment */ + #undef OBJ_ALIGN + +-/* needed object alignment in bytes */ ++/* needed object alignment bytes */ + #undef OBJ_ALIGNMENT + + /* Define to the address where bug reports for this package should be sent. */ +@@ -345,7 +339,7 @@ + /* system pagewidth */ + #undef PAGEWIDTH + +-/* have sigcontext in signal.h */ ++/* have sigcontext of signal.h */ + #undef SIGNAL_H_HAS_SIGCONTEXT + + /* sizeof linked list for contiguous pages */ +--- gcl-2.6.12.orig/h/lu.h ++++ gcl-2.6.12/h/lu.h +@@ -355,7 +355,8 @@ struct cfdata { + FIRSTWORD; + char *cfd_start; + int cfd_size; +- int cfd_fillp; ++ int cfd_fillp:31; ++ int cfd_prof:1; + object *cfd_self; + SPAD; + }; +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1788,10 +1788,8 @@ int sigprocmask ( int how, const sigset_ + void recreate_heap1 ( void ); + #endif + +-#ifdef GCL_GPROF + void + gprof_cleanup(void); +-#endif + + int + msystem(const char *); +@@ -1970,3 +1968,6 @@ seek_to_end_ofile(FILE *); + + void + travel_find_sharing(object,object); ++ ++object ++new_cfdata(void); +--- gcl-2.6.12.orig/h/ptable.h ++++ gcl-2.6.12/h/ptable.h +@@ -38,6 +38,8 @@ typedef struct node TABL[]; + struct string_address_table + { struct node *ptable; + unsigned int length; ++ struct node *local_ptable; ++ unsigned int local_length; + unsigned int alloc_length; + }; + +--- gcl-2.6.12.orig/lsp/gcl_mislib.lsp ++++ gcl-2.6.12/lsp/gcl_mislib.lsp +@@ -165,3 +165,27 @@ + (push (string-concatenate s l) nl)) + (setq *load-path* nl)) + nil) ++ ++(defun default-symtab nil (concatenate 'string *tmp-dir* "gcl_symtab")) ++ ++(defun gprof-output (symtab gmon) ++ (with-open-file ++ (s (format nil "|gprof -S '~a' '~a' '~a'" symtab (kcl-self) gmon)) ++ (copy-stream s *standard-output*))) ++ ++ ++(defun gprof-start (&optional (start 0 start-p) (end 0 end-p) (symtab (default-symtab))) ++ (unless end-p ++ (multiple-value-bind ++ (s e) ++ (gprof-addresses) ++ (setq start (if start-p start s) end e))) ++ (when (monstartup start end) ++ (write-symtab symtab start end))) ++ ++(defun gprof-quit (&optional (symtab (default-symtab)) &aux (gmon (mcleanup))) ++ (when gmon ++ (gprof-output symtab gmon))) ++ ++ ++ +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -1177,24 +1177,6 @@ init_tm(enum type t, char *name, int els + call is too fragile. 20050115 CM*/ + static int gcl_alloc_initialized; + +- +-#ifdef GCL_GPROF +-static unsigned long textstart,textend,textpage; +-static void init_textpage() { +- +- extern void *GCL_GPROF_START; +- unsigned long s=(unsigned long)GCL_GPROF_START; +- +- textstart=(unsigned long)&GCL_GPROF_START; +- textend=(unsigned long)&etext; +- if (stextend || s>textstart)) +- textstart=s; +- +- textpage=2*(textend-textstart)/PAGESIZE; +- +-} +-#endif +- + object malloc_list=Cnil; + + #include +@@ -1220,10 +1202,6 @@ gcl_init_alloc(void *cs_start) { + init_darwin_zone_compat (); + #endif + +-#ifdef GCL_GPROF +- init_textpage(); +-#endif +- + #if defined(BSD) && defined(RLIMIT_STACK) + { + struct rlimit rl; +@@ -1301,11 +1279,6 @@ gcl_init_alloc(void *cs_start) { + initial_sbrk=data_start=heap_end; + first_data_page=page(data_start); + +-/* #ifdef GCL_GPROF */ +-/* if (new_holepage>PAGEWIDTH)); + } + +- +-#ifdef GCL_GPROF +- +-static unsigned long start,end,gprof_on; +-static void *initial_monstartup_pointer; +- +-void +-gprof_cleanup(void) { +- +- extern void _mcleanup(void); +- +- if (initial_monstartup_pointer) { +- _mcleanup(); +- gprof_on=0; +- } +- +- if (gprof_on) { +- +- char b[PATH_MAX],b1[PATH_MAX]; +- +- if (!getcwd(b,sizeof(b))) +- FEerror("Cannot get working directory", 0); +- if (chdir(P_tmpdir)) +- FEerror("Cannot change directory to tmpdir", 0); +- _mcleanup(); +- if (snprintf(b1,sizeof(b1),"gmon.out.%u",getpid())<=0) +- FEerror("Cannot write temporary gmon filename", 0); +- if (rename("gmon.out",b1)) +- FEerror("Cannot rename gmon.out",0); +- if (chdir(b)) +- FEerror("Cannot restore working directory", 0); +- gprof_on=0; +- +- } +- +-} +- +-static inline int +-my_monstartup(unsigned long start,unsigned long end) { +- +- extern void monstartup(unsigned long,unsigned long); +- +- monstartup(start,end); +- +- return 0; +- +-} +- +-DEFUN_NEW("GPROF-START",object,fSgprof_start,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { +- +- extern void *GCL_GPROF_START; +- static int n; +- +- if (!gprof_on) { +- start=start ? start : textstart; +- end=end ? end : textend; +- writable_malloc_wrap(my_monstartup,int,start,end); +- gprof_on=1; +- if (!n && atexit(gprof_cleanup)) { +- FEerror("Cannot setup gprof_cleanup on exit", 0); +- n=1; +- } +- } +- +- return Cnil; +- +-} +- +-DEFUN_NEW("GPROF-SET",object,fSgprof_set,SI +- ,2,2,NONE,OI,IO,OO,OO,(fixnum dstart,fixnum dend),"") +-{ +- +- start=dstart; +- end=dend; +- +- return Cnil; +- +-} +- +-DEFUN_NEW("GPROF-QUIT",object,fSgprof_quit,SI +- ,0,0,NONE,OO,OO,OO,OO,(void),"") +-{ +- extern void _mcleanup(void); +- char b[PATH_MAX],b1[PATH_MAX]; +- FILE *pp; +- unsigned n; +- +- if (!gprof_on) +- return Cnil; +- +- massert(getcwd(b,sizeof(b))); +- massert(!chdir(P_tmpdir)); +- _mcleanup(); +- massert(snprintf(b1,sizeof(b1),"gprof '%s'",kcl_self)>0); +- massert((pp=popen(b1,"r"))); +- while ((n=fread(b1,1,sizeof(b1),pp))) +- massert(fwrite(b1,1,n,stdout)); +- massert(pclose(pp)>=0); +- massert(!chdir(b)); +- gprof_on=0; +- +- return Cnil; +- +-} +- +-#endif +- + DEFUN_NEW("SET-STARTING-HOLE-DIVISOR",object,fSset_starting_hole_divisor,SI,1,1,NONE,II,OO,OO,OO,(fixnum div),"") { + if (div>0 && div <100) + starting_hole_div=div; +@@ -1808,20 +1670,7 @@ malloc_internal(size_t size) { + void * + malloc(size_t size) { + +- void *v=malloc_internal(size);; +- +- /* FIXME: this is just to handle clean freeing of the +- monstartup memory allocated automatically on raw image +- startup. In saved images, monstartup memory is only +- allocated with gprof-start. 20040804 CM*/ +-#ifdef GCL_GPROF +- if (raw_image && size>(textend-textstart) && !initial_monstartup_pointer) { +- massert(!atexit(gprof_cleanup)); +- initial_monstartup_pointer=v; +- } +-#endif +- +- return v; ++ return malloc_internal(size); + + } + +@@ -1830,7 +1679,6 @@ void + free(void *ptr) { + + object *p,pp; +- static void *initial_monstartup_pointer_echo; + + if (ptr == 0) + return; +@@ -1839,15 +1687,9 @@ free(void *ptr) { + if ((pp)->c.c_car->st.st_self == ptr) { + (pp)->c.c_car->st.st_self = NULL; + *p = pp->c.c_cdr; +-#ifdef GCL_GPROF +- if (initial_monstartup_pointer==ptr) { +- initial_monstartup_pointer_echo=ptr; +- initial_monstartup_pointer=NULL; +- } +-#endif + return; + } +- if (ptr!=initial_monstartup_pointer_echo) { ++ { + static void *old_ptr; + if (old_ptr==ptr) return; + old_ptr=ptr; +@@ -1855,7 +1697,6 @@ free(void *ptr) { + FEerror("free(3) error.",0); + #endif + } +- initial_monstartup_pointer_echo=NULL; + return; + } + +--- gcl-2.6.12.orig/o/cmpaux.c ++++ gcl-2.6.12/o/cmpaux.c +@@ -393,6 +393,15 @@ call_init(int init_address, object memor + + */ + ++DEFUN_NEW("MARK-MEMORY-AS-PROFILING",object,fSmark_memory_as_profiling,SI,0,0, ++ NONE,OO,OO,OO,OO,(void),"") { ++ ++ sSPmemory->s.s_dbind->cfd.cfd_prof=1; ++ ++ return Cnil; ++ ++} ++ + void + do_init(object *statVV) + {object fasl_vec=sSPinit->s.s_dbind; +@@ -467,6 +476,22 @@ char *s; + + #endif + ++object ++new_cfdata(void) { ++ ++ object memory=alloc_object(t_cfdata); ++ ++ memory->cfd.cfd_size=0; ++ memory->cfd.cfd_fillp=0; ++ memory->cfd.cfd_prof=0; ++ memory->cfd.cfd_self=0; ++ memory->cfd.cfd_start=0; ++ ++ return memory; ++ ++} ++ ++ + void + gcl_init_or_load1(void (*fn)(void),const char *file) { + +@@ -476,10 +501,7 @@ gcl_init_or_load1(void (*fn)(void),const + object fasl_data; + file=FIX_PATH_STRING(file); + +- memory=alloc_object(t_cfdata); +- memory->cfd.cfd_self=0; +- memory->cfd.cfd_fillp=0; +- memory->cfd.cfd_size = 0; ++ memory=new_cfdata(); + memory->cfd.cfd_start= (char *)fn; + printf("Initializing %s\n",file); fflush(stdout); + fasl_data = read_fasl_data(file); +--- gcl-2.6.12.orig/o/fasldlsym.c ++++ gcl-2.6.12/o/fasldlsym.c +@@ -101,10 +101,7 @@ fasload(object faslfile) { + SEEK_TO_END_OFILE(faslstream->sm.sm_fp); + + data = read_fasl_vector(faslstream); +- memory = alloc_object(t_cfdata); +- memory->cfd.cfd_self = NULL; +- memory->cfd.cfd_start = NULL; +- memory->cfd.cfd_size = 0; ++ memory=new_cfdata(); + + if(symbol_value(sLAload_verboseA)!=Cnil) + printf(" start address (dynamic) %p ",fptr); +--- /dev/null ++++ gcl-2.6.12/o/gprof.c +@@ -0,0 +1,137 @@ ++#include "include.h" ++#include "page.h" ++#include "ptable.h" ++ ++ ++static unsigned long gprof_on; ++ ++DEFUN_NEW("MCLEANUP",object,fSmcleanup,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { ++ ++ extern void _mcleanup(void); ++ ++ if (!gprof_on) ++ return Cnil; ++ ++ massert(getcwd(FN1,sizeof(FN1))); ++ massert(!chdir(P_tmpdir)); ++ _mcleanup(); ++ massert(!chdir(FN1)); ++ gprof_on=0; ++ massert(snprintf(FN1,sizeof(FN1),"%s/gmon.out",P_tmpdir)>0); ++ return make_simple_string(FN1); ++} ++ ++static inline int ++my_monstartup(unsigned long start,unsigned long end) { ++ ++ extern void monstartup(unsigned long,unsigned long); ++ ++ monstartup(start,end); ++ ++ return 0; ++ ++} ++ ++DEFUN_NEW("MONSTARTUP",object,fSmonstartup,SI,2,2,NONE,OI,IO,OO,OO,(ufixnum start,ufixnum end),"") { ++ ++ if (gprof_on) ++ return Cnil; ++ ++ writable_malloc_wrap(my_monstartup,int,start,end); ++ gprof_on=1; ++ ++ return Ct; ++ ++} ++ ++void ++gprof_cleanup(void) { ++ ++ FFN(fSmcleanup)(); ++ /*rename gmon?*/ ++ ++} ++ ++DEFUNM_NEW("GPROF-ADDRESSES",object,fSgprof_addresses,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { ++ ++ void *min=heap_end,*max=data_start,*c; ++ static void *mintext; ++ struct pageinfo *v; ++ object x; ++ fixnum i; ++ struct typemanager *tm=tm_of(t_cfdata); ++ ++ for (v=cell_list_head;v;v=v->next) ++ if (v->type==tm->tm_type) ++ for (c=pagetochar(page(v)),i=0;itm_nppage;i++,c+=tm->tm_size) ++ if (!is_free((x=c)) && type_of(x)==t_cfdata && x->cfd.cfd_prof) { ++ min=(void *)x->cfd.cfd_startcfd.cfd_start : min; ++ max=(void *)x->cfd.cfd_start+x->cfd.cfd_size>max ? x->cfd.cfd_start+x->cfd.cfd_size : max; ++ } ++ ++ if (maxp_link) ++ for (i=0,b=p->p_internal,be=b+p->p_internal_size;b; ++ b=i ? NULL : p->p_external,be=b+p->p_external_size,i=1) ++ for (;bc.c_cdr) ++ if ((f=(s=l->c.c_car)->s.s_gfdef)!=OBJNULL && s->s.s_hpack==(object)p) ++ switch(type_of(f)) { ++ case t_cfun:case t_sfun:case t_vfun:case t_afun:case t_gfun: ++ if ((ufixnum)f->cf.cf_self>=start && (ufixnum)f->cf.cf_selfcf.cf_self, ++ p->p_name->st.st_fillp,p->p_name->st.st_self, ++ s->st.st_fillp,s->st.st_self); ++ break; ++ } ++ fprintf(pp,"%016lx T GCL_MONEND\n",end); ++ ++ for (i=0;icfd.cfd_self = 0; +- memory->cfd.cfd_start = 0; +- memory->cfd.cfd_size = datasize+textsize+bsssize + extra_bss; +- vs_push(memory); +- the_start=start_address= +- memory->cfd.cfd_start = +- alloc_contblock(memory->cfd.cfd_size); +- sfaslp->s_start_data = start_address + textsize; +- sfaslp->s_start_bss = start_address + textsize + datasize; +- END_NO_INTERRUPT; ++ memory=new_cfdata(); ++ memory->cfd.cfd_size = datasize+textsize+bsssize + extra_bss; ++ vs_push(memory); ++ the_start=start_address= ++ memory->cfd.cfd_start= ++ alloc_contblock(memory->cfd.cfd_size); ++ sfaslp->s_start_data = start_address + textsize; ++ sfaslp->s_start_bss = start_address + textsize + datasize; ++ END_NO_INTERRUPT; + } + #else + the_start = start_address +--- gcl-2.6.12.orig/o/sfaslbfd.c ++++ gcl-2.6.12/o/sfaslbfd.c +@@ -269,9 +269,7 @@ fasload(object faslfile) { + curr_size=(unsigned long)current; + max_align=1<cfd.cfd_self = 0; +- memory->cfd.cfd_start = 0; ++ memory=new_cfdata(); + memory->cfd.cfd_size = curr_size + (max_align > sizeof(char *) ? max_align :0); + + memory->cfd.cfd_start=alloc_contblock(memory->cfd.cfd_size); +--- gcl-2.6.12.orig/o/sfaslcoff.c ++++ gcl-2.6.12/o/sfaslcoff.c +@@ -207,10 +207,8 @@ load_memory(struct scnhdr *sec1,struct s + if (ALLOC_SEC(sec)) + sec->s_paddr=sz; + +- memory = alloc_object(t_cfdata); ++ memory=new_cfdata(); + memory->cfd.cfd_size=sz; +- memory->cfd.cfd_self=0; +- memory->cfd.cfd_start=0; + memory->cfd.cfd_start=alloc_code_space(sz); + + for (sec=sec1;secn_sclass!=2 || sym->n_scnum<1) ++ if (sym->n_sclass<2 || sym->n_sclass>3 || sym->n_scnum<1) + continue; + + ns++; +@@ -270,7 +268,7 @@ load_self_symbols() { + + } + +- c_table.alloc_length=c_table.length=ns; ++ c_table.alloc_length=ns; + assert(c_table.ptable=malloc(sizeof(*c_table.ptable)*c_table.alloc_length)); + assert(st=malloc(sl)); + +@@ -296,9 +294,36 @@ load_self_symbols() { + sym+=sym->n_numaux; + + } +- ++ c_table.length=a-c_table.ptable; + qsort(c_table.ptable,c_table.length,sizeof(*c_table.ptable),node_compare); + ++ for (c_table.local_ptable=a,sym=sy1;symn_sclass!=3 || sym->n_scnum<1) ++ continue; ++ ++ NM(sym,st1,s,strcpy(st,s)); ++ ++ sec=sec1+sym->n_scnum-1; ++ jj=sym->n_value+sec->s_vaddr+h->h_ibase; ++ ++#ifdef FIX_ADDRESS ++ FIX_ADDRESS(jj); ++#endif ++ ++ a->address=jj; ++ a->string=st; ++ ++ a++; ++ st+=strlen(st)+1; ++ sym+=sym->n_numaux; ++ ++ } ++ c_table.local_length=a-c_table.local_ptable; ++ qsort(c_table.local_ptable,c_table.local_length,sizeof(*c_table.local_ptable),node_compare); ++ ++ massert(c_table.alloc_length==c_table.length+c_table.local_length); ++ + massert(!un_mmap(v1,ve)); + massert(!fclose(f)); + +--- gcl-2.6.12.orig/o/sfaslelf.c ++++ gcl-2.6.12/o/sfaslelf.c +@@ -55,9 +55,12 @@ License for more details. + #define ulmax(a_,b_) ({ul _a=a_,_b=b_;_a<_b ? _b : _a;}) + #define ALLOC_SEC(sec) (sec->sh_flags&SHF_ALLOC && (sec->sh_type==SHT_PROGBITS || sec->sh_type==SHT_NOBITS)) + #define LOAD_SEC(sec) (sec->sh_flags&SHF_ALLOC && sec->sh_type==SHT_PROGBITS) +-#define LOAD_SYM_BY_BIND(sym) ({ul _b=ELF_ST_BIND(sym->st_info); sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK);}) +-#define LOAD_SYM_BY_NAME(sym,st1) 0 +-#define LOAD_SYM(sym,st1) (LOAD_SYM_BY_BIND(sym)||LOAD_SYM_BY_NAME(sym,st1)) ++#define EXT_SYM(sym) ({ul _b=ELF_ST_BIND(sym->st_info); \ ++ sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK);}) ++#define LOCAL_SYM(sym) (sym->st_value && \ ++ ELF_ST_BIND(sym->st_info)==STB_LOCAL) ++ /* && ELF_ST_TYPE(sym->st_info)==STT_FUNC) */ ++#define LOAD_SYM(sym) (EXT_SYM(sym)||LOCAL_SYM(sym)) + + #define MASK(n) (~(~0ULL << (n))) + +@@ -271,10 +274,8 @@ load_memory(Shdr *sec1,Shdr *sece,void * + sz+=gsz; + } + +- memory=alloc_object(t_cfdata); ++ memory=new_cfdata(); + memory->cfd.cfd_size=sz; +- memory->cfd.cfd_self=0; +- memory->cfd.cfd_start=0; + memory->cfd.cfd_start=alloc_code_space(sz); + + a=(ul)memory->cfd.cfd_start; +@@ -411,7 +412,7 @@ calc_space(ul *ns,ul *sl,Sym *sym1,Sym * + + for (sym=sym1;symcfd.cfd_size=sz; +- memory->cfd.cfd_self=0; +- memory->cfd.cfd_start=0; + memory->cfd.cfd_start=alloc_code_space(sz); + + a=(ul)memory->cfd.cfd_start; +@@ -411,23 +409,19 @@ load_self_symbols() { + + if (sym->n_type & N_STAB) + continue; +- if (!(sym->n_type & N_EXT)) +- continue; + + ns++; + sl+=strlen(sym->n_un.n_strx+strtab)+1; + + } + +- c_table.alloc_length=c_table.length=ns; ++ c_table.alloc_length=ns; + assert(c_table.ptable=malloc(sizeof(*c_table.ptable)*c_table.alloc_length)); + assert(s=malloc(sl)); + + for (a=c_table.ptable,sym=sym1;symn_type & N_STAB) +- continue; +- if (!(sym->n_type & N_EXT)) ++ if (sym->n_type & N_STAB || !(sym->n_type & N_EXT)) + continue; + + a->address=sym->n_value; +@@ -438,9 +432,28 @@ load_self_symbols() { + s+=strlen(s)+1; + + } +- ++ c_table.length=a-c_table.ptable; + qsort(c_table.ptable,c_table.length,sizeof(*c_table.ptable),node_compare); + ++ c_table.local_ptable=a; ++ for (a=c_table.ptable,sym=sym1;symn_type & N_STAB || sym->n_type & N_EXT) ++ continue; ++ ++ a->address=sym->n_value; ++ a->string=s; ++ strcpy(s,sym->n_un.n_strx+strtab); ++ ++ a++; ++ s+=strlen(s)+1; ++ ++ } ++ c_table.local_length=a-c_table.local_ptable; ++ qsort(c_table.local_ptable,c_table.local_length,sizeof(*c_table.local_ptable),node_compare); ++ ++ massert(c_table.alloc_length==c_table.length+c_table.local_length); ++ + massert(!un_mmap(addr,addre)); + massert(!fclose(f)); + +--- gcl-2.6.12.orig/o/sfaslmacosx.c ++++ gcl-2.6.12/o/sfaslmacosx.c +@@ -232,10 +232,7 @@ int fasload (object faslfile) + + close_stream (faslstream); + +- memory = alloc_object (t_cfdata); +- memory->cfd.cfd_self = NULL; +- memory->cfd.cfd_start = NULL; +- memory->cfd.cfd_size = 0; ++ memory=new_cfdata(); + + if (symbol_value (sLAload_verboseA) != Cnil) + printf (" start address (dynamic) %p ", fptr); +--- gcl-2.6.12.orig/o/unixfasl.c ++++ gcl-2.6.12/o/unixfasl.c +@@ -146,9 +146,7 @@ object faslfile; + fread(&header, sizeof(header), 1, fp); + #endif + +- memory = alloc_object(t_cfdata); +- memory->cfd.cfd_self = NULL; +- memory->cfd.cfd_start = NULL; ++ memory=new_cfdata(); + memory->cfd.cfd_size = textsize + datasize + bsssize; + vs_push(memory); + /* If the file is smaller than the space asked for, typically the file +@@ -314,12 +312,10 @@ DEFUN_NEW("FASLINK-INT",object,fSfaslink + setbuf(fp, buf); + fread(&header, sizeof(header), 1, fp); + {BEGIN_NO_INTERRUPT; +- memory = alloc_object(t_cfdata); +- memory->cfd.cfd_self=0; +- memory->cfd.cfd_start = NULL; +- memory->cfd.cfd_size = textsize + datasize + bsssize; +- vs_push(memory); +- memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock, ++ memory=new_cfdata(); ++ memory->cfd.cfd_size = textsize + datasize + bsssize; ++ vs_push(memory); ++ memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock, + memory->cfd.cfd_size, + sizeof(double)); + END_NO_INTERRUPT;} +--- gcl-2.6.12.orig/unixport/makefile ++++ gcl-2.6.12/unixport/makefile +@@ -69,28 +69,26 @@ $(LSPDIR)/auto_new.lsp: $(LSPDIR)/auto.l + [ "$(RL_OBJS)" = "" ] || \ + echo "(AUTOLOAD 'init-readline '|readline|)" >>$@ + +-sys_init.lsp: sys_init.lsp.in ++saved_%:raw_% $(RSYM) sys_init.lsp.in raw_%_map msys \ ++ $(CMPDIR)/gcl_cmpmain.lsp \ ++ $(CMPDIR)/gcl_lfun_list.lsp \ ++ $(CMPDIR)/gcl_cmpopt.lsp $(HDIR)/cmpinclude.h \ ++ $(LSPDIR)/gcl_auto_new.lsp + +- cat $< | sed \ ++ cat sys_init.lsp.in | sed \ + -e "s#@LI-VERS@#(`cat ../majvers`.`cat ../minvers`) `cat ../release`#1" \ + -e "s#@LI-EXTVERS@#`cat ../minvers | cut -f2 -d.`#1" \ + -e "s#@LI-MINVERS@#`cat ../minvers | cut -f1 -d.`#1" \ + -e "s#@LI-MAJVERS@#`cat ../majvers`#1" \ + -e "s#@LI-RELEASE@#`cat ../release`#1" \ +- -e "s#@LI-CC@#\"$(GCL_CC) -c $(FINAL_CFLAGS)\"#1" \ ++ -e "s#@LI-CC@#\"$(GCL_CC) -c $(filter-out -pg,$(FINAL_CFLAGS))\"#1" \ ++ -e "s#@LI-DFP@#\"$(filter -pg,$(FINAL_CFLAGS))\"#1" \ + -e "s#@LI-LD@#\"$(GCL_CC) $(LD_FLAGS) -o \"#1" \ +- -e "s#@LI-LD-LIBS@#\" $(LD_LIBS_PRE) -l$* $(LD_LIBS_POST)\"#1" \ ++ -e "s#@LI-LD-LIBS@#\" $(LD_LIBS_POST)\"#1" \ + -e "s#@LI-OPT-THREE@#\"$(O3FLAGS)\"#1" \ + -e "s#@LI-OPT-TWO@#\"$(O2FLAGS)\"#1" \ +- -e "s#@LI-INIT-LSP@#\"$@\"#1" >$@ +- +-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 ++ -e "s#@LI-INIT-LSP@#\"$@\"#1" >foo + +- cp sys_init.lsp foo + echo "(unless si::*quit-tags* (in-package \"USER\")(system:save-system \"$@\"))" >>foo + j=$$(ar t lib$*.a |grep ^gcl_);[ "$$j" = "" ] || ar x lib$*.a $$j #accelerator + $(PORTDIR)/raw_$*$(EXE) $(PORTDIR)/ -libdir $(GCLDIR)/ < foo +@@ -160,7 +158,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 sys_init.lsp ++ gazonk*.lsp plt*h *_map saved_* lib* raw_* msys out* log* tmp* gcl.script + + .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_init.lsp.in ++++ gcl-2.6.12/unixport/sys_init.lsp.in +@@ -59,8 +59,10 @@ + + (in-package :compiler) + (setq *cc* @LI-CC@ ++ *default-prof-p* (> (length @LI-DFP@) 0) + *ld* @LI-LD@ + *ld-libs* @LI-LD-LIBS@ ++ *ld-libs* (concatenate 'string "-l" #+ansi-cl "ansi_" "gcl " *ld-libs*) + *opt-three* @LI-OPT-THREE@ + *opt-two* @LI-OPT-TWO@ + *init-lsp* @LI-INIT-LSP@) diff --git a/patches/list_order.18 b/patches/list_order.18 new file mode 100644 index 00000000..8528b67b --- /dev/null +++ b/patches/list_order.18 @@ -0,0 +1,60 @@ +Description: + 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-60) unstable; urgency=medium + . + * list_order.17 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-01-23 + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -483,6 +483,12 @@ Cannot compile ~a.~%" + + (defvar *use-buggy* nil) + ++(defun remove-flag (flag flags) ++ (let ((i (search flag flags))) ++ (if i ++ (concatenate 'string (subseq flags 0 i) (remove-flag flag (subseq flags (+ i (length flag))))) ++ flags))) ++ + (defun compiler-command (&rest args &aux na ) + (declare (special *c-debug*)) + (let ((dirlist (pathname-directory (first args))) +@@ -493,7 +499,7 @@ Cannot compile ~a.~%" + (setq na (namestring + (make-pathname :name name :type (pathname-type(first args))))) + (format nil "~a ~a -I~a ~a ~a -c ~a -o ~a ~a" +- *cc* ++ (if *prof-p* (remove-flag "-fomit-frame-pointer" *cc*) *cc*) + (if *prof-p* " -pg " "") + (concatenate 'string si::*system-directory* "../h") + (if (and (boundp '*c-debug*) *c-debug*) " -g " "") +--- gcl-2.6.12.orig/o/makefile ++++ gcl-2.6.12/o/makefile +@@ -34,7 +34,7 @@ boot.o: boot.c $(DECL) boot.h + $(CC) -c $(CFLAGS) $(DEFS) -fPIC $*.c $(AUX_INFO) + + gprof.o: gprof.c $(DECL) +- $(CC) -c $(CFLAGS) $(DEFS) -pg $*.c $(AUX_INFO) ++ $(CC) -c $(filter-out -fomit-frame-pointer,$(CFLAGS)) $(DEFS) -pg $*.c $(AUX_INFO) + + prelink.o: prelink.c $(DECL) + $(CC) -c $(filter-out -pg,$(CFLAGS)) -fPIE $(DEFS) $*.c $(AUX_INFO) diff --git a/patches/list_order.19 b/patches/list_order.19 new file mode 100644 index 00000000..2c82b592 --- /dev/null +++ b/patches/list_order.19 @@ -0,0 +1,218 @@ +Description: + 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-60) unstable; urgency=medium + . + * list_order.18 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-01-24 + +--- gcl-2.6.12.orig/lsp/gcl_mislib.lsp ++++ gcl-2.6.12/lsp/gcl_mislib.lsp +@@ -166,24 +166,45 @@ + (setq *load-path* nl)) + nil) + +-(defun default-symtab nil (concatenate 'string *tmp-dir* "gcl_symtab")) +- + (defun gprof-output (symtab gmon) + (with-open-file + (s (format nil "|gprof -S '~a' '~a' '~a'" symtab (kcl-self) gmon)) + (copy-stream s *standard-output*))) + ++(defun write-symtab (symtab start end &aux (*package* (find-package "KEYWORD"))) ++ ++ (with-open-file ++ (s symtab :direction :output :if-exists :supersede) ++ ++ (format s "~16,'0x T ~a~%" start "GCL_MONSTART") + +-(defun gprof-start (&optional (start 0 start-p) (end 0 end-p) (symtab (default-symtab))) +- (unless end-p +- (multiple-value-bind +- (s e) +- (gprof-addresses) +- (setq start (if start-p start s) end e))) +- (when (monstartup start end) +- (write-symtab symtab start end))) ++ (dolist (p (list-all-packages)) ++ (do-symbols (x p) ++ (when (and (eq (symbol-package x) p) (fboundp x)) ++ (let* ((y (symbol-function x)) ++ (y (if (and (consp y) (eq 'macro (car y))) (cdr y) y)) ++ (y (if (compiled-function-p y) (function-start y) 0))) ++ (when (<= start y end) ++ (format s "~16,'0x T ~s~%" y x)))))) ++ ++ (let ((string-register "")) ++ (dotimes (i (ptable-alloc-length)) ++ (multiple-value-bind ++ (x y) (ptable i string-register) ++ (when (<= start x end) ++ (format s "~16,'0x T ~a~%" x y))))) ++ ++ (format s "~16,'0x T ~a~%" end "GCL_MONEND")) ++ ++ symtab) ++ ++(defun gprof-start (&optional (symtab "gcl_symtab") (adrs (gprof-addresses)) ++ &aux (start (car adrs))(end (cdr adrs))) ++ (let ((symtab (write-symtab symtab start end))) ++ (when (monstartup start end) ++ symtab))) + +-(defun gprof-quit (&optional (symtab (default-symtab)) &aux (gmon (mcleanup))) ++(defun gprof-quit (&optional (symtab "gcl_symtab") &aux (gmon (mcleanup))) + (when gmon + (gprof-output symtab gmon))) + +--- gcl-2.6.12.orig/o/fat_string.c ++++ gcl-2.6.12/o/fat_string.c +@@ -59,17 +59,16 @@ DEFUN_NEW("PROFILE",object,fSprofile,SI + } + + #endif +-DEFUN_NEW("FUNCTION-START",object,fSfunction_start,SI +- ,1,1,NONE,OO,OO,OO,OO,(object funobj),"") +-{/* 1 args */ +- if(type_of(funobj)!=t_cfun +- && type_of(funobj)!=t_sfun +- && type_of(funobj)!=t_vfun +- && type_of(funobj)!=t_afun +- && type_of(funobj)!=t_gfun) +- FEerror("not compiled function",0); +- funobj=make_fixnum((long) (funobj->cf.cf_self)); +- RETURN1(funobj); ++DEFUN_NEW("FUNCTION-START",object,fSfunction_start,SI,1,1,NONE,OO,OO,OO,OO,(object funobj),"") { ++ ++ switch (type_of(funobj)) { ++ case t_cfun:case t_sfun:case t_vfun:case t_afun:case t_gfun:case t_closure:case t_cclosure: ++ return make_fixnum((long) (funobj->cf.cf_self)); ++ default: ++ TYPE_ERROR(funobj,sLcompiled_function); ++ return Cnil; ++ } ++ + } + + /* begin fasl stuff*/ +--- gcl-2.6.12.orig/o/gprof.c ++++ gcl-2.6.12/o/gprof.c +@@ -12,13 +12,11 @@ DEFUN_NEW("MCLEANUP",object,fSmcleanup,S + if (!gprof_on) + return Cnil; + +- massert(getcwd(FN1,sizeof(FN1))); +- massert(!chdir(P_tmpdir)); +- _mcleanup(); +- massert(!chdir(FN1)); ++ massert((_mcleanup(),1)); + gprof_on=0; +- massert(snprintf(FN1,sizeof(FN1),"%s/gmon.out",P_tmpdir)>0); +- return make_simple_string(FN1); ++ ++ return make_simple_string("gmon.out"); ++ + } + + static inline int +@@ -48,11 +46,10 @@ void + gprof_cleanup(void) { + + FFN(fSmcleanup)(); +- /*rename gmon?*/ + + } + +-DEFUNM_NEW("GPROF-ADDRESSES",object,fSgprof_addresses,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { ++DEFUN_NEW("GPROF-ADDRESSES",object,fSgprof_addresses,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { + + void *min=heap_end,*max=data_start,*c; + static void *mintext; +@@ -77,10 +74,8 @@ DEFUNM_NEW("GPROF-ADDRESSES",object,fSgp + mintext=data_start; + + #ifdef GCL_GPROF +- for (i=0;ip_link) +- for (i=0,b=p->p_internal,be=b+p->p_internal_size;b; +- b=i ? NULL : p->p_external,be=b+p->p_external_size,i=1) +- for (;bc.c_cdr) +- if ((f=(s=l->c.c_car)->s.s_gfdef)!=OBJNULL && s->s.s_hpack==(object)p) +- switch(type_of(f)) { +- case t_cfun:case t_sfun:case t_vfun:case t_afun:case t_gfun: +- if ((ufixnum)f->cf.cf_self>=start && (ufixnum)f->cf.cf_selfcf.cf_self, +- p->p_name->st.st_fillp,p->p_name->st.st_self, +- s->st.st_fillp,s->st.st_self); +- break; +- } +- fprintf(pp,"%016lx T GCL_MONEND\n",end); +- +- for (i=0;ist.st_self=(void *)c_table.ptable[i].string; ++ s->st.st_fillp=s->st.st_dim=strlen(s->st.st_self); ++ RETURN2(make_fixnum(c_table.ptable[i].address),s); + } diff --git a/patches/list_order.20 b/patches/list_order.20 new file mode 100644 index 00000000..7e87bf07 --- /dev/null +++ b/patches/list_order.20 @@ -0,0 +1,72 @@ +Description: + 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-60) unstable; urgency=medium + . + * list_order.19 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-01-30 + +--- gcl-2.6.12.orig/h/elf64_ppcle_reloc_special.h ++++ gcl-2.6.12/h/elf64_ppcle_reloc_special.h +@@ -16,7 +16,7 @@ find_special_params(void *v,Shdr *sec1,S + Rela *r; + void *ve; + +- massert((sec=get_section(".rela.plt",sec1,sece,sn))); ++ massert((sec=get_section(".rela.dyn",sec1,sece,sn))); + + v+=sec->sh_offset; + ve=v+sec->sh_size; +--- gcl-2.6.12.orig/h/object.h ++++ gcl-2.6.12/h/object.h +@@ -401,9 +401,9 @@ char *tmp_alloc; + */ + + #define ALLOC_ALIGNED(f, size,align) \ +- (align <= sizeof(plong) ? (char *)((f)(size)) : \ +- (tmp_alloc = (char *)((f)(size+(size ?(align)-1 : 0)))+(align)-1 , \ +- (char *)(align * (((unsigned long)tmp_alloc)/align)))) ++ ({ufixnum _size=size,_align=align;_align <= sizeof(plong) ? (char *)((f)(_size)) : \ ++ (tmp_alloc = (char *)((f)(_size+(_size ?(_align)-1 : 0)))+(_align)-1 , \ ++ (char *)(_align * (((unsigned long)tmp_alloc)/_align)));}) + #define AR_ALLOC(f,n,type) (type *) \ + (ALLOC_ALIGNED(f,(n)*sizeof(type),sizeof(type))) + +--- gcl-2.6.12.orig/o/fat_string.c ++++ gcl-2.6.12/o/fat_string.c +@@ -47,13 +47,17 @@ DEFUN_NEW("PROFILE",object,fSprofile,SI + + object ar=sSAprofile_arrayA->s.s_dbind; + void *x; ++ fixnum a,s; + + if (type_of(ar)!=t_string) + FEerror("si:*Profile-array* not a string",0); + if( type_of(start_address)!=t_fixnum || type_of(scale)!=t_fixnum) + FEerror("Needs start address and scale as args",0); + +- x=!(fix(start_address)*fix(scale)) ? NULL : (void *) (ar->ust.ust_self); ++ massert((a=fix(start_address))>=0); ++ massert((s=fix(scale))>=0); ++ ++ x=a&&s ? (void *) (ar->ust.ust_self) : NULL; + profil(x, (ar->ust.ust_dim),fix(start_address),fix(scale) << 8); + RETURN1(start_address); + } diff --git a/patches/list_order.21 b/patches/list_order.21 new file mode 100644 index 00000000..a8fc1531 --- /dev/null +++ b/patches/list_order.21 @@ -0,0 +1,48 @@ +Description: + 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-61) unstable; urgency=medium + . + * list_order.20 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-01-30 + +--- gcl-2.6.12.orig/h/alpha-linux.h ++++ gcl-2.6.12/h/alpha-linux.h +@@ -5,12 +5,14 @@ + + #undef MPROTECT_ACTION_FLAGS + #define MPROTECT_ACTION_FLAGS SA_RESTART|SA_SIGINFO +-#ifdef IN_GBC +-#include +-#define GET_FAULT_ADDR(sig,code,scp,addr) \ +- (char *)((struct ucontext *)scp )->uc_mcontext.sc_traparg_a0 +-#endif +-#define SGC ++/* #ifdef IN_GBC */ ++/* #include */ ++/* #define GET_FAULT_ADDR(sig,code,scp,addr) \ no longer working*/ ++/* (char *)((struct ucontext *)scp )->uc_mcontext.sc_traparg_a0 */ ++/*#define GET_FAULT_ADDR(sig,code,sv,a) ((siginfo_t *)code)->si_addr perhaps try this when get access*/ ++/* #endif */ ++/* #define SGC */ ++#undef SGC + + #define RELOC_H "elf64_alpha_reloc.h" + #define SPECIAL_RELOC_H "elf64_alpha_reloc_special.h" diff --git a/patches/list_order.22 b/patches/list_order.22 new file mode 100644 index 00000000..26481812 --- /dev/null +++ b/patches/list_order.22 @@ -0,0 +1,62 @@ +Description: + 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-61) unstable; urgency=medium + . + * list_order.21 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-02-01 + +--- gcl-2.6.12.orig/o/sfaslelf.c ++++ gcl-2.6.12/o/sfaslelf.c +@@ -55,12 +55,10 @@ License for more details. + #define ulmax(a_,b_) ({ul _a=a_,_b=b_;_a<_b ? _b : _a;}) + #define ALLOC_SEC(sec) (sec->sh_flags&SHF_ALLOC && (sec->sh_type==SHT_PROGBITS || sec->sh_type==SHT_NOBITS)) + #define LOAD_SEC(sec) (sec->sh_flags&SHF_ALLOC && sec->sh_type==SHT_PROGBITS) +-#define EXT_SYM(sym) ({ul _b=ELF_ST_BIND(sym->st_info); \ +- sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK);}) +-#define LOCAL_SYM(sym) (sym->st_value && \ +- ELF_ST_BIND(sym->st_info)==STB_LOCAL) +- /* && ELF_ST_TYPE(sym->st_info)==STT_FUNC) */ +-#define LOAD_SYM(sym) (EXT_SYM(sym)||LOCAL_SYM(sym)) ++#define LOAD_SYM(sym,st1) (sym->st_value && (EXT_SYM(sym,st1)||LOCAL_SYM(sym))) ++#define EXT_SYM(sym,st1) (ELF_ST_BIND(sym->st_info)==STB_GLOBAL||ELF_ST_BIND(sym->st_info)==STB_WEAK||LOAD_SYM_BY_NAME(sym,st1)) ++#define LOCAL_SYM(sym) ELF_ST_BIND(sym->st_info)==STB_LOCAL ++#define LOAD_SYM_BY_NAME(sym,st1) 0 + + #define MASK(n) (~(~0ULL << (n))) + +@@ -412,7 +410,7 @@ calc_space(ul *ns,ul *sl,Sym *sym1,Sym * + + for (sym=sym1;sym + 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-62) unstable; urgency=medium + . + * list_order.22 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-02-01 + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -658,7 +658,7 @@ Cannot compile ~a.~%" + (defun make-user-init (files outn) + + (let* ((c (pathname outn)) +- (c (merge-pathnames c (make-pathname :directory '(:current)))) ++ (c (merge-pathnames c (make-pathname :directory '(:relative)))) + (o (merge-pathnames (make-pathname :type "o") c)) + (c (merge-pathnames (make-pathname :type "c") c))) + +@@ -769,7 +769,7 @@ Cannot compile ~a.~%" + + (with-open-file (st (namestring map) :direction :output)) + (safe-system +- (let* ((par (namestring (make-pathname :directory '(:back)))) ++ (let* ((par (namestring (make-pathname :directory '(:relative :back)))) + (i (concatenate 'string " " par)) + (j (concatenate 'string " " si::*system-directory* par))) + (format nil "~a ~a ~a ~a -L~a ~a ~a ~a" +--- gcl-2.6.12.orig/gcl-tk/makefile ++++ gcl-2.6.12/gcl-tk/makefile +@@ -38,13 +38,13 @@ clean:: + rm -f ${GUIOS} $(OFILES) gcltkaux gcltksrv *.o */*.o demos/index.lsp *.fn demos/*.fn + + .c.o: +- $(GCLTKCC) -c $(CFLAGS1) ${ODIR_DEBUG} $*.c ++ $(GCLTKCC) -c $(filter-out -pg,$(CFLAGS1)) -fPIE ${ODIR_DEBUG} $*.c + + + # for some reason -lieee is on various linux systems in the list of requireds.. + + gcltkaux: $(GUIOS) +- $(LD_ORDINARY_CC) $(GUIOS) $(LDFLAGS) -o gcltkaux ${TK_LIB_SPEC} ${TCL_LIB_SPEC} ++ $(LD_ORDINARY_CC) $(GUIOS) $(filter-out %gcl.script,$(LDFLAGS)) -pie -o gcltkaux ${TK_LIB_SPEC} ${TCL_LIB_SPEC} + + gcltksrv: makefile + cat gcltksrv.in | sed -e "s!TK_LIBRARY=.*!TK_LIBRARY=${TK_LIBRARY}!g" \ +--- gcl-2.6.12.orig/h/386-gnu.h ++++ gcl-2.6.12/h/386-gnu.h +@@ -60,4 +60,4 @@ + + #define NEED_STACK_CHK_GUARD + +-#define DEFINED_REAL_MAXPAGE (1UL<<18) /*FIXME brk probe broken*/ ++#undef HAVE_D_TYPE /*FIXME defined, but not implemented in readdir*/ +--- gcl-2.6.12.orig/o/unixfsys.c ++++ gcl-2.6.12/o/unixfsys.c +@@ -307,8 +307,11 @@ DEFUN_NEW("D-TYPE-LIST",object,fSd_type_ + MMcons(make_fixnum(DT_UNKNOWN),make_keyword("UNKNOWN")) + ) + #else ++#undef DT_UNKNOWN + #define DT_UNKNOWN 0 ++#undef DT_REG + #define DT_REG 1 ++#undef DT_DIR + #define DT_DIR 2 + list(3, + MMcons(make_fixnum(DT_REG),make_keyword("FILE")), diff --git a/patches/list_order.24 b/patches/list_order.24 new file mode 100644 index 00000000..04332178 --- /dev/null +++ b/patches/list_order.24 @@ -0,0 +1,44 @@ +Description: + 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-63) unstable; urgency=medium + . + * list_order.23 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-02-04 + +--- gcl-2.6.12.orig/h/gmp_wrappers.h ++++ gcl-2.6.12/h/gmp_wrappers.h +@@ -148,6 +148,8 @@ MEM_GMP_CALL(1,gmp_ulint,mpz_popcount,0, + /*MEM_GMP_CALL(2,void *,mpz_realloc,mpz_t,mp_size_t)*/ + MEM_GMP_CALL(1,size_t,mpz_size,0,mpz_t) + MEM_GMP_CALL(2,size_t,mpz_sizeinbase,0,mpz_t,int) ++MEM_GMP_CALL(1,void,gmp_randinit_default,0,__gmp_randstate_struct *) ++MEM_GMP_CALL(2,void,gmp_randseed_ui,0,__gmp_randstate_struct *,unsigned long int) + + /* FIXME: find a way to have this follow the convention in gmp.h*/ + +@@ -191,5 +193,7 @@ MEM_GMP_CALL(2,size_t,mpz_sizeinbase,0,m + /*#define __gmpz_realloc m__gmpz_realloc*/ + #define __gmpz_size m__gmpz_size + #define __gmpz_sizeinbase m__gmpz_sizeinbase ++#define __gmp_randinit_default m__gmp_randinit_default ++#define __gmp_randseed_ui m__gmp_randseed_ui + + #endif /*GMP_WRAPPERS_H*/ diff --git a/patches/list_order.25 b/patches/list_order.25 new file mode 100644 index 00000000..ee4e2fb7 --- /dev/null +++ b/patches/list_order.25 @@ -0,0 +1,81 @@ +Description: + 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-64) unstable; urgency=medium + . + * list_order.24 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-02-22 + +--- gcl-2.6.12.orig/makefile ++++ gcl-2.6.12/makefile +@@ -149,7 +149,7 @@ command: + merge: + $(CC) -o merge merge.c + +-LISP_LIB=cmpnew/gcl_collectfn.o cmpnew/gcl_collectfn.lsp xgcl-2/sysdef.lisp xgcl-2/gcl_dwtest.lsp xgcl-2/gcl_dwtestcases.lsp lsp/gcl_gprof.lsp lsp/gcl_info.o lsp/gcl_profile.lsp lsp/gcl_export.lsp lsp/gcl_autoload.lsp cmpnew/gcl_cmpmain.lsp cmpnew/gcl_cmpopt.lsp cmpnew/gcl_lfun_list.lsp lsp/gcl_auto_new.lsp h/cmpinclude.h unixport/init_$(SYSTEM).lsp unixport/lib$(SYSTEM).a unixport/libgclp.a gcl-tk/tk-package.lsp $(TK_LISP_LIB) $(RL_LIB) $(FIRST_FILE) $(LAST_FILE) $(addsuffix /sys-proclaim.lisp,lsp cmpnew pcl clcs) unixport/gcl.script ++LISP_LIB=cmpnew/gcl_collectfn.o cmpnew/gcl_collectfn.lsp xgcl-2/sysdef.lisp xgcl-2/gcl_dwtest.lsp xgcl-2/gcl_dwtestcases.lsp lsp/gcl_gprof.lsp lsp/gcl_info.o lsp/gcl_profile.lsp lsp/gcl_export.lsp lsp/gcl_autoload.lsp cmpnew/gcl_cmpmain.lsp cmpnew/gcl_cmpopt.lsp cmpnew/gcl_lfun_list.lsp lsp/gcl_auto_new.lsp h/cmpinclude.h unixport/sys_init.lsp unixport/lib$(SYSTEM).a unixport/libgclp.a gcl-tk/tk-package.lsp $(TK_LISP_LIB) $(RL_LIB) $(FIRST_FILE) $(LAST_FILE) $(addsuffix /sys-proclaim.lisp,lsp cmpnew pcl clcs) unixport/gcl.script + + install-command: + rm -f $(DESTDIR)$(prefix)/bin/gcl +--- gcl-2.6.12.orig/unixport/makefile ++++ gcl-2.6.12/unixport/makefile +@@ -69,13 +69,9 @@ $(LSPDIR)/auto_new.lsp: $(LSPDIR)/auto.l + [ "$(RL_OBJS)" = "" ] || \ + echo "(AUTOLOAD 'init-readline '|readline|)" >>$@ + +-saved_%:raw_% $(RSYM) sys_init.lsp.in raw_%_map msys \ +- $(CMPDIR)/gcl_cmpmain.lsp \ +- $(CMPDIR)/gcl_lfun_list.lsp \ +- $(CMPDIR)/gcl_cmpopt.lsp $(HDIR)/cmpinclude.h \ +- $(LSPDIR)/gcl_auto_new.lsp ++sys_init.lsp: sys_init.lsp.in + +- cat sys_init.lsp.in | sed \ ++ cat $< | sed \ + -e "s#@LI-VERS@#(`cat ../majvers`.`cat ../minvers`) `cat ../release`#1" \ + -e "s#@LI-EXTVERS@#`cat ../minvers | cut -f2 -d.`#1" \ + -e "s#@LI-MINVERS@#`cat ../minvers | cut -f1 -d.`#1" \ +@@ -87,8 +83,16 @@ saved_%:raw_% $(RSYM) sys_init.lsp.in ra + -e "s#@LI-LD-LIBS@#\" $(LD_LIBS_POST)\"#1" \ + -e "s#@LI-OPT-THREE@#\"$(O3FLAGS)\"#1" \ + -e "s#@LI-OPT-TWO@#\"$(O2FLAGS)\"#1" \ +- -e "s#@LI-INIT-LSP@#\"$@\"#1" >foo ++ -e "s#@LI-INIT-LSP@#\"$@\"#1" >$@ ++ ++ ++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 sys_init.lsp foo + echo "(unless si::*quit-tags* (in-package \"USER\")(system:save-system \"$@\"))" >>foo + j=$$(ar t lib$*.a |grep ^gcl_);[ "$$j" = "" ] || ar x lib$*.a $$j #accelerator + $(PORTDIR)/raw_$*$(EXE) $(PORTDIR)/ -libdir $(GCLDIR)/ < foo +@@ -156,7 +160,7 @@ map_%: + # $(CC) $(LD_FLAGS) -c -o $@ plt.c $(CFLAGS) -I$(HDIR) -I$(ODIR) + + clean: +- rm -rf saved_*$(EXE) raw_*$(EXE) *.o core a.out $(RSYM) \ ++ rm -rf saved_*$(EXE) raw_*$(EXE) *.o core a.out $(RSYM) sys_init.lsp \ + $(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 + diff --git a/patches/list_order.4 b/patches/list_order.4 new file mode 100644 index 00000000..bebb20d1 --- /dev/null +++ b/patches/list_order.4 @@ -0,0 +1,36 @@ +Description: + 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-57) unstable; urgency=medium + . + * list_order.13 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-09-18 + +--- gcl-2.6.12.orig/lsp/gcl_directory.lsp ++++ gcl-2.6.12/lsp/gcl_directory.lsp +@@ -62,7 +62,7 @@ + (when (pathname-match-p dir v) + (push (merge-pathnames (parse-namestring dir nil *default-pathname-defaults* :start pos) pexp nil) r))) + :file) +- (when (pathname-match-p dir v) (push pexp r)))) ++ (when (pathname-match-p dir v) (push (pathname (copy-seq (namestring pexp))) r)))) + (make-frame "")) + r) + diff --git a/patches/list_order.5 b/patches/list_order.5 new file mode 100644 index 00000000..c3f200f8 --- /dev/null +++ b/patches/list_order.5 @@ -0,0 +1,205 @@ +Description: + 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-48) unstable; urgency=medium + . + * list_order.1 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-06-08 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4188,6 +4188,7 @@ case $use in + mips*) + case $canonical in + mips64*linux*) ++# assert_arg_to_cflags -mxgot + assert_arg_to_ldflags -Wl,-z,now;; + esac + ;; +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -389,6 +389,7 @@ case $use in + mips*) + case $canonical in + mips64*linux*) ++# assert_arg_to_cflags -mxgot + assert_arg_to_ldflags -Wl,-z,now;; + esac + ;; +--- gcl-2.6.12.orig/h/elf64_mips_reloc.h ++++ gcl-2.6.12/h/elf64_mips_reloc.h +@@ -32,23 +32,14 @@ + if (s>=ggot && sr_addend=((void *)gote-(void *)got)-s; +- switch(tp) { +- case R_MIPS_GOT_HI16: +- case R_MIPS_CALL_HI16: +- r->r_info=((ul)R_MIPS_HI16<<56)|(r->r_info&MASK(32)); +- relocate(sym1,r,((Rela *)r)->r_addend,start,got,gote); +- break; +- case R_MIPS_GOT_LO16: +- case R_MIPS_CALL_LO16: +- r->r_info=((ul)R_MIPS_LO16<<56)|(r->r_info&MASK(32)); +- relocate(sym1,r,((Rela *)r)->r_addend,start,got,gote); +- break; +- default: +- store_val(where,MASK(16),((void *)gote-(void *)got)); +- break; +- } ++ *gote=s+(MIPS_HIGH(a)<<16); ++ a=(void *)gote-(void *)got; ++ if (tp==R_MIPS_GOT_HI16||tp==R_MIPS_CALL_HI16) ++ a=MIPS_HIGH(a); ++ else if (tp==R_MIPS_GOT_LO16||tp==R_MIPS_CALL_LO16) ++ a&=MASK(16); ++ massert(!(a&~MASK(16))); ++ store_val(where,MASK(16),a); + break; + case R_MIPS_GOT_OFST: + recurse(s+a); +@@ -63,8 +54,7 @@ + case R_MIPS_LO16: + recurse(s+a); + s+=a; +- a=*where&MASK(16); +- if (a&0x8000) a|=0xffffffffffff0000; ++ a=(short)*where; + a+=s&MASK(16); + a+=(a&0x8000)<<1; + store_val(where,MASK(16),a); +--- gcl-2.6.12.orig/h/elf64_mips_reloc_special.h ++++ gcl-2.6.12/h/elf64_mips_reloc_special.h +@@ -16,6 +16,7 @@ static ul ggot,ggote,la; static Rela *hr + + #undef ELF_R_TYPE + #define ELF_R_TYPE(a_) ELF_R_TYPE1(a_) ++#define MIPS_HIGH(a_) ({ul _a=(a_);(_a-(short)_a)>>16;}) + + typedef struct { + ul entry,gotoff; +@@ -98,12 +99,12 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + Sym *sym; + Shdr *sec; + void *v,*ve; +- ul q=0,a,b; ++ ul a,b; + + for (sym=sym1;symst_size=0; ++ sym->st_other=sym->st_size=0; + +- for (*gs=0,sec=sec1;secsh_type==SHT_RELA) + for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) + if (ELF_R_TYPE(r->r_info)==R_MIPS_CALL16|| +@@ -116,24 +117,37 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + + sym=sym1+ELF_R_SYM(r->r_info); + +- a=r->r_addend>>15; ++ /*unlikely to save got space by recording possible holes in addend range*/ ++ if ((a=MIPS_HIGH(r->r_addend)+1)>sym->st_other) ++ sym->st_other=a; ++ ++ } + +- if (2*a>=sizeof(sym->st_size) || !((sym->st_size>>(a*16))&0xffff)) { ++ for (*gs=0,sec=sec1;secsh_type==SHT_RELA) ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++ if (ELF_R_TYPE(r->r_info)==R_MIPS_CALL16|| ++ ELF_R_TYPE(r->r_info)==R_MIPS_GOT_DISP|| ++ ELF_R_TYPE(r->r_info)==R_MIPS_GOT_HI16|| ++ ELF_R_TYPE(r->r_info)==R_MIPS_GOT_LO16|| ++ ELF_R_TYPE(r->r_info)==R_MIPS_CALL_HI16|| ++ ELF_R_TYPE(r->r_info)==R_MIPS_CALL_LO16|| ++ ELF_R_TYPE(r->r_info)==R_MIPS_GOT_PAGE) { + +- q=++*gs; +- if (2*ast_size)) { +- massert(q<=0xffff); +- sym->st_size|=(q<<(a*16)); +- } +- +- massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); ++ sym=sym1+ELF_R_SYM(r->r_info); + ++ if (sym->st_other) { ++ sym->st_size=++*gs; ++ if (sym->st_other>1) ++ (*gs)+=sym->st_other-1; ++ else ++ massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); ++ sym->st_other=0; + } + + b=sizeof(r->r_addend)*4; + massert(!(r->r_addend>>b)); +- q=2*a>=sizeof(sym->st_size) ? q : (sym->st_size>>(a*16))&0xffff; +- r->r_addend|=(q<<=b); ++ r->r_addend|=((sym->st_size+MIPS_HIGH(r->r_addend))<s=0; + unlock_pool(); + +- f.l_type=F_UNLCK; +- massert(!fcntl(pool,F_SETLK,&f)); +- +- fprintf(stderr,"Initializing pool\n"); +- fflush(stderr); +- + } + + f.l_type=F_RDLCK; +- massert(!fcntl(pool,F_SETLK,&f)); ++ plp=&f; ++ massert(!set_lock()); ++ ++ plp=&pl; + + register_pool(1); + massert(!atexit(close_pool)); diff --git a/patches/list_order.6 b/patches/list_order.6 new file mode 100644 index 00000000..285f16e7 --- /dev/null +++ b/patches/list_order.6 @@ -0,0 +1,103 @@ +Description: + 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-49) unstable; urgency=medium + . + * list_order.5 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-06-13 + +--- gcl-2.6.12.orig/o/eval.c ++++ gcl-2.6.12/o/eval.c +@@ -96,18 +96,18 @@ quick_call_sfun(object fun) { + + } + +-/* only for sfun not gfun !! Does not check number of args */ +-static void +-call_sfun_no_check(object fun) +-{ DEBUG_AVMA +- int n; +- object *base=vs_base; +- n=vs_top - base; +- base[0]=c_apply_n_fun(fun,n,base); +- vs_top=(vs_base=base)+1; +- CHECK_AVMA; +- return; +-} ++/* /\* only for sfun not gfun !! Does not check number of args *\/ */ ++/* static void */ ++/* call_sfun_no_check(object fun) */ ++/* { DEBUG_AVMA */ ++/* int n; */ ++/* object *base=vs_base; */ ++/* n=vs_top - base; */ ++/* base[0]=c_apply_n_fun(fun,n,base); */ ++/* vs_top=(vs_base=base)+1; */ ++/* CHECK_AVMA; */ ++/* return; */ ++/* } */ + static void + call_vfun(object fun) + { DEBUG_AVMA +@@ -615,10 +615,11 @@ super_funcall_no_event(object fun) { + + switch(type_of(fun)) { + case t_cfun: +- (*fun->cf.cf_self)(); +- return; ++ (*fun->cf.cf_self)(); return; ++ case t_cclosure: ++ (*fun->cc.cc_self)(fun); return; + case t_sfun: +- call_sfun_no_check(fun); return; ++ /* call_sfun_no_check(fun); return; */ + case t_gfun: + quick_call_sfun(fun); return; + case t_vfun: +@@ -631,7 +632,7 @@ super_funcall_no_event(object fun) { + super_funcall_no_event(fun->s.s_gfdef); + return; + default: +- funcall_no_event(fun); ++ funcall(fun); + } + + } +--- gcl-2.6.12.orig/o/read.d ++++ gcl-2.6.12/o/read.d +@@ -1176,6 +1176,7 @@ Lsharp_left_parenthesis_reader() + goto L; + } + vs_base[0]=list(4,siScomma,sLapply,list(2,sLquote,sLvector),vs_base[2]); ++ vs_top=vs_base+1; + return; + } + vsp = vs_top; +--- gcl-2.6.12.orig/o/sgbc.c ++++ gcl-2.6.12/o/sgbc.c +@@ -369,7 +369,7 @@ memprotect_handler_test(int sig, long co + do_gcl_abort(); + } + memprotect_handler_invocations=1; +- if (faddr!=memprotect_test_address) ++ if (page(faddr)!=page(memprotect_test_address)) + memprotect_result=memprotect_bad_fault_address; + else + memprotect_result=memprotect_none; diff --git a/patches/list_order.7 b/patches/list_order.7 new file mode 100644 index 00000000..526b7ee5 --- /dev/null +++ b/patches/list_order.7 @@ -0,0 +1,47 @@ +Description: + 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-50) unstable; urgency=medium + . + * list_order.6 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-06-14 + +--- gcl-2.6.12.orig/h/m68k-linux.h ++++ gcl-2.6.12/h/m68k-linux.h +@@ -63,7 +63,7 @@ + + + #define M68K +-#define SGC ++/* #define SGC *//*FIXME: Unknown m68k cpu in modern emulators*/ + + #include + int cacheflush(void *,int,int,int); +--- gcl-2.6.12.orig/o/sgbc.c ++++ gcl-2.6.12/o/sgbc.c +@@ -871,7 +871,7 @@ sgc_quit(void) { + f=n; + n=OBJ_LINK(n); + } +- SET_LINK(f,OBJNULL); ++ SET_LINK(f,n!=OBJNULL ? n : o); + tm->tm_tail=f; + tm->tm_nfree += tm->tm_alt_nfree; + tm->tm_alt_nfree = 0; diff --git a/patches/list_order.8 b/patches/list_order.8 new file mode 100644 index 00000000..37103e27 --- /dev/null +++ b/patches/list_order.8 @@ -0,0 +1,78 @@ +Description: + 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-51) unstable; urgency=medium + . + * list_order.7 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-06-15 + +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -966,6 +966,11 @@ sweep_phase(void) { + STATIC object f; + STATIC struct pageinfo *v; + ++ for (j= t_start; j < t_contiguous ; j++) { ++ tm_of(j)->tm_free=OBJNULL; ++ tm_of(j)->tm_nfree=0; ++ } ++ + for (v=cell_list_head;v;v=v->next) { + + tm = tm_of((enum type)v->type); +@@ -975,22 +980,23 @@ sweep_phase(void) { + k = 0; + for (j = tm->tm_nppage; j > 0; --j, p += tm->tm_size) { + x = (object)p; +- if (is_free(x)) +- continue; +- else if (is_marked(x)) { ++ ++ if (is_marked(x)) { + unmark(x); + continue; + } + +- SET_LINK(f,x); + make_free(x); ++ SET_LINK(f,x); + f = x; + k++; ++ + } ++ + SET_LINK(f,OBJNULL); + tm->tm_tail = f; + tm->tm_nfree += k; +- pagetoinfo(page(v))->in_use-=k; ++ pagetoinfo(page(v))->in_use=tm->tm_nppage-k; + + } + +--- gcl-2.6.12.orig/o/sgbc.c ++++ gcl-2.6.12/o/sgbc.c +@@ -873,6 +873,7 @@ sgc_quit(void) { + } + SET_LINK(f,n!=OBJNULL ? n : o); + tm->tm_tail=f; ++ for (;OBJ_LINK(tm->tm_tail)!=OBJNULL;tm->tm_tail=OBJ_LINK(tm->tm_tail)); + tm->tm_nfree += tm->tm_alt_nfree; + tm->tm_alt_nfree = 0; + tm->tm_alt_free = OBJNULL; diff --git a/patches/list_order.9 b/patches/list_order.9 new file mode 100644 index 00000000..4cbf3b41 --- /dev/null +++ b/patches/list_order.9 @@ -0,0 +1,146 @@ +Description: + 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-52) unstable; urgency=medium + . + * list_order.8 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-06-18 + +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -959,7 +959,7 @@ mark_c_stack(jmp_buf env1, int n, void ( + static void + sweep_phase(void) { + +- STATIC long j, k; ++ STATIC long j, k, l; + STATIC object x; + STATIC char *p; + STATIC struct typemanager *tm; +@@ -977,26 +977,28 @@ sweep_phase(void) { + + p = pagetochar(page(v)); + f = FREELIST_TAIL(tm); +- k = 0; ++ l = k = 0; + for (j = tm->tm_nppage; j > 0; --j, p += tm->tm_size) { + x = (object)p; + + if (is_marked(x)) { + unmark(x); ++ l++; + continue; + } + ++ k++; ++ + make_free(x); + SET_LINK(f,x); + f = x; +- k++; + + } + + SET_LINK(f,OBJNULL); + tm->tm_tail = f; + tm->tm_nfree += k; +- pagetoinfo(page(v))->in_use=tm->tm_nppage-k; ++ pagetoinfo(page(v))->in_use=l; + + } + +--- gcl-2.6.12.orig/o/sgbc.c ++++ gcl-2.6.12/o/sgbc.c +@@ -152,7 +152,7 @@ sgc_mark_phase(void) { + + static void + sgc_sweep_phase(void) { +- STATIC long j, k; ++ STATIC long j, k, l; + STATIC object x; + STATIC char *p; + STATIC struct typemanager *tm; +@@ -160,13 +160,18 @@ sgc_sweep_phase(void) { + int size; + STATIC struct pageinfo *v; + ++ for (j= t_start; j < t_contiguous ; j++) { ++ tm_of(j)->tm_free=OBJNULL; ++ tm_of(j)->tm_nfree=0; ++ } ++ + for (v=cell_list_head;v;v=v->next) { + + tm = tm_of((enum type)v->type); + + p = pagetochar(page(v)); + f = FREELIST_TAIL(tm); +- k = 0; ++ l = k = 0; + size=tm->tm_size; + + if (v->sgc_flags&SGC_PAGE_FLAG) { +@@ -175,10 +180,9 @@ sgc_sweep_phase(void) { + + x = (object)p; + +- if (is_free(x)) +- continue; +- else if (is_marked(x)) { ++ if (is_marked(x)) { + unmark(x); ++ l++; + continue; + } + +@@ -187,26 +191,26 @@ sgc_sweep_phase(void) { + continue; + #endif + +- /* it is ok to free x */ +- +- SET_LINK(f,x); ++ k++; + make_free(x); ++ SET_LINK(f,x); ++ f = x; ++ + #ifndef SGC_WHOLE_PAGE + if (TYPEWORD_TYPE_P(v->type)) x->d.s = SGC_RECENT; + #endif +- f = x; +- k++; + + } ++ + SET_LINK(f,OBJNULL); + tm->tm_tail = f; + tm->tm_nfree += k; +- v->in_use-=k; ++ v->in_use=l; + + } 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)) { ++ if (is_marked(x)) { + unmark(x); + } + } diff --git a/patches/pathnames1.1 b/patches/pathnames1.1 new file mode 100644 index 00000000..d4b661e1 --- /dev/null +++ b/patches/pathnames1.1 @@ -0,0 +1,18763 @@ +Description: + 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-38) unstable; urgency=medium + . + * Version_2_6_13pre50 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-11 + +--- gcl-2.6.12.orig/ansi-tests/ansi-aux.lsp ++++ gcl-2.6.12/ansi-tests/ansi-aux.lsp +@@ -80,6 +80,10 @@ Results: ~A~%" expected-number form n re + "Like EQUALP, but guaranteed to return T for true." + (apply #'values (mapcar #'notnot (multiple-value-list (equalp x y))))) + ++(defun equalpt-or-report (x y) ++ "Like EQUALPT, but return either T or a list of the arguments." ++ (or (equalpt x y) (list x y))) ++ + (defun =t (x &rest args) + "Like =, but guaranteed to return T for true." + (apply #'values (mapcar #'notnot (multiple-value-list (apply #'= x args))))) +@@ -223,6 +227,13 @@ Results: ~A~%" expected-number form n re + P x p1 x TYPE p2) + t))))) + ++(defun check-predicate (predicate &optional guard (universe *universe*)) ++ "Return all elements of UNIVERSE for which the guard (if present) is false ++ and for which PREDICATE is false." ++ (remove-if #'(lambda (e) (or (and guard (funcall guard e)) ++ (funcall predicate e))) ++ universe)) ++ + (declaim (special *catch-error-type*)) + + (defun catch-continue-debugger-hook (condition dbh) +@@ -296,7 +307,167 @@ the condition to go uncaught if it canno + (defmacro classify-error (form) + `(classify-error** ',form)) + ++(defun sequencep (x) (typep x 'sequence)) ++ + ;;; ++(defun typef (type) #'(lambda (x) (typep x type))) ++ ++(defmacro signals-error (form error-name &key (safety 3) (name nil name-p) (inline nil)) ++ `(handler-bind ++ ((warning #'(lambda (c) (declare (ignore c)) ++ (muffle-warning)))) ++ (proclaim '(optimize (safety 3))) ++ (handler-case ++ (apply #'values ++ nil ++ (multiple-value-list ++ ,(cond ++ (inline form) ++ (regression-test::*compile-tests* ++ `(funcall (compile nil '(lambda () ++ (declare (optimize (safety ,safety))) ++ ,form)))) ++ (t `(eval ',form))))) ++ (,error-name (c) ++ (cond ++ ,@(case error-name ++ (type-error ++ `(((typep (type-error-datum c) ++ (type-error-expected-type c)) ++ (values ++ nil ++ (list (list 'typep (list 'quote ++ (type-error-datum c)) ++ (list 'quote ++ (type-error-expected-type c))) ++ "==> true"))))) ++ ((undefined-function unbound-variable) ++ (and name-p ++ `(((not (eq (cell-error-name c) ',name)) ++ (values ++ nil ++ (list 'cell-error-name "==>" ++ (cell-error-name c))))))) ++ ((stream-error end-of-file reader-error) ++ `(((not (streamp (stream-error-stream c))) ++ (values ++ nil ++ (list 'stream-error-stream "==>" ++ (stream-error-stream c)))))) ++ (file-error ++ `(((not (pathnamep (pathname (file-error-pathname c)))) ++ (values ++ nil ++ (list 'file-error-pathname "==>" ++ (file-error-pathname c)))))) ++ (t nil)) ++ (t (printable-p c))))))) ++ ++(defmacro signals-error-always (form error-name) ++ `(values ++ (signals-error ,form ,error-name) ++ (signals-error ,form ,error-name :safety 0))) ++ ++(defmacro signals-type-error (var datum-form form &key (safety 3) (inline nil)) ++ (let ((lambda-form ++ `(lambda (,var) ++ (declare (optimize (safety ,safety))) ++ ,form))) ++ `(let ((,var ,datum-form)) ++ (declare (optimize safety)) ++ (handler-bind ++ ((warning #'(lambda (c) (declare (ignore c)) ++ (muffle-warning)))) ++ ; (proclaim '(optimize (safety 3))) ++ (handler-case ++ (apply #'values ++ nil ++ (multiple-value-list ++ (funcall ++ ,(cond ++ (inline `(function ,lambda-form)) ++ (regression-test::*compile-tests* ++ `(compile nil ',lambda-form)) ++ (t `(eval ',lambda-form))) ++ ,var))) ++ (type-error ++ (c) ++ (let ((datum (type-error-datum c)) ++ (expected-type (type-error-expected-type c))) ++ (cond ++ ((not (eql ,var datum)) ++ (list :datum-mismatch ,var datum)) ++ ((typep datum expected-type) ++ (list :is-typep datum expected-type)) ++ (t (printable-p c)))))))))) ++ ++(declaim (special *mini-universe*)) ++ ++(defun check-type-error* (pred-fn guard-fn &optional (universe *mini-universe*)) ++ "Check that for all elements in some set, either guard-fn is true or ++ pred-fn signals a type error." ++ (let (val) ++ (loop for e in universe ++ unless (or (funcall guard-fn e) ++ (equal ++ (setf val (multiple-value-list ++ (signals-type-error x e (funcall pred-fn x) :inline t))) ++ '(t))) ++ collect (list e val)))) ++ ++(defmacro check-type-error (&body args) ++ `(locally (declare (optimize safety)) (check-type-error* ,@args))) ++ ++(defun printable-p (obj) ++ "Returns T iff obj can be printed to a string." ++ (with-standard-io-syntax ++ (let ((*print-readably* nil) ++ (*print-escape* nil)) ++ (declare (optimize safety)) ++ (handler-case (and (stringp (write-to-string obj)) t) ++ (condition (c) (declare (ignore c)) nil))))) ++ ++(defun make-special-string (string &key fill adjust displace base) ++ (let* ((len (length string)) ++ (len2 (if fill (+ len 4) len)) ++ (etype (if base 'base-char 'character))) ++ (if displace ++ (let ((s0 (make-array (+ len2 5) ++ :initial-contents ++ (concatenate 'string ++ (make-string 2 :initial-element #\X) ++ string ++ (make-string (if fill 7 3) ++ :initial-element #\Y)) ++ :element-type etype))) ++ (make-array len2 :element-type etype ++ :adjustable adjust ++ :fill-pointer (if fill len nil) ++ :displaced-to s0 ++ :displaced-index-offset 2)) ++ (make-array len2 :element-type etype ++ :initial-contents ++ (if fill (concatenate 'string string "ZZZZ") string) ++ :fill-pointer (if fill len nil) ++ :adjustable adjust)))) ++ ++(defmacro do-special-strings ((var string-form &optional ret-form) &body forms) ++ (let ((string (gensym)) ++ (fill (gensym "FILL")) ++ (adjust (gensym "ADJUST")) ++ (base (gensym "BASE")) ++ (displace (gensym "DISPLACE"))) ++ `(let ((,string ,string-form)) ++ (dolist (,fill '(nil t) ,ret-form) ++ (dolist (,adjust '(nil t)) ++ (dolist (,base '(nil t)) ++ (dolist (,displace '(nil t)) ++ (let ((,var (make-special-string ++ ,string ++ :fill ,fill :adjust ,adjust ++ :base ,base :displace ,displace))) ++ ,@forms)))))))) ++ + ;;; A scaffold is a structure that is used to remember the object + ;;; identities of the cons cells in a (noncircular) data structure. + ;;; This lets us check if the data structure has been changed by +@@ -1307,6 +1478,13 @@ the condition to go uncaught if it canno + (unuse-package package using-package))) + (delete-package package)))) + ++(defun delete-all-versions (pathspec) ++ "Replace the versions field of the pathname specified by pathspec with ++ :wild, and delete all the files this refers to." ++ (let* ((wild-pathname (make-pathname :version :wild :defaults (pathname pathspec))) ++ (truenames (directory wild-pathname))) ++ (mapc #'delete-file truenames))) ++ + (defconstant +fail-count-limit+ 20) + + (defmacro test-with-package-iterator (package-list-expr &rest symbol-types) +@@ -1455,3 +1633,5 @@ the condition to go uncaught if it canno + (list n1) + (random-partition n3 (- p 1 r)))))))))) + ++(defmacro expand-in-current-env (macro-form &environment env) ++ (macroexpand macro-form env)) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/broadcast-stream-streams.lsp +@@ -0,0 +1,30 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Jan 29 22:06:28 2004 ++;;;; Contains: Tests of BROADCAST-STREAM-STREAMS ++ ++(in-package :cl-test) ++ ++(deftest broadcast-stream-streams.1 ++ (broadcast-stream-streams (make-broadcast-stream)) ++ nil) ++ ++(deftest broadcast-stream-streams.2 ++ (equalt ++ (broadcast-stream-streams (make-broadcast-stream *standard-output*)) ++ (list *standard-output*)) ++ t) ++ ++(deftest broadcast-stream-streams.error.1 ++ (signals-error (broadcast-stream-streams) program-error) ++ t) ++ ++(deftest broadcast-stream-streams.error.2 ++ (signals-error (broadcast-stream-streams (make-broadcast-stream) nil) ++ program-error) ++ t) ++ ++ ++ ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/clear-input.lsp +@@ -0,0 +1,64 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Wed Jan 28 06:12:39 2004 ++;;;; Contains: Tests of CLEAR-INPUT ++ ++(in-package :cl-test) ++ ++;;; These tests are limited, since whether an input stream can be ++;;; cleared is not well specified. ++ ++(deftest clear-input.1 ++ (loop for s in (list *debug-io* *query-io* ++ *standard-input* *terminal-io*) ++ always (eq (clear-input s) nil)) ++ t) ++ ++(deftest clear-input.2 ++ (clear-input) ++ nil) ++ ++(deftest clear-input.3 ++ (clear-input nil) ++ nil) ++ ++(deftest clear-input.4 ++ (clear-input t) ++ nil) ++ ++(deftest clear-input.5 ++ (with-input-from-string ++ (is "!?*") ++ (let ((*terminal-io* (make-two-way-stream is (make-broadcast-stream)))) ++ (clear-input t))) ++ nil) ++ ++(deftest clear-input.6 ++ (with-input-from-string ++ (*standard-input* "345") ++ (clear-input nil)) ++ nil) ++ ++;;; Error cases ++ ++(deftest clear-input.error.1 ++ :notes (:assume-no-simple-streams) ++ (signals-error (clear-input t nil) program-error) ++ t) ++ ++(deftest clear-input.error.2 ++ :notes (:assume-no-simple-streams) ++ (signals-error (clear-input nil nil) program-error) ++ t) ++ ++(deftest clear-input.error.3 ++ (signals-error (clear-input t nil nil) program-error) ++ t) ++ ++(deftest clear-input.error.4 ++ (signals-error (clear-input nil nil nil) program-error) ++ t) ++ ++(deftest clear-input.error.5 ++ (check-type-error #'clear-input #'(lambda (x) (typep x '(or stream (member nil t))))) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/clear-output.lsp +@@ -0,0 +1,53 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Wed Jan 28 06:43:17 2004 ++;;;; Contains: Tests of CLEAR-OUTPUT ++ ++(in-package :cl-test) ++ ++(deftest clear-output.1 ++ (progn (finish-output) (clear-output)) ++ nil) ++ ++(deftest clear-output.2 ++ (progn (finish-output) (clear-output t)) ++ nil) ++ ++(deftest clear-output.3 ++ (progn (finish-output) (clear-output nil)) ++ nil) ++ ++(deftest clear-output.4 ++ (loop for s in (list *debug-io* *error-output* *query-io* ++ *standard-output* *trace-output* *terminal-io*) ++ for dummy = (finish-output s) ++ for results = (multiple-value-list (clear-output s)) ++ unless (equal results '(nil)) ++ collect s) ++ nil) ++ ++(deftest clear-output.5 ++ (let ((os (make-string-output-stream))) ++ (let ((*terminal-io* (make-two-way-stream (make-string-input-stream "") ++ os))) ++ (clear-output t))) ++ nil) ++ ++(deftest clear-output.6 ++ (let ((*standard-output* (make-string-output-stream))) ++ (clear-output nil)) ++ nil) ++ ++;;; Error tests ++ ++(deftest clear-output.error.1 ++ (signals-error (clear-output nil nil) program-error) ++ t) ++ ++(deftest clear-output.error.2 ++ (signals-error (clear-output t nil) program-error) ++ t) ++ ++(deftest clear-output.error.3 ++ (check-type-error #'clear-output #'(lambda (x) (typep x '(or stream (member nil t))))) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/compile-file-test-file.lsp +@@ -0,0 +1,3 @@ ++(in-package "CL-TEST") ++ ++(defun compile-file-test-fun.1 () nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/concatenated-stream-streams.lsp +@@ -0,0 +1,67 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Feb 14 08:43:45 2004 ++;;;; Contains: Tests of CONCATENATED-STREAM-STREAMS ++ ++(in-package :cl-test) ++ ++(deftest concatenated-stream-streams.1 ++ (concatenated-stream-streams (make-concatenated-stream)) ++ nil) ++ ++(deftest concatenated-stream-streams.2 ++ (equalt (list (list *standard-input*)) ++ (multiple-value-list ++ (concatenated-stream-streams ++ (make-concatenated-stream *standard-input*)))) ++ t) ++ ++(deftest concatenated-stream-streams.3 ++ (with-input-from-string ++ (s1 "abc") ++ (with-input-from-string ++ (s2 "def") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (equalt (list (list s1 s2)) ++ (multiple-value-list ++ (concatenated-stream-streams s)))))) ++ t) ++ ++(deftest concatenated-stream-streams.4 ++ (with-input-from-string ++ (s1 "") ++ (with-input-from-string ++ (s2 "def") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (equalt (list (list s1 s2)) ++ (multiple-value-list ++ (concatenated-stream-streams s)))))) ++ t) ++ ++(deftest concatenated-stream-streams.5 ++ (with-input-from-string ++ (s1 "") ++ (with-input-from-string ++ (s2 "def") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (values ++ (read-char s) ++ (equalt (list (list s2)) ++ (multiple-value-list ++ (concatenated-stream-streams s))))))) ++ #\d t) ++ ++;;; Error cases ++ ++(deftest concatenated-stream-streams.error.1 ++ (signals-error (concatenated-stream-streams) program-error) ++ t) ++ ++(deftest concatenated-stream-streams.error.2 ++ (signals-error (concatenated-stream-streams ++ (make-concatenated-stream) ++ nil) ++ program-error) ++ t) ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/delete-file.lsp +@@ -0,0 +1,95 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 13 18:42:29 2004 ++;;;; Contains: Tests for DELETE-FILE ++ ++(in-package :cl-test) ++ ++(deftest delete-file.1 ++ (let ((pn "scratchfile.txt")) ++ (unless (probe-file pn) ++ (with-open-file (s pn :direction :output) ++ (format s "Contents~%"))) ++ (values ++ (notnot (probe-file pn)) ++ (multiple-value-list (delete-file pn)) ++ (probe-file pn))) ++ t (t) nil) ++ ++(deftest delete-file.2 ++ (let ((pn #p"scratchfile.txt")) ++ (unless (probe-file pn) ++ (with-open-file (s pn :direction :output) ++ (format s "Contents~%"))) ++ (values ++ (notnot (probe-file pn)) ++ (multiple-value-list (delete-file pn)) ++ (probe-file pn))) ++ t (t) nil) ++ ++(deftest delete-file.3 ++ (let ((pn "CLTEST:SCRATCHFILE.TXT")) ++ (assert (typep (pathname pn) 'logical-pathname)) ++ (unless (probe-file pn) ++ (with-open-file (s pn :direction :output) ++ (format s "Contents~%"))) ++ (values ++ (notnot (probe-file pn)) ++ (multiple-value-list (delete-file pn)) ++ (probe-file pn))) ++ t (t) nil) ++ ++(deftest delete-file.4 ++ (let ((pn "CLTEST:SCRATCHFILE.TXT")) ++ (assert (typep (pathname pn) 'logical-pathname)) ++ (unless (probe-file pn) ++ (with-open-file (s pn :direction :output) ++ (format s "Contents~%"))) ++ (let ((s (open pn :direction :input))) ++ (close s) ++ (values ++ (notnot (probe-file pn)) ++ (multiple-value-list (delete-file s)) ++ (probe-file pn)))) ++ t (t) nil) ++ ++;;; Specialized string tests ++ ++(deftest delete-file.5 ++ (do-special-strings ++ (pn "scratchfile.txt" nil) ++ (unless (probe-file pn) ++ (with-open-file (s pn :direction :output) ++ (format s "Contents~%"))) ++ (assert (probe-file pn)) ++ (assert (equal (multiple-value-list (delete-file pn)) '(t))) ++ (assert (not (probe-file pn)))) ++ nil) ++ ++;;; Error tests ++ ++(deftest delete-file.error.1 ++ (signals-error (delete-file) program-error) ++ t) ++ ++(deftest delete-file.error.2 ++ (let ((pn "scratch.txt")) ++ (unless (probe-file pn) ++ (with-open-file (s pn :direction :output) ++ (format s "Contents~%"))) ++ (values ++ (notnot (probe-file pn)) ++ (signals-error (delete-file "scratch.txt" nil) program-error) ++ (notnot (probe-file pn)) ++ (delete-file pn) ++ (probe-file pn))) ++ t t t t nil) ++ ++#| ++(deftest delete-file.error.3 ++ (let ((pn "nonexistent.txt")) ++ (when (probe-file pn) (delete-file pn)) ++ (signals-error (delete-file "nonexistent.txt") file-error)) ++ t) ++|# ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/directory-namestring.lsp +@@ -0,0 +1,50 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Sep 12 06:21:42 2004 ++;;;; Contains: Tests for DIRECTORY-NAMESTRING ++ ++(in-package :cl-test) ++ ++(deftest directory-namestring.1 ++ (let* ((vals (multiple-value-list ++ (directory-namestring "directory-namestring.lsp"))) ++ (s (first vals))) ++ (if (and (null (cdr vals)) ++ (stringp s) ++ (equal (directory-namestring s) s)) ++ :good ++ vals)) ++ :good) ++ ++(deftest directory-namestring.2 ++ (do-special-strings ++ (s "directory-namestring.lsp" nil) ++ (let ((ns (directory-namestring s))) ++ (assert (stringp ns)) ++ (assert (string= (directory-namestring ns) ns)))) ++ nil) ++ ++;;; Lispworks makes another assumption about filename normalization ++;;; when using file streams as pathname designators, so this test ++;;; doesn't work there. ++;;; (This is another example of the difficulty of testing a feature ++;;; in which so much is left up to the implementation.) ++#-lispworks ++(deftest directory-namestring.3 ++ (let* ((name "directory-namestring.lsp") ++ (pn (merge-pathnames (pathname name))) ++ (name2 (with-open-file (s pn :direction :input) ++ (directory-namestring s))) ++ (name3 (directory-namestring pn))) ++ (or (equalt name2 name3) (list name2 name3))) ++ t) ++ ++;;; Error tests ++ ++(deftest directory-namestring.error.1 ++ (signals-error (directory-namestring) program-error) ++ t) ++ ++(deftest directory-namestring.error.2 ++ (signals-error (directory-namestring "directory-namestring.lsp" nil) program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/directory.lsp +@@ -0,0 +1,71 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Jan 1 12:00:18 2004 ++;;;; Contains: Tests of DIRECTORY ++ ++(in-package :cl-test) ++ ++(deftest directory.1 ++ (directory "nonexistent") ++ nil) ++ ++(deftest directory.2 ++ (directory #p"nonexistent") ++ nil) ++ ++(deftest directory.3 ++ (directory "nonexistent" :allow-other-keys nil) ++ nil) ++ ++(deftest directory.4 ++ (directory "nonexistent" :allow-other-keys t :foo 'bar) ++ nil) ++ ++(deftest directory.5 ++ (directory "nonexistent" :foo 0 :allow-other-keys t) ++ nil) ++ ++(deftest directory.6 ++ (let* ((pattern-pathname (make-pathname :name :wild :type :wild ++ :defaults *default-pathname-defaults*)) ++ (pathnames (directory pattern-pathname))) ++ (values ++ (remove-if #'pathnamep pathnames) ++ (loop for pn in pathnames ++ unless (equal pn (truename pn)) ++ collect pn) ++;; (loop for pn in pathnames ++;; unless (pathname-match-p pn pattern-pathname) ++;; collect pn)) ++ )) ++ nil nil ;; nil ++ ) ++ ++(deftest directory.7 ++ (let* ((pattern-pathname (make-pathname :name :wild :type :wild ++ :defaults *default-pathname-defaults*)) ++ (pathnames (directory pattern-pathname))) ++ (loop for pn in pathnames ++ unless (equal pn (probe-file pn)) ++ collect pn)) ++ nil) ++ ++(deftest directory.8 ++ (let* ((pathname-pattern "CLTEST:*.*") ++ (len (length (directory pathname-pattern)))) ++ (if (< len 300) len nil)) ++ nil) ++ ++;;; Specialized string tests ++ ++(deftest directory.9 ++ (do-special-strings ++ (s "nonexistent" nil) ++ (assert (null (directory s)))) ++ nil) ++ ++;;; Error tests ++ ++(deftest directory.error.1 ++ (signals-error (directory) program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/echo-stream-input-stream.lsp +@@ -0,0 +1,27 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Feb 12 04:30:40 2004 ++;;;; Contains: Tests of ECHO-STREAM-INPUT-STREAM ++ ++(in-package :cl-test) ++ ++(deftest echo-stream-input-stream.1 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (equalt (multiple-value-list (echo-stream-input-stream s)) ++ (list is))) ++ t) ++ ++(deftest echo-stream-input-stream.error.1 ++ (signals-error (echo-stream-input-stream) program-error) ++ t) ++ ++(deftest echo-stream-input-stream.error.2 ++ (signals-error (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (echo-stream-input-stream s nil)) ++ program-error) ++ t) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/echo-stream-output-stream.lsp +@@ -0,0 +1,26 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Feb 12 04:32:33 2004 ++;;;; Contains: Tests off ECHO-STREAM-OUTPUT-STREAM ++ ++(in-package :cl-test) ++ ++(deftest echo-stream-output-stream.1 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (equalt (multiple-value-list (echo-stream-output-stream s)) ++ (list os))) ++ t) ++ ++(deftest echo-stream-output-stream.error.1 ++ (signals-error (echo-stream-output-stream) program-error) ++ t) ++ ++(deftest echo-stream-output-stream.error.2 ++ (signals-error (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (echo-stream-output-stream s nil)) ++ program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/enough-namestring.lsp +@@ -0,0 +1,84 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Sep 12 06:23:50 2004 ++;;;; Contains: Tests of ENOUGH-NAMESTRING ++ ++(in-package :cl-test) ++ ++(deftest enough-namestring.1 ++ (let* ((vals (multiple-value-list (enough-namestring "enough-namestring.lsp"))) ++ (s (first vals))) ++ (if (and (null (cdr vals)) ++ (stringp s) ++ (equal (enough-namestring s) s)) ++ :good ++ vals)) ++ :good) ++ ++(deftest enough-namestring.2 ++ (do-special-strings ++ (s "enough-namestring.lsp" nil) ++ (let ((ns (enough-namestring s))) ++ (assert (stringp ns)) ++ (assert (string= (enough-namestring ns) ns)))) ++ nil) ++ ++(deftest enough-namestring.3 ++ (let* ((name "enough-namestring.lsp") ++ (pn (merge-pathnames (pathname name))) ++ (name2 (enough-namestring pn)) ++ (name3 (enough-namestring name))) ++ (or (equalt name2 name3) (list name2 name3))) ++ t) ++ ++(deftest enough-namestring.4 ++ (let* ((name "enough-namestring.lsp") ++ (pn (merge-pathnames (pathname name))) ++ (name2 (with-open-file (s pn :direction :input) (enough-namestring s))) ++ (name3 (enough-namestring name))) ++ (or (equalt name2 name3) (list name2 name3))) ++ t) ++ ++(deftest enough-namestring.5 ++ (let* ((vals (multiple-value-list (enough-namestring "enough-namestring.lsp" ++ *default-pathname-defaults*))) ++ (s (first vals))) ++ (if (and (null (cdr vals)) ++ (stringp s) ++ (equal (enough-namestring s) s)) ++ :good ++ vals)) ++ :good) ++ ++(deftest enough-namestring.6 ++ (let* ((vals (multiple-value-list (enough-namestring "enough-namestring.lsp" ++ (namestring *default-pathname-defaults*)))) ++ (s (first vals))) ++ (if (and (null (cdr vals)) ++ (stringp s) ++ (equal (enough-namestring s) s)) ++ :good ++ vals)) ++ :good) ++ ++(deftest enough-namestring.7 ++ (do-special-strings ++ (s (namestring *default-pathname-defaults*) nil) ++ (let* ((vals (multiple-value-list (enough-namestring "enough-namestring.lsp" s))) ++ (s2 (first vals))) ++ (assert (null (cdr vals))) ++ (assert (stringp s2)) ++ (assert (equal (enough-namestring s2) s2)))) ++ nil) ++ ++;;; Error tests ++ ++(deftest enough-namestring.error.1 ++ (signals-error (enough-namestring) program-error) ++ t) ++ ++(deftest enough-namestring.error.2 ++ (signals-error ++ (enough-namestring "enough-namestring.lsp" *default-pathname-defaults* nil) ++ program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/ensure-directories-exist.lsp +@@ -0,0 +1,166 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Mon Jan 5 20:53:03 2004 ++;;;; Contains: Tests of ENSURE-DIRECTORIES-EXIST ++ ++(in-package :cl-test) ++ ++(deftest ensure-directories-exist.1 ++ (let* ((pn (make-pathname :name "ensure-directories-exist.lsp" ++ :defaults *default-pathname-defaults*)) ++ (results nil) ++ (verbosity ++ (with-output-to-string ++ (*standard-output*) ++ (setq results (multiple-value-list (ensure-directories-exist pn)))))) ++ (values ++ (length results) ++ (equalt (truename pn) (truename (first results))) ++ (second results) ++ verbosity)) ++ 2 t nil "") ++ ++(deftest ensure-directories-exist.2 ++ (with-open-file ++ (s "ensure-directories-exist.lsp" :direction :input) ++ (let* ((results (multiple-value-list (ensure-directories-exist s)))) ++ (values ++ (length results) ++ (equalt (truename (first results)) (truename s)) ++ (second results)))) ++ 2 t nil) ++ ++(deftest ensure-directories-exist.3 ++ (let ((s (open "ensure-directories-exist.lsp" :direction :input))) ++ (close s) ++ (let* ((results (multiple-value-list (ensure-directories-exist s)))) ++ (values ++ (length results) ++ (equalt (truename (first results)) (truename s)) ++ (second results)))) ++ 2 t nil) ++ ++(deftest ensure-directories-exist.4 ++ (let* ((pn (make-pathname :name "ensure-directories-exist.lsp" ++ :defaults *default-pathname-defaults*)) ++ (results nil) ++ (verbosity ++ (with-output-to-string ++ (*standard-output*) ++ (setq results (multiple-value-list ++ (ensure-directories-exist pn :verbose nil)))))) ++ (values ++ (length results) ++ (equalt (truename pn) (truename (first results))) ++ (second results) ++ verbosity)) ++ 2 t nil "") ++ ++(deftest ensure-directories-exist.5 ++ (let* ((pn (make-pathname :name "ensure-directories-exist.lsp" ++ :defaults *default-pathname-defaults*)) ++ (results nil) ++ (verbosity ++ (with-output-to-string ++ (*standard-output*) ++ (setq results (multiple-value-list ++ (ensure-directories-exist pn :verbose t)))))) ++ (values ++ (length results) ++ (equalt (truename pn) (truename (first results))) ++ (second results) ++ verbosity)) ++ 2 t nil "") ++ ++(deftest ensure-directories-exist.6 ++ (let* ((pn (make-pathname :name "ensure-directories-exist.lsp" ++ :defaults *default-pathname-defaults*)) ++ (results nil) ++ (verbosity ++ (with-output-to-string ++ (*standard-output*) ++ (setq results (multiple-value-list ++ (ensure-directories-exist ++ pn :allow-other-keys nil)))))) ++ (values ++ (length results) ++ (equalt (truename pn) (truename (first results))) ++ (second results) ++ verbosity)) ++ 2 t nil "") ++ ++(deftest ensure-directories-exist.7 ++ (let* ((pn (make-pathname :name "ensure-directories-exist.lsp" ++ :defaults *default-pathname-defaults*)) ++ (results nil) ++ (verbosity ++ (with-output-to-string ++ (*standard-output*) ++ (setq results (multiple-value-list ++ (ensure-directories-exist ++ pn :allow-other-keys t :nonsense t)))))) ++ (values ++ (length results) ++ (equalt (truename pn) (truename (first results))) ++ (second results) ++ verbosity)) ++ 2 t nil "") ++ ++;;; Case where directory shouldn't exist ++ ++;; The directort ansi-tests/scratch must not exist before this ++;; test is run ++(deftest ensure-directories-exist.8 ++ (let* ((subdir (make-pathname :directory '(:relative "scratch") ++ :defaults *default-pathname-defaults*)) ++ (pn (make-pathname :name "foo" :type "txt" ++ :defaults subdir))) ++ (ignore-errors (delete-file pn) (delete-file subdir)) ++ (assert (not (probe-file pn)) () ++ "Delete subdirectory scratch and its contents!") ++ (let* ((results nil) ++ (verbosity ++ (with-output-to-string ++ (*standard-output*) ++ (setq results (multiple-value-list (ensure-directories-exist pn))))) ++ (result-pn (first results)) ++ (created (second results))) ++ ;; Create the file and write to it ++ (with-open-file (*standard-output* ++ pn :direction :output :if-exists :error ++ :if-does-not-exist :create) ++ (print nil)) ++ (values ++ (length results) ++ (notnot created) ++ (equalt pn result-pn) ++ (notnot (probe-file pn)) ++ verbosity ++ ))) ++ 2 t t t "") ++ ++;;; Specialized string tests ++ ++(deftest ensure-directories-exist.9 ++ (do-special-strings ++ (str "ensure-directories-exist.lsp" nil) ++ (let* ((results (multiple-value-list (ensure-directories-exist str)))) ++ (assert (eql (length results) 2)) ++ (assert (equalt (truename (first results)) (truename str))) ++ (assert (null (second results))))) ++ nil) ++ ++;; FIXME ++;; Need to add a LPN test ++ ++(deftest ensure-directories-exist.error.1 ++ (signals-error-always ++ (ensure-directories-exist ++ (make-pathname :directory '(:relative :wild) ++ :defaults *default-pathname-defaults*)) ++ file-error) ++ t t) ++ ++(deftest ensure-directories-exist.error.2 ++ (signals-error (ensure-directories-exist) program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/file-author.lsp +@@ -0,0 +1,88 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 6 05:41:06 2004 ++;;;; Contains: Tests of FILE-AUTHOR ++ ++(in-package :cl-test) ++ ++(deftest file-author.1 ++ (loop for pn in ++ (directory (make-pathname :name :wild :type :wild ++ :defaults *default-pathname-defaults*)) ++ for author = (file-author pn) ++ unless (or (null author) (stringp author)) ++ collect (list pn author)) ++ nil) ++ ++(deftest file-author.2 ++ (let ((author (file-author "file-author.lsp"))) ++ (if (or (null author) (stringp author)) ++ nil ++ author)) ++ nil) ++ ++(deftest file-author.3 ++ (let ((author (file-author #p"file-author.lsp"))) ++ (if (or (null author) (stringp author)) ++ nil ++ author)) ++ nil) ++ ++(deftest file-author.4 ++ (let ((author (file-author (truename "file-author.lsp")))) ++ (if (or (null author) (stringp author)) ++ nil ++ author)) ++ nil) ++ ++(deftest file-author.5 ++ (let ((author (with-open-file (s "file-author.lsp" :direction :input) ++ (file-author s)))) ++ (if (or (null author) (stringp author)) ++ nil ++ author)) ++ nil) ++ ++(deftest file-author.6 ++ (let ((author (let ((s (open "file-author.lsp" :direction :input))) ++ (close s) ++ (file-author s)))) ++ (if (or (null author) (stringp author)) ++ nil ++ author)) ++ nil) ++ ++;;; Specialized string tests ++ ++(deftest file-author.7 ++ (do-special-strings ++ (s "file-author.lsp" nil) ++ (assert (equal (file-author s) (file-author "file-author.lsp")))) ++ nil) ++ ++;;; FIXME ++;;; Add LPN test ++ ++;;; Error tests ++ ++(deftest file-author.error.1 ++ (signals-error (file-author) program-error) ++ t) ++ ++(deftest file-author.error.2 ++ (signals-error (file-author "file-author.lsp" nil) program-error) ++ t) ++ ++(deftest file-author.error.3 ++ (signals-error-always ++ (file-author (make-pathname :name :wild :type "lsp" ++ :defaults *default-pathname-defaults*)) ++ file-error) ++ t t) ++ ++(deftest file-author.error.4 ++ (signals-error-always ++ (file-author (make-pathname :name "file-author" :type :wild ++ :defaults *default-pathname-defaults*)) ++ file-error) ++ t t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/file-error.lsp +@@ -0,0 +1,89 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 13 19:10:02 2004 ++;;;; Contains: Tests of the FILE-ERROR condition, and associated accessor function ++ ++(in-package :cl-test) ++ ++(deftest file-error.1 ++ (let ((pn (make-pathname :name :wild ++ :type "txt" ++ :version :newest ++ :defaults *default-pathname-defaults*))) ++ (handler-case ++ (probe-file pn) ++ (error (c) ++ (values ++ (notnot (typep c 'file-error)) ++ (if (equalp (file-error-pathname c) pn) ++ t ++ (list (file-error-pathname c) pn)))))) ++ t t) ++ ++(deftest file-error-pathname.1 ++ (let ((c (make-condition 'file-error :pathname "foo.txt"))) ++ (values ++ (notnot (typep c 'file-error)) ++ (eqlt (class-of c) (find-class 'file-error)) ++ (file-error-pathname c))) ++ t t "foo.txt") ++ ++(deftest file-error-pathname.2 ++ (let ((c (make-condition 'file-error :pathname #p"foo.txt"))) ++ (values ++ (notnot (typep c 'file-error)) ++ (eqlt (class-of c) (find-class 'file-error)) ++ (equalt #p"foo.txt" (file-error-pathname c)))) ++ t t t) ++ ++(deftest file-error-pathname.3 ++ (let ((c (make-condition 'file-error :pathname "CLTEST:FOO.TXT"))) ++ (values ++ (notnot (typep c 'file-error)) ++ (eqlt (class-of c) (find-class 'file-error)) ++ (equalpt "CLTEST:FOO.TXT" ++ (file-error-pathname c)))) ++ t t t) ++ ++(deftest file-error-pathname.4 ++ (let ((c (make-condition 'file-error :pathname (logical-pathname "CLTEST:FOO.TXT")))) ++ (values ++ (notnot (typep c 'file-error)) ++ (eqlt (class-of c) (find-class 'file-error)) ++ (equalpt (logical-pathname "CLTEST:FOO.TXT") ++ (file-error-pathname c)))) ++ t t t) ++ ++(deftest file-error-pathname.5 ++ (with-open-file (s "file-error.lsp" :direction :input) ++ (let ((c (make-condition 'file-error :pathname s))) ++ (values ++ (notnot (typep c 'file-error)) ++ (eqlt (class-of c) (find-class 'file-error)) ++ (equalpt s (file-error-pathname c))))) ++ t t t) ++ ++(deftest file-error-pathname.6 ++ (let ((s (open "file-error.lsp" :direction :input))) ++ (close s) ++ (let ((c (make-condition 'file-error :pathname s))) ++ (values ++ (notnot (typep c 'file-error)) ++ (eqlt (class-of c) (find-class 'file-error)) ++ (equalpt s (file-error-pathname c))))) ++ t t t) ++ ++(deftest file-error-pathname.error.1 ++ (signals-error (file-error-pathname) program-error) ++ t) ++ ++(deftest file-error-pathname.error.2 ++ (signals-error ++ (file-error-pathname (make-condition 'file-error :pathname "foo.txt") nil) ++ program-error) ++ t) ++ ++ ++ ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/file-length.lsp +@@ -0,0 +1,176 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Wed Jan 21 06:21:11 2004 ++;;;; Contains: Tests of FILE-LENGTH ++ ++(in-package :cl-test) ++ ++(deftest file-length.error.1 ++ (signals-error (file-length) program-error) ++ t) ++ ++(deftest file-length.error.2 ++ (signals-error ++ (with-open-file (is "file-length.lsp" :direction :input) ++ (file-length is nil)) ++ program-error) ++ t) ++ ++(deftest file-length.error.3 ++ (loop for x in *mini-universe* ++ unless (or (typep x 'file-stream) ++ (typep x 'broadcast-stream) ++ (handler-case (progn (file-length x) nil) ++ (type-error (c) ++ (assert (not (typep x (type-error-expected-type c)))) ++ t) ++ (condition () nil))) ++ collect x) ++ nil) ++ ++(deftest file-length.error.4 ++ :notes (:assume-no-simple-streams :assume-no-gray-streams) ++ (signals-error (with-input-from-string (s "abc") (file-length s)) ++ type-error) ++ t) ++ ++(deftest file-length.error.5 ++ (signals-error ++ (with-open-file ++ (is "file-length.lsp" :direction :input) ++ (with-open-file ++ (os "tmp.txt" :direction :output :if-exists :supersede) ++ (let ((s (make-two-way-stream is os))) ++ (unwind-protect (file-length s) (close s))))) ++ type-error) ++ t) ++ ++(deftest file-length.error.6 ++ (signals-error ++ (with-open-file ++ (is "file-length.lsp" :direction :input) ++ (with-open-file ++ (os "tmp.txt" :direction :output :if-exists :supersede) ++ (let ((s (make-echo-stream is os))) ++ (unwind-protect (file-length s) (close s))))) ++ type-error) ++ t) ++ ++(deftest file-length.error.8 ++ (with-open-file ++ (os "tmp.txt" :direction :output :if-exists :supersede) ++ (let ((s (make-broadcast-stream os))) ++ (eqlt (file-length s) (file-length os)))) ++ t) ++ ++(deftest file-length.error.9 ++ (signals-type-error s (make-concatenated-stream) ++ (unwind-protect (file-length s) (close s))) ++ t) ++ ++(deftest file-length.error.10 ++ (signals-error ++ (with-open-file ++ (is "file-length.lsp" :direction :input) ++ (let ((s (make-concatenated-stream is))) ++ (unwind-protect (file-length s) (close s)))) ++ type-error) ++ t) ++ ++(deftest file-length.error.11 ++ :notes (:assume-no-simple-streams :assume-no-gray-streams) ++ (signals-type-error s (make-string-input-stream "abcde") ++ (unwind-protect (file-length s) (close s))) ++ t) ++ ++(deftest file-length.error.12 ++ :notes (:assume-no-simple-streams :assume-no-gray-streams) ++ (signals-type-error s (make-string-output-stream) ++ (unwind-protect (file-length s) (close s))) ++ t) ++ ++;;; Non-error tests ++ ++(deftest file-length.1 ++ (let ((results (multiple-value-list ++ (with-open-file ++ (is "file-length.lsp" :direction :input) ++ (file-length is))))) ++ (and (= (length results) 1) ++ (typep (car results) '(integer 1)) ++ t)) ++ t) ++ ++(deftest file-length.2 ++ (loop for i from 1 to 32 ++ for etype = `(unsigned-byte ,i) ++ for e = (max 0 (- (ash 1 i) 5)) ++ for os = (open "tmp.dat" :direction :output ++ :if-exists :supersede ++ :element-type etype) ++ do (loop repeat 17 do (write-byte e os)) ++ do (finish-output os) ++ unless (= (file-length os) 17) ++ collect (list i (file-length os)) ++ do (close os)) ++ nil) ++ ++(deftest file-length.3 ++ (loop for i from 1 to 32 ++ for etype = `(unsigned-byte ,i) ++ for e = (max 0 (- (ash 1 i) 5)) ++ for os = (open "tmp.dat" :direction :output ++ :if-exists :supersede ++ :element-type etype) ++ for len = 0 ++ do (loop repeat 17 do (write-byte e os)) ++ do (close os) ++ unless (let ((is (open "tmp.dat" :direction :input ++ :element-type etype))) ++ (prog1 ++ (= (file-length is) 17) ++ (close is))) ++ collect i) ++ nil) ++ ++(deftest file-length.4 ++ (loop for i from 33 to 100 ++ for etype = `(unsigned-byte ,i) ++ for e = (max 0 (- (ash 1 i) 5)) ++ for os = (open "tmp.dat" :direction :output ++ :if-exists :supersede ++ :element-type etype) ++ do (loop repeat 17 do (write-byte e os)) ++ do (finish-output os) ++ unless (= (file-length os) 17) ++ collect (list i (file-length os)) ++ do (close os)) ++ nil) ++ ++(deftest file-length.5 ++ (loop for i from 33 to 100 ++ for etype = `(unsigned-byte ,i) ++ for e = (max 0 (- (ash 1 i) 5)) ++ for os = (open "tmp.dat" :direction :output ++ :if-exists :supersede ++ :element-type etype) ++ for len = 0 ++ do (loop repeat 17 do (write-byte e os)) ++ do (close os) ++ unless (let ((is (open "tmp.dat" :direction :input ++ :element-type etype))) ++ (prog1 ++ (= (file-length is) 17) ++ (close is))) ++ collect i) ++ nil) ++ ++(deftest file-length.6 ++ (with-open-file ++ (*foo* "file-length.lsp" :direction :input) ++ (declare (special *foo*)) ++ (let ((s (make-synonym-stream '*foo*))) ++ (unwind-protect ++ (typep* (file-length s) '(integer 1)) ++ (close s)))) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/file-namestring.lsp +@@ -0,0 +1,44 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Sep 11 07:40:47 2004 ++;;;; Contains: Tests for FILE-NAMESTRING ++ ++(in-package :cl-test) ++ ++(deftest file-namestring.1 ++ (let* ((vals (multiple-value-list ++ (file-namestring "file-namestring.lsp"))) ++ (s (first vals))) ++ (if (and (null (cdr vals)) ++ (stringp s) ++ (equal (file-namestring s) s)) ++ :good ++ vals)) ++ :good) ++ ++(deftest file-namestring.2 ++ (do-special-strings ++ (s "file-namestring.lsp" nil) ++ (let ((ns (file-namestring s))) ++ (assert (stringp ns)) ++ (assert (string= (file-namestring ns) ns)))) ++ nil) ++ ++(deftest file-namestring.3 ++ (let* ((name "file-namestring.lsp") ++ (pn (merge-pathnames (pathname name))) ++ (name2 (with-open-file (s pn :direction :input) ++ (file-namestring s))) ++ (name3 (file-namestring pn))) ++ (or (equalt name2 name3) (list name2 name3))) ++ t) ++ ++;;; Error tests ++ ++(deftest file-namestring.error.1 ++ (signals-error (file-namestring) program-error) ++ t) ++ ++(deftest file-namestring.error.2 ++ (signals-error (file-namestring "file-namestring.lsp" nil) program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/file-position.lsp +@@ -0,0 +1,170 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Jan 22 03:02:31 2004 ++;;;; Contains: Tests of FILE-POSITION ++ ++(in-package :cl-test) ++ ++(deftest file-position.1 ++ (with-open-file (is "file-position.lsp":direction :input) ++ (file-position is)) ++ 0) ++ ++(deftest file-position.2 ++ (with-open-file (is "file-position.lsp":direction :input) ++ (values ++ (multiple-value-list ++ (notnot-mv (file-position is :start))) ++ (file-position is))) ++ ++ (t) 0) ++ ++(deftest file-position.3 ++ (with-open-file (is "file-position.lsp":direction :input) ++ (values ++ (multiple-value-list ++ (notnot-mv (file-position is :end))) ++ (notnot (> (file-position is) 0)))) ++ (t) t) ++ ++(deftest file-position.4 ++ (with-open-file ++ (is "file-position.lsp":direction :input) ++ (values ++ (file-position is) ++ (read-char is) ++ (notnot (> (file-position is) 0)))) ++ 0 #\; t) ++ ++(deftest file-position.5 ++ (with-open-file ++ (os "tmp.dat":direction :output ++ :if-exists :supersede) ++ (values ++ (file-position os) ++ (write-char #\x os) ++ (notnot (> (file-position os) 0)))) ++ 0 #\x t) ++ ++(deftest file-position.6 ++ (with-open-file ++ (os "tmp.dat":direction :output ++ :if-exists :supersede) ++ (let ((p1 (file-position os)) ++ (delta (file-string-length os #\x))) ++ (write-char #\x os) ++ (let ((p2 (file-position os))) ++ (or (null p1) (null p2) (null delta) ++ (=t (+ p1 delta) p2))))) ++ t) ++ ++;;; Byte streams ++ ++(deftest file-position.7 ++ (loop for len from 1 to 32 ++ for n = (ash 1 len) ++ do (with-open-file ++ (os "tmp.dat" :direction :output ++ :if-exists :supersede ++ :element-type `(unsigned-byte ,len)) ++ (loop for i from 0 below 100 ++ for r = (logand (1- n) i) ++ for pos = (file-position os) ++ do (assert (or (not pos) (eql pos i))) ++ do (write-byte r os))) ++ do (with-open-file ++ (is "tmp.dat" :direction :input ++ :element-type `(unsigned-byte ,len)) ++ (loop for i from 0 below 100 ++ for pos = (file-position is) ++ do (assert (or (not pos) (eql pos i))) ++ do (let ((byte (read-byte is))) ++ (assert (eql byte (logand (1- n) i))))))) ++ nil) ++ ++(deftest file-position.8 ++ (loop for len from 33 to 100 ++ for n = (ash 1 len) ++ do (with-open-file ++ (os "tmp.dat" :direction :output ++ :if-exists :supersede ++ :element-type `(unsigned-byte ,len)) ++ (loop for i from 0 below 100 ++ for r = (logand (1- n) i) ++ for pos = (file-position os) ++ do (assert (or (not pos) (eql pos i))) ++ do (write-byte r os))) ++ do (with-open-file ++ (is "tmp.dat" :direction :input ++ :element-type `(unsigned-byte ,len)) ++ (loop for i from 0 below 100 ++ for pos = (file-position is) ++ do (assert (or (not pos) (eql pos i))) ++ do (let ((byte (read-byte is))) ++ (assert (eql byte (logand (1- n) i))))))) ++ nil) ++ ++(deftest file-position.9 ++ (with-input-from-string ++ (s "abcdefghijklmnopqrstuvwxyz") ++ (loop repeat 26 ++ for p = (file-position s) ++ unless (or (not p) ++ (progn ++ (file-position s p) ++ (eql (file-position s) p))) ++ collect p ++ do (read-char s))) ++ nil) ++ ++(deftest file-position.10 ++ (with-output-to-string ++ (s) ++ (loop repeat 26 ++ for p = (file-position s) ++ unless (or (not p) ++ (progn ++ (file-position s p) ++ (eql (file-position s) p))) ++ collect p ++ do (write-char #\x s))) ++ "xxxxxxxxxxxxxxxxxxxxxxxxxx") ++ ++;;; Error tests ++ ++(deftest file-position.error.1 ++ (signals-error (file-position) program-error) ++ t) ++ ++(deftest file-position.error.2 ++ (signals-error ++ (file-position (make-string-input-stream "abc") :start nil) ++ program-error) ++ t) ++ ++;;; It's not clear what 'too large' means -- can we set the ++;;; file position to a point where the file may later be extended ++;;; by some other writer? ++#| ++(deftest file-position.error.3 ++ (signals-error ++ (with-open-file ++ (is "file-position.lsp" :direction :input) ++ (flet ((%fail () (error 'type-error))) ++ (unless (file-position is :end) (%fail)) ++ (let ((fp (file-position is))) ++ (unless fp (%fail)) ++ (file-position is (+ 1000000 fp))))) ++ error) ++ t) ++ ++(deftest file-position.error.4 ++ (signals-error ++ (with-open-file ++ (is "file-position.lsp" :direction :input) ++ (file-position is 1000000000000000000000)) ++ error) ++ t) ++|# ++ ++ +\ No newline at end of file +--- /dev/null ++++ gcl-2.6.12/ansi-tests/file-string-length.lsp +@@ -0,0 +1,73 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Jan 22 21:34:04 2004 ++;;;; Contains: Tests of FILE-STRING-LENGTH ++ ++(in-package :cl-test) ++ ++(deftest file-string-length.1 ++ (with-open-file ++ (s "tmp.dat" :direction :output ++ :if-exists :supersede) ++ (loop for x across +standard-chars+ ++ for len = (file-string-length s x) ++ do (assert (typep len '(or null (integer 0)))) ++ do (let ((pos1 (file-position s))) ++ (write-char x s) ++ (let ((pos2 (file-position s))) ++ (when (and pos1 pos2 len) ++ (assert (= (+ pos1 len) pos2))))))) ++ nil) ++ ++(deftest file-string-length.2 ++ (with-open-file ++ (s "tmp.dat" :direction :output ++ :if-exists :supersede) ++ (loop for x across +standard-chars+ ++ for len = (file-string-length s (string x)) ++ do (assert (typep len '(or null (integer 0)))) ++ do (let ((pos1 (file-position s))) ++ (write-sequence (string x) s) ++ (let ((pos2 (file-position s))) ++ (when (and pos1 pos2 len) ++ (assert (= (+ pos1 len) pos2))))))) ++ nil) ++ ++(deftest file-string-length.3 ++ (with-open-file ++ (stream "tmp.dat" :direction :output ++ :if-exists :supersede) ++ (let* ((s1 "abcde") ++ (n (file-string-length stream s1))) ++ (do-special-strings ++ (s2 s1 nil) ++ (assert (= (file-string-length stream s2) n))))) ++ nil) ++ ++;;; Error tests ++ ++(deftest file-string-length.error.1 ++ (signals-error (file-string-length) program-error) ++ t) ++ ++(deftest file-string-length.error.2 ++ (signals-error ++ (with-open-file ++ (s "tmp.dat" :direction :output ++ :if-exists :supersede) ++ (file-string-length s)) ++ program-error) ++ t) ++ ++(deftest file-string-length.error.3 ++ (signals-error ++ (with-open-file ++ (s "tmp.dat" :direction :output ++ :if-exists :supersede) ++ (file-string-length s #\x nil)) ++ program-error) ++ t) ++ ++ ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/file-write-date.lsp +@@ -0,0 +1,89 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 6 06:01:35 2004 ++;;;; Contains: Tests for FILE-WRITE-DATE ++ ++(in-package :cl-test) ++ ++(deftest file-write-date.1 ++ (let* ((pn "file-write-date.lsp") ++ (date (file-write-date pn)) ++ (time (get-universal-time))) ++ (or (null date) ++ (and (integerp date) ++ (<= 0 date time) ++ t))) ++ t) ++ ++(deftest file-write-date.2 ++ (let* ((pn #p"file-write-date.lsp") ++ (date (file-write-date pn)) ++ (time (get-universal-time))) ++ (or (null date) ++ (and (integerp date) ++ (<= 0 date time) ++ t))) ++ t) ++ ++(deftest file-write-date.3 ++ (let* ((pn (truename "file-write-date.lsp")) ++ (date (file-write-date pn)) ++ (time (get-universal-time))) ++ (or (null date) ++ (and (integerp date) ++ (<= 0 date time) ++ t))) ++ t) ++ ++(deftest file-write-date.4 ++ (loop for pn in (directory ++ (make-pathname :name :wild :type :wild ++ :defaults *default-pathname-defaults*)) ++ for date = (file-write-date pn) ++ for time = (get-universal-time) ++ unless (or (null date) ++ (<= 0 date time)) ++ collect (list pn date time)) ++ nil) ++ ++(deftest file-write-date.5 ++ (length (multiple-value-list (file-write-date "file-write-date.lsp"))) ++ 1) ++ ++;;; Specialized string tests ++ ++(deftest file-write-date.6 ++ (let* ((str "file-write-date.lsp") ++ (date (file-write-date str))) ++ (do-special-strings ++ (s str nil) ++ (assert (equal (file-write-date s) date)))) ++ nil) ++ ++;;; FIXME ++;;; Add LPN test ++ ++;;; Error tests ++ ++(deftest file-write-date.error.1 ++ (signals-error (file-write-date) program-error) ++ t) ++ ++(deftest file-write-date.error.2 ++ (signals-error (file-write-date "file-write-date.lsp" nil) ++ program-error) ++ t) ++ ++(deftest file-write-date.error.3 ++ (signals-error-always ++ (file-write-date (make-pathname :name :wild :type "lsp" ++ :defaults *default-pathname-defaults*)) ++ file-error) ++ t t) ++ ++(deftest file-write-date.error.4 ++ (signals-error-always ++ (file-write-date (make-pathname :name "file-write-date" :type :wild ++ :defaults *default-pathname-defaults*)) ++ file-error) ++ t t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/finish-output.lsp +@@ -0,0 +1,54 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Wed Jan 28 06:38:20 2004 ++;;;; Contains: Tests of FINISH-OUTPUT ++ ++(in-package :cl-test) ++ ++(deftest finish-output.1 ++ (finish-output) ++ nil) ++ ++(deftest finish-output.2 ++ (finish-output t) ++ nil) ++ ++(deftest finish-output.3 ++ (finish-output nil) ++ nil) ++ ++(deftest finish-output.4 ++ (loop for s in (list *debug-io* *error-output* *query-io* ++ *standard-output* *trace-output* *terminal-io*) ++ for results = (multiple-value-list (finish-output s)) ++ unless (equal results '(nil)) ++ collect s) ++ nil) ++ ++(deftest finish-output.5 ++ (let ((os (make-string-output-stream))) ++ (let ((*terminal-io* (make-two-way-stream (make-string-input-stream "") ++ os))) ++ (finish-output t))) ++ nil) ++ ++(deftest finish-output.6 ++ (let ((*standard-output* (make-string-output-stream))) ++ (finish-output nil)) ++ nil) ++ ++;;; Error tests ++ ++(deftest finish-output.error.1 ++ (signals-error (finish-output nil nil) program-error) ++ t) ++ ++(deftest finish-output.error.2 ++ (signals-error (finish-output t nil) program-error) ++ t) ++ ++(deftest finish-output.error.3 ++ (check-type-error #'finish-output ++ #'(lambda (x) (typep x '(or stream (member nil t))))) ++ nil) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/force-output.lsp +@@ -0,0 +1,56 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Wed Jan 28 06:41:46 2004 ++;;;; Contains: Tests of FORCE-OUTPUT ++ ++(in-package :cl-test) ++ ++(deftest force-output.1 ++ (force-output) ++ nil) ++ ++(deftest force-output.2 ++ (force-output t) ++ nil) ++ ++(deftest force-output.3 ++ (force-output nil) ++ nil) ++ ++(deftest force-output.4 ++ (loop for s in (list *debug-io* *error-output* *query-io* ++ *standard-output* *trace-output* *terminal-io*) ++ for results = (multiple-value-list (force-output s)) ++ unless (equal results '(nil)) ++ collect s) ++ nil) ++ ++(deftest force-output.5 ++ (let ((os (make-string-output-stream))) ++ (let ((*terminal-io* (make-two-way-stream (make-string-input-stream "") ++ os))) ++ (force-output t))) ++ nil) ++ ++(deftest force-output.6 ++ (let ((*standard-output* (make-string-output-stream))) ++ (force-output nil)) ++ nil) ++ ++ ++;;; Error tests ++ ++(deftest force-output.error.1 ++ (signals-error (force-output nil nil) program-error) ++ t) ++ ++(deftest force-output.error.2 ++ (signals-error (force-output t nil) program-error) ++ t) ++ ++(deftest force-output.error.3 ++ (check-type-error #'force-output ++ #'(lambda (x) (typep x '(or stream (member nil t))))) ++ nil) ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/fresh-line.lsp +@@ -0,0 +1,87 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Jan 18 20:41:18 2004 ++;;;; Contains: Tests of FRESH-LINE ++ ++(in-package :cl-test) ++ ++(deftest fresh-line.1 ++ (let (result) ++ (values ++ (with-output-to-string ++ (*standard-output*) ++ (write-char #\a) ++ (setq result (notnot (fresh-line)))) ++ result)) ++ #.(concatenate 'string "a" (string #\Newline)) ++ t) ++ ++(deftest fresh-line.2 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (write-char #\a s) ++ (setq result (notnot (fresh-line s)))) ++ result)) ++ #.(concatenate 'string "a" (string #\Newline)) ++ t) ++ ++(deftest fresh-line.3 ++ (with-output-to-string ++ (s) ++ (write-char #\x s) ++ (fresh-line s) ++ (fresh-line s) ++ (write-char #\y s)) ++ #.(concatenate 'string "x" (string #\Newline) "y")) ++ ++(deftest fresh-line.4 ++ (let (result) ++ (values ++ (with-output-to-string ++ (*standard-output*) ++ (setq result (multiple-value-list (fresh-line)))) ++ result)) ++ "" (nil)) ++ ++(deftest fresh-line.5 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (write-char #\Space s) ++ (setq result ++ (list ++ (multiple-value-list (notnot-mv (fresh-line s))) ++ (multiple-value-list (fresh-line s)) ++ (multiple-value-list (fresh-line s))))) ++ result)) ++ " ++" ((t) (nil) (nil))) ++ ++(deftest fresh-line.6 ++ (with-output-to-string ++ (os) ++ (let ((*terminal-io* (make-two-way-stream *standard-input* os))) ++ (write-char #\a t) ++ (fresh-line t) ++ (finish-output t))) ++ #.(concatenate 'string (string #\a) (string #\Newline))) ++ ++(deftest fresh-line.7 ++ (with-output-to-string ++ (*standard-output*) ++ (write-char #\a nil) ++ (terpri nil)) ++ #.(concatenate 'string (string #\a) (string #\Newline))) ++ ++;;; Error tests ++ ++(deftest fresh-line.error.1 ++ (signals-error ++ (with-output-to-string ++ (s) ++ (fresh-line s nil)) ++ program-error) ++ t) +--- gcl-2.6.12.orig/ansi-tests/gclload2.lsp ++++ gcl-2.6.12/ansi-tests/gclload2.lsp +@@ -46,6 +46,15 @@ + ;;; Tests of strings + (load "load-strings.lsp") + ++;;; Tests of pathnames ++(load "load-pathnames.lsp") ++ ++;;; Tests of file operations ++(load "load-files.lsp") ++ ++;;; Tests of streams ++(load "load-streams.lsp") ++ + ;;; Tests for character functions + (compile-and-load "char-aux.lsp") + (load "character.lsp") +--- /dev/null ++++ gcl-2.6.12/ansi-tests/get-output-stream-string.lsp +@@ -0,0 +1,32 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Feb 14 09:48:46 2004 ++;;;; Contains: Tests of GET-OUTPUT-STREAM-STRING ++ ++(in-package :cl-test) ++ ++;; this function is used extensively elsewhere in the test suite ++ ++(deftest get-output-stream-string.1 ++ (let ((s (make-string-output-stream))) ++ (values ++ (get-output-stream-string s) ++ (write-string "abc" s) ++ (write-string "def" s) ++ (get-output-stream-string s) ++ (get-output-stream-string s))) ++ "" "abc" "def" "abcdef" "") ++ ++;;; Error cases ++ ++(deftest get-output-stream-string.error.1 ++ (signals-error (get-output-stream-string) t) ++ t) ++ ++(deftest get-output-stream-string.error.2 ++ (signals-error (get-output-stream-string (make-string-output-stream) nil) t) ++ t) ++ ++ ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/host-namestring.lsp +@@ -0,0 +1,49 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Sep 12 06:22:40 2004 ++;;;; Contains: Tests of HOST-NAMESTRING ++ ++(in-package :cl-test) ++ ++(deftest host-namestring.1 ++ (let* ((vals (multiple-value-list ++ (host-namestring "host-namestring.lsp"))) ++ (s (first vals))) ++ (if (and (null (cdr vals)) ++ (or (null s) ++ (stringp s) ++ ;; (equal (host-namestring s) s) ++ )) ++ :good ++ vals)) ++ :good) ++ ++(deftest host-namestring.2 ++ (do-special-strings ++ (s "host-namestring.lsp" nil) ++ (let ((ns (host-namestring s))) ++ (when ns ++ (assert (stringp ns)) ++ ;; (assert (string= (host-namestring ns) ns)) ++ ))) ++ nil) ++ ++(deftest host-namestring.3 ++ (let* ((name "host-namestring.lsp") ++ (pn (merge-pathnames (pathname name))) ++ (name2 (with-open-file (s pn :direction :input) ++ (host-namestring s))) ++ (name3 (host-namestring pn))) ++ (or (equalt name2 name3) (list name2 name3))) ++ t) ++ ++;;; Error tests ++ ++(deftest host-namestring.error.1 ++ (signals-error (host-namestring) program-error) ++ t) ++ ++(deftest host-namestring.error.2 ++ (signals-error (host-namestring "host-namestring.lsp" nil) program-error) ++ t) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/input-stream-p.lsp +@@ -0,0 +1,40 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 13 19:39:27 2004 ++;;;; Contains: Tests for INPUT-STREAM-P ++ ++(in-package :cl-test) ++ ++(deftest input-stream-p.1 ++ (notnot-mv (input-stream-p *standard-input*)) ++ t) ++ ++(deftest input-stream-p.2 ++ (notnot-mv (input-stream-p *terminal-io*)) ++ t) ++ ++(deftest input-stream-p.3 ++ (with-open-file (s "input-stream-p.lsp" :direction :input) ++ (notnot-mv (input-stream-p s))) ++ t) ++ ++(deftest input-stream-p.4 ++ (with-open-file (s "foo.txt" :direction :output ++ :if-exists :supersede) ++ (input-stream-p s)) ++ nil) ++ ++;;; Error tests ++ ++(deftest input-stream-p.error.1 ++ (signals-error (input-stream-p) program-error) ++ t) ++ ++(deftest input-stream-p.error.2 ++ (signals-error (input-stream-p *standard-input* nil) ++ program-error) ++ t) ++ ++(deftest input-stream-p.error.3 ++ (check-type-error #'input-stream-p #'streamp) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/interactive-stream-p.lsp +@@ -0,0 +1,28 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 13 19:47:59 2004 ++;;;; Contains: Tests of INTERACTIVE-STREAM-P ++ ++(in-package :cl-test) ++ ++(deftest interactive-stream-p.1 ++ (let ((streams (list *debug-io* *error-output* *query-io* ++ *standard-input* *standard-output* ++ *trace-output* *terminal-io*))) ++ (mapc #'interactive-stream-p streams) ++ ;; no error should occur ++ nil) ++ nil) ++ ++(deftest interactive-stream-p.error.1 ++ (check-type-error #'interactive-stream-p #'streamp) ++ nil) ++ ++(deftest interactive-stream-p.error.2 ++ (signals-error (interactive-stream-p) program-error) ++ t) ++ ++(deftest interactive-stream-p.error.3 ++ (signals-error (interactive-stream-p *terminal-io* nil) ++ program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/ldtest.lsp +@@ -0,0 +1 @@ ++(in-package :cl-test) (defun LOAD-TEST-FUN-3 () :foo) +\ No newline at end of file +--- /dev/null ++++ gcl-2.6.12/ansi-tests/listen.lsp +@@ -0,0 +1,73 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 27 21:16:39 2004 ++;;;; Contains: Tests of LISTEN ++ ++(in-package :cl-test) ++ ++(deftest listen.1 ++ (with-input-from-string (s "") (listen s)) ++ nil) ++ ++(deftest listen.2 ++ (with-input-from-string (s "x") (notnot-mv (listen s))) ++ t) ++ ++(deftest listen.3 ++ (with-input-from-string (*standard-input* "") (listen)) ++ nil) ++ ++(deftest listen.4 ++ (with-input-from-string (*standard-input* "A") (notnot-mv (listen))) ++ t) ++ ++;;; (deftest listen.5 ++;;; (when (interactive-stream-p *standard-input*) ++;;; (clear-input) (listen)) ++;;; nil) ++ ++(deftest listen.6 ++ (with-input-from-string ++ (s "x") ++ (values ++ (read-char s) ++ (listen s) ++ (unread-char #\x s) ++ (notnot (listen s)) ++ (read-char s))) ++ #\x nil nil t #\x) ++ ++(deftest listen.7 ++ (with-open-file ++ (s "listen.lsp") ++ (values ++ (notnot (listen s)) ++ (handler-case ++ (locally (declare (optimize safety)) ++ (loop (read-char s))) ++ (end-of-file () (listen s))))) ++ t nil) ++ ++(deftest listen.8 ++ (with-input-from-string ++ (is "abc") ++ (let ((*terminal-io* (make-two-way-stream is (make-broadcast-stream)))) ++ (notnot-mv (listen t)))) ++ t) ++ ++(deftest listen.9 ++ (with-input-from-string ++ (*standard-input* "345") ++ (notnot-mv (listen nil))) ++ t) ++ ++;;; Error tests ++ ++(deftest listen.error.1 ++ :notes (:assume-no-simple-streams) ++ (signals-error (listen *standard-input* nil) program-error) ++ t) ++ ++(deftest listen.error.2 ++ (signals-error (listen *standard-input* nil nil) program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/load-files.lsp +@@ -0,0 +1,16 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Jan 1 11:59:35 2004 ++;;;; Contains: Load tests of section 20, 'Files' ++ ++(in-package :cl-test) ++ ++(load "directory.lsp") ++(load "probe-file.lsp") ++(load "ensure-directories-exist.lsp") ++(load "truename.lsp") ++(load "file-author.lsp") ++(load "file-write-date.lsp") ++(load "rename-file.lsp") ++(load "delete-file.lsp") ++(load "file-error.lsp") +--- /dev/null ++++ gcl-2.6.12/ansi-tests/load-logical-pathname-translations.lsp +@@ -0,0 +1,34 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Wed Dec 31 09:31:33 2003 ++;;;; Contains: Tests (such as they are) for LOAD-LOGICAL-PATHNAME-TRANSLATIONS ++ ++(in-package :cl-test) ++ ++;;; The function LOAD-LOGICAL-PATHNAME-TRANSLATIONS is almost entirely ++;;; untestable, since the basic behavior is implementation defined. ++ ++(deftest load-logical-pathname-translations.1 ++ (load-logical-pathname-translations "CLTESTROOT") ++ nil) ++ ++;;; Error cases ++ ++(deftest load-logical-pathname-translations.error.1 ++ (handler-case ++ (progn (load-logical-pathname-translations ++ "THEREHADBETTERNOTBEAHOSTCALLEDTHIS") ++ nil) ++ (error () :good)) ++ :good) ++ ++(deftest load-logical-pathname-translations.error.2 ++ (signals-error (load-logical-pathname-translations) ++ program-error) ++ t) ++ ++(deftest load-logical-pathname-translations.error.3 ++ (signals-error (load-logical-pathname-translations "CLTESTROOT" nil) ++ program-error) ++ t) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/load-pathnames.lsp +@@ -0,0 +1,36 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Nov 29 04:33:05 2003 ++;;;; Contains: Load tests for pathnames and logical pathnames ++ ++(in-package :cl-test) ++ ++(compile-and-load "pathnames-aux.lsp") ++ ++(load "pathnames.lsp") ++(load "pathname.lsp") ++(load "pathnamep.lsp") ++(load "make-pathname.lsp") ++(load "pathname-host.lsp") ++(load "pathname-device.lsp") ++(load "pathname-directory.lsp") ++(load "pathname-name.lsp") ++(load "pathname-type.lsp") ++(load "pathname-version.lsp") ++ ++(load "load-logical-pathname-translations.lsp") ++(load "logical-pathname.lsp") ++(load "logical-pathname-translations.lsp") ++(load "translate-logical-pathname.lsp") ++ ++(load "namestring.lsp") ++(load "file-namestring.lsp") ++(load "directory-namestring.lsp") ++(load "host-namestring.lsp") ++(load "enough-namestring.lsp") ++ ++(load "wild-pathname-p.lsp") ++(load "merge-pathnames.lsp") ++(load "pathname-match-p.lsp") ++ ++(load "parse-namestring.lsp") +\ No newline at end of file +--- /dev/null ++++ gcl-2.6.12/ansi-tests/load-streams.lsp +@@ -0,0 +1,57 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 13 19:38:10 2004 ++;;;; Contains: Load files containing tests for section 21 (streams) ++ ++(in-package :cl-test) ++ ++(load "input-stream-p.lsp") ++(load "output-stream-p.lsp") ++(load "interactive-stream-p.lsp") ++(load "open-stream-p.lsp") ++(load "stream-element-type.lsp") ++(load "streamp.lsp") ++(load "read-byte.lsp") ++(load "peek-char.lsp") ++(load "read-char.lsp") ++(load "read-char-no-hang.lsp") ++(load "terpri.lsp") ++(load "fresh-line.lsp") ++(load "unread-char.lsp") ++(load "write-char.lsp") ++(load "read-line.lsp") ++(load "write-string.lsp") ++(load "write-line.lsp") ++(load "read-sequence.lsp") ++(load "write-sequence.lsp") ++(load "file-length.lsp") ++(load "file-position.lsp") ++(load "file-string-length.lsp") ++(load "open.lsp") ++(load "stream-external-format.lsp") ++(load "with-open-file.lsp") ++(load "with-open-stream.lsp") ++(load "listen.lsp") ++(load "clear-input.lsp") ++(load "finish-output.lsp") ++(load "force-output.lsp") ++(load "clear-output.lsp") ++(load "make-synonym-stream.lsp") ++(load "synonym-stream-symbol.lsp") ++(load "make-broadcast-stream.lsp") ++(load "broadcast-stream-streams.lsp") ++(load "make-two-way-stream.lsp") ++(load "two-way-stream-input-stream.lsp") ++(load "two-way-stream-output-stream.lsp") ++(load "echo-stream-input-stream.lsp") ++(load "echo-stream-output-stream.lsp") ++(load "make-echo-stream.lsp") ++(load "concatenated-stream-streams.lsp") ++(load "make-concatenated-stream.lsp") ++(load "get-output-stream-string.lsp") ++(load "make-string-input-stream.lsp") ++(load "make-string-output-stream.lsp") ++(load "with-input-from-string.lsp") ++(load "with-output-to-string.lsp") ++(load "stream-error-stream.lsp") ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/load-system-construction.lsp +@@ -0,0 +1,12 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Dec 12 19:44:29 2004 ++;;;; Contains: Load tests for system construction (section 24) ++ ++(in-package :cl-test) ++ ++(load "compile-file.lsp") ++(load "load.lsp") ++(load "with-compilation-unit.lsp") ++(load "features.lsp") ++(load "modules.lsp") +--- /dev/null ++++ gcl-2.6.12/ansi-tests/load-test-file-2.lsp +@@ -0,0 +1,7 @@ ++(in-package :cl-test) ++ ++(declaim (special *load-test-var.1* *load-test-var.2*)) ++(eval-when (:load-toplevel) ++ (setq *load-test-var.1* *load-pathname*) ++ (setq *load-test-var.2* *load-truename*)) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/load-test-file.lsp +@@ -0,0 +1,9 @@ ++(in-package :cl-test) ++ ++(defun load-file-test-fun.1 () ++ '#.*load-pathname*) ++ ++(defun load-file-test-fun.2 () ++ '#.*load-truename*) ++ ++ +--- gcl-2.6.12.orig/ansi-tests/load.lsp ++++ gcl-2.6.12/ansi-tests/load.lsp +@@ -1,15 +1,227 @@ +-;; Get the MK package +-;; I've hardwired a path here; fix for your system +-;; I assume the package is already compiled. +-(unless (find-package "MK") +- (load #.(concatenate 'string "../defsys30/defsystem." +- #+cmu (C::BACKEND-FASL-FILE-TYPE C::*TARGET-BACKEND*) +- #+allegro "fasl" +- #+(or akcl gcl) "o"))) +- +-(load "rt/rt.system") +-(mk::load-system "rt") +-(mk::compile-system "cltest") ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Apr 12 21:51:49 2005 ++;;;; Contains: Tests of LOAD ++ + (in-package :cl-test) + ++(defun load-file-test (file funname &rest args &key ++ if-does-not-exist ++ (print nil print-p) ++ (verbose nil verbose-p) ++ (*load-print* nil) ++ (*load-verbose* nil) ++ external-format) ++ (declare (ignorable external-format if-does-not-exist ++ print print-p verbose verbose-p)) ++ (fmakunbound funname) ++ (let* ((str (make-array '(0) :element-type 'character :adjustable t ++ :fill-pointer 0)) ++ (vals (multiple-value-list ++ (with-output-to-string ++ (*standard-output* str) ++ (apply #'load file :allow-other-keys t args)))) ++ (print? (if print-p print *load-print*)) ++ (verbose? (if verbose-p verbose *load-verbose*))) ++ (values ++ (let ((v1 (car vals)) ++ (v2 (or (and verbose-p (not verbose)) ++ (and (not verbose-p) (not *load-verbose*)) ++ (position #\; str))) ++ (v3 (or (and print-p (not print)) ++ (and (not print-p) (not *load-print*)) ++ (> (length str) 0))) ++ (v4 (if (or print? verbose?) ++ (> (length str) 0) ++ t))) ++ (if (and (= (length vals) 1) v1 v2 v3 v4) t (list vals v2 v3 v4 str))) ++ (funcall funname)))) ++ ++(deftest load.1 ++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1) ++ t nil) ++ ++(deftest load.2 ++ (load-file-test #p"compile-file-test-file.lsp" 'compile-file-test-fun.1) ++ t nil) ++ ++(deftest load.3 ++ (with-input-from-string ++ (s "(in-package :cl-test) (defun load-file-test-fun.2 () 'good)") ++ (load-file-test s 'load-file-test-fun.2)) ++ t good) ++ ++(deftest load.4 ++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 ++ :external-format :default) ++ t nil) ++ ++(deftest load.5 ++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 ++ :verbose t) ++ t nil) ++ ++(deftest load.6 ++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 ++ :*load-verbose* t) ++ t nil) ++ ++(deftest load.7 ++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 ++ :*load-verbose* t :verbose nil) ++ t nil) ++ ++(deftest load.8 ++ (with-input-from-string ++ (s "(in-package :cl-test) (defun load-file-test-fun.2 () 'good)") ++ (load-file-test s 'load-file-test-fun.2 :verbose t)) ++ t good) ++ ++(deftest load.9 ++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 ++ :print t) ++ t nil) ++ ++(deftest load.10 ++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 ++ :*load-print* t) ++ t nil) ++ ++(deftest load.11 ++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 ++ :*load-print* t :print nil) ++ t nil) ++ ++(deftest load.12 ++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 ++ :*load-print* nil :print t) ++ t nil) ++ ++(deftest load.13 ++ (with-input-from-string ++ (s "(in-package :cl-test) (defun load-file-test-fun.2 () 'good)") ++ (load-file-test s 'load-file-test-fun.2 :print t)) ++ t good) ++ ++(deftest load.14 ++ (load "nonexistent-file.lsp" :if-does-not-exist nil) ++ nil) ++ ++(defpackage LOAD-TEST-PACKAGE (:use "COMMON-LISP")) ++ ++(deftest load.15 ++ (let ((*package* (find-package "LOAD-TEST-PACKAGE"))) ++ (with-input-from-string ++ (s "(defun f () 'good)") ++ (load-file-test s 'load-test-package::f))) ++ t load-test-package::good) ++ ++(deftest load.15a ++ (let ((*package* (find-package "CL-TEST"))) ++ (values ++ (with-input-from-string ++ (s "(eval-when (:load-toplevel :execute) (setq *package* (find-package \"LOAD-TEST-PACKAGE\"))) ++ (defun f () 'good)") ++ (multiple-value-list (load-file-test s 'load-test-package::f))) ++ (read-from-string "GOOD"))) ++ (t load-test-package::good) good) ++ ++(deftest load.16 ++ (let ((*readtable* (copy-readtable nil))) ++ (set-macro-character #\! (get-macro-character #\')) ++ (with-input-from-string ++ (s "(in-package :cl-test) (defun load-file-test-fun.3 () !good)") ++ (load-file-test s 'load-file-test-fun.3))) ++ t good) ++ ++(deftest load.16a ++ (let ((*readtable* *readtable*) ++ (*package* (find-package "CL-TEST"))) ++ (values ++ (with-input-from-string ++ (s "(in-package :cl-test) ++ (eval-when (:load-toplevel :execute) ++ (setq *readtable* (copy-readtable nil)) ++ (set-macro-character #\\! (get-macro-character #\\'))) ++ (defun load-file-test-fun.3 () !good)") ++ (multiple-value-list ++ (load-file-test s 'load-file-test-fun.3))) ++ (read-from-string "!FOO"))) ++ (t good) !FOO) ++ ++(deftest load.17 ++ (let ((file #p"load-test-file.lsp")) ++ (fmakunbound 'load-file-test-fun.1) ++ (fmakunbound 'load-file-test-fun.2) ++ (values ++ (notnot (load file)) ++ (let ((p1 (pathname (merge-pathnames file))) ++ (p2 (funcall 'load-file-test-fun.1))) ++ (equalpt-or-report p1 p2)) ++ (let ((p1 (truename file)) ++ (p2 (funcall 'load-file-test-fun.2))) ++ (equalpt-or-report p1 p2)))) ++ t t t) ++ ++;;; Test that the load pathname/truename variables are bound ++;;; properly when loading compiled files ++ ++(deftest load.18 ++ (let* ((file "load-test-file-2.lsp") ++ (target (enough-namestring (compile-file-pathname file)))) ++ (declare (special *load-test-var.1* *load-test-var.2*)) ++ (compile-file file) ++ (makunbound '*load-test-var.1*) ++ (makunbound '*load-test-var.2*) ++ (load target) ++ (values ++ (let ((p1 (pathname (merge-pathnames target))) ++ (p2 *load-test-var.1*)) ++ (equalpt-or-report p1 p2)) ++ (let ((p1 (truename target)) ++ (p2 *load-test-var.2*)) ++ (equalpt-or-report p1 p2)))) ++ t t) ++ ++(deftest load.19 ++ (let ((file (logical-pathname "CLTEST:LDTEST.LSP")) ++ (fn 'load-test-fun-3) ++ (*package* (find-package "CL-TEST"))) ++ (with-open-file ++ (s file :direction :output :if-exists :supersede ++ :if-does-not-exist :create) ++ (format s "(in-package :cl-test) (defun ~a () :foo)" fn)) ++ (fmakunbound fn) ++ (values ++ (notnot (load file)) ++ (funcall fn))) ++ t :foo) ++ ++;;; Defaults of the load variables ++ ++(deftest load-pathname.1 ++ *load-pathname* ++ nil) ++ ++(deftest load-truename.1 ++ *load-truename* ++ nil) ++ ++(deftest load-print.1 ++ *load-print* ++ nil) ++ ++;;; Error tests ++ ++(deftest load.error.1 ++ (signals-error (load "nonexistent-file.lsp") file-error) ++ t) ++ ++(deftest load.error.2 ++ (signals-error (load) program-error) ++ t) + ++(deftest load.error.3 ++ (signals-error (load "compile-file-test-file.lsp" :bad-key-arg t) ++ program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/logical-pathname-translations.lsp +@@ -0,0 +1,8 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Wed Dec 31 09:46:08 2003 ++;;;; Contains: Tests of LOGICAL-PATHNAME-TRANSLATIONS ++ ++(in-package :cl-test) ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/logical-pathname.lsp +@@ -0,0 +1,93 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Dec 30 19:05:01 2003 ++;;;; Contains: Tests of LOGICAL-PATHNAME ++ ++(in-package :cl-test) ++ ++(deftest logical-pathname.1 ++ (loop for x in *logical-pathnames* ++ always (eql x (logical-pathname x))) ++ t) ++ ++(deftest logical-pathname.2 ++ (notnot-mv (typep (logical-pathname "CLTEST:FOO") 'logical-pathname)) ++ t) ++ ++(deftest logical-pathname.3 ++ (let ((name "CLTEST:TEMP.DAT.NEWEST")) ++ (with-open-file ++ (s (logical-pathname name) ++ :direction :output ++ :if-exists :supersede ++ :if-does-not-exist :create) ++ (or (equalt (logical-pathname s) (logical-pathname name)) ++ (list (logical-pathname s) (logical-pathname name))))) ++ t) ++ ++ ++;;; Error tests ++ ++(deftest logical-pathname.error.1 ++ (check-type-error #'logical-pathname ++ (typef '(or string stream logical-pathname))) ++ nil) ++ ++(deftest logical-pathname.error.2 ++ ;; Doesn't specify a host ++ (signals-error (logical-pathname "FOO.TXT") type-error) ++ t) ++ ++(deftest logical-pathname.error.3 ++ (signals-error ++ (with-open-file (s #p"logical-pathname.lsp" :direction :input) ++ (logical-pathname s)) ++ type-error) ++ t) ++ ++(deftest logical-pathname.error.4 ++ (signals-error ++ (with-open-stream ++ (is (make-concatenated-stream)) ++ (with-open-stream ++ (os (make-broadcast-stream)) ++ (with-open-stream ++ (s (make-two-way-stream is os)) ++ (logical-pathname s)))) ++ type-error) ++ t) ++ ++(deftest logical-pathname.error.5 ++ (signals-error ++ (with-open-stream ++ (is (make-concatenated-stream)) ++ (with-open-stream ++ (os (make-broadcast-stream)) ++ (with-open-stream ++ (s (make-echo-stream is os)) ++ (logical-pathname s)))) ++ type-error) ++ t) ++ ++(deftest logical-pathname.error.6 ++ (signals-error (with-open-stream (s (make-broadcast-stream)) (logical-pathname s)) type-error) ++ t) ++ ++(deftest logical-pathname.error.7 ++ (signals-error (with-open-stream (s (make-concatenated-stream)) (logical-pathname s)) type-error) ++ t) ++ ++(deftest logical-pathname.error.8 ++ (signals-error (with-open-stream (s (make-string-input-stream "foo")) ++ (logical-pathname s)) type-error) ++ t) ++ ++(deftest logical-pathname.error.9 ++ (signals-error (with-output-to-string (s) (logical-pathname s)) type-error) ++ t) ++ ++(deftest logical-pathname.error.10 ++ (handler-case ++ (progn (eval '(locally (declare (optimize safety)) (logical-pathname "CLROOT:%"))) t) ++ (type-error () t)) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/make-broadcast-stream.lsp +@@ -0,0 +1,99 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Jan 29 21:28:25 2004 ++;;;; Contains: Tests of MAKE-BROADCAST-STREAM ++ ++(in-package :cl-test) ++ ++(deftest make-broadcast-stream.1 ++ (let ((s (make-broadcast-stream))) ++ (assert (typep s 'stream)) ++ (assert (typep s 'broadcast-stream)) ++ (assert (output-stream-p s)) ++ ;; (assert (not (input-stream-p s))) ++ (assert (open-stream-p s)) ++ (assert (streamp s)) ++ ;; (assert (eq (stream-element-type s) t)) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'broadcast-stream)) ++ (notnot (output-stream-p s)) ++ (progn (write-char #\x s) nil) ++ )) ++ t t t nil) ++ ++(deftest make-broadcast-stream.2 ++ (with-output-to-string ++ (s1) ++ (let ((s (make-broadcast-stream s1))) ++ (assert (typep s 'stream)) ++ (assert (typep s 'broadcast-stream)) ++ (assert (output-stream-p s)) ++ ;; (assert (not (input-stream-p s))) ++ (assert (open-stream-p s)) ++ (assert (streamp s)) ++ (assert (eql (stream-element-type s) ++ (stream-element-type s1))) ++ (write-char #\x s))) ++ "x") ++ ++(deftest make-broadcast-stream.3 ++ (let ((s1 (make-string-output-stream)) ++ (s2 (make-string-output-stream))) ++ (let ((s (make-broadcast-stream s1 s2))) ++ (assert (typep s 'stream)) ++ (assert (typep s 'broadcast-stream)) ++ (assert (output-stream-p s)) ++ ;; (assert (not (input-stream-p s))) ++ (assert (open-stream-p s)) ++ (assert (streamp s)) ++ (assert (eql (stream-element-type s) ++ (stream-element-type s2))) ++ (format s "This is a test")) ++ (values ++ (get-output-stream-string s1) ++ (get-output-stream-string s2))) ++ "This is a test" ++ "This is a test") ++ ++(deftest make-broadcast-stream.4 ++ (fresh-line (make-broadcast-stream)) ++ nil) ++ ++(deftest make-broadcast-stream.5 ++ (file-length (make-broadcast-stream)) ++ 0) ++ ++(deftest make-broadcast-stream.6 ++ (file-position (make-broadcast-stream)) ++ 0) ++ ++(deftest make-broadcast-stream.7 ++ (file-string-length (make-broadcast-stream) "antidisestablishmentarianism") ++ 1) ++ ++(deftest make-broadcast-stream.8 ++ (stream-external-format (make-broadcast-stream)) ++ :default) ++ ++ ++ ++;;; FIXME ++;;; Add tests for: close, ++;;; peek-char, read-char-no-hang, terpri, fresh-line, unread-char, ++;;; read-line, write-line, write-string, read-sequence, write-sequence, ++;;; read-byte, write-byte, listen, clear-input, finish-output, force-output, ++;;; clear-output, print, prin1 princ ++ ++;;; Error tests ++ ++(deftest make-broadcast-stream.error.1 ++ (check-type-error #'make-broadcast-stream ++ #'(lambda (x) (and (streamp x) (output-stream-p x)))) ++ nil) ++ ++(deftest make-broadcast-stream.error.2 ++ (check-type-error #'make-broadcast-stream ++ #'(lambda (x) (and (streamp x) (output-stream-p x))) ++ *streams*) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/make-concatenated-stream.lsp +@@ -0,0 +1,323 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Feb 14 08:41:18 2004 ++;;;; Contains: Tests of MAKE-CONCATENATED-STREAM ++ ++(in-package :cl-test) ++ ++(deftest make-concatenated-stream.1 ++ (let ((s (make-concatenated-stream))) ++ (read s nil :eof)) ++ :eof) ++ ++(deftest make-concatenated-stream.2 ++ (let ((s (make-concatenated-stream))) ++ (notnot-mv (input-stream-p s))) ++ t) ++ ++(deftest make-concatenated-stream.3 ++ (let ((s (make-concatenated-stream))) ++ (output-stream-p s)) ++ nil) ++ ++(deftest make-concatenated-stream.4 ++ (let ((s (make-concatenated-stream))) ++ (notnot-mv (streamp s))) ++ t) ++ ++(deftest make-concatenated-stream.5 ++ (let ((s (make-concatenated-stream))) ++ (notnot-mv (typep s 'stream))) ++ t) ++ ++(deftest make-concatenated-stream.6 ++ (let ((s (make-concatenated-stream))) ++ (notnot-mv (typep s 'concatenated-stream))) ++ t) ++ ++(deftest make-concatenated-stream.7 ++ (let ((s (make-concatenated-stream))) ++ (notnot-mv (open-stream-p s))) ++ t) ++ ++(deftest make-concatenated-stream.8 ++ (let ((s (make-concatenated-stream *standard-input*))) ++ (notnot-mv (stream-element-type s))) ++ t) ++ ++(deftest make-concatenated-stream.9 ++ (let ((pn #p"tmp.dat") ++ (element-type '(unsigned-byte 8))) ++ (with-open-file (s pn :direction :output :element-type element-type ++ :if-exists :supersede) ++ (dolist (b '(1 5 9 13)) (write-byte b s))) ++ (with-open-file ++ (s1 pn :direction :input :element-type element-type) ++ (with-open-file ++ (s2 pn :direction :input :element-type element-type) ++ (let ((s (make-concatenated-stream s1 s2))) ++ (loop repeat 8 collect (read-byte s)))))) ++ (1 5 9 13 1 5 9 13)) ++ ++(deftest make-concatenated-stream.10 ++ (let ((s (make-concatenated-stream))) ++ (read-byte s nil :eof)) ++ :eof) ++ ++(deftest make-concatenated-stream.11 ++ (let ((s (make-concatenated-stream))) ++ (peek-char nil s nil :eof)) ++ :eof) ++ ++(deftest make-concatenated-stream.12 ++ (with-input-from-string ++ (s1 "a") ++ (with-input-from-string ++ (s2 "b") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (values ++ (peek-char nil s) ++ (read-char s) ++ (peek-char nil s) ++ (read-char s) ++ (peek-char nil s nil :eof))))) ++ #\a #\a #\b #\b :eof) ++ ++(deftest make-concatenated-stream.13 ++ (with-input-from-string ++ (s1 " a ") ++ (with-input-from-string ++ (s2 " b ") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (values ++ (peek-char t s) ++ (read-char s) ++ (peek-char t s) ++ (read-char s) ++ (peek-char t s nil :eof))))) ++ #\a #\a #\b #\b :eof) ++ ++(deftest make-concatenated-stream.14 ++ (with-input-from-string ++ (s1 "a") ++ (with-input-from-string ++ (s2 "b") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (values ++ (read-char s) ++ (unread-char #\a s) ++ (read-char s) ++ (read-char s) ++ (unread-char #\b s) ++ (read-char s) ++ (read-char s nil :eof))))) ++ #\a nil #\a #\b nil #\b :eof) ++ ++(deftest make-concatenated-stream.15 ++ (let ((s (make-concatenated-stream))) ++ (read-char-no-hang s nil :eof)) ++ :eof) ++ ++(deftest make-concatenated-stream.16 ++ (with-input-from-string ++ (s1 "a") ++ (with-input-from-string ++ (s2 "b") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (values ++ (read-char-no-hang s) ++ (read-char-no-hang s) ++ (read-char-no-hang s nil :eof))))) ++ #\a #\b :eof) ++ ++(deftest make-concatenated-stream.17 ++ (with-input-from-string ++ (s1 "a") ++ (with-input-from-string ++ (s2 "b") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (multiple-value-bind (str mnp) ++ (read-line s) ++ (values str (notnot mnp)))))) ++ "ab" t) ++ ++(deftest make-concatenated-stream.18 ++ (with-input-from-string ++ (s1 "ab") ++ (with-input-from-string ++ (s2 "") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (multiple-value-bind (str mnp) ++ (read-line s) ++ (values str (notnot mnp)))))) ++ "ab" t) ++ ++(deftest make-concatenated-stream.19 ++ (with-input-from-string ++ (s1 "") ++ (with-input-from-string ++ (s2 "ab") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (multiple-value-bind (str mnp) ++ (read-line s) ++ (values str (notnot mnp)))))) ++ "ab" t) ++ ++(deftest make-concatenated-stream.20 ++ (with-input-from-string ++ (s1 "ab") ++ (with-input-from-string ++ (s2 (concatenate 'string (string #\Newline) "def")) ++ (let ((s (make-concatenated-stream s1 s2))) ++ (read-line s)))) ++ "ab" nil) ++ ++(deftest make-concatenated-stream.21 ++ (with-input-from-string ++ (s1 "") ++ (with-input-from-string ++ (s2 "") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (multiple-value-bind (str mnp) ++ (read-line s nil :eof) ++ (values str (notnot mnp)))))) ++ :eof t) ++ ++(deftest make-concatenated-stream.22 ++ (let ((pn #p"tmp.dat") ++ (element-type '(unsigned-byte 8))) ++ (with-open-file (s pn :direction :output :element-type element-type ++ :if-exists :supersede) ++ (dolist (b '(1 5 9 13)) (write-byte b s))) ++ (with-open-file ++ (s1 pn :direction :input :element-type element-type) ++ (with-open-file ++ (s2 pn :direction :input :element-type element-type) ++ (let ((s (make-concatenated-stream s1 s2)) ++ (x (vector nil nil nil nil nil nil nil nil))) ++ (values ++ (read-sequence x s) ++ x))))) ++ 8 ++ #(1 5 9 13 1 5 9 13)) ++ ++(deftest make-concatenated-stream.23 ++ (let ((pn #p"tmp.dat") ++ (element-type '(unsigned-byte 8))) ++ (with-open-file (s pn :direction :output :element-type element-type ++ :if-exists :supersede) ++ (dolist (b '(1 5 9 13)) (write-byte b s))) ++ (with-open-file ++ (s1 pn :direction :input :element-type element-type) ++ (with-open-file ++ (s2 pn :direction :input :element-type element-type) ++ (let ((s (make-concatenated-stream s1 s2)) ++ (x (vector nil nil nil nil nil nil))) ++ (values ++ (read-sequence x s) ++ x))))) ++ 6 ++ #(1 5 9 13 1 5)) ++ ++(deftest make-concatenated-stream.24 ++ (let ((pn #p"tmp.dat") ++ (element-type '(unsigned-byte 8))) ++ (with-open-file (s pn :direction :output :element-type element-type ++ :if-exists :supersede) ++ (dolist (b '(1 5 9 13)) (write-byte b s))) ++ (with-open-file ++ (s1 pn :direction :input :element-type element-type) ++ (with-open-file ++ (s2 pn :direction :input :element-type element-type) ++ (let ((s (make-concatenated-stream s1 s2)) ++ (x (vector nil nil nil nil nil nil nil nil nil nil))) ++ (values ++ (read-sequence x s) ++ x))))) ++ 8 ++ #(1 5 9 13 1 5 9 13 nil nil)) ++ ++(deftest make-concatenated-stream.25 ++ (close (make-concatenated-stream)) ++ t) ++ ++(deftest make-concatenated-stream.26 ++ (let ((s (make-concatenated-stream))) ++ (values (prog1 (close s) (close s)) ++ (open-stream-p s))) ++ t nil) ++ ++(deftest make-concatenated-stream.27 ++ (with-input-from-string ++ (s1 "abc") ++ (let ((s (make-concatenated-stream s1))) ++ (values ++ (notnot (open-stream-p s1)) ++ (notnot (open-stream-p s)) ++ (close s) ++ (notnot (open-stream-p s1)) ++ (open-stream-p s)))) ++ t t t t nil) ++ ++(deftest make-concatenated-stream.28 ++ (with-input-from-string ++ (s1 "a") ++ (let ((s (make-concatenated-stream s1))) ++ (notnot-mv (listen s)))) ++ t) ++ ++(deftest make-concatenated-stream.28a ++ (listen (make-concatenated-stream)) ++ nil) ++ ++(deftest make-concatenated-stream.29 ++ (with-input-from-string ++ (s1 "") ++ (let ((s (make-concatenated-stream s1))) ++ (listen s))) ++ nil) ++ ++(deftest make-concatenated-stream.30 ++ (with-input-from-string ++ (s1 "") ++ (with-input-from-string ++ (s2 "a") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (notnot-mv (listen s))))) ++ t) ++ ++(deftest make-concatenated-stream.31 ++ (with-input-from-string ++ (s1 "") ++ (with-input-from-string ++ (s2 "") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (listen s)))) ++ nil) ++ ++(deftest make-concatenated-stream.32 ++ (clear-input (make-concatenated-stream)) ++ nil) ++ ++(deftest make-concatenated-stream.33 ++ (with-input-from-string ++ (s1 "abc") ++ (clear-input (make-concatenated-stream s1))) ++ nil) ++ ++;;; Error cases ++ ++(deftest make-concatenated-stream.error.1 ++ (loop for x in *mini-universe* ++ unless (or (and (streamp x) (input-stream-p x)) ++ (eval `(signals-error (make-concatenated-stream ',x) t))) ++ collect x) ++ nil) ++ ++(deftest make-concatenated-stream.error.2 ++ (loop for x in *streams* ++ unless (or (and (streamp x) (input-stream-p x)) ++ (eval `(signals-error (make-concatenated-stream ',x) t))) ++ collect x) ++ nil) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/make-echo-stream.lsp +@@ -0,0 +1,332 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Feb 12 04:34:42 2004 ++;;;; Contains: Tests of MAKE-ECHO-STREAM ++ ++(in-package :cl-test) ++ ++(deftest make-echo-stream.1 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values ++ (read-char s) ++ (get-output-stream-string os))) ++ #\f "f") ++ ++(deftest make-echo-stream.2 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (get-output-stream-string os)) ++ "") ++ ++(deftest make-echo-stream.3 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values (read-line s nil) ++ (get-output-stream-string os))) ++ "foo" "foo") ++ ++;;; Tests of READ-BYTE on echo streams ++ ++(deftest make-echo-stream.4 ++ (let ((pn #p"tmp.dat") ++ (pn2 #p"tmp2.dat") ++ (element-type '(unsigned-byte 8))) ++ (with-open-file (os pn ++ :direction :output ++ :element-type element-type ++ :if-exists :supersede) ++ (loop for x in '(2 3 5 7 11) ++ do (write-byte x os))) ++ (with-open-file ++ (is pn :direction :input :element-type element-type) ++ (values ++ (with-open-file ++ (os pn2 :direction :output :if-exists :supersede ++ :element-type element-type) ++ (let ((s (make-echo-stream is os))) ++ (loop repeat 6 collect (read-byte s nil :eof1)))) ++ (with-open-file ++ (s pn2 :direction :input :element-type element-type) ++ (loop repeat 6 collect (read-byte s nil :eof2)))))) ++ (2 3 5 7 11 :eof1) ++ (2 3 5 7 11 :eof2)) ++ ++(deftest make-echo-stream.5 ++ (let ((pn #p"tmp.dat") ++ (pn2 #p"tmp2.dat") ++ (element-type '(unsigned-byte 8))) ++ (with-open-file (os pn ++ :direction :output ++ :element-type element-type ++ :if-exists :supersede) ++ (loop for x in '(2 3 5 7 11) ++ do (write-byte x os))) ++ (with-open-file ++ (is pn :direction :input :element-type element-type) ++ (values ++ (with-open-file ++ (os pn2 :direction :output :if-exists :supersede ++ :element-type element-type) ++ (let ((s (make-echo-stream is os))) ++ (loop repeat 6 collect (read-byte s nil 100)))) ++ (with-open-file ++ (s pn2 :direction :input :element-type element-type) ++ (loop repeat 6 collect (read-byte s nil 200)))))) ++ (2 3 5 7 11 100) ++ (2 3 5 7 11 200)) ++ ++(deftest make-echo-stream.6 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values (coerce (loop repeat 3 collect (read-char-no-hang s)) 'string) ++ (get-output-stream-string os))) ++ "foo" "foo") ++ ++(deftest make-echo-stream.7 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values (coerce (loop repeat 4 collect (read-char-no-hang s nil '#\z)) ++ 'string) ++ (get-output-stream-string os))) ++ "fooz" "foo") ++ ++;;; peek-char + echo streams is tested in peek-char.lsp ++;;; unread-char + echo streams is tested in unread-char.lsp ++ ++(deftest make-echo-stream.8 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os)) ++ (x (copy-seq "xxxxxx"))) ++ (values ++ (read-sequence x s) ++ x ++ (get-output-stream-string os))) ++ 3 ++ "fooxxx" ++ "foo") ++ ++(deftest make-echo-stream.9 ++ (let ((pn #p"tmp.dat") ++ (pn2 #p"tmp2.dat") ++ (element-type '(unsigned-byte 8))) ++ (with-open-file (os pn ++ :direction :output ++ :element-type element-type ++ :if-exists :supersede) ++ (loop for x in '(2 3 5 7 11) ++ do (write-byte x os))) ++ (with-open-file ++ (is pn :direction :input :element-type element-type) ++ (values ++ (with-open-file ++ (os pn2 :direction :output :if-exists :supersede ++ :element-type element-type) ++ (let ((s (make-echo-stream is os)) ++ (x (vector 0 0 0 0 0 0 0 0))) ++ (list (read-sequence x s) ++ x))) ++ (with-open-file ++ (s pn2 :direction :input :element-type element-type) ++ (loop repeat 8 collect (read-byte s nil nil)))))) ++ (5 #(2 3 5 7 11 0 0 0)) ++ (2 3 5 7 11 nil nil nil)) ++ ++(deftest make-echo-stream.10 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values ++ (notnot (open-stream-p s)) ++ (close s) ++ (open-stream-p s) ++ (notnot (open-stream-p is)) ++ (notnot (open-stream-p os)))) ++ t t nil t t) ++ ++(deftest make-echo-stream.11 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values ++ (notnot (listen s)) ++ (read-char s) ++ (notnot (listen s)) ++ (read-char s) ++ (notnot (listen s)) ++ (read-char s) ++ (listen s))) ++ t #\f t #\o t #\o nil) ++ ++(deftest make-echo-stream.12 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values ++ (notnot (streamp s)) ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'echo-stream)) ++ (notnot (input-stream-p s)) ++ (notnot (output-stream-p s)) ++ (notnot (stream-element-type s)))) ++ t t t t t t) ++ ++;;; FIXME ++;;; Add tests for clear-input, file-position(?) ++;;; Also, add tests for output operations (since echo-streams are ++;;; bidirectional) ++ ++(deftest make-echo-stream.13 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values ++ (write-char #\0 s) ++ (close s) ++ (get-output-stream-string os))) ++ #\0 t "0") ++ ++(deftest make-echo-stream.14 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values ++ (terpri s) ++ (close s) ++ (get-output-stream-string os))) ++ nil t #.(string #\Newline)) ++ ++(deftest make-echo-stream.15 ++ (let ((pn #p"tmp.dat") ++ (pn2 #p"tmp2.dat") ++ (element-type '(unsigned-byte 8))) ++ (with-open-file (os pn ++ :direction :output ++ :element-type element-type ++ :if-exists :supersede)) ++ (with-open-file ++ (is pn :direction :input :element-type element-type) ++ (values ++ (with-open-file ++ (os pn2 :direction :output :if-exists :supersede ++ :element-type element-type) ++ (let ((s (make-echo-stream is os)) ++ (x (mapcar #'char-code (coerce "abcdefg" 'list)))) ++ (loop for b in x do ++ (assert (equal (list b) ++ (multiple-value-list (write-byte b s))))) ++ (close s))))) ++ (with-open-file ++ (is pn2 :direction :input :element-type element-type) ++ (let ((x (vector 0 0 0 0 0 0 0))) ++ (read-sequence x is) ++ (values ++ (read-byte is nil :done) ++ (map 'string #'code-char x))))) ++ :done ++ "abcdefg") ++ ++(deftest make-echo-stream.16 ++ (let ((pn #p"tmp.dat") ++ (pn2 #p"tmp2.dat") ++ (element-type '(unsigned-byte 8))) ++ (with-open-file (os pn ++ :direction :output ++ :element-type element-type ++ :if-exists :supersede)) ++ (with-open-file ++ (is pn :direction :input :element-type element-type) ++ (values ++ (with-open-file ++ (os pn2 :direction :output :if-exists :supersede ++ :element-type element-type) ++ (let ((s (make-echo-stream is os)) ++ (x (map 'vector #'char-code "abcdefg"))) ++ (assert (equal (multiple-value-list (write-sequence x s)) (list x))) ++ (close s))))) ++ (with-open-file ++ (is pn2 :direction :input :element-type element-type) ++ (let ((x (vector 0 0 0 0 0 0 0))) ++ (read-sequence x is) ++ (values ++ (read-byte is nil :done) ++ (map 'string #'code-char x))))) ++ :done ++ "abcdefg") ++ ++(deftest make-echo-stream.17 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values ++ (write-char #\X s) ++ (notnot (fresh-line s)) ++ (finish-output s) ++ (force-output s) ++ (close s) ++ (get-output-stream-string os))) ++ #\X t nil nil t #.(coerce '(#\X #\Newline) 'string)) ++ ++(deftest make-echo-stream.18 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values ++ (write-string "159" s) ++ (close s) ++ (get-output-stream-string os))) ++ "159" t "159") ++ ++(deftest make-echo-stream.20 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values ++ (write-string "0159X" s :start 1 :end 4) ++ (close s) ++ (get-output-stream-string os))) ++ "0159X" t "159") ++ ++(deftest make-echo-stream.21 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values ++ (write-line "159" s) ++ (close s) ++ (get-output-stream-string os))) ++ "159" t #.(concatenate 'string "159" (string #\Newline))) ++ ++(deftest make-echo-stream.22 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values ++ (write-char #\0 s) ++ (clear-output s))) ++ #\0 nil) ++ ++;;; Error tests ++ ++(deftest make-echo-stream.error.1 ++ (signals-error (make-echo-stream) program-error) ++ t) ++ ++(deftest make-echo-stream.error.2 ++ (signals-error (make-echo-stream *standard-input*) program-error) ++ t) ++ ++(deftest make-echo-stream.error.3 ++ (signals-error (make-echo-stream *standard-input* *standard-output* nil) ++ program-error) ++ t) ++ ++ ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/make-pathname.lsp +@@ -0,0 +1,171 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Nov 29 05:54:30 2003 ++;;;; Contains: Tests of MAKE-PATHNAME ++ ++(in-package :cl-test) ++ ++(defvar *null-pathname* ++ (make-pathname)) ++ ++(defun make-pathname-test ++ (&rest args &key (defaults nil) ++ (host (if defaults (pathname-host defaults) ++ (pathname-host *default-pathname-defaults*))) ++ (device (if defaults (pathname-device defaults) ++ (pathname-device *null-pathname*))) ++ (directory (if defaults (pathname-directory defaults) ++ (pathname-directory *null-pathname*))) ++ (name (if defaults (pathname-name defaults) ++ (pathname-name *null-pathname*))) ++ (type (if defaults (pathname-type defaults) ++ (pathname-type *null-pathname*))) ++ (version (if defaults (pathname-version defaults) ++ (pathname-version *null-pathname*))) ++ case) ++ (declare (ignorable case)) ++ (let* ((vals (multiple-value-list (apply #'make-pathname args))) ++ (pn (first vals))) ++ (and (= (length vals) 1) ++ (typep pn 'pathname) ++ (equalp (pathname-host pn) host) ++ (equalp (pathname-device pn) device) ++ ;; (equalp (pathname-directory pn) directory) ++ (let ((pnd (pathname-directory pn))) ++ (if (eq directory :wild) ++ (member pnd '((:absolute :wild-inferiors) ++ (:absolute :wild)) ++ :test #'equal) ++ (equalp pnd directory))) ++ (equalp (pathname-name pn) name) ++ (equalp (pathname-type pn) type) ++ (equalp (pathname-version pn) version) ++ t))) ++ ++ ++ ++(deftest make-pathname.1 ++ (make-pathname-test) ++ t) ++ ++(deftest make-pathname.2 ++ (make-pathname-test :name "foo") ++ t) ++ ++(deftest make-pathname.2a ++ (do-special-strings ++ (s "foo") ++ (assert (make-pathname-test :name s))) ++ nil) ++ ++(deftest make-pathname.3 ++ (make-pathname-test :name "foo" :type "txt") ++ t) ++ ++(deftest make-pathname.3a ++ (do-special-strings ++ (s "txt") ++ (assert (make-pathname-test :name "foo" :type s))) ++ nil) ++ ++(deftest make-pathname.4 ++ (make-pathname-test :type "lsp") ++ t) ++ ++(deftest make-pathname.5 ++ (make-pathname-test :directory :wild) ++ t) ++ ++(deftest make-pathname.6 ++ (make-pathname-test :name :wild) ++ t) ++ ++(deftest make-pathname.7 ++ (make-pathname-test :type :wild) ++ t) ++ ++(deftest make-pathname.8 ++ (make-pathname-test :version :wild) ++ t) ++ ++(deftest make-pathname.9 ++ (make-pathname-test :defaults *default-pathname-defaults*) ++ t) ++ ++(deftest make-pathname.10 ++ (make-pathname-test :defaults (make-pathname :name "foo" :type "bar")) ++ t) ++ ++(deftest make-pathname.11 ++ (make-pathname-test :version :newest) ++ t) ++ ++(deftest make-pathname.12 ++ (make-pathname-test :case :local) ++ t) ++ ++(deftest make-pathname.13 ++ (make-pathname-test :case :common) ++ t) ++ ++(deftest make-pathname.14 ++ (let ((*default-pathname-defaults* ++ (make-pathname :name "foo" :type "lsp" :version :newest))) ++ (make-pathname-test)) ++ t) ++ ++;;; Works on the components of actual pathnames ++(deftest make-pathname.rebuild ++ (loop for p in *pathnames* ++ for host = (pathname-host p) ++ for device = (pathname-device p) ++ for directory = (pathname-directory p) ++ for name = (pathname-name p) ++ for type = (pathname-type p) ++ for version = (pathname-version p) ++ for p2 = (make-pathname ++ :host host ++ :device device ++ :directory directory ++ :name name ++ :type type ++ :version version) ++ unless (equal p p2) ++ collect (list p p2)) ++ nil) ++ ++;;; Various constraints on :directory ++ ++(deftest make-pathname-error-absolute-up ++ (signals-error (directory (make-pathname :directory '(:absolute :up))) ++ file-error) ++ t) ++ ++(deftest make-pathname-error-absolute-back ++ (signals-error (directory (make-pathname :directory '(:absolute :back))) ++ file-error) ++ t) ++ ++;; The next test is correct, but was causing very large amounts of time to be spent ++;; in buggy implementations ++;;#| ++(deftest make-pathname-error-absolute-wild-inferiors-up ++ (signals-error (directory (make-pathname :directory '(:absolute :wild-inferiors :up))) ++ file-error) ++ t) ++;;|# ++ ++(deftest make-pathname-error-relative-wild-inferiors-up ++ (signals-error (length (directory (make-pathname :directory '(:relative :wild-inferiors :up)))) ++ file-error) ++ t) ++ ++(deftest make-pathname-error-absolute-wild-inferiors-back ++ (signals-error (directory (make-pathname :directory '(:absolute :wild-inferiors :back))) ++ file-error) ++ t) ++ ++(deftest make-pathname-error-relative-wild-inferiors-back ++ (signals-error (directory (make-pathname :directory '(:relative :wild-inferiors :back))) ++ file-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/make-string-input-stream.lsp +@@ -0,0 +1,93 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Feb 14 18:36:48 2004 ++;;;; Contains: Tests for MAKE-STRING-INPUT-STREAM ++ ++(in-package :cl-test) ++ ++(deftest make-string-input-stream.1 ++ (let ((s (make-string-input-stream ""))) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (streamp s)) ++ (notnot (input-stream-p s)) ++ (output-stream-p s))) ++ t t t nil) ++ ++(deftest make-string-input-stream.2 ++ (let ((s (make-string-input-stream "abcd"))) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (streamp s)) ++ (notnot (input-stream-p s)) ++ (output-stream-p s))) ++ t t t nil) ++ ++ ++(deftest make-string-input-stream.3 ++ (let ((s (make-string-input-stream "abcd" 1))) ++ (values (read-line s))) ++ "bcd") ++ ++ ++(deftest make-string-input-stream.4 ++ (let ((s (make-string-input-stream "abcd" 0 2))) ++ (values (read-line s))) ++ "ab") ++ ++(deftest make-string-input-stream.5 ++ (let ((s (make-string-input-stream "abcd" 1 nil))) ++ (values (read-line s))) ++ "bcd") ++ ++(deftest make-string-input-stream.6 ++ (let ((str1 (make-array 6 :element-type 'character ++ :initial-contents "abcdef" ++ :fill-pointer 4))) ++ (let ((s (make-string-input-stream str1))) ++ (values (read-line s) (read-char s nil :eof)))) ++ "abcd" :eof) ++ ++(deftest make-string-input-stream.7 ++ (let* ((str1 (make-array 6 :element-type 'character ++ :initial-contents "abcdef")) ++ (str2 (make-array 4 :element-type 'character ++ :displaced-to str1))) ++ (let ((s (make-string-input-stream str2))) ++ (values (read-line s) (read-char s nil :eof)))) ++ "abcd" :eof) ++ ++(deftest make-string-input-stream.8 ++ (let* ((str1 (make-array 6 :element-type 'character ++ :initial-contents "abcdef")) ++ (str2 (make-array 4 :element-type 'character ++ :displaced-to str1 ++ :displaced-index-offset 1))) ++ (let ((s (make-string-input-stream str2))) ++ (values (read-line s) (read-char s nil :eof)))) ++ "bcde" :eof) ++ ++(deftest make-string-input-stream.9 ++ (let ((str1 (make-array 6 :element-type 'character ++ :initial-contents "abcdef" ++ :adjustable t))) ++ (let ((s (make-string-input-stream str1))) ++ (values (read-line s) (read-char s nil :eof)))) ++ "abcdef" :eof) ++ ++(deftest make-string-input-stream.10 ++ :notes (:allow-nil-arrays :nil-vectors-are-strings) ++ (let ((s (make-string-input-stream ++ (make-array 0 :element-type nil)))) ++ (read-char s nil :eof)) ++ :eof) ++ ++;;; Error tests ++ ++(deftest make-string-input-stream.error.1 ++ (signals-error (make-string-input-stream) program-error) ++ t) ++ ++(deftest make-string-input-stream.error.2 ++ (signals-error (make-string-input-stream "abc" 1 2 nil) program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/make-string-output-stream.lsp +@@ -0,0 +1,139 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Feb 14 19:42:07 2004 ++;;;; Contains: Tests of MAKE-STRING-OUTPUT-STREAM ++ ++(in-package :cl-test) ++ ++(deftest make-string-output-stream.1 ++ (let ((s (make-string-output-stream))) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (input-stream-p s) ++ (notnot (output-stream-p s)) ++ (notnot (open-stream-p s)))) ++ t t nil t t) ++ ++(deftest make-string-output-stream.2 ++ (let ((s (make-string-output-stream :element-type 'character))) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (input-stream-p s) ++ (notnot (output-stream-p s)) ++ (notnot (open-stream-p s)))) ++ t t nil t t) ++ ++(deftest make-string-output-stream.3 ++ (let ((s (make-string-output-stream :element-type 'base-char))) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (input-stream-p s) ++ (notnot (output-stream-p s)) ++ (notnot (open-stream-p s)))) ++ t t nil t t) ++ ++(deftest make-string-output-stream.4 ++ :notes (:nil-vectors-are-strings) ++ (let ((s (make-string-output-stream :element-type nil))) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (input-stream-p s) ++ (notnot (output-stream-p s)) ++ (notnot (open-stream-p s)))) ++ t t nil t t) ++ ++(deftest make-string-output-stream.5 ++ (let ((s (make-string-output-stream :allow-other-keys nil))) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (input-stream-p s) ++ (notnot (output-stream-p s)) ++ (notnot (open-stream-p s)))) ++ t t nil t t) ++ ++(deftest make-string-output-stream.6 ++ (let ((s (make-string-output-stream :allow-other-keys t :foo 'bar))) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (input-stream-p s) ++ (notnot (output-stream-p s)) ++ (notnot (open-stream-p s)))) ++ t t nil t t) ++ ++(deftest make-string-output-stream.7 ++ (let ((s (make-string-output-stream :foo 'bar :allow-other-keys t ++ :allow-other-keys nil ++ :foo2 'x))) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (input-stream-p s) ++ (notnot (output-stream-p s)) ++ (notnot (open-stream-p s)))) ++ t t nil t t) ++ ++(deftest make-string-output-stream.8 ++ (let ((s (make-string-output-stream))) ++ (write-string "abc" s) ++ (write-string "def" s) ++ (get-output-stream-string s)) ++ "abcdef") ++ ++(deftest make-string-output-stream.9 ++ (let ((s (make-string-output-stream :element-type 'character))) ++ (write-string "abc" s) ++ (write-string "def" s) ++ (get-output-stream-string s)) ++ "abcdef") ++ ++(deftest make-string-output-stream.10 ++ (let ((s (make-string-output-stream :element-type 'base-char))) ++ (write-string "abc" s) ++ (write-string "def" s) ++ (get-output-stream-string s)) ++ "abcdef") ++ ++(deftest make-string-output-stream.11 ++ :notes (:nil-vectors-are-strings) ++ (let ((s (make-string-output-stream :element-type nil))) ++ (get-output-stream-string s)) ++ "") ++ ++(deftest make-string-output-stream.12 ++ :notes (:nil-vectors-are-strings) ++ (let ((s (make-string-output-stream :element-type nil))) ++ (typep #\a (array-element-type (get-output-stream-string s)))) ++ nil) ++ ++(deftest make-string-output-stream.13 ++ (let ((s (make-string-output-stream))) ++ (values ++ (close s) ++ (open-stream-p s))) ++ t nil) ++ ++;;; Error tests ++ ++(deftest make-string-output-stream.error.1 ++ (signals-error (make-string-output-stream nil) program-error) ++ t) ++ ++(deftest make-string-output-stream.error.2 ++ (signals-error (make-string-output-stream :foo nil) program-error) ++ t) ++ ++(deftest make-string-output-stream.error.3 ++ (signals-error (make-string-output-stream :allow-other-keys nil ++ :foo 'bar) ++ program-error) ++ t) ++ ++ ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/make-synonym-stream.lsp +@@ -0,0 +1,97 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Wed Jan 28 06:54:33 2004 ++;;;; Contains: Tests of MAKE-SYNONYM-STREAM ++ ++(in-package :cl-test) ++ ++(deftest make-synonym-stream.1 ++ (with-input-from-string ++ (*s* "abcde") ++ (declare (special *s*)) ++ (let ((ss (make-synonym-stream '*s*))) ++ (assert (typep ss 'stream)) ++ (assert (typep ss 'synonym-stream)) ++ (assert (input-stream-p ss)) ++ (assert (not (output-stream-p ss))) ++ (assert (open-stream-p ss)) ++ (assert (streamp ss)) ++ (assert (stream-element-type ss)) ++ (values ++ (read-char *s*) ++ (read-char ss) ++ (read-char *s*) ++ (read-char ss) ++ (read-char ss)))) ++ #\a #\b #\c #\d #\e) ++ ++ ++;;; This test was wrong (section 21.1.4) ++#| ++(deftest make-synonym-stream.2 ++ (let ((ss (make-synonym-stream '*s*))) ++ (with-input-from-string ++ (*s* "z") ++ (declare (special *s*)) ++ (assert (typep ss 'stream)) ++ (assert (typep ss 'synonym-stream)) ++ (assert (input-stream-p ss)) ++ (assert (not (output-stream-p ss))) ++ (assert (open-stream-p ss)) ++ (assert (streamp ss)) ++ (assert (stream-element-type ss)) ++ (read-char ss))) ++ #\z) ++|# ++ ++(deftest make-synonym-stream.3 ++ (with-output-to-string ++ (*s*) ++ (declare (special *s*)) ++ (let ((ss (make-synonym-stream '*s*))) ++ (assert (typep ss 'stream)) ++ (assert (typep ss 'synonym-stream)) ++ (assert (output-stream-p ss)) ++ (assert (not (input-stream-p ss))) ++ (assert (open-stream-p ss)) ++ (assert (streamp ss)) ++ (assert (stream-element-type ss)) ++ (write-char #\a *s*) ++ (write-char #\b ss) ++ (write-char #\x *s*) ++ (write-char #\y ss))) ++ "abxy") ++ ++(deftest make-synonym-stream.4 ++ (let ((ss (make-synonym-stream '*terminal-io*))) ++ (assert (typep ss 'stream)) ++ (assert (typep ss 'synonym-stream)) ++ (assert (output-stream-p ss)) ++ (assert (input-stream-p ss)) ++ (assert (open-stream-p ss)) ++ (assert (streamp ss)) ++ (assert (stream-element-type ss)) ++ nil) ++ nil) ++ ++ ++;;; FIXME ++;;; Add tests for: close, ++;;; peek-char, read-char-no-hang, terpri, fresh-line, unread-char, ++;;; read-line, write-line, write-string, read-sequence, write-sequence, ++;;; read-byte, write-byte, listen, clear-input, finish-output, force-output, ++;;; clear-output, format, print, prin1, princ ++ ++;;; Error cases ++ ++(deftest make-synonym-stream.error.1 ++ (signals-error (make-synonym-stream) program-error) ++ t) ++ ++(deftest make-synonym-stream.error.2 ++ (signals-error (make-synonym-stream '*standard-input* nil) program-error) ++ t) ++ ++(deftest make-synonym-stream.error.3 ++ (check-type-error #'make-synonym-stream #'symbolp) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/make-two-way-stream.lsp +@@ -0,0 +1,244 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Fri Jan 30 05:39:56 2004 ++;;;; Contains: Tests for MAKE-TWO-WAY-STREAM ++ ++(in-package :cl-test) ++ ++(deftest make-two-way-stream.1 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (assert (typep s 'stream)) ++ (assert (typep s 'two-way-stream)) ++ (assert (streamp s)) ++ (assert (open-stream-p s)) ++ (assert (input-stream-p s)) ++ (assert (output-stream-p s)) ++ (assert (stream-element-type s)) ++ (values ++ (read-char s) ++ (write-char #\b s) ++ (read-char s) ++ (write-char #\a s) ++ (read-char s) ++ (write-char #\r s) ++ (get-output-stream-string os))) ++ #\f #\b #\o #\a #\o #\r "bar") ++ ++(deftest make-two-way-stream.2 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (values ++ (close s) ++ (open-stream-p s) ++ (notnot (open-stream-p is)) ++ (notnot (open-stream-p os)) ++ (write-char #\8 os) ++ (get-output-stream-string os))) ++ t nil t t #\8 "8") ++ ++(deftest make-two-way-stream.3 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (values ++ (peek-char nil s) ++ (read-char s) ++ (get-output-stream-string os))) ++ #\f #\f "") ++ ++(deftest make-two-way-stream.4 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (values ++ (read-char-no-hang s) ++ (read-char-no-hang s nil) ++ (read-char-no-hang s t :eof) ++ (read-char-no-hang s nil :eof) ++ (get-output-stream-string os))) ++ #\f #\o #\o :eof "") ++ ++(deftest make-two-way-stream.5 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (values ++ (terpri s) ++ (get-output-stream-string os))) ++ nil #.(string #\Newline)) ++ ++(deftest make-two-way-stream.6 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (values ++ (write-char #\+ s) ++ (notnot (fresh-line s)) ++ (read-char s) ++ (get-output-stream-string os))) ++ #\+ t #\f #.(coerce (list #\+ #\Newline) 'string)) ++ ++(deftest make-two-way-stream.7 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (values ++ (read-char s) ++ (unread-char #\f s) ++ (read-char s) ++ (read-char s) ++ (unread-char #\o s) ++ (get-output-stream-string os))) ++ #\f nil #\f #\o nil "") ++ ++(deftest make-two-way-stream.8 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (values ++ (read-line s) ++ (get-output-stream-string os))) ++ "foo" "") ++ ++(deftest make-two-way-stream.9 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (values ++ (write-string "bar" s) ++ (get-output-stream-string os))) ++ "bar" "bar") ++ ++(deftest make-two-way-stream.10 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (values ++ (write-line "bar" s) ++ (get-output-stream-string os))) ++ "bar" #.(concatenate 'string "bar" '(#\Newline))) ++ ++(deftest make-two-way-stream.11 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (let ((x (vector nil nil nil))) ++ (values ++ (read-sequence x s) ++ x ++ (get-output-stream-string os)))) ++ 3 #(#\f #\o #\o) "") ++ ++(deftest make-two-way-stream.12 ++ (let ((pn1 #p"tmp.dat") ++ (pn2 #p"tmp2.dat") ++ (element-type '(unsigned-byte 8))) ++ (with-open-file (s pn1 :direction :output :if-exists :supersede ++ :element-type element-type) ++ (dolist (b '(3 8 19 41)) (write-byte b s))) ++ (with-open-file ++ (is pn1 :direction :input :element-type element-type) ++ (with-open-file ++ (os pn2 :direction :output :element-type element-type ++ :if-exists :supersede) ++ (let ((s (make-two-way-stream is os)) ++ (x (vector nil nil nil nil))) ++ (assert (eql (read-sequence x s) 4)) ++ (assert (equalp x #(3 8 19 41))) ++ (let ((y #(100 5 18 211 0 178))) ++ (assert (eql (write-sequence y s) y)) ++ (close s))))) ++ (with-open-file ++ (s pn2 :direction :input :element-type element-type) ++ (let ((x (vector nil nil nil nil nil nil nil))) ++ (values ++ (read-sequence x s) ++ x)))) ++ 6 ++ #(100 5 18 211 0 178 nil)) ++ ++(deftest make-two-way-stream.13 ++ (let ((pn1 #p"tmp.dat") ++ (pn2 #p"tmp2.dat") ++ (element-type '(unsigned-byte 32))) ++ (with-open-file (s pn1 :direction :output :if-exists :supersede ++ :element-type element-type) ++ (dolist (b '(3 8 19 41)) (write-byte b s))) ++ (with-open-file ++ (is pn1 :direction :input :element-type element-type) ++ (with-open-file ++ (os pn2 :direction :output :element-type element-type ++ :if-exists :supersede) ++ (let ((s (make-two-way-stream is os)) ++ (x (vector nil nil nil nil))) ++ (assert (eql (read-sequence x s) 4)) ++ (assert (equalp x #(3 8 19 41))) ++ (let ((y #(100 5 18 211 0 178))) ++ (assert (eql (write-sequence y s) y)) ++ (close s))))) ++ (with-open-file ++ (s pn2 :direction :input :element-type element-type) ++ (let ((x (vector nil nil nil nil nil nil nil))) ++ (values ++ (read-sequence x s) ++ x)))) ++ 6 ++ #(100 5 18 211 0 178 nil)) ++ ++(deftest make-two-way-stream.14 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (values ++ (write-string "abc" s) ++ (clear-input s) ++ (write-string "def" s) ++ (get-output-stream-string os))) ++ "abc" nil "def" "abcdef") ++ ++;;; Error tests ++ ++(deftest make-two-way-stream.error.1 ++ (signals-error (make-two-way-stream) program-error) ++ t) ++ ++(deftest make-two-way-stream.error.2 ++ (signals-error (make-two-way-stream (make-string-input-stream "foo")) ++ program-error) ++ t) ++ ++(deftest make-two-way-stream.error.3 ++ (signals-error (let ((os (make-string-output-stream))) ++ (make-two-way-stream (make-string-input-stream "foo") ++ os nil)) ++ program-error) ++ t) ++ ++(deftest make-two-way-stream.error.4 ++ (check-type-error #'(lambda (x) (make-two-way-stream x (make-string-output-stream))) ++ #'(lambda (x) (and (streamp x) (input-stream-p x)))) ++ nil) ++ ++(deftest make-two-way-stream.error.5 ++ (check-type-error #'(lambda (x) (make-two-way-stream x (make-string-output-stream))) ++ #'(lambda (x) (and (streamp x) (input-stream-p x))) ++ *streams*) ++ nil) ++ ++(deftest make-two-way-stream.error.6 ++ (check-type-error #'(lambda (x) (make-two-way-stream (make-string-input-stream "foo") x)) ++ #'(lambda (x) (and (streamp x) (output-stream-p x)))) ++ nil) ++ ++(deftest make-two-way-stream.error.7 ++ (check-type-error #'(lambda (x) (make-two-way-stream (make-string-input-stream "foo") x)) ++ #'(lambda (x) (and (streamp x) (output-stream-p x))) ++ *streams*) ++ nil) ++ ++ ++ ++ +\ No newline at end of file +--- /dev/null ++++ gcl-2.6.12/ansi-tests/merge-pathnames.lsp +@@ -0,0 +1,124 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Wed Dec 31 11:25:55 2003 ++;;;; Contains: Tests of MERGE-PATHNAMES ++ ++(in-package :cl-test) ++ ++#| ++(defun merge-pathnames-test (&rest args) ++ (assert (<= 1 (length args) 3)) ++ (let* ((p1 (car args)) ++ (p2 (if (cdr args) (cadr args) *default-pathname-defaults*)) ++ (default-version (if (cddr args) (caddr args) :newest)) ++ (results (multiple-value-list (apply #'merge-pathnames args)))) ++ (assert (= (length results) 1)) ++ (let ((p3 (first results))) ++ ++|# ++ ++(deftest merge-pathnames.1 ++ (let* ((p1 (make-pathname :name "foo")) ++ (p2 (merge-pathnames p1 p1 nil))) ++ (values ++ (equalpt (pathname-name p1) "foo") ++ (if (equalpt p1 p2) t ++ (list p1 p2)))) ++ t t) ++ ++(deftest merge-pathnames.2 ++ (let* ((p1 (make-pathname :name "foo")) ++ (p2 (merge-pathnames p1 p1))) ++ (values ++ (equalpt (pathname-host p1) (pathname-host p2)) ++ (equalpt (pathname-device p1) (pathname-device p2)) ++ (equalpt (pathname-directory p1) (pathname-directory p2)) ++ (pathname-name p1) ++ (pathname-name p2) ++ (equalpt (pathname-type p1) (pathname-type p2)) ++ (if (pathname-version p1) ++ (equalpt (pathname-version p1) (pathname-version p2)) ++ (equalpt (pathname-version p2) :newest)))) ++ t t t "foo" "foo" t t) ++ ++(deftest merge-pathnames.3 ++ (let* ((p1 (make-pathname :name "foo")) ++ (p2 (make-pathname :name "bar")) ++ (p3 (merge-pathnames p1 p2))) ++ (values ++ (equalpt (pathname-host p1) (pathname-host p3)) ++ (equalpt (pathname-device p1) (pathname-device p3)) ++ (equalpt (pathname-directory p1) (pathname-directory p3)) ++ (pathname-name p1) ++ (pathname-name p3) ++ (equalpt (pathname-type p1) (pathname-type p3)) ++ (if (pathname-version p1) ++ (equalpt (pathname-version p1) (pathname-version p3)) ++ (equalpt (pathname-version p3) :newest)))) ++ t t t "foo" "foo" t t) ++ ++(deftest merge-pathnames.4 ++ (let* ((p1 (make-pathname :name "foo")) ++ (p2 (make-pathname :type "lsp")) ++ (p3 (merge-pathnames p1 p2))) ++ (values ++ (equalpt (pathname-host p1) (pathname-host p3)) ++ (equalpt (pathname-device p1) (pathname-device p3)) ++ (equalpt (pathname-directory p1) (pathname-directory p3)) ++ (pathname-name p1) ++ (pathname-type p2) ++ (pathname-type p3) ++ (equalpt (pathname-type p2) (pathname-type p3)) ++ (if (pathname-version p1) ++ (equalpt (pathname-version p1) (pathname-version p3)) ++ (equalpt (pathname-version p3) :newest)))) ++ t t t "foo" "lsp" "lsp" t t) ++ ++(deftest merge-pathnames.5 ++ (let* ((p1 (make-pathname :name "foo")) ++ (p2 (make-pathname :type "lsp" :version :newest)) ++ (p3 (merge-pathnames p1 p2 nil))) ++ (values ++ (equalpt (pathname-host p1) (pathname-host p3)) ++ (equalpt (pathname-device p1) (pathname-device p3)) ++ (equalpt (pathname-directory p1) (pathname-directory p3)) ++ (pathname-name p1) ++ (pathname-name p3) ++ (pathname-type p2) ++ (pathname-type p3) ++ (equalpt (pathname-version p1) (pathname-version p3)))) ++ t t t "foo" "foo" "lsp" "lsp" t) ++ ++(deftest merge-pathnames.6 ++ (let* ((p1 (make-pathname)) ++ (p2 (make-pathname :name "foo" :version :newest)) ++ (p3 (merge-pathnames p1 p2 nil))) ++ (values ++ (equalpt (pathname-host p1) (pathname-host p3)) ++ (equalpt (pathname-device p1) (pathname-device p3)) ++ (equalpt (pathname-directory p1) (pathname-directory p3)) ++ (pathname-name p2) ++ (pathname-name p3) ++ (equalpt (pathname-type p2) (pathname-type p3)) ++ (pathname-version p2) ++ (pathname-version p3))) ++ t t t "foo" "foo" t :newest :newest) ++ ++(deftest merge-pathnames.7 ++ (let* ((p1 (make-pathname)) ++ (p2 *default-pathname-defaults*) ++ (p3 (merge-pathnames p1))) ++ (values ++ (equalpt (pathname-host p1) (pathname-host p3)) ++ (equalpt (pathname-host p2) (pathname-host p3)) ++ (equalpt (pathname-device p2) (pathname-device p3)) ++ (equalpt (pathname-directory p2) (pathname-directory p3)) ++ (equalpt (pathname-name p2) (pathname-name p3)) ++ (equalpt (pathname-type p2) (pathname-type p3)) ++ (cond ++ ((pathname-version p1) (equalpt (pathname-version p1) ++ (pathname-version p3))) ++ ((pathname-version p2) (equalpt (pathname-version p2) ++ (pathname-version p3))) ++ (t (equalpt (pathname-version p3) :newest))))) ++ t t t t t t t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/namestring.lsp +@@ -0,0 +1,64 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Sep 2 07:24:42 2004 ++;;;; Contains: Tests for NAMESTRING ++ ++(in-package :cl-test) ++ ++(deftest namestring.1 ++ (let* ((vals (multiple-value-list (namestring "namestring.lsp"))) ++ (s (first vals))) ++ (if (and (null (cdr vals)) ++ (stringp s) ++ (equal (namestring s) s)) ++ :good ++ vals)) ++ :good) ++ ++(deftest namestring.2 ++ (do-special-strings ++ (s "namestring.lsp" nil) ++ (let ((ns (namestring s))) ++ (assert (stringp ns)) ++ (assert (string= (namestring ns) ns)))) ++ nil) ++ ++;;; I'm not convinced these tested required behavior, so I'm commenting ++;;; them out for now. FIXME: determine if they are bogus ++#| ++(deftest namestring.3 ++ (let* ((name "namestring.lsp") ++ (pn (merge-pathnames (pathname name))) ++ (name2 (namestring pn)) ++ (pn2 (pathname name2))) ++ (or (equalt pn pn2) (list (list pn (pathname-host pn) (pathname-device pn) ++ (pathname-directory pn) (pathname-name pn) ++ (pathname-type pn) (pathname-version pn)) ++ (list pn2 (pathname-host pn2) (pathname-device pn2) ++ (pathname-directory pn2) (pathname-name pn2) ++ (pathname-type pn2) (pathname-version pn2))))) ++ t) ++ ++(deftest namestring.4 ++ (let* ((name "namestring.lsp") ++ (pn (merge-pathnames (pathname name))) ++ (name2 (with-open-file (s pn :direction :input) (namestring s))) ++ (pn2 (pathname name2))) ++ (or (equalt pn pn2) (list (list pn (pathname-host pn) (pathname-device pn) ++ (pathname-directory pn) (pathname-name pn) ++ (pathname-type pn) (pathname-version pn)) ++ (list pn2 (pathname-host pn2) (pathname-device pn2) ++ (pathname-directory pn2) (pathname-name pn2) ++ (pathname-type pn2) (pathname-version pn2))))) ++ t) ++|# ++ ++;;; Error tests ++ ++(deftest namestring.error.1 ++ (signals-error (namestring) program-error) ++ t) ++ ++(deftest namestring.error.2 ++ (signals-error (namestring "namestring.lsp" nil) program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/open-stream-p.lsp +@@ -0,0 +1,54 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 13 19:52:30 2004 ++;;;; Contains: Tests of OPEN-STREAM-P ++ ++(in-package :cl-test) ++ ++(deftest open-stream-p.1 ++ (loop for s in (list *debug-io* *error-output* *query-io* ++ *standard-input* *standard-output* ++ *trace-output* *terminal-io*) ++ for results = (multiple-value-list (open-stream-p s)) ++ unless (and (eql (length results) 1) ++ (car results)) ++ collect s) ++ nil) ++ ++(deftest open-stream-p.2 ++ (with-open-file (s "open-stream-p.lsp" :direction :input) ++ (notnot-mv (open-stream-p s))) ++ t) ++ ++(deftest open-stream-p.3 ++ (with-open-file (s "foo.txt" :direction :output ++ :if-exists :supersede) ++ (notnot-mv (open-stream-p s))) ++ t) ++ ++(deftest open-stream-p.4 ++ (let ((s (open "open-stream-p.lsp" :direction :input))) ++ (close s) ++ (open-stream-p s)) ++ nil) ++ ++(deftest open-stream-p.5 ++ (let ((s (open "foo.txt" :direction :output ++ :if-exists :supersede))) ++ (close s) ++ (open-stream-p s)) ++ nil) ++ ++;;; error tests ++ ++(deftest open-stream-p.error.1 ++ (signals-error (open-stream-p) program-error) ++ t) ++ ++(deftest open-stream-p.error.2 ++ (signals-error (open-stream-p *standard-input* nil) program-error) ++ t) ++ ++(deftest open-stream-p.error.3 ++ (check-type-error #'open-stream-p #'streamp) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/open.lsp +@@ -0,0 +1,1238 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Fri Jan 23 05:36:55 2004 ++;;;; Contains: Tests of OPEN ++ ++(in-package :cl-test) ++ ++;;; Input streams ++ ++(defun generator-for-element-type (type) ++ (etypecase type ++ ((member character base-char) ++ #'(lambda (i) (aref "abcdefghijklmnopqrstuvwxyz" (mod i 26)))) ++ ((member signed-byte unsigned-byte bit) ++ #'(lambda (i) (logand i 1))) ++ (cons ++ (let ((op (car type)) ++ (arg1 (cadr type)) ++ (arg2 (caddr type))) ++ (ecase op ++ (unsigned-byte ++ (let ((mask (1- (ash 1 arg1)))) ++ #'(lambda (i) (logand i mask)))) ++ (signed-byte ++ (let ((mask (1- (ash 1 (1- arg1))))) ++ #'(lambda (i) (logand i mask)))) ++ (integer ++ (let* ((lo arg1) ++ (hi arg2) ++ (lower-bound ++ (etypecase lo ++ (integer lo) ++ (cons (1+ (car lo))))) ++ (upper-bound ++ (etypecase hi ++ (integer hi) ++ (cons (1- (car hi))))) ++ (range (1+ (- upper-bound lower-bound)))) ++ #'(lambda (i) (+ lower-bound (mod i range)))))))))) ++ ++(compile 'generator-for-element-type) ++ ++(defmacro def-open-test (name args form expected ++ &key ++ (notes nil notes-p) ++ (build-form nil build-form-p) ++ (element-type 'character element-type-p) ++ (pathname #p"tmp.dat")) ++ ++ (when element-type-p ++ (setf args (append args (list :element-type `',element-type)))) ++ ++ (unless build-form-p ++ (let ((write-element-form ++ (cond ++ ((subtypep element-type 'integer) ++ `(write-byte ++ (funcall (the function ++ (generator-for-element-type ',element-type)) i) ++ os)) ++ ((subtypep element-type 'character) ++ `(write-char ++ (funcall (the function ++ (generator-for-element-type ',element-type)) i) ++ os))))) ++ (setq build-form ++ `(with-open-file ++ (os pn :direction :output ++ ,@(if element-type-p ++ `(:element-type ',element-type)) ++ :if-exists :supersede) ++ (assert (open-stream-p os)) ++ (dotimes (i 10) ,write-element-form) ++ (finish-output os) ++ )))) ++ ++ `(deftest ,name ++ ,@(when notes-p `(:notes ,notes)) ++ (let ((pn ,pathname)) ++ (delete-all-versions pn) ++ ,build-form ++ (let ((s (open pn ,@args))) ++ (unwind-protect ++ (progn ++ (assert (open-stream-p s)) ++ (assert (typep s 'file-stream)) ++ ,@ ++ (unless (member element-type '(signed-byte unsigned-byte)) ++ #-allegro ++ `((assert (subtypep ',element-type ++ (stream-element-type s)))) ++ #+allegro nil ++ ) ++ ,form) ++ (close s)))) ++ ,@expected)) ++ ++;; (compile 'def-open-test) ++ ++(def-open-test open.1 () (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.2 (:direction :input) ++ (values (read-line s nil)) ("abcdefghij") :element-type character) ++(def-open-test open.3 (:direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.4 (:direction :input) ++ (values (read-line s nil)) ("abcdefghij") :element-type base-char) ++(def-open-test open.5 (:if-exists :error) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.6 (:if-exists :error :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.7 (:if-exists :new-version) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.8 (:if-exists :new-version :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.9 (:if-exists :rename) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.10 (:if-exists :rename :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.11 (:if-exists :rename-and-delete) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.12 (:if-exists :rename-and-delete :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.13 (:if-exists :overwrite) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.14 (:if-exists :overwrite :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.15 (:if-exists :append) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.16 (:if-exists :append :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.17 (:if-exists :supersede) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.18 (:if-exists :supersede :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.19 (:if-exists nil) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.20 (:if-exists nil :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++ ++(def-open-test open.21 (:if-does-not-exist nil) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.22 (:if-does-not-exist nil :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.23 (:if-does-not-exist :error) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.24 (:if-does-not-exist :error :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.25 (:if-does-not-exist :create) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.26 (:if-does-not-exist :create :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++ ++(def-open-test open.27 (:external-format :default) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.28 (:external-format :default :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++ ++(def-open-test open.29 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 0 1 0 1 0 1 0 1)) :element-type (unsigned-byte 1)) ++(def-open-test open.30 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 0 1 0 1 0 1 0 1)) :element-type (unsigned-byte 1)) ++ ++(def-open-test open.31 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 0 1 2 3 0 1)) :element-type (unsigned-byte 2)) ++(def-open-test open.32 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 0 1 2 3 0 1)) :element-type (unsigned-byte 2)) ++ ++(def-open-test open.33 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 0 1)) :element-type (unsigned-byte 3)) ++(def-open-test open.34 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 0 1)) :element-type (unsigned-byte 3)) ++ ++(def-open-test open.35 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 4)) ++(def-open-test open.36 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 4)) ++ ++(def-open-test open.37 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 5)) ++(def-open-test open.38 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 5)) ++ ++(def-open-test open.39 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 6)) ++(def-open-test open.40 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 6)) ++ ++(def-open-test open.41 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 7)) ++(def-open-test open.42 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 7)) ++ ++(def-open-test open.43 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 8)) ++(def-open-test open.44 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 8)) ++ ++(def-open-test open.45 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 9)) ++(def-open-test open.46 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 9)) ++ ++(def-open-test open.47 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 10)) ++(def-open-test open.48 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 10)) ++ ++(def-open-test open.49 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 20)) ++(def-open-test open.50 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 20)) ++ ++(def-open-test open.51 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 25)) ++(def-open-test open.52 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 25)) ++ ++(def-open-test open.53 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 30)) ++(def-open-test open.54 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 30)) ++ ++(def-open-test open.55 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 32)) ++(def-open-test open.56 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 32)) ++ ++(def-open-test open.57 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 33)) ++(def-open-test open.58 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 33)) ++ ++(def-open-test open.59 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 0 1 0 1 0 1 0 1)) :element-type unsigned-byte) ++(def-open-test open.60 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 0 1 0 1 0 1 0 1)) :element-type unsigned-byte) ++ ++(def-open-test open.61 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 0 1 0 1 0 1 0 1)) :element-type signed-byte) ++(def-open-test open.62 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 0 1 0 1 0 1 0 1)) :element-type signed-byte) ++ ++ ++(def-open-test open.63 () ++ (values (read-line s nil)) ("abcdefghij") ++ :pathname "tmp.dat") ++ ++(def-open-test open.64 () ++ (values (read-line s nil)) ("abcdefghij") ++ :pathname (logical-pathname "CLTEST:TMP.DAT")) ++ ++;;; It works on recognizable subtypes. ++(deftest open.65 ++ (let ((type '(or (integer 0 1) (integer 100 200))) ++ (pn #p"tmp.dat") ++ (vals '(0 1 100 120 130 190 200 1 0 150))) ++ (or ++ (not (subtypep type 'integer)) ++ (progn ++ (with-open-file ++ (os pn :direction :output ++ :element-type type ++ :if-exists :supersede) ++ (dolist (e vals) (write-byte e os))) ++ (let ((s (open pn :direction :input ++ :element-type type)) ++ (seq (make-array 10))) ++ (unwind-protect ++ (progn (read-sequence seq s) seq) ++ (close s)) ++ (notnot (every #'eql seq vals)))))) ++ t) ++ ++;;; FIXME: Add -- tests for when the filespec is a stream ++ ++(deftest open.66 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (with-open-file ++ (s pn :direction :io :if-exists :rename-and-delete ++ :if-does-not-exist :create) ++ (format s "some stuff~%") ++ (finish-output s) ++ (let ((is (open s :direction :input))) ++ (unwind-protect ++ (values ++ (read-char is) ++ (notnot (file-position s :start)) ++ (read-line is) ++ (read-line s)) ++ (close is))))) ++ #\s ++ t ++ "ome stuff" ++ "some stuff") ++ ++(deftest open.67 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (let ((s (open pn :direction :output))) ++ (unwind-protect ++ (progn ++ (format s "some stuff~%") ++ (finish-output s) ++ (close s) ++ (let ((is (open s :direction :input))) ++ (unwind-protect ++ (values (read-line is)) ++ (close is)))) ++ (when (open-stream-p s) (close s))))) ++ "some stuff") ++ ++;;; FIXME: Add -- tests for when element-type is :default ++ ++;;; Tests of file creation ++ ++(defmacro def-open-output-test ++ (name args form expected ++ &rest keyargs ++ &key ++ (element-type 'character) ++ (build-form ++ `(dotimes (i 10) ++ ,(cond ++ ((subtypep element-type 'integer) ++ `(write-byte ++ (funcall (the function ++ (generator-for-element-type ',element-type)) i) ++ s)) ++ ((subtypep element-type 'character) ++ `(write-char ++ (funcall (the function ++ (generator-for-element-type ',element-type)) i) ++ s))))) ++ &allow-other-keys) ++ `(def-open-test ,name (:direction :output ,@args) ++ (progn ++ ,build-form ++ (assert (output-stream-p s)) ++ ,form) ++ ,expected ++ :build-form nil ++ ,@keyargs)) ++ ++;; (compile 'def-open-output-test) ++ ++(def-open-output-test open.output.1 () ++ (progn (close s) ++ (with-open-file (is #p"tmp.dat") (values (read-line is nil)))) ++ ("abcdefghij")) ++ ++(def-open-output-test open.output.2 () ++ (progn (close s) ++ (with-open-file (is "tmp.dat") (values (read-line is nil)))) ++ ("abcdefghij") ++ :pathname "tmp.dat") ++ ++(def-open-output-test open.output.3 ++ () ++ (progn (close s) ++ (with-open-file (is (logical-pathname "CLTEST:TMP.DAT")) ++ (values (read-line is nil)))) ++ ("abcdefghij") ++ :pathname (logical-pathname "CLTEST:TMP.DAT")) ++ ++(def-open-output-test open.output.4 () ++ (progn (close s) ++ (with-open-file (is #p"tmp.dat" :element-type 'character) ++ (values (read-line is nil)))) ++ ("abcdefghij") ++ :element-type character) ++ ++(def-open-output-test open.output.5 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type 'base-char) ++ (values (read-line is nil)))) ++ ("abcdefghij") ++ :element-type base-char) ++ ++(def-open-output-test open.output.6 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(integer 0 1)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 0 1 0 1 0 1 0 1)) ++ :element-type (integer 0 1)) ++ ++(def-open-output-test open.output.7 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type 'bit) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 0 1 0 1 0 1 0 1)) ++ :element-type bit) ++ ++(def-open-output-test open.output.8 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 1)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 0 1 0 1 0 1 0 1)) ++ :element-type (unsigned-byte 1)) ++ ++(def-open-output-test open.output.9 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 2)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 2 3 0 1 2 3 0 1)) ++ :element-type (unsigned-byte 2)) ++ ++(def-open-output-test open.output.10 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 3)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 2 3 4 5 6 7 0 1)) ++ :element-type (unsigned-byte 3)) ++ ++(def-open-output-test open.output.11 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 4)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 4)) ++ ++ ++(def-open-output-test open.output.12 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 6)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 6)) ++ ++(def-open-output-test open.output.13 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 8)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 8)) ++ ++(def-open-output-test open.output.14 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 12)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 12)) ++ ++(def-open-output-test open.output.15 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 16)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 16)) ++ ++(def-open-output-test open.output.16 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 24)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 24)) ++ ++(def-open-output-test open.output.17 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 32)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 32)) ++ ++(def-open-output-test open.output.18 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 64)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 64)) ++ ++(def-open-output-test open.output.19 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 100)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 100)) ++ ++(deftest open.output.20 ++ (let ((pn #p"tmp.dat")) ++ (with-open-file (s pn :direction :output :if-exists :supersede)) ++ (open pn :direction :output :if-exists nil)) ++ nil) ++ ++(def-open-test open.output.21 (:if-exists :new-version :direction :output) ++ (progn (write-sequence "wxyz" s) ++ (close s) ++ (with-open-file ++ (s pn :direction :input) ++ (values (read-line s nil)))) ++ ("wxyz") ++ :notes (:open-if-exists-new-version-no-error) ++ ) ++ ++(def-open-test open.output.22 (:if-exists :rename :direction :output) ++ (progn (write-sequence "wxyz" s) ++ (close s) ++ (with-open-file ++ (s pn :direction :input) ++ (values (read-line s nil)))) ++ ("wxyz")) ++ ++(def-open-test open.output.23 (:if-exists :rename-and-delete ++ :direction :output) ++ (progn (write-sequence "wxyz" s) ++ (close s) ++ (with-open-file ++ (s pn :direction :input) ++ (values (read-line s nil)))) ++ ("wxyz")) ++ ++(def-open-test open.output.24 (:if-exists :overwrite ++ :direction :output) ++ (progn (write-sequence "wxyz" s) ++ (close s) ++ (with-open-file ++ (s pn :direction :input) ++ (values (read-line s nil)))) ++ ("wxyzefghij")) ++ ++(def-open-test open.output.25 (:if-exists :append ++ :direction :output) ++ (progn (write-sequence "wxyz" s) ++ (close s) ++ (with-open-file ++ (s pn :direction :input) ++ (values (read-line s nil)))) ++ ("abcdefghijwxyz")) ++ ++(def-open-test open.output.26 (:if-exists :supersede ++ :direction :output) ++ (progn (write-sequence "wxyz" s) ++ (close s) ++ (with-open-file ++ (s pn :direction :input) ++ (values (read-line s nil)))) ++ ("wxyz")) ++ ++(def-open-output-test open.output.27 (:if-does-not-exist :create ++ :direction :output) ++ (progn (close s) ++ (with-open-file ++ (is pn :direction :input) ++ (values (read-line is nil)))) ++ ("abcdefghij")) ++ ++(deftest open.output.28 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :direction :output :if-does-not-exist nil)) ++ nil) ++ ++(def-open-output-test open.output.28a (:external-format :default) ++ (progn (close s) ++ (with-open-file (is #p"tmp.dat") (values (read-line is nil)))) ++ ("abcdefghij")) ++ ++(def-open-output-test open.output.29 ++ (:external-format (prog1 ++ (with-open-file (s "foo.dat" :direction :output ++ :if-exists :supersede) ++ (stream-external-format s)) ++ (delete-all-versions "foo.dat") ++ )) ++ (progn (close s) ++ (with-open-file (is #p"tmp.dat") (values (read-line is nil)))) ++ ("abcdefghij")) ++ ++;;; Default behavior of open :if-exists is :create when the version ++;;; of the filespec is :newest ++ ++(deftest open.output.30 ++ :notes (:open-if-exists-new-version-no-error) ++ (let ((pn (make-pathname :name "tmp" :type "dat" :version :newest))) ++ (or (not (eql (pathname-version pn) :newest)) ++ (progn ++ ;; Create file ++ (let ((s1 (open pn :direction :output :if-exists :overwrite ++ :if-does-not-exist :create))) ++ (unwind-protect ++ ;; Now try again ++ (let ((s2 (open pn :direction :output))) ++ (unwind-protect ++ (write-line "abcdef" s2) ++ (close s2)) ++ (unwind-protect ++ (progn ++ (setq s2 (open s1 :direction :input)) ++ (equalt (read-line s2 nil) "abcdef")) ++ (close s2))) ++ (close s1) ++ (delete-all-versions pn) ++ ))))) ++ t) ++ ++(def-open-output-test open.output.31 (:if-exists :rename ++ :direction :output) ++ (progn (close s) ++ (with-open-file ++ (is pn :direction :input) ++ (values (read-line is nil)))) ++ ("abcdefghij")) ++ ++(def-open-output-test open.output.32 (:if-exists :rename-and-delete ++ :direction :output) ++ (progn (close s) ++ (with-open-file ++ (is pn :direction :input) ++ (values (read-line is nil)))) ++ ("abcdefghij")) ++ ++(def-open-output-test open.output.33 (:if-exists :new-version ++ :direction :output) ++ (progn (close s) ++ (with-open-file ++ (is pn :direction :input) ++ (values (read-line is nil)))) ++ ("abcdefghij")) ++ ++(def-open-output-test open.output.34 (:if-exists :supersede ++ :direction :output) ++ (progn (close s) ++ (with-open-file ++ (is pn :direction :input) ++ (values (read-line is nil)))) ++ ("abcdefghij")) ++ ++(def-open-output-test open.output.35 (:if-exists nil ++ :direction :output) ++ (progn (close s) ++ (with-open-file ++ (is pn :direction :input) ++ (values (read-line is nil)))) ++ ("abcdefghij")) ++ ++;;; Add -- tests for when the filespec is a stream ++ ++ ++;;; Tests of bidirectional IO ++ ++(defmacro def-open-io-test ++ (name args form expected ++ &rest keyargs ++ &key ++ (element-type 'character) ++ (build-form ++ `(dotimes (i 10) ++ ,(cond ++ ((subtypep element-type 'integer) ++ `(write-byte ++ (funcall (the function ++ (generator-for-element-type ',element-type)) i) ++ s)) ++ ((subtypep element-type 'character) ++ `(write-char ++ (funcall (the function ++ (generator-for-element-type ',element-type)) i) ++ s))))) ++ &allow-other-keys) ++ `(def-open-test ,name (:direction :io ,@args) ++ (progn ++ ,build-form ++ (assert (input-stream-p s)) ++ (assert (output-stream-p s)) ++ ,form) ++ ,expected ++ :build-form nil ++ ,@keyargs)) ++ ++;; (compile 'def-open-io-test) ++ ++(def-open-io-test open.io.1 () ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij")) ++ ++(def-open-io-test open.io.2 () ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij") ++ :pathname "tmp.dat") ++ ++(def-open-io-test open.io.3 ++ () ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij") ++ :pathname (logical-pathname "CLTEST:TMP.DAT")) ++ ++(def-open-io-test open.io.4 () ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij") ++ :element-type character) ++ ++(def-open-io-test open.io.5 () ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij") ++ :element-type base-char) ++ ++(def-open-io-test open.io.6 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 0 1 0 1 0 1 0 1)) ++ :element-type (integer 0 1)) ++ ++(def-open-io-test open.io.7 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 0 1 0 1 0 1 0 1)) ++ :element-type bit) ++ ++(def-open-io-test open.io.8 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 0 1 0 1 0 1 0 1)) ++ :element-type (unsigned-byte 1)) ++ ++(def-open-io-test open.io.9 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 2 3 0 1 2 3 0 1)) ++ :element-type (unsigned-byte 2)) ++ ++(def-open-io-test open.io.10 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 2 3 4 5 6 7 0 1)) ++ :element-type (unsigned-byte 3)) ++ ++(def-open-io-test open.io.11 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 4)) ++ ++ ++(def-open-io-test open.io.12 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 6)) ++ ++(def-open-io-test open.io.13 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 8)) ++ ++(def-open-io-test open.io.14 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 12)) ++ ++(def-open-io-test open.io.15 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 16)) ++ ++(def-open-io-test open.io.16 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 24)) ++ ++(def-open-io-test open.io.17 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 32)) ++ ++(def-open-io-test open.io.18 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 64)) ++ ++(def-open-io-test open.io.19 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 100)) ++ ++(deftest open.io.20 ++ (let ((pn #p"tmp.dat")) ++ (with-open-file (s pn :direction :io :if-exists :supersede)) ++ (open pn :direction :io :if-exists nil)) ++ nil) ++ ++(def-open-test open.io.21 (:if-exists :new-version :direction :io) ++ (progn (write-sequence "wxyz" s) ++ (file-position s :start) ++ (values (read-line s nil))) ++ ("wxyz") ++ :notes (:open-if-exists-new-version-no-error) ++ ) ++ ++(def-open-test open.io.22 (:if-exists :rename :direction :io) ++ (progn (write-sequence "wxyz" s) ++ (file-position s :start) ++ (values (read-line s nil))) ++ ("wxyz")) ++ ++(def-open-test open.io.23 (:if-exists :rename-and-delete ++ :direction :io) ++ (progn (write-sequence "wxyz" s) ++ (file-position s :start) ++ (values (read-line s nil))) ++ ("wxyz")) ++ ++(def-open-test open.io.24 (:if-exists :overwrite ++ :direction :io) ++ (progn (write-sequence "wxyz" s) ++ (file-position s :start) ++ (values (read-line s nil))) ++ ("wxyzefghij")) ++ ++(def-open-test open.io.25 (:if-exists :append ++ :direction :io) ++ (progn (write-sequence "wxyz" s) ++ (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghijwxyz")) ++ ++(def-open-test open.io.26 (:if-exists :supersede ++ :direction :io) ++ (progn (write-sequence "wxyz" s) ++ (file-position s :start) ++ (values (read-line s nil))) ++ ("wxyz")) ++ ++(def-open-io-test open.io.27 (:if-does-not-exist :create ++ :direction :io) ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij")) ++ ++(deftest open.io.28 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :direction :io :if-does-not-exist nil)) ++ nil) ++ ++(def-open-io-test open.io.28a (:external-format :default) ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij")) ++ ++(def-open-io-test open.io.29 ++ (:external-format (prog1 ++ (with-open-file (s "foo.dat" :direction :io ++ :if-exists :supersede) ++ (stream-external-format s)) ++ (delete-all-versions "foo.dat") ++ )) ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij")) ++ ++;;; Default behavior of open :if-exists is :create when the version ++;;; of the filespec is :newest ++ ++(deftest open.io.30 ++ :notes (:open-if-exists-new-version-no-error) ++ (let ((pn (make-pathname :name "tmp" :type "dat" :version :newest))) ++ (or (not (eql (pathname-version pn) :newest)) ++ (progn ++ ;; Create file ++ (let ((s1 (open pn :direction :io :if-exists :overwrite ++ :if-does-not-exist :create))) ++ (unwind-protect ++ ;; Now try again ++ (let ((s2 (open pn :direction :io))) ++ (unwind-protect ++ (write-line "abcdef" s2) ++ (close s2)) ++ (unwind-protect ++ (progn ++ (setq s2 (open s1 :direction :input)) ++ (equalt (read-line s2 nil) "abcdef")) ++ (close s2))) ++ (close s1) ++ (delete-all-versions pn) ++ ))))) ++ t) ++ ++(def-open-io-test open.io.31 (:if-exists :rename ++ :direction :io) ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij")) ++ ++(def-open-io-test open.io.32 (:if-exists :rename-and-delete ++ :direction :io) ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij")) ++ ++(def-open-io-test open.io.33 (:if-exists :new-version ++ :direction :io) ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij")) ++ ++(def-open-io-test open.io.34 (:if-exists :supersede ++ :direction :io) ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij")) ++ ++(def-open-io-test open.io.35 (:if-exists nil ++ :direction :io) ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij")) ++ ++;;;; :PROBE tests ++ ++(defmacro def-open-probe-test ++ (name args form ++ &key (build-form nil build-form-p) ++ (pathname #p"tmp.dat")) ++ (unless build-form-p ++ (setf build-form ++ `(with-open-file (s pn :direction :output ++ :if-exists :supersede)))) ++ `(deftest ,name ++ (let ((pn ,pathname)) ++ (delete-all-versions pn) ++ ,build-form ++ (let ((s (open pn :direction :probe ,@args))) ++ (values ++ ,(if build-form ++ `(and ++ (typep s 'file-stream) ++ (not (open-stream-p s)) ++ ) ++ `(not s)) ++ ,form))) ++ t t)) ++ ++(def-open-probe-test open.probe.1 () t) ++(def-open-probe-test open.probe.2 (:if-exists :error) t) ++(def-open-probe-test open.probe.3 (:if-exists :new-version) t) ++(def-open-probe-test open.probe.4 (:if-exists :rename) t) ++(def-open-probe-test open.probe.5 (:if-exists :rename-and-delete) t) ++(def-open-probe-test open.probe.6 (:if-exists :overwrite) t) ++(def-open-probe-test open.probe.7 (:if-exists :append) t) ++(def-open-probe-test open.probe.8 (:if-exists :supersede) t) ++ ++(def-open-probe-test open.probe.9 (:if-does-not-exist :error) t) ++(def-open-probe-test open.probe.10 (:if-does-not-exist nil) t) ++(def-open-probe-test open.probe.11 (:if-does-not-exist :create) t) ++ ++(def-open-probe-test open.probe.12 () t :build-form nil) ++(def-open-probe-test open.probe.13 (:if-exists :error) t :build-form nil) ++(def-open-probe-test open.probe.14 (:if-exists :new-version) t :build-form nil) ++(def-open-probe-test open.probe.15 (:if-exists :rename) t :build-form nil) ++(def-open-probe-test open.probe.16 (:if-exists :rename-and-delete) t ++ :build-form nil) ++(def-open-probe-test open.probe.17 (:if-exists :overwrite) t ++ :build-form nil) ++(def-open-probe-test open.probe.18 (:if-exists :append) t ++ :build-form nil) ++(def-open-probe-test open.probe.19 (:if-exists :supersede) t ++ :build-form nil) ++ ++(def-open-probe-test open.probe.20 (:if-does-not-exist nil) t ++ :build-form nil) ++ ++(deftest open.probe.21 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (let ((s (open pn :direction :probe :if-does-not-exist :create))) ++ (values ++ (notnot s) ++ (notnot (probe-file pn))))) ++ t t) ++ ++(deftest open.probe.22 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (let ((s (open pn :direction :probe :if-does-not-exist :create ++ :if-exists :error))) ++ (values ++ (notnot s) ++ (notnot (probe-file pn))))) ++ t t) ++ ++(def-open-probe-test open.probe.23 (:external-format :default) t) ++(def-open-probe-test open.probe.24 (:element-type 'character) t) ++(def-open-probe-test open.probe.25 (:element-type 'bit) t) ++(def-open-probe-test open.probe.26 (:element-type '(unsigned-byte 2)) t) ++(def-open-probe-test open.probe.27 (:element-type '(unsigned-byte 4)) t) ++(def-open-probe-test open.probe.28 (:element-type '(unsigned-byte 8)) t) ++(def-open-probe-test open.probe.29 (:element-type '(unsigned-byte 9)) t) ++(def-open-probe-test open.probe.30 (:element-type '(unsigned-byte 15)) t) ++(def-open-probe-test open.probe.31 (:element-type '(unsigned-byte 16)) t) ++(def-open-probe-test open.probe.32 (:element-type '(unsigned-byte 17)) t) ++(def-open-probe-test open.probe.33 (:element-type '(unsigned-byte 31)) t) ++(def-open-probe-test open.probe.34 (:element-type '(unsigned-byte 32)) t) ++(def-open-probe-test open.probe.35 (:element-type '(unsigned-byte 33)) t) ++(def-open-probe-test open.probe.36 (:element-type '(integer -1002 13112)) t) ++ ++;;;; Error tests ++ ++(deftest open.error.1 ++ (signals-error (open) program-error) ++ t) ++ ++(deftest open.error.2 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (close (open pn :direction :output :if-does-not-exist :create)) ++ (open pn :if-exists :error :direction :output)) ++ file-error) ++ t t) ++ ++(deftest open.error.3 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (close (open pn :direction :output :if-does-not-exist :create)) ++ (open pn :if-exists :error :direction :io)) ++ file-error) ++ t t) ++ ++(deftest open.error.4 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn)) ++ file-error) ++ t t) ++ ++(deftest open.error.5 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :if-does-not-exist :error)) ++ file-error) ++ t t) ++ ++(deftest open.error.6 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :direction :input)) ++ file-error) ++ t t) ++ ++(deftest open.error.7 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :if-does-not-exist :error :direction :input)) ++ file-error) ++ t t) ++ ++(deftest open.error.8 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :direction :output :if-does-not-exist :error)) ++ file-error) ++ t t) ++ ++(deftest open.error.9 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :direction :io :if-does-not-exist :error)) ++ file-error) ++ t t) ++ ++(deftest open.error.10 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :direction :probe :if-does-not-exist :error)) ++ file-error) ++ t t) ++ ++(deftest open.error.11 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :direction :output :if-exists :overwrite)) ++ file-error) ++ t t) ++ ++(deftest open.error.12 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :direction :output :if-exists :append)) ++ file-error) ++ t t) ++ ++(deftest open.error.13 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :direction :io :if-exists :overwrite)) ++ file-error) ++ t t) ++ ++(deftest open.error.14 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :direction :io :if-exists :append)) ++ file-error) ++ t t) ++ ++(deftest open.error.15 ++ (signals-error-always ++ (open (make-pathname :name :wild :type "lsp")) ++ file-error) ++ t t) ++ ++(deftest open.error.16 ++ (signals-error-always ++ (open (make-pathname :name "open" :type :wild)) ++ file-error) ++ t t) ++ ++(deftest open.error.17 ++ (signals-error-always ++ (let ((pn (make-pathname :name "open" :type "lsp" :version :wild))) ++ (if (wild-pathname-p pn) (open pn) ++ (error 'file-error))) ++ file-error) ++ t t) ++ ++(deftest open.error.18 ++ (signals-error-always ++ (open #p"tmp.dat" :direction :output :if-exists :supersede ++ :external-form (gensym)) ++ error) ++ t t) ++ ++ ++;;; FIXME -- add tests for :element-type :default ++ ++;;; FIXME -- add tests for filespec being a specialized string +--- /dev/null ++++ gcl-2.6.12/ansi-tests/output-stream-p.lsp +@@ -0,0 +1,39 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 13 19:46:12 2004 ++;;;; Contains: Tests of OUTPUT-STREAM-P ++ ++(in-package :cl-test) ++ ++(deftest output-stream-p.1 ++ (notnot-mv (output-stream-p *standard-output*)) ++ t) ++ ++(deftest output-stream-p.2 ++ (notnot-mv (output-stream-p *terminal-io*)) ++ t) ++ ++(deftest output-stream-p.3 ++ (with-open-file (s "output-stream-p.lsp" :direction :input) ++ (output-stream-p s)) ++ nil) ++ ++(deftest output-stream-p.4 ++ (with-open-file (s "foo.txt" :direction :output ++ :if-exists :supersede) ++ (notnot-mv (output-stream-p s))) ++ t) ++ ++;;; Error tests ++ ++(deftest output-stream-p.error.1 ++ (signals-error (output-stream-p) program-error) ++ t) ++ ++(deftest output-stream-p.error.2 ++ (signals-error (output-stream-p *standard-output* nil) program-error) ++ t) ++ ++(deftest output-stream-p.error.3 ++ (check-type-error #'output-stream-p #'streamp) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/parse-namestring.lsp +@@ -0,0 +1,89 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Aug 14 13:59:18 2004 ++;;;; Contains: Tests of PARSE-NAMESTRING ++ ++(in-package :cl-test) ++ ++;;; "Parsing a null string always succeeds, producing a pathname ++;;; with all components (except the host) equal to nil." ++ ++(deftest parse-namestring.1 ++ (let ((vals (multiple-value-list (parse-namestring "")))) ++ (assert (= (length vals) 2)) ++ (let ((pn (first vals)) ++ (pos (second vals))) ++ (values ++ (pathname-directory pn) ++ (pathname-device pn) ++ (pathname-name pn) ++ (pathname-type pn) ++ (pathname-version pn) ++ pos))) ++ nil nil nil nil nil 0) ++ ++(deftest parse-namestring.2 ++ (let ((vals (multiple-value-list (parse-namestring (make-array 0 :element-type 'base-char))))) ++ (assert (= (length vals) 2)) ++ (let ((pn (first vals)) ++ (pos (second vals))) ++ (values ++ (pathname-directory pn) ++ (pathname-device pn) ++ (pathname-name pn) ++ (pathname-type pn) ++ (pathname-version pn) ++ pos))) ++ nil nil nil nil nil 0) ++ ++(deftest parse-namestring.3 ++ (let ((vals (multiple-value-list (parse-namestring (make-array 4 :element-type 'base-char ++ :initial-element #\X ++ :fill-pointer 0))))) ++ (assert (= (length vals) 2)) ++ (let ((pn (first vals)) ++ (pos (second vals))) ++ (values ++ (pathname-directory pn) ++ (pathname-device pn) ++ (pathname-name pn) ++ (pathname-type pn) ++ (pathname-version pn) ++ pos))) ++ nil nil nil nil nil 0) ++ ++(deftest parse-namestring.4 ++ (loop for etype in '(standard-char base-char character) ++ for s0 = (make-array 4 :element-type etype :initial-element #\X) ++ for s = (make-array 0 :element-type etype :displaced-to s0 ++ :displaced-index-offset 1) ++ for vals = (multiple-value-list (parse-namestring s)) ++ for pn = (first vals) ++ for pos = (second vals) ++ do (assert (= (length vals) 2)) ++ nconc ++ (let ((result (list (pathname-directory pn) ++ (pathname-device pn) ++ (pathname-name pn) ++ (pathname-type pn) ++ (pathname-version pn) ++ pos))) ++ (unless (equal result '(nil nil nil nil nil 0)) ++ (list (list etype result))))) ++ nil) ++ ++;;; Error tests ++ ++(deftest parse-namestring.error.1 ++ (signals-error (parse-namestring) program-error) ++ t) ++ ++(deftest parse-name-string.error.2 ++ (signals-error (parse-namestring "" nil *default-pathname-defaults* :foo nil) program-error) ++ t) ++ ++(deftest parse-name-string.error.3 ++ (signals-error (parse-namestring "" nil *default-pathname-defaults* :start) program-error) ++ t) ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/pathname-device.lsp +@@ -0,0 +1,74 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Dec 6 14:23:54 2003 ++;;;; Contains: Tests for PATHNAME-DEVICE ++ ++(in-package :cl-test) ++ ++(compile-and-load "pathnames-aux.lsp") ++ ++(deftest pathname-device.1 ++ (loop for p in *pathnames* ++ for device = (pathname-device p) ++ unless (or (stringp device) ++ (member device '(nil :wild :unspecific))) ++ collect (list p device)) ++ nil) ++ ++(deftest pathname-device.2 ++ (loop for p in *pathnames* ++ for device = (pathname-device p :case :local) ++ unless (or (stringp device) ++ (member device '(nil :wild :unspecific))) ++ collect (list p device)) ++ nil) ++ ++(deftest pathname-device.3 ++ (loop for p in *pathnames* ++ for device = (pathname-device p :case :common) ++ unless (or (stringp device) ++ (member device '(nil :wild :unspecific))) ++ collect (list p device)) ++ nil) ++ ++(deftest pathname-device.4 ++ (loop for p in *pathnames* ++ for device = (pathname-device p :allow-other-keys nil) ++ unless (or (stringp device) ++ (member device '(nil :wild :unspecific))) ++ collect (list p device)) ++ nil) ++ ++(deftest pathname-device.5 ++ (loop for p in *pathnames* ++ for device = (pathname-device p :foo 'bar :allow-other-keys t) ++ unless (or (stringp device) ++ (member device '(nil :wild :unspecific))) ++ collect (list p device)) ++ nil) ++ ++(deftest pathname-device.6 ++ (loop for p in *pathnames* ++ for device = (pathname-device p :allow-other-keys t :allow-other-keys nil :foo 'bar) ++ unless (or (stringp device) ++ (member device '(nil :wild :unspecific))) ++ collect (list p device)) ++ nil) ++ ++;;; section 19.3.2.1 ++(deftest pathname-device.7 ++ (loop for p in *logical-pathnames* ++ always (eq (pathname-device p) :unspecific)) ++ t) ++ ++(deftest pathname-device.8 ++ (do-special-strings (s "" nil) (pathname-device s)) ++ nil) ++ ++(deftest pathname-device.error.1 ++ (signals-error (pathname-device) program-error) ++ t) ++ ++(deftest pathname-device.error.2 ++ (check-type-error #'pathname-device #'could-be-pathname-designator) ++ nil) +\ No newline at end of file +--- /dev/null ++++ gcl-2.6.12/ansi-tests/pathname-directory.lsp +@@ -0,0 +1,89 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Dec 6 14:24:39 2003 ++;;;; Contains: Tests for PATHNAME-DIRECTORY ++ ++(in-package :cl-test) ++ ++(compile-and-load "pathnames-aux.lsp") ++ ++(deftest pathname-directory.1 ++ (loop for p in *pathnames* ++ for directory = (pathname-directory p) ++ unless (or (stringp directory) ++ (member directory '(nil :wild :unspecific)) ++ (and (consp directory) ++ (member (car directory) '(:absolute :relative)))) ++ collect (list p directory)) ++ nil) ++ ++(deftest pathname-directory.2 ++ (loop for p in *pathnames* ++ for directory = (pathname-directory p :case :local) ++ unless (or (stringp directory) ++ (member directory '(nil :wild :unspecific)) ++ (and (consp directory) ++ (member (car directory) '(:absolute :relative)))) ++ collect (list p directory)) ++ nil) ++ ++(deftest pathname-directory.3 ++ (loop for p in *pathnames* ++ for directory = (pathname-directory p :case :common) ++ unless (or (stringp directory) ++ (member directory '(nil :wild :unspecific)) ++ (and (consp directory) ++ (member (car directory) '(:absolute :relative)))) ++ collect (list p directory)) ++ nil) ++ ++(deftest pathname-directory.4 ++ (loop for p in *pathnames* ++ for directory = (pathname-directory p :allow-other-keys nil) ++ unless (or (stringp directory) ++ (member directory '(nil :wild :unspecific)) ++ (and (consp directory) ++ (member (car directory) '(:absolute :relative)))) ++ collect (list p directory)) ++ nil) ++ ++(deftest pathname-directory.5 ++ (loop for p in *pathnames* ++ for directory = (pathname-directory p :foo 'bar :allow-other-keys t) ++ unless (or (stringp directory) ++ (member directory '(nil :wild :unspecific)) ++ (and (consp directory) ++ (member (car directory) '(:absolute :relative)))) ++ collect (list p directory)) ++ nil) ++ ++(deftest pathname-directory.6 ++ (loop for p in *pathnames* ++ for directory = (pathname-directory p :allow-other-keys t ++ :allow-other-keys nil ++ 'foo 'bar) ++ unless (or (stringp directory) ++ (member directory '(nil :wild :unspecific)) ++ (and (consp directory) ++ (member (car directory) '(:absolute :relative)))) ++ collect (list p directory)) ++ nil) ++ ++;;; section 19.3.2.1 ++(deftest pathname-directory.7 ++ (loop for p in *logical-pathnames* ++ when (eq (pathname-directory p) :unspecific) ++ collect p) ++ nil) ++ ++(deftest pathname-directory.8 ++ (do-special-strings (s "" nil) (pathname-directory s)) ++ nil) ++ ++(deftest pathname-directory.error.1 ++ (signals-error (pathname-directory) program-error) ++ t) ++ ++(deftest pathname-directory.error.2 ++ (check-type-error #'pathname-directory #'could-be-pathname-designator) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/pathname-host.lsp +@@ -0,0 +1,79 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Dec 6 14:23:22 2003 ++;;;; Contains: Tests for PATHNAME-HOST ++ ++(in-package :cl-test) ++ ++(compile-and-load "pathnames-aux.lsp") ++ ++(deftest pathname-host.1 ++ (loop for p in *pathnames* ++ always (eql (length (multiple-value-list (pathname-host p))) 1)) ++ t) ++ ++(deftest pathname-host.2 ++ (loop for p in *pathnames* ++ always (eql (length (multiple-value-list (pathname-host p :case :local))) 1)) ++ t) ++ ++(deftest pathname-host.3 ++ (loop for p in *pathnames* ++ always (eql (length (multiple-value-list (pathname-host p :case :common))) 1)) ++ t) ++ ++(deftest pathname-host.4 ++ (loop for p in *pathnames* ++ always (eql (length (multiple-value-list (pathname-host p :allow-other-keys nil))) 1)) ++ t) ++ ++(deftest pathname-host.5 ++ (loop for p in *pathnames* ++ always (eql (length (multiple-value-list ++ (pathname-host p :foo t :allow-other-keys t))) 1)) ++ t) ++ ++(deftest pathname-host.6 ++ (loop for p in *pathnames* ++ always (eql (length (multiple-value-list ++ (pathname-host p :allow-other-keys t ++ :allow-other-keys nil ++ 'foo t))) 1)) ++ t) ++ ++;;; section 19.3.2.1 ++(deftest pathname-host.7 ++ (loop for p in *logical-pathnames* ++ when (eq (pathname-host p) :unspecific) ++ collect p) ++ nil) ++ ++(deftest pathname-host.8 ++ (do-special-strings (s "" nil) (pathname-host s)) ++ nil) ++ ++#| ++(deftest pathname-host.9 ++ (loop for p in *pathnames* ++ for host = (pathname-host p) ++ unless (or (stringp host) ++ (and (listp host) (every #'stringp host)) ++ (eql host :unspecific)) ++ collect (list p host)) ++ nil) ++|# ++ ++;;; Error cases ++ ++(deftest pathname-host.error.1 ++ (signals-error (pathname-host) program-error) ++ t) ++ ++(deftest pathname-host.error.2 ++ (check-type-error #'pathname-host #'could-be-pathname-designator) ++ nil) ++ ++(deftest pathname-host.error.3 ++ (signals-error (pathname-host *default-pathname-defaults* '#:bogus t) ++ program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/pathname-match-p.lsp +@@ -0,0 +1,103 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Aug 15 07:46:22 2004 ++;;;; Contains: Tests for PATHNAME-MATCH-P ++ ++(in-package :cl-test) ++ ++(compile-and-load "pathnames-aux.lsp") ++ ++;;; Much of the behavior cannot be tested portably. ++ ++(deftest pathname-match-p.1 ++ (let ((pn1 (make-pathname :name :wild)) ++ (pn2 (make-pathname :name "foo"))) ++ (pathname-match-p pn1 pn2)) ++ nil) ++ ++(deftest pathname-match-p.2 ++ (let ((pn1 (make-pathname :type :wild)) ++ (pn2 (make-pathname :type "txt"))) ++ (pathname-match-p pn1 pn2)) ++ nil) ++ ++(deftest pathname-match-p.3 ++ (let ((pn1 (make-pathname :directory '(:absolute :wild))) ++ (pn2 (make-pathname :directory '(:absolute)))) ++ (pathname-match-p pn1 pn2)) ++ nil) ++ ++(deftest pathname-match-p.4 ++ (let ((pn1 (make-pathname :directory '(:relative :wild))) ++ (pn2 (make-pathname :directory '(:relative)))) ++ (pathname-match-p pn1 pn2)) ++ nil) ++ ++(deftest pathname-match-p.5 ++ (let ((pn1 (make-pathname :directory '(:relative :wild))) ++ (pn2 (make-pathname :directory nil))) ++ (and (wild-pathname-p pn1) ++ (not (pathname-directory pn2)) ++ (not (pathname-match-p pn1 pn2)))) ++ nil) ++ ++(deftest pathname-match-p.6 ++ (let ((pn1 (make-pathname :version :wild)) ++ (pn2 (make-pathname))) ++ (and (wild-pathname-p pn1) ++ (not (pathname-version pn2)) ++ (not (pathname-match-p pn1 pn2)))) ++ nil) ++ ++;;; Specialized string tests ++ ++(deftest pathname-match-p.7 ++ (let ((wpn (parse-namestring "CLTEST:*.LSP"))) ++ (assert (wild-pathname-p wpn)) ++ (do-special-strings ++ (s "CLTEST:FOO.LSP" nil) ++ (assert (pathname-match-p s wpn)))) ++ nil) ++ ++(deftest pathname-match-p.8 ++ (do-special-strings ++ (s "CLTEST:*.LSP" nil) ++ (assert (pathname-match-p "CLTEST:FOO.LSP" s))) ++ nil) ++ ++ ++;;; Add more tests here ++ ++;;; Here are error tests ++ ++(deftest pathname-match-p.error.1 ++ (signals-error (pathname-match-p) program-error) ++ t) ++ ++(deftest pathname-match-p.error.2 ++ (signals-error (pathname-match-p #p"") program-error) ++ t) ++ ++(deftest pathname-match-p.error.3 ++ (signals-error (pathname-match-p #p"" #p"" nil) program-error) ++ t) ++ ++(deftest pathname-match-p.error.4 ++ (check-type-error #'(lambda (x) (pathname-match-p x #p"")) ++ #'could-be-pathname-designator) ++ nil) ++ ++(deftest pathname-match-p.error.5 ++ (check-type-error #'(lambda (x) (declare (optimize (safety 0))) (pathname-match-p x #p"")) ++ #'could-be-pathname-designator) ++ nil) ++ ++(deftest pathname-match-p.error.6 ++ (check-type-error #'(lambda (x) (pathname-match-p #p"" x)) ++ #'could-be-pathname-designator) ++ nil) ++ ++(deftest pathname-match-p.error.7 ++ (check-type-error #'(lambda (x) (declare (optimize (safety 0))) (pathname-match-p #p"" x)) ++ #'could-be-pathname-designator) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/pathname-name.lsp +@@ -0,0 +1,75 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Dec 6 14:45:16 2003 ++;;;; Contains: Tests for PATHNAME-NAME ++ ++(in-package :cl-test) ++ ++(compile-and-load "pathnames-aux.lsp") ++ ++(deftest pathname-name.1 ++ (loop for p in *pathnames* ++ for name = (pathname-name p) ++ unless (or (stringp name) ++ (member name '(nil :wild :unspecific))) ++ collect (list p name)) ++ nil) ++ ++(deftest pathname-name.2 ++ (loop for p in *pathnames* ++ for name = (pathname-name p :case :local) ++ unless (or (stringp name) ++ (member name '(nil :wild :unspecific))) ++ collect (list p name)) ++ nil) ++ ++(deftest pathname-name.3 ++ (loop for p in *pathnames* ++ for name = (pathname-name p :case :common) ++ unless (or (stringp name) ++ (member name '(nil :wild :unspecific))) ++ collect (list p name)) ++ nil) ++ ++(deftest pathname-name.4 ++ (loop for p in *pathnames* ++ for name = (pathname-name p :allow-other-keys nil) ++ unless (or (stringp name) ++ (member name '(nil :wild :unspecific))) ++ collect (list p name)) ++ nil) ++ ++(deftest pathname-name.5 ++ (loop for p in *pathnames* ++ for name = (pathname-name p :foo 'bar :allow-other-keys t) ++ unless (or (stringp name) ++ (member name '(nil :wild :unspecific))) ++ collect (list p name)) ++ nil) ++ ++(deftest pathname-name.6 ++ (loop for p in *pathnames* ++ for name = (pathname-name p :allow-other-keys t :allow-other-keys nil :foo 'bar) ++ unless (or (stringp name) ++ (member name '(nil :wild :unspecific))) ++ collect (list p name)) ++ nil) ++ ++;;; section 19.3.2.1 ++(deftest pathname-name.7 ++ (loop for p in *logical-pathnames* ++ when (eq (pathname-name p) :unspecific) ++ collect p) ++ nil) ++ ++(deftest pathname-name.8 ++ (do-special-strings (s "" nil) (pathname-name s)) ++ nil) ++ ++(deftest pathname-name.error.1 ++ (signals-error (pathname-name) program-error) ++ t) ++ ++(deftest pathname-name.error.2 ++ (check-type-error #'pathname-name #'could-be-pathname-designator) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/pathname-type.lsp +@@ -0,0 +1,75 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Dec 6 14:45:16 2003 ++;;;; Contains: Tests for PATHNAME-TYPE ++ ++(in-package :cl-test) ++ ++(compile-and-load "pathnames-aux.lsp") ++ ++(deftest pathname-type.1 ++ (loop for p in *pathnames* ++ for type = (pathname-type p) ++ unless (or (stringp type) ++ (member type '(nil :wild :unspecific))) ++ collect (list p type)) ++ nil) ++ ++(deftest pathname-type.2 ++ (loop for p in *pathnames* ++ for type = (pathname-type p :case :local) ++ unless (or (stringp type) ++ (member type '(nil :wild :unspecific))) ++ collect (list p type)) ++ nil) ++ ++(deftest pathname-type.3 ++ (loop for p in *pathnames* ++ for type = (pathname-type p :case :common) ++ unless (or (stringp type) ++ (member type '(nil :wild :unspecific))) ++ collect (list p type)) ++ nil) ++ ++(deftest pathname-type.4 ++ (loop for p in *pathnames* ++ for type = (pathname-type p :allow-other-keys nil) ++ unless (or (stringp type) ++ (member type '(nil :wild :unspecific))) ++ collect (list p type)) ++ nil) ++ ++(deftest pathname-type.5 ++ (loop for p in *pathnames* ++ for type = (pathname-type p :foo 'bar :allow-other-keys t) ++ unless (or (stringp type) ++ (member type '(nil :wild :unspecific))) ++ collect (list p type)) ++ nil) ++ ++(deftest pathname-type.6 ++ (loop for p in *pathnames* ++ for type = (pathname-type p :allow-other-keys t :allow-other-keys nil :foo 'bar) ++ unless (or (stringp type) ++ (member type '(nil :wild :unspecific))) ++ collect (list p type)) ++ nil) ++ ++;;; section 19.3.2.1 ++(deftest pathname-type.7 ++ (loop for p in *logical-pathnames* ++ when (eq (pathname-type p) :unspecific) ++ collect p) ++ nil) ++ ++(deftest pathname-type.8 ++ (do-special-strings (s "" nil) (pathname-type s)) ++ nil) ++ ++(deftest pathname-type.error.1 ++ (signals-error (pathname-type) program-error) ++ t) ++ ++(deftest pathname-type.error.2 ++ (check-type-error #'pathname-type #'could-be-pathname-designator) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/pathname-version.lsp +@@ -0,0 +1,40 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Dec 6 14:45:16 2003 ++;;;; Contains: Tests for PATHNAME-VERSION ++ ++(in-package :cl-test) ++ ++(compile-and-load "pathnames-aux.lsp") ++ ++(deftest pathname-version.1 ++ (loop for p in *pathnames* ++ for version = (pathname-version p) ++ unless (or (integerp version) (symbolp version)) ++ collect (list p version)) ++ nil) ++ ++;;; section 19.3.2.1 ++(deftest pathname-version.2 ++ (loop for p in *logical-pathnames* ++ when (eq (pathname-version p) :unspecific) ++ collect p) ++ nil) ++ ++(deftest pathname-version.3 ++ (do-special-strings (s "" nil) (pathname-version s)) ++ nil) ++ ++(deftest pathname-version.error.1 ++ (signals-error (pathname-version) program-error) ++ t) ++ ++(deftest pathname-version.error.2 ++ (signals-error (pathname-version *default-pathname-defaults* nil) ++ program-error) ++ t) ++ ++(deftest pathname-version.error.3 ++ (check-type-error #'pathname-version #'could-be-pathname-designator) ++ nil) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/pathname.lsp +@@ -0,0 +1,88 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Nov 29 05:06:57 2003 ++;;;; Contains: Tests of the function PATHNAME ++ ++(in-package :cl-test) ++ ++(deftest pathname.1 ++ (loop for x in *pathnames* ++ always (eq x (pathname x))) ++ t) ++ ++(deftest pathname.2 ++ (equalt #p"ansi-aux.lsp" (pathname "ansi-aux.lsp")) ++ t) ++ ++(deftest pathname.3 ++ (let ((s (open "ansi-aux.lsp" :direction :input))) ++ (prog1 (equalt (truename (pathname s)) (truename #p"ansi-aux.lsp")) ++ (close s))) ++ t) ++ ++(deftest pathname.4 ++ (let ((s (open "ansi-aux.lsp" :direction :input))) ++ (close s) ++ (equalt (truename (pathname s)) (truename #p"ansi-aux.lsp"))) ++ t) ++ ++(deftest pathname.5 ++ (loop for x in *logical-pathnames* ++ always (eq x (pathname x))) ++ t) ++ ++(deftest pathname.6 ++ (equalt #p"ansi-aux.lsp" ++ (pathname (make-array 12 :initial-contents "ansi-aux.lsp" ++ :element-type 'base-char))) ++ t) ++ ++(deftest pathname.7 ++ (equalt #p"ansi-aux.lsp" ++ (pathname (make-array 15 :initial-contents "ansi-aux.lspXXX" ++ :element-type 'base-char ++ :fill-pointer 12))) ++ t) ++ ++(deftest pathname.8 ++ (equalt #p"ansi-aux.lsp" ++ (pathname (make-array 12 :initial-contents "ansi-aux.lsp" ++ :element-type 'base-char ++ :adjustable t))) ++ t) ++ ++(deftest pathname.9 ++ (equalt #p"ansi-aux.lsp" ++ (pathname (make-array 15 :initial-contents "ansi-aux.lspXXX" ++ :element-type 'character ++ :fill-pointer 12))) ++ t) ++ ++(deftest pathname.10 ++ (equalt #p"ansi-aux.lsp" ++ (pathname (make-array 12 :initial-contents "ansi-aux.lsp" ++ :element-type 'character ++ :adjustable t))) ++ t) ++ ++(deftest pathname.11 ++ (loop for etype in '(standard-char base-char character) ++ collect ++ (equalt #p"ansi-aux.lsp" ++ (pathname ++ (let* ((s (make-array 15 :initial-contents "XXansi-aux.lspX" ++ :element-type etype))) ++ (make-array 12 :element-type etype ++ :displaced-to s ++ :displaced-index-offset 2))))) ++ (t t t)) ++ ++;;; Error tests ++ ++(deftest pathname.error.1 ++ (signals-error (pathname) program-error) ++ t) ++ ++(deftest pathname.error.2 ++ (signals-error (pathname (first *pathnames*) nil) program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/pathnamep.lsp +@@ -0,0 +1,31 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Dec 6 10:26:45 2003 ++;;;; Contains: Tests of PATHNAMEP ++ ++(in-package :cl-test) ++ ++(deftest pathnamep.1 ++ (check-type-predicate #'pathnamep 'pathname) ++ 0) ++ ++(deftest pathnamep.2 ++ (check-predicate #'(lambda (x) (eql (length (multiple-value-list (pathnamep x))) 1))) ++ nil) ++ ++(deftest pathnamep.3 ++ (check-predicate (typef '(not logical-pathname)) #'pathnamep) ++ nil) ++ ++(deftest pathnamep.error.1 ++ (signals-error (pathnamep) program-error) ++ t) ++ ++(deftest pathnamep.error.2 ++ (signals-error (pathnamep nil nil) program-error) ++ t) ++ ++(deftest pathnamep.error.3 ++ (signals-error (pathnamep *default-pathname-defaults* nil) ++ program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/pathnames-aux.lsp +@@ -0,0 +1,25 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Dec 6 15:05:05 2003 ++;;;; Contains: Functions associated with pathname tests ++ ++(in-package :cl-test) ++ ++(defun could-be-pathname-designator (x) ++ (or (stringp x) ++ (pathnamep x) ++ (typep x 'file-stream) ++ (and (typep x 'synonym-stream) ++ (could-be-pathname-designator ++ (symbol-value ++ (synonym-stream-symbol x)))))) ++ ++(defun explode-pathname (pn) ++ (list ++ :host (pathname-host pn) ++ :device (pathname-device pn) ++ :directory (pathname-directory pn) ++ :name (pathname-name pn) ++ :type (pathname-type pn) ++ :version (pathname-version pn))) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/pathnames.lsp +@@ -0,0 +1,19 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Nov 29 04:21:53 2003 ++;;;; Contains: Various tests on pathnames ++ ++(in-package :cl-test) ++ ++(deftest pathnames-print-and-read-properly ++ (with-standard-io-syntax ++ (loop ++ for p1 in *pathnames* ++ for s = (handler-case (write-to-string p1 :readably t) ++ (print-not-readable () :unreadable-error)) ++ unless (eql s :unreadable-error) ++ append ++ (let ((p2 (read-from-string s))) ++ (unless (equal p1 p2) ++ (list (list p1 s p2)))))) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/peek-char.lsp +@@ -0,0 +1,329 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Jan 17 21:02:13 2004 ++;;;; Contains: Tests of PEEK-CHAR ++ ++(in-package :cl-test) ++ ++(deftest peek-char.1 ++ (with-input-from-string ++ (*standard-input* "abc") ++ (values ++ (peek-char) ++ (read-char) ++ (read-char) ++ (peek-char) ++ (read-char))) ++ #\a #\a #\b #\c #\c) ++ ++(deftest peek-char.2 ++ (with-input-from-string ++ (*standard-input* " ab") ++ (values ++ (peek-char) ++ (read-char) ++ (peek-char t) ++ (read-char) ++ (peek-char t) ++ (read-char))) ++ #\Space #\Space #\a #\a #\b #\b) ++ ++(deftest peek-char.3 ++ (with-input-from-string ++ (*standard-input* (concatenate 'string ++ (string #\Newline) ++ (string #\Newline) ++ " " ++ (string #\Newline) ++ "ab")) ++ (values ++ (peek-char) ++ (read-char) ++ (peek-char t) ++ (read-char) ++ (peek-char t) ++ (read-char))) ++ #\Newline #\Newline #\a #\a #\b #\b) ++ ++(when (name-char "Linefeed") ++ (deftest peek-char.4 ++ (with-input-from-string ++ (*standard-input* (concatenate 'string ++ (string (name-char "Linefeed")) ++ (string (name-char "Linefeed")) ++ "abc")) ++ (values ++ (peek-char) ++ (read-char) ++ (peek-char t) ++ (read-char))) ++ #.(name-char "Linefeed") ++ #.(name-char "Linefeed") ++ #\a #\a)) ++ ++(when (name-char "Page") ++ (deftest peek-char.5 ++ (with-input-from-string ++ (*standard-input* (concatenate 'string ++ (string (name-char "Page")) ++ (string (name-char "Page")) ++ "abc")) ++ (values ++ (peek-char) ++ (read-char) ++ (peek-char t) ++ (read-char))) ++ #.(name-char "Page") ++ #.(name-char "Page") ++ #\a #\a)) ++ ++(when (name-char "Tab") ++ (deftest peek-char.6 ++ (with-input-from-string ++ (*standard-input* (concatenate 'string ++ (string (name-char "Tab")) ++ (string (name-char "Tab")) ++ "abc")) ++ (values ++ (peek-char) ++ (read-char) ++ (peek-char t) ++ (read-char))) ++ #.(name-char "Tab") ++ #.(name-char "Tab") ++ #\a #\a)) ++ ++(when (name-char "Return") ++ (deftest peek-char.7 ++ (with-input-from-string ++ (*standard-input* (concatenate 'string ++ (string (name-char "Return")) ++ (string (name-char "Return")) ++ "abc")) ++ (values ++ (peek-char) ++ (read-char) ++ (peek-char t) ++ (read-char))) ++ #.(name-char "Return") ++ #.(name-char "Return") ++ #\a #\a)) ++ ++(deftest peek-char.8 ++ (with-input-from-string ++ (s "a bcd") ++ (values ++ (peek-char nil s) ++ (read-char s) ++ (peek-char t s) ++ (read-char s) ++ (peek-char t s) ++ (read-char s))) ++ #\a #\a #\b #\b #\c #\c) ++ ++(deftest peek-char.9 ++ (with-input-from-string ++ (*standard-input* " a bCcde") ++ (values ++ (peek-char #\c) ++ (read-char) ++ (read-char))) ++ #\c #\c #\d) ++ ++(deftest peek-char.10 ++ (with-input-from-string ++ (*standard-input* " ; foo") ++ (values ++ (peek-char t) ++ (read-char))) ++ #\; #\;) ++ ++(deftest peek-char.11 ++ (with-input-from-string ++ (s "") ++ (peek-char nil s nil)) ++ nil) ++ ++(deftest peek-char.12 ++ (with-input-from-string ++ (s "") ++ (peek-char nil s nil 'foo)) ++ foo) ++ ++(deftest peek-char.13 ++ (with-input-from-string ++ (s " ") ++ (peek-char t s nil)) ++ nil) ++ ++(deftest peek-char.14 ++ (with-input-from-string ++ (s " ") ++ (peek-char t s nil 'foo)) ++ foo) ++ ++(deftest peek-char.15 ++ (with-input-from-string ++ (s "ab c d") ++ (peek-char #\z s nil)) ++ nil) ++ ++(deftest peek-char.16 ++ (with-input-from-string ++ (s "ab c d") ++ (peek-char #\z s nil 'foo)) ++ foo) ++ ++;;; Interaction with echo streams ++ ++(deftest peek-char.17 ++ (block done ++ (with-input-from-string ++ (is "ab") ++ (with-output-to-string ++ (os) ++ (let ((es (make-echo-stream is os))) ++ (let ((pos1 (file-position os))) ++ (unless (zerop pos1) (return-from done :good)) ++ (peek-char nil es nil) ++ (let ((pos2 (file-position os))) ++ (return-from done ++ (if (eql pos1 pos2) ++ :good ++ (list pos1 pos2))))))))) ++ :good) ++ ++(deftest peek-char.18 ++ (block done ++ (with-input-from-string ++ (is " ab") ++ (with-output-to-string ++ (os) ++ (let ((es (make-echo-stream is os))) ++ (let ((pos1 (file-position os))) ++ (unless (zerop pos1) (return-from done :good)) ++ (peek-char t es nil) ++ (let ((pos2 (file-position os))) ++ (return-from done ++ (if (eql pos1 pos2) ++ pos1 ++ :good)))))))) ++ :good) ++ ++(deftest peek-char.19 ++ (block done ++ (with-input-from-string ++ (is "abcde") ++ (with-output-to-string ++ (os) ++ (let ((es (make-echo-stream is os))) ++ (let ((pos1 (file-position os))) ++ (unless (zerop pos1) (return-from done :good)) ++ (peek-char #\c es nil) ++ (let ((pos2 (file-position os))) ++ (return-from done ++ (if (eql pos1 pos2) ++ pos1 ++ :good)))))))) ++ :good) ++ ++;;; Interactions with the readtable ++ ++(deftest peek-char.20 ++ (let ((*readtable* (copy-readtable))) ++ (set-syntax-from-char #\Space #\a) ++ (with-input-from-string ++ (*standard-input* " x") ++ (values ++ (peek-char) ++ (read-char) ++ (peek-char t) ++ (read-char)))) ++ #\Space #\Space ++ #\Space #\Space ; *not* #\x #\x ++ ) ++ ++(deftest peek-char.21 ++ (let ((*readtable* (copy-readtable))) ++ (set-syntax-from-char #\x #\Space) ++ (with-input-from-string ++ (*standard-input* "xxa") ++ (values ++ (peek-char) ++ (read-char) ++ (peek-char t) ++ (read-char)))) ++ #\x #\x ++ #\a #\a ; *not* #\x #\x ++ ) ++ ++;;; Stream designators are accepted for the stream argument ++ ++(deftest peek-char.22 ++ (with-input-from-string ++ (is "!?*") ++ (let ((*terminal-io* (make-two-way-stream is (make-string-output-stream)))) ++ (peek-char nil t))) ++ #\!) ++ ++(deftest peek-char.23 ++ (with-input-from-string ++ (*standard-input* "345") ++ (peek-char nil nil)) ++ #\3) ++ ++;;; Error tests ++ ++(deftest peek-char.error.1 ++ (signals-error ++ (with-input-from-string ++ (s "abc") ++ (peek-char s nil nil nil nil 'nonsense)) ++ program-error) ++ t) ++ ++ ++(deftest peek-char.error.2 ++ (signals-error-always ++ (with-input-from-string ++ (*standard-input* "") ++ (peek-char)) ++ end-of-file) ++ t t) ++ ++(deftest peek-char.error.3 ++ (signals-error-always ++ (with-input-from-string ++ (s "") ++ (peek-char nil s)) ++ end-of-file) ++ t t) ++ ++(deftest peek-char.error.4 ++ (signals-error-always ++ (with-input-from-string ++ (s " ") ++ (peek-char t s)) ++ end-of-file) ++ t t) ++ ++(deftest peek-char.error.5 ++ (signals-error-always ++ (with-input-from-string ++ (s "abcd") ++ (peek-char #\z s)) ++ end-of-file) ++ t t) ++ ++;;; There was a consensus on comp.lang.lisp that the requirement ++;;; that an end-of-file error be thrown in the following case ++;;; is a spec bug ++#| ++(deftest peek-char.error.6 ++ (signals-error ++ (with-input-from-string ++ (s "") ++ (peek-char nil s nil nil t)) ++ end-of-file) ++ t) ++|# +--- /dev/null ++++ gcl-2.6.12/ansi-tests/probe-file.lsp +@@ -0,0 +1,58 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Mon Jan 5 20:46:29 2004 ++;;;; Contains: Tests of PROBE-FILE ++ ++(in-package :cl-test) ++ ++(deftest probe-file.1 ++ (probe-file #p"nonexistent") ++ nil) ++ ++(deftest probe-file.2 ++ (let ((s (open #p"probe-file.lsp" :direction :input))) ++ (prog1 ++ (equalpt (truename #p"probe-file.lsp") ++ (probe-file s)) ++ (close s))) ++ t) ++ ++(deftest probe-file.3 ++ (let ((s (open #p"probe-file.lsp" :direction :input))) ++ (close s) ++ (equalpt (truename #p"probe-file.lsp") ++ (probe-file s))) ++ t) ++ ++(deftest probe-file.4 ++ (equalpt (truename #p"probe-file.lsp") ++ (probe-file "CLTEST:PROBE-FILE.LSP")) ++ t) ++ ++;;; Specialized string tests ++ ++(deftest probe-file.5 ++ (do-special-strings ++ (str "probe-file.lsp" nil) ++ (let ((s (open str :direction :input))) ++ (assert (equalpt (truename #p"probe-file.lsp") (probe-file s))) ++ (close s))) ++ nil) ++ ++;;; Error tests ++ ++(deftest probe-file.error.1 ++ (signals-error (probe-file) program-error) ++ t) ++ ++(deftest probe-file.error.2 ++ (signals-error (probe-file #p"probe-file.lsp" nil) program-error) ++ t) ++ ++(deftest probe-file.error.3 ++ (signals-error-always (probe-file (make-pathname :name :wild)) file-error) ++ t t) ++ ++(deftest probe-file.error.4 ++ (signals-error-always (probe-file "CLTEST:*.FOO") file-error) ++ t t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/read-byte.lsp +@@ -0,0 +1,194 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Jan 17 17:30:49 2004 ++;;;; Contains: Tests of READ-BYTE, WRITE-BYTE ++ ++(in-package :cl-test) ++ ++(deftest read-byte.1 ++ (let ((s (open "foo.txt" ++ :direction :output ++ :if-exists :supersede ++ :element-type '(unsigned-byte 8)))) ++ (values ++ (write-byte 17 s) ++ (close s) ++ (progn ++ (setq s (open "foo.txt" ++ :direction :input ++ :element-type '(unsigned-byte 8))) ++ (read-byte s)) ++ (close s))) ++ 17 t 17 t) ++ ++(deftest read-byte.2 ++ (let ((s (open "foo.txt" ++ :direction :output ++ :if-exists :supersede ++ :element-type '(unsigned-byte 8)))) ++ (values ++ (close s) ++ (progn ++ (setq s (open "foo.txt" ++ :direction :input ++ :element-type '(unsigned-byte 8))) ++ (read-byte s nil 'foo)) ++ (read-byte s nil) ++ (close s))) ++ t foo nil t) ++ ++(deftest read-byte.3 ++ (loop with b1 = 0 ++ and b2 = 0 ++ for i from 1 to 32 ++ do (let ((s (open "foo.txt" ++ :direction :output ++ :if-exists :supersede ++ :element-type `(unsigned-byte ,i)))) ++ (write-byte (1- (ash 1 i)) s) ++ (write-byte 1 s) ++ (close s)) ++ unless (let ((s (open "foo.txt" ++ :direction :input ++ :element-type `(unsigned-byte ,i)))) ++ (prog1 ++ (and (eql (setq b1 (read-byte s)) (1- (ash 1 i))) ++ (eql (setq b2 (read-byte s)) 1)) ++ (close s))) ++ collect (list i b1 b2)) ++ nil) ++ ++(deftest read-byte.4 ++ (loop with b1 = 0 ++ and b2 = 0 ++ for i from 33 to 200 by 7 ++ do (let ((s (open "foo.txt" ++ :direction :output ++ :if-exists :supersede ++ :element-type `(unsigned-byte ,i)))) ++ (write-byte (1- (ash 1 i)) s) ++ (write-byte 1 s) ++ (close s)) ++ unless (let ((s (open "foo.txt" ++ :direction :input ++ :element-type `(unsigned-byte ,i)))) ++ (prog1 ++ (and (eql (setq b1 (read-byte s)) (1- (ash 1 i))) ++ (eql (setq b2 (read-byte s)) 1)) ++ (close s))) ++ collect (list i b1 b2)) ++ nil) ++ ++;;; Error tests ++ ++(deftest read-byte.error.1 ++ (signals-error (read-byte) program-error) ++ t) ++ ++(deftest read-byte.error.2 ++ (progn ++ (let ((s (open "foo.txt" ++ :direction :output ++ :if-exists :supersede ++ :element-type `(unsigned-byte 8)))) ++ (close s)) ++ (signals-error ++ (let ((s (open "foo.txt" ++ :direction :input ++ :element-type '(unsigned-byte 8)))) ++ (read-byte s)) ++ end-of-file)) ++ t) ++ ++(deftest read-byte.error.3 ++ (progn ++ (let ((s (open "foo.txt" ++ :direction :output ++ :if-exists :supersede))) ++ (close s)) ++ (signals-error ++ (let ((s (open "foo.txt" :direction :input))) ++ (unwind-protect ++ (read-byte s) ++ (close s))) ++ error)) ++ t) ++ ++(deftest read-byte.error.4 ++ (signals-error-always ++ (progn ++ (let ((s (open "foo.txt" ++ :direction :output ++ :if-exists :supersede ++ :element-type '(unsigned-byte 8)))) ++ (close s)) ++ (let ((s (open "foo.txt" ++ :direction :input ++ :element-type '(unsigned-byte 8)))) ++ (unwind-protect ++ (read-byte s t) ++ (close s)))) ++ end-of-file) ++ t t) ++ ++(deftest read-byte.error.5 ++ (check-type-error #'read-byte #'streamp) ++ nil) ++ ++(deftest read-byte.error.6 ++ (progn ++ (let ((s (open "foo.txt" ++ :direction :output ++ :if-exists :supersede ++ :element-type '(unsigned-byte 8)))) ++ (close s)) ++ (signals-error ++ (let ((s (open "foo.txt" ++ :direction :input ++ :element-type '(unsigned-byte 8)))) ++ (unwind-protect ++ (read-byte s t t nil) ++ (close s))) ++ program-error)) ++ t) ++ ++ ++(deftest write-byte.error.1 ++ (signals-error (write-byte) program-error) ++ t) ++ ++(deftest write-byte.error.2 ++ (signals-error (write-byte 0) program-error) ++ t) ++ ++(deftest write-byte.error.3 ++ (signals-error ++ (let ((s (open "foo.txt" ++ :direction :output ++ :if-exists :supersede ++ :element-type '(unsigned-byte 8)))) ++ (unwind-protect ++ (write 1 s nil) ++ (close s))) ++ program-error) ++ t) ++ ++(deftest write-byte.error.4 ++ (check-type-error #'(lambda (x) (write-byte 0 x)) #'streamp) ++ nil) ++ ++(deftest write-byte.error.5 ++ (signals-error ++ (let ((s (open "foo.txt" ++ :direction :output ++ :if-exists :supersede))) ++ (unwind-protect ++ (write 1 s) ++ (close s))) ++ error) ++ t) ++ ++ ++ ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/read-char-no-hang.lsp +@@ -0,0 +1,123 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Jan 18 20:32:38 2004 ++;;;; Contains: Tests of READ-CHAR-NO-HANG ++ ++(in-package :cl-test) ++ ++(deftest read-char-no-hang.1 ++ (with-input-from-string ++ (*standard-input* "a") ++ (read-char-no-hang)) ++ #\a) ++ ++(deftest read-char-no-hang.2 ++ (with-input-from-string ++ (*standard-input* "abc") ++ (values ++ (read-char-no-hang) ++ (read-char-no-hang) ++ (read-char-no-hang))) ++ #\a #\b #\c) ++ ++(when (code-char 0) ++ (deftest read-char-no-hang.3 ++ (with-input-from-string ++ (*standard-input* (concatenate 'string ++ "a" ++ (string (code-char 0)) ++ "b")) ++ (values ++ (read-char-no-hang) ++ (read-char-no-hang) ++ (read-char-no-hang))) ++ #\a #.(code-char 0) #\b)) ++ ++(deftest read-char-no-hang.4 ++ (with-input-from-string ++ (s "abc") ++ (values ++ (read-char-no-hang s) ++ (read-char-no-hang s) ++ (read-char-no-hang s))) ++ #\a #\b #\c) ++ ++(deftest read-char-no-hang.5 ++ (with-input-from-string ++ (s "") ++ (read-char-no-hang s nil)) ++ nil) ++ ++(deftest read-char-no-hang.6 ++ (with-input-from-string ++ (s "") ++ (read-char-no-hang s nil 'foo)) ++ foo) ++ ++(deftest read-char-no-hang.7 ++ (with-input-from-string ++ (s "abc") ++ (values ++ (read-char-no-hang s nil nil) ++ (read-char-no-hang s nil nil) ++ (read-char-no-hang s nil nil))) ++ #\a #\b #\c) ++ ++(deftest read-char-no-hang.8 ++ (with-input-from-string ++ (s "abc") ++ (values ++ (read-char-no-hang s nil t) ++ (read-char-no-hang s nil t) ++ (read-char-no-hang s nil t))) ++ #\a #\b #\c) ++ ++(deftest read-char-no-hang.9 ++ (with-input-from-string ++ (is "!?*") ++ (let ((*terminal-io* (make-two-way-stream is (make-string-output-stream)))) ++ (read-char-no-hang t))) ++ #\!) ++ ++(deftest read-char-no-hang.10 ++ (with-input-from-string ++ (*standard-input* "345") ++ (read-char-no-hang nil)) ++ #\3) ++ ++;;; Need a test of the non-hanging. ++;;; This is hard to do portably. ++ ++;;; Error tests ++ ++(deftest read-char-no-hang.error.1 ++ (signals-error ++ (with-input-from-string ++ (s "abc") ++ (read-char-no-hang s nil nil nil nil)) ++ program-error) ++ t) ++ ++(deftest read-char-no-hang.error.2 ++ (signals-error-always ++ (with-input-from-string ++ (s "") ++ (read-char-no-hang s)) ++ end-of-file) ++ t t) ++ ++(deftest read-char-no-hang.error.3 ++ (signals-error-always ++ (with-input-from-string ++ (s "") ++ (read-char-no-hang s t)) ++ end-of-file) ++ t t) ++ ++(deftest read-char-no-hang.error.4 ++ (signals-error-always ++ (with-input-from-string ++ (s "") ++ (read-char-no-hang s t t)) ++ end-of-file) ++ t t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/read-char.lsp +@@ -0,0 +1,121 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Jan 18 08:53:56 2004 ++;;;; Contains: Tests of READ-CHAR ++ ++(in-package :cl-test) ++ ++(deftest read-char.1 ++ (with-input-from-string ++ (*standard-input* "a") ++ (read-char)) ++ #\a) ++ ++(deftest read-char.2 ++ (with-input-from-string ++ (*standard-input* "abc") ++ (values ++ (read-char) ++ (read-char) ++ (read-char))) ++ #\a #\b #\c) ++ ++(when (code-char 0) ++ (deftest read-char.3 ++ (with-input-from-string ++ (*standard-input* (concatenate 'string ++ "a" ++ (string (code-char 0)) ++ "b")) ++ (values ++ (read-char) ++ (read-char) ++ (read-char))) ++ #\a #.(code-char 0) #\b)) ++ ++(deftest read-char.4 ++ (with-input-from-string ++ (s "abc") ++ (values ++ (read-char s) ++ (read-char s) ++ (read-char s))) ++ #\a #\b #\c) ++ ++(deftest read-char.5 ++ (with-input-from-string ++ (s "") ++ (read-char s nil)) ++ nil) ++ ++(deftest read-char.6 ++ (with-input-from-string ++ (s "") ++ (read-char s nil 'foo)) ++ foo) ++ ++(deftest read-char.7 ++ (with-input-from-string ++ (s "abc") ++ (values ++ (read-char s nil nil) ++ (read-char s nil nil) ++ (read-char s nil nil))) ++ #\a #\b #\c) ++ ++(deftest read-char.8 ++ (with-input-from-string ++ (s "abc") ++ (values ++ (read-char s nil t) ++ (read-char s nil t) ++ (read-char s nil t))) ++ #\a #\b #\c) ++ ++(deftest read-char.9 ++ (with-input-from-string ++ (is "!?*") ++ (let ((*terminal-io* (make-two-way-stream is (make-string-output-stream)))) ++ (read-char t))) ++ #\!) ++ ++(deftest read-char.10 ++ (with-input-from-string ++ (*standard-input* "345") ++ (read-char nil)) ++ #\3) ++ ++ ++;;; Error tests ++ ++(deftest read-char.error.1 ++ (signals-error ++ (with-input-from-string ++ (s "abc") ++ (read-char s nil nil nil nil)) ++ program-error) ++ t) ++ ++(deftest read-char.error.2 ++ (signals-error-always ++ (with-input-from-string ++ (s "") ++ (read-char s)) ++ end-of-file) ++ t t) ++ ++(deftest read-char.error.3 ++ (signals-error-always ++ (with-input-from-string ++ (s "") ++ (read-char s t)) ++ end-of-file) ++ t t) ++ ++(deftest read-char.error.4 ++ (signals-error-always ++ (with-input-from-string ++ (s "") ++ (read-char s t t)) ++ end-of-file) ++ t t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/read-line.lsp +@@ -0,0 +1,104 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Jan 18 20:53:59 2004 ++;;;; Contains: Tests of READ-LINE ++ ++(in-package :cl-test) ++ ++(deftest read-line.1 ++ (with-input-from-string ++ (*standard-input* " abcd ") ++ (let ((vals (multiple-value-list (read-line)))) ++ (assert (= (length vals) 2)) ++ (values (first vals) (notnot (second vals))))) ++ " abcd " t) ++ ++(deftest read-line.2 ++ (with-input-from-string ++ (*standard-input* (string #\Newline)) ++ (read-line)) ++ "" nil) ++ ++(deftest read-line.3 ++ (with-input-from-string ++ (s (concatenate 'string "abc" (string #\Newline))) ++ (read-line s)) ++ "abc" nil) ++ ++(deftest read-line.4 ++ (with-input-from-string ++ (s "") ++ (let ((vals (multiple-value-list (read-line s nil)))) ++ (assert (= (length vals) 2)) ++ (values (first vals) (notnot (second vals))))) ++ nil t) ++ ++(deftest read-line.5 ++ (with-input-from-string ++ (s "") ++ (let ((vals (multiple-value-list (read-line s nil 'foo)))) ++ (assert (= (length vals) 2)) ++ (values (first vals) (notnot (second vals))))) ++ foo t) ++ ++(deftest read-line.6 ++ (with-input-from-string ++ (s " abcd ") ++ (let ((vals (multiple-value-list (read-line s t nil t)))) ++ (assert (= (length vals) 2)) ++ (values (first vals) (notnot (second vals))))) ++ " abcd " t) ++ ++(deftest read-line.7 ++ (with-input-from-string ++ (is "abc") ++ (let ((*terminal-io* (make-two-way-stream is *standard-output*))) ++ (let ((vals (multiple-value-list (read-line t)))) ++ (assert (= (length vals) 2)) ++ (assert (second vals)) ++ (first vals)))) ++ "abc") ++ ++(deftest read-line.8 ++ (with-input-from-string ++ (*standard-input* "abc") ++ (let ((vals (multiple-value-list (read-line nil)))) ++ (assert (= (length vals) 2)) ++ (assert (second vals)) ++ (first vals))) ++ "abc") ++ ++;;; Error tests ++ ++(deftest read-line.error.1 ++ (signals-error ++ (with-input-from-string ++ (s (concatenate 'string "abc" (string #\Newline))) ++ (read-line s t nil nil nil)) ++ program-error) ++ t) ++ ++(deftest read-line.error.2 ++ (signals-error-always ++ (with-input-from-string ++ (s "") ++ (read-line s)) ++ end-of-file) ++ t t) ++ ++(deftest read-line.error.3 ++ (signals-error-always ++ (with-input-from-string ++ (*standard-input* "") ++ (read-line)) ++ end-of-file) ++ t t) ++ ++(deftest read-line.error.4 ++ (signals-error-always ++ (with-input-from-string ++ (s "") ++ (read-line s t)) ++ end-of-file) ++ t t) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/read-sequence.lsp +@@ -0,0 +1,300 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Mon Jan 19 06:55:04 2004 ++;;;; Contains: Tests of READ-SEQUENCE ++ ++(in-package :cl-test) ++ ++;;; Read into a string ++ ++(defmacro def-read-sequence-test (name init args input &rest expected) ++ `(deftest ,name ++ (let ((s ,init)) ++ (with-input-from-string ++ (is ,input) ++ (values ++ (read-sequence s is ,@args) ++ s))) ++ ,@expected)) ++ ++(def-read-sequence-test read-sequence.string.1 (copy-seq " ") ++ () "abcdefghijk" 5 "abcde") ++ ++(def-read-sequence-test read-sequence.string.2 (copy-seq " ") ++ () "abc" 3 "abc ") ++ ++(def-read-sequence-test read-sequence.string.3 (copy-seq " ") ++ (:start 1) "abcdefghijk" 5 " abcd") ++ ++(def-read-sequence-test read-sequence.string.4 (copy-seq " ") ++ (:end 3) "abcdefghijk" 3 "abc ") ++ ++(def-read-sequence-test read-sequence.string.5 (copy-seq " ") ++ (:start 1 :end 4) "abcdefghijk" 4 " abc ") ++ ++(def-read-sequence-test read-sequence.string.6 (copy-seq " ") ++ (:start 0 :end 0) "abcdefghijk" 0 " ") ++ ++(def-read-sequence-test read-sequence.string.7 (copy-seq " ") ++ (:end nil) "abcdefghijk" 5 "abcde") ++ ++(def-read-sequence-test read-sequence.string.8 (copy-seq " ") ++ (:allow-other-keys nil) "abcdefghijk" 5 "abcde") ++ ++(def-read-sequence-test read-sequence.string.9 (copy-seq " ") ++ (:allow-other-keys t :foo 'bar) "abcdefghijk" 5 "abcde") ++ ++(def-read-sequence-test read-sequence.string.10 (copy-seq " ") ++ (:foo 'bar :allow-other-keys 'x) "abcdefghijk" 5 "abcde") ++ ++(def-read-sequence-test read-sequence.string.11 (copy-seq " ") ++ (:foo 'bar :allow-other-keys 'x :allow-other-keys nil) ++ "abcdefghijk" 5 "abcde") ++ ++(def-read-sequence-test read-sequence.string.12 (copy-seq " ") ++ (:end 5 :end 3 :start 0 :start 1) "abcdefghijk" 5 "abcde") ++ ++;;; Read into a base string ++ ++(def-read-sequence-test read-sequence.base-string.1 ++ (make-array 5 :element-type 'base-char) ++ () "abcdefghijk" 5 "abcde") ++ ++(def-read-sequence-test read-sequence.base-string.2 ++ (make-array 5 :element-type 'base-char :initial-element #\Space) ++ () "abc" 3 "abc ") ++ ++(def-read-sequence-test read-sequence.base-string.3 ++ (make-array 5 :element-type 'base-char :initial-element #\Space) ++ (:start 1) "abcdefghijk" 5 " abcd") ++ ++(def-read-sequence-test read-sequence.base-string.4 ++ (make-array 5 :element-type 'base-char :initial-element #\Space) ++ (:end 3) "abcdefghijk" 3 "abc ") ++ ++(def-read-sequence-test read-sequence.base-string.5 ++ (make-array 5 :element-type 'base-char :initial-element #\Space) ++ (:start 1 :end 4) "abcdefghijk" 4 " abc ") ++ ++(def-read-sequence-test read-sequence.base-string.6 ++ (make-array 5 :element-type 'base-char :initial-element #\Space) ++ (:start 0 :end 0) "abcdefghijk" 0 " ") ++ ++(def-read-sequence-test read-sequence.base-string.7 ++ (make-array 5 :element-type 'base-char :initial-element #\Space) ++ (:end nil) "abcdefghijk" 5 "abcde") ++ ++;;; Read into a list ++ ++(def-read-sequence-test read-sequence.list.1 (make-list 5) ++ () "abcdefghijk" 5 (#\a #\b #\c #\d #\e)) ++ ++(def-read-sequence-test read-sequence.list.2 (make-list 5) ++ () "abc" 3 (#\a #\b #\c nil nil)) ++ ++(def-read-sequence-test read-sequence.list.3 (make-list 5) ++ (:start 1) "abcdefghijk" 5 (nil #\a #\b #\c #\d)) ++ ++(def-read-sequence-test read-sequence.list.4 (make-list 5) ++ (:end 3) "abcdefghijk" 3 (#\a #\b #\c nil nil)) ++ ++(def-read-sequence-test read-sequence.list.5 (make-list 5) ++ (:end 4 :start 1) "abcdefghijk" 4 (nil #\a #\b #\c nil)) ++ ++(def-read-sequence-test read-sequence.list.6 (make-list 5) ++ (:start 0 :end 0) "abcdefghijk" 0 (nil nil nil nil nil)) ++ ++(def-read-sequence-test read-sequence.list.7 (make-list 5) ++ (:end nil) "abcdefghijk" 5 (#\a #\b #\c #\d #\e)) ++ ++;;; Read into a vector ++ ++(def-read-sequence-test read-sequence.vector.1 ++ (vector nil nil nil nil nil) ++ () "abcdefghijk" 5 #(#\a #\b #\c #\d #\e)) ++ ++(def-read-sequence-test read-sequence.vector.2 ++ (vector nil nil nil nil nil) ++ () "abc" 3 #(#\a #\b #\c nil nil)) ++ ++(def-read-sequence-test read-sequence.vector.3 ++ (vector nil nil nil nil nil) ++ (:start 2) "abcdefghijk" 5 #(nil nil #\a #\b #\c)) ++ ++(def-read-sequence-test read-sequence.vector.4 ++ (vector nil nil nil nil nil) ++ (:start 1 :end 4) "abcdefghijk" 4 #(nil #\a #\b #\c nil)) ++ ++(def-read-sequence-test read-sequence.vector.5 ++ (vector nil nil nil nil nil) ++ (:end 2) "abcdefghijk" 2 #(#\a #\b nil nil nil)) ++ ++(def-read-sequence-test read-sequence.vector.6 ++ (vector nil nil nil nil nil) ++ (:end 0 :start 0) "abcdefghijk" 0 #(nil nil nil nil nil)) ++ ++(def-read-sequence-test read-sequence.vector.7 ++ (vector nil nil nil nil nil) ++ (:end nil) "abcdefghijk" 5 #(#\a #\b #\c #\d #\e)) ++ ++;;; Read into a vector with a fill pointer ++ ++(def-read-sequence-test read-sequence.fill-vector.1 ++ (make-array 10 :initial-element nil :fill-pointer 5) ++ () "abcdefghijk" 5 #(#\a #\b #\c #\d #\e)) ++ ++(def-read-sequence-test read-sequence.fill-vector.2 ++ (make-array 10 :initial-element nil :fill-pointer 5) ++ () "ab" 2 #(#\a #\b nil nil nil)) ++ ++(def-read-sequence-test read-sequence.fill-vector.3 ++ (make-array 10 :initial-element nil :fill-pointer 5) ++ () "" 0 #(nil nil nil nil nil)) ++ ++(def-read-sequence-test read-sequence.fill-vector.4 ++ (make-array 10 :initial-element nil :fill-pointer 5) ++ (:start 2) "abcdefghijk" 5 #(nil nil #\a #\b #\c)) ++ ++(def-read-sequence-test read-sequence.fill-vector.5 ++ (make-array 10 :initial-element nil :fill-pointer 5) ++ (:start 1 :end 4) "abcdefghijk" 4 #(nil #\a #\b #\c nil)) ++ ++(def-read-sequence-test read-sequence.fill-vector.6 ++ (make-array 10 :initial-element nil :fill-pointer 5) ++ (:end 2) "abcdefghijk" 2 #(#\a #\b nil nil nil)) ++ ++(def-read-sequence-test read-sequence.fill-vector.7 ++ (make-array 10 :initial-element nil :fill-pointer 5) ++ (:end 0 :start 0) "abcdefghijk" 0 #(nil nil nil nil nil)) ++ ++(def-read-sequence-test read-sequence.fill-vector.8 ++ (make-array 10 :initial-element nil :fill-pointer 5) ++ (:end nil) "abcdefghijk" 5 #(#\a #\b #\c #\d #\e)) ++ ++;;; Nil vectors ++ ++(deftest read-sequence.nil-vector.1 ++ :notes (:nil-vectors-are-strings) ++ (let ((s (make-array 0 :element-type nil))) ++ (with-input-from-string ++ (is "abcde") ++ (values ++ (read-sequence s is) ++ s))) ++ 0 "") ++ ++;;; Read into a bit vector ++ ++(defmacro def-read-sequence-bv-test (name init args &rest expected) ++ `(deftest ,name ++ ;; Create output file ++ (progn ++ (let (os) ++ (unwind-protect ++ (progn ++ (setq os (open "temp.dat" :direction :output ++ :element-type '(unsigned-byte 8) ++ :if-exists :supersede)) ++ (loop for i in '(0 1 1 0 0 1 1 0 1 0 1 1 1 0) ++ do (write-byte i os))) ++ (when os (close os)))) ++ (let (is (bv (copy-seq ,init))) ++ (unwind-protect ++ (progn ++ (setq is (open "temp.dat" :direction :input ++ :element-type '(unsigned-byte 8))) ++ (values ++ (read-sequence bv is ,@args) ++ bv)) ++ (when is (close is))))) ++ ,@expected)) ++ ++(def-read-sequence-bv-test read-sequence.bv.1 #*00000000000000 () ++ 14 #*01100110101110) ++ ++(def-read-sequence-bv-test read-sequence.bv.2 #*00000000000000 (:start 0) ++ 14 #*01100110101110) ++ ++(def-read-sequence-bv-test read-sequence.bv.3 #*00000000000000 (:end 14) ++ 14 #*01100110101110) ++ ++(def-read-sequence-bv-test read-sequence.bv.4 #*00000000000000 (:end nil) ++ 14 #*01100110101110) ++ ++(def-read-sequence-bv-test read-sequence.bv.5 #*00000000000000 (:start 2) ++ 14 #*00011001101011) ++ ++(def-read-sequence-bv-test read-sequence.bv.6 #*00000000000000 ++ (:start 2 :end 13) ++ 13 #*00011001101010) ++ ++(def-read-sequence-bv-test read-sequence.bv.7 #*00000000000000 (:end 6) ++ 6 #*01100100000000) ++ ++;;; Error cases ++ ++(deftest read-sequence.error.1 ++ (signals-error (read-sequence) program-error) ++ t) ++ ++(deftest read-sequence.error.2 ++ (signals-error (read-sequence (make-string 10)) program-error) ++ t) ++ ++(deftest read-sequence.error.3 ++ (signals-error ++ (read-sequence (make-string 5) (make-string-input-stream "abc") :start) ++ program-error) ++ t) ++ ++(deftest read-sequence.error.4 ++ (signals-error ++ (read-sequence (make-string 5) (make-string-input-stream "abc") :foo 1) ++ program-error) ++ t) ++ ++(deftest read-sequence.error.5 ++ (signals-error ++ (read-sequence (make-string 5) (make-string-input-stream "abc") ++ :allow-other-keys nil :bar 2) ++ program-error) ++ t) ++ ++(deftest read-sequence.error.6 ++ (check-type-error #'(lambda (x) (read-sequence x (make-string-input-stream "abc"))) ++ #'sequencep) ++ nil) ++ ++(deftest read-sequence.error.7 ++ (signals-error ++ (read-sequence (cons 'a 'b) (make-string-input-stream "abc")) ++ type-error) ++ t) ++ ++;;; This test appears to cause Allegro CL to crash ++(deftest read-sequence.error.8 ++ (signals-type-error x -1 ++ (read-sequence (make-string 3) ++ (make-string-input-stream "abc") ++ :start x)) ++ t) ++ ++(deftest read-sequence.error.9 ++ (check-type-error #'(lambda (s) ++ (read-sequence (make-string 3) (make-string-input-stream "abc") ++ :start s)) ++ (typef 'unsigned-byte)) ++ nil) ++ ++(deftest read-sequence.error.10 ++ (signals-type-error x -1 ++ (read-sequence (make-string 3) (make-string-input-stream "abc") ++ :end x)) ++ t) ++ ++(deftest read-sequence.error.11 ++ (check-type-error #'(lambda (e) ++ (read-sequence (make-string 3) (make-string-input-stream "abc") ++ :end e)) ++ (typef '(or unsigned-byte null))) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/rename-file.lsp +@@ -0,0 +1,199 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Jan 8 06:22:53 2004 ++;;;; Contains: Tests for RENAME-FILE ++ ++(in-package :cl-test) ++ ++(deftest rename-file.1 ++ (let ((pn1 #p"file-to-be-renamed.txt") ++ (pn2 #p"file-that-was-renamed.txt")) ++ (delete-all-versions pn1) ++ (delete-all-versions pn2) ++ (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) ++ (let ((results (multiple-value-list (rename-file pn1 pn2)))) ++ (destructuring-bind (defaulted-new-name old-truename new-truename) ++ results ++ (values ++ (=t (length results) 3) ++ (probe-file pn1) ++ (notnot (probe-file pn2)) ++ (list (notnot (pathnamep defaulted-new-name)) ++ (notnot (pathnamep old-truename)) ++ (notnot (pathnamep new-truename)) ++ (typep old-truename 'logical-pathname) ++ (typep new-truename 'logical-pathname)) ++ (notnot (probe-file defaulted-new-name)) ++ (probe-file old-truename) ++ (notnot (probe-file new-truename)))))) ++ t nil t (t t t nil nil) t nil t) ++ ++(deftest rename-file.2 ++ (let ((pn1 "file-to-be-renamed.txt") ++ (pn2 "file-that-was-renamed.txt")) ++ (delete-all-versions pn1) ++ (delete-all-versions pn2) ++ (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) ++ (let ((results (multiple-value-list (rename-file pn1 pn2)))) ++ (destructuring-bind (defaulted-new-name old-truename new-truename) ++ results ++ (values ++ (=t (length results) 3) ++ (probe-file pn1) ++ (notnot (probe-file pn2)) ++ (list (notnot (pathnamep defaulted-new-name)) ++ (notnot (pathnamep old-truename)) ++ (notnot (pathnamep new-truename)) ++ (typep old-truename 'logical-pathname) ++ (typep new-truename 'logical-pathname)) ++ (notnot (probe-file defaulted-new-name)) ++ (probe-file old-truename) ++ (notnot (probe-file new-truename)))))) ++ t nil t (t t t nil nil) t nil t) ++ ++ (deftest rename-file.3 ++ (let* ((pn1 (make-pathname :name "file-to-be-renamed" ++ :type "txt" ++ :version :newest ++ :defaults *default-pathname-defaults*)) ++ (pn2 (make-pathname :name "file-that-was-renamed")) ++ (pn3 (make-pathname :name "file-that-was-renamed" ++ :defaults pn1))) ++ (delete-all-versions pn1) ++ (delete-all-versions pn3) ++ (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) ++ (let ((results (multiple-value-list (rename-file pn1 pn2)))) ++ (destructuring-bind (defaulted-new-name old-truename new-truename) ++ results ++ (values ++ (equalpt (pathname-type pn1) ++ (pathname-type defaulted-new-name)) ++ (=t (length results) 3) ++ (probe-file pn1) ++ (notnot (probe-file pn3)) ++ (list (notnot (pathnamep defaulted-new-name)) ++ (notnot (pathnamep old-truename)) ++ (notnot (pathnamep new-truename)) ++ (typep old-truename 'logical-pathname) ++ (typep new-truename 'logical-pathname)) ++ (notnot (probe-file defaulted-new-name)) ++ (probe-file old-truename) ++ (notnot (probe-file new-truename)))))) ++ t t nil t (t t t nil nil) t nil t) ++ ++(deftest rename-file.4 ++ (let ((pn1 "file-to-be-renamed.txt") ++ (pn2 "file-that-was-renamed.txt")) ++ (delete-all-versions pn1) ++ (delete-all-versions pn2) ++ (let ((s (open pn1 :direction :output))) ++ (format s "Whatever~%") ++ (close s) ++ (let ((results (multiple-value-list (rename-file s pn2)))) ++ (destructuring-bind (defaulted-new-name old-truename new-truename) ++ results ++ (values ++ (=t (length results) 3) ++ (probe-file pn1) ++ (notnot (probe-file pn2)) ++ (list (notnot (pathnamep defaulted-new-name)) ++ (notnot (pathnamep old-truename)) ++ (notnot (pathnamep new-truename)) ++ (typep old-truename 'logical-pathname) ++ (typep new-truename 'logical-pathname)) ++ (notnot (probe-file defaulted-new-name)) ++ (probe-file old-truename) ++ (notnot (probe-file new-truename))))))) ++ t nil t (t t t nil nil) t nil t) ++ ++(deftest rename-file.5 ++ (let ((pn1 "CLTEST:FILE-TO-BE-RENAMED.TXT") ++ (pn2 "CLTEST:FILE-THAT-WAS-RENAMED.TXT")) ++ (delete-all-versions pn1) ++ (delete-all-versions pn2) ++ (assert (typep (pathname pn1) 'logical-pathname)) ++ (assert (typep (pathname pn2) 'logical-pathname)) ++ (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) ++ (let ((results (multiple-value-list (rename-file pn1 pn2)))) ++ (destructuring-bind (defaulted-new-name old-truename new-truename) ++ results ++ (values ++ (=t (length results) 3) ++ (probe-file pn1) ++ (notnot (probe-file pn2)) ++ (list (notnot (pathnamep defaulted-new-name)) ++ (notnot (pathnamep old-truename)) ++ (notnot (pathnamep new-truename)) ++ (typep old-truename 'logical-pathname) ++ (typep new-truename 'logical-pathname)) ++ (notnot (probe-file defaulted-new-name)) ++ (probe-file old-truename) ++ (notnot (probe-file new-truename)) ++ (notnot (typep defaulted-new-name 'logical-pathname)) ++ )))) ++ t nil t (t t t nil nil) t nil t t) ++ ++;;; Specialized string tests ++ ++(deftest rename-file.6 ++ (do-special-strings ++ (s "file-to-be-renamed.txt" nil) ++ (let ((pn1 s) ++ (pn2 "file-that-was-renamed.txt")) ++ (delete-all-versions pn1) ++ (delete-all-versions pn2) ++ (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) ++ (let ((results (multiple-value-list (rename-file pn1 pn2)))) ++ (destructuring-bind (defaulted-new-name old-truename new-truename) ++ results ++ (assert ++ (equal ++ (list ++ (=t (length results) 3) ++ (probe-file pn1) ++ (notnot (probe-file pn2)) ++ (list (notnot (pathnamep defaulted-new-name)) ++ (notnot (pathnamep old-truename)) ++ (notnot (pathnamep new-truename)) ++ (typep old-truename 'logical-pathname) ++ (typep new-truename 'logical-pathname)) ++ (notnot (probe-file defaulted-new-name)) ++ (probe-file old-truename) ++ (notnot (probe-file new-truename))) ++ '(t nil t (t t t nil nil) t nil t))))))) ++ nil) ++ ++(deftest rename-file.7 ++ (do-special-strings ++ (s "file-that-was-renamed.txt" nil) ++ (let ((pn1 "file-to-be-renamed.txt") ++ (pn2 s)) ++ (delete-all-versions pn1) ++ (delete-all-versions pn2) ++ (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) ++ (let ((results (multiple-value-list (rename-file pn1 pn2)))) ++ (destructuring-bind (defaulted-new-name old-truename new-truename) ++ results ++ (assert ++ (equal ++ (list ++ (=t (length results) 3) ++ (probe-file pn1) ++ (notnot (probe-file pn2)) ++ (list (notnot (pathnamep defaulted-new-name)) ++ (notnot (pathnamep old-truename)) ++ (notnot (pathnamep new-truename)) ++ (typep old-truename 'logical-pathname) ++ (typep new-truename 'logical-pathname)) ++ (notnot (probe-file defaulted-new-name)) ++ (probe-file old-truename) ++ (notnot (probe-file new-truename))) ++ '(t nil t (t t t nil nil) t nil t))))))) ++ nil) ++ ++;;; Error tests ++ ++(deftest rename-file.error.1 ++ (signals-error (rename-file) program-error) ++ t) ++ +--- gcl-2.6.12.orig/ansi-tests/rt.lsp ++++ gcl-2.6.12/ansi-tests/rt.lsp +@@ -21,81 +21,147 @@ + | SOFTWARE. | + |----------------------------------------------------------------------------|# + +-;This is the December 19, 1990 version of the regression tester. ++;This was the December 19, 1990 version of the regression tester, but ++;has since been modified. + + (in-package :regression-test) + ++(declaim (ftype (function (t) t) get-entry expanded-eval do-entries)) ++(declaim (type list *entries*)) ++(declaim (ftype (function (t &rest t) t) report-error)) ++(declaim (ftype (function (t &optional t) t) do-entry)) ++ + (defvar *test* nil "Current test name") + (defvar *do-tests-when-defined* nil) +-(defvar *entries* '(nil) "Test database") ++(defvar *entries* (list nil) "Test database. Has a leading dummy cell that does not contain an entry.") ++(defvar *entries-tail* *entries* "Tail of the *entries* list") ++(defvar *entries-table* (make-hash-table :test #'equal) ++ "Map the names of entries to the cons cell in *entries* that precedes the one whose car is the entry.") + (defvar *in-test* nil "Used by TEST") + (defvar *debug* nil "For debugging") + (defvar *catch-errors* t "When true, causes errors in a test to be caught.") + (defvar *print-circle-on-failure* nil + "Failure reports are printed with *PRINT-CIRCLE* bound to this value.") + +-(defvar *compile-tests* nil "When true, compile the tests before running +-them.") ++(defvar *compile-tests* nil "When true, compile the tests before running them.") ++(defvar *expanded-eval* nil "When true, convert the tests into a form that is less likely to have compiler optimizations.") + (defvar *optimization-settings* '((safety 3))) + ++(defvar *failed-tests* nil "After DO-TESTS, becomes the list of names of tests that have failed") ++(defvar *passed-tests* nil "After DO-TESTS, becomes the list of names of tests that have passed") ++ + (defvar *expected-failures* nil + "A list of test names that are expected to fail.") + +-(defstruct (entry (:conc-name nil) +- (:type list)) +- pend name form) +- +-(defmacro vals (entry) `(cdddr ,entry)) +- +-(defmacro defn (entry) `(cdr ,entry)) ++(defvar *notes* (make-hash-table :test 'equal) ++ "A mapping from names of notes to note objects.") ++ ++(defstruct (entry (:conc-name nil)) ++ pend name props form vals) ++ ++;;; Note objects are used to attach information to tests. ++;;; A typical use is to mark tests that depend on a particular ++;;; part of a set of requirements, or a particular interpretation ++;;; of the requirements. ++ ++(defstruct note ++ name ++ contents ++ disabled ;; When true, tests with this note are considered inactive ++ ) ++ ++;; (defmacro vals (entry) `(cdddr ,entry)) ++ ++(defmacro defn (entry) ++ (let ((var (gensym))) ++ `(let ((,var ,entry)) ++ (list* (name ,var) (form ,var) (vals ,var))))) ++ ++(defun entry-notes (entry) ++ (let* ((props (props entry)) ++ (notes (getf props :notes))) ++ (if (listp notes) ++ notes ++ (list notes)))) ++ ++(defun has-disabled-note (entry) ++ (let ((notes (entry-notes entry))) ++ (loop for n in notes ++ for note = (if (note-p n) n ++ (gethash n *notes*)) ++ thereis (and note (note-disabled note))))) ++ ++(defun has-note (entry note) ++ (unless (note-p note) ++ (let ((new-note (gethash note *notes*))) ++ (setf note new-note))) ++ (and note (not (not (member note (entry-notes entry)))))) + + (defun pending-tests () +- (do ((l (cdr *entries*) (cdr l)) +- (r nil)) +- ((null l) (nreverse r)) +- (when (pend (car l)) +- (push (name (car l)) r)))) ++ (loop for entry in (cdr *entries*) ++ when (and (pend entry) (not (has-disabled-note entry))) ++ collect (name entry))) + + (defun rem-all-tests () + (setq *entries* (list nil)) ++ (setq *entries-tail* *entries*) ++ (clrhash *entries-table*) + nil) + + (defun rem-test (&optional (name *test*)) +- (do ((l *entries* (cdr l))) +- ((null (cdr l)) nil) +- (when (equal (name (cadr l)) name) +- (setf (cdr l) (cddr l)) +- (return name)))) ++ (let ((pred (gethash name *entries-table*))) ++ (when pred ++ (if (null (cddr pred)) ++ (setq *entries-tail* pred) ++ (setf (gethash (name (caddr pred)) *entries-table*) pred)) ++ (setf (cdr pred) (cddr pred)) ++ (remhash name *entries-table*) ++ name))) + + (defun get-test (&optional (name *test*)) + (defn (get-entry name))) + + (defun get-entry (name) +- (let ((entry (find name (cdr *entries*) +- :key #'name +- :test #'equal))) ++ (let ((entry ;; (find name (the list (cdr *entries*)) ++ ;; :key #'name :test #'equal) ++ (cadr (gethash name *entries-table*)) ++ )) + (when (null entry) + (report-error t + "~%No test with name ~:@(~S~)." + name)) + entry)) + +-(defmacro deftest (name form &rest values) +- `(add-entry '(t ,name ,form .,values))) ++(defmacro deftest (name &rest body) ++ (let* ((p body) ++ (properties ++ (loop while (keywordp (first p)) ++ unless (cadr p) ++ do (error "Poorly formed deftest: ~A~%" ++ (list* 'deftest name body)) ++ append (list (pop p) (pop p)))) ++ (form (pop p)) ++ (vals p)) ++ `(add-entry (make-entry :pend t ++ :name ',name ++ :props ',properties ++ :form ',form ++ :vals ',vals)))) + + (defun add-entry (entry) +- (setq entry (copy-list entry)) +- (do ((l *entries* (cdr l))) (nil) +- (when (null (cdr l)) +- (setf (cdr l) (list entry)) +- (return nil)) +- (when (equal (name (cadr l)) +- (name entry)) +- (setf (cadr l) entry) ++ (setq entry (copy-entry entry)) ++ (let* ((pred (gethash (name entry) *entries-table*))) ++ (cond ++ (pred ++ (setf (cadr pred) entry) + (report-error nil + "Redefining test ~:@(~S~)" +- (name entry)) +- (return nil))) ++ (name entry))) ++ (t ++ (setf (gethash (name entry) *entries-table*) *entries-tail*) ++ (setf (cdr *entries-tail*) (cons entry nil)) ++ (setf *entries-tail* (cdr *entries-tail*)) ++ ))) + (when *do-tests-when-defined* + (do-entry entry)) + (setq *test* (name entry))) +@@ -105,53 +171,59 @@ them.") + (apply #'format t args) + (if error? (throw '*debug* nil))) + (error? (apply #'error args)) +- (t (apply #'warn args)))) ++ (t (apply #'warn args))) ++ nil) + +-(defun do-test (&optional (name *test*)) +- (do-entry (get-entry name))) ++(defun do-test (&optional (name *test*) &rest key-args) ++ (flet ((%parse-key-args ++ (&key ++ ((:catch-errors *catch-errors*) *catch-errors*) ++ ((:compile *compile-tests*) *compile-tests*)) ++ (do-entry (get-entry name)))) ++ (apply #'%parse-key-args key-args))) ++ ++(defun my-aref (a &rest args) ++ (apply #'aref a args)) ++ ++(defun my-row-major-aref (a index) ++ (row-major-aref a index)) + + (defun equalp-with-case (x y) + "Like EQUALP, but doesn't do case conversion of characters. + Currently doesn't work on arrays of dimension > 2." + (cond ++ ((eq x y) t) + ((consp x) + (and (consp y) + (equalp-with-case (car x) (car y)) + (equalp-with-case (cdr x) (cdr y)))) + ((and (typep x 'array) + (= (array-rank x) 0)) +- (equalp-with-case (aref x) (aref y))) ++ (equalp-with-case (my-aref x) (my-aref y))) + ((typep x 'vector) + (and (typep y 'vector) + (let ((x-len (length x)) + (y-len (length y))) + (and (eql x-len y-len) + (loop +- for e1 across x +- for e2 across y ++ for i from 0 below x-len ++ for e1 = (my-aref x i) ++ for e2 = (my-aref y i) + always (equalp-with-case e1 e2)))))) + ((and (typep x 'array) + (typep y 'array) + (not (equal (array-dimensions x) + (array-dimensions y)))) + nil) +- #| +- ((and (typep x 'array) +- (= (array-rank x) 2)) +- (let ((dim (array-dimensions x))) +- (loop for i from 0 below (first dim) +- always (loop for j from 0 below (second dim) +- always (equalp-with-case (aref x i j) +- (aref y i j)))))) +- |# + + ((typep x 'array) + (and (typep y 'array) + (let ((size (array-total-size x))) + (loop for i from 0 below size +- always (equalp-with-case (row-major-aref x i) +- (row-major-aref y i)))))) +- ++ always (equalp-with-case (my-row-major-aref x i) ++ (my-row-major-aref y i)))))) ++ ((typep x 'pathname) ++ (equal x y)) + (t (eql x y)))) + + (defun do-entry (entry &optional +@@ -165,49 +237,110 @@ them.") + r) + ;; (declare (special *break-on-warnings*)) + +- (flet ((%do +- () +- (setf r +- (multiple-value-list +- (if *compile-tests* +- (funcall (compile +- nil +- `(lambda () +- (declare +- (optimize ,@*optimization-settings*)) +- ,(form entry)))) +- (eval (form entry))))))) +- (block aborted +- (if *catch-errors* +- (handler-bind (#-ecl (style-warning #'muffle-warning) +- (error #'(lambda (c) +- (setf aborted t) +- (setf r (list c)) +- (return-from aborted nil)))) +- (%do)) +- (%do)))) +- ++ (block aborted ++ (setf r ++ (flet ((%do () ++ (handler-bind ++ #-sbcl nil ++ #+sbcl ((sb-ext:code-deletion-note #'(lambda (c) ++ (if (has-note entry :do-not-muffle) ++ nil ++ (muffle-warning c))))) ++ (cond ++ (*compile-tests* ++ (multiple-value-list ++ (funcall (compile ++ nil ++ `(lambda () ++ (declare ++ (optimize ,@*optimization-settings*)) ++ ,(form entry)))))) ++ (*expanded-eval* ++ (multiple-value-list ++ (expanded-eval (form entry)))) ++ (t ++ (multiple-value-list ++ (eval (form entry)))))))) ++ (if *catch-errors* ++ (handler-bind ++ (#-ecl (style-warning #'(lambda (c) (if (has-note entry :do-not-muffle-warnings) ++ c ++ (muffle-warning c)))) ++ (error #'(lambda (c) ++ (setf aborted t) ++ (setf r (list c)) ++ (return-from aborted nil)))) ++ (%do)) ++ (%do))))) ++ + (setf (pend entry) + (or aborted + (not (equalp-with-case r (vals entry))))) ++ + (when (pend entry) + (let ((*print-circle* *print-circle-on-failure*)) +- (format s "~&Test ~:@(~S~) failed~%Form: ~S~%Expected value~P:~%" +- *test* (form entry) (length (vals entry))) +- (dolist (v (vals entry)) (format s "~10t~S~%" v)) +- (format s "Actual value~P:~%" (length r)) +- (dolist (v r) +- (format s "~10t~S~:[~; [~2:*~A]~]~%" +- v (typep v 'condition))))))) ++ (format s "~&Test ~:@(~S~) failed~ ++ ~%Form: ~S~ ++ ~%Expected value~P: ~ ++ ~{~S~^~%~17t~}~%" ++ *test* (form entry) ++ (length (vals entry)) ++ (vals entry)) ++ (handler-case ++ (let ((st (format nil "Actual value~P: ~ ++ ~{~S~^~%~15t~}.~%" ++ (length r) r))) ++ (format s "~A" st)) ++ (error () (format s "Actual value: #~%"))) ++ (finish-output s))))) + (when (not (pend entry)) *test*)) + ++(defun expanded-eval (form) ++ "Split off top level of a form and eval separately. This reduces the chance that ++ compiler optimizations will fold away runtime computation." ++ (if (not (consp form)) ++ (eval form) ++ (let ((op (car form))) ++ (cond ++ ((eq op 'let) ++ (let* ((bindings (loop for b in (cadr form) ++ collect (if (consp b) b (list b nil)))) ++ (vars (mapcar #'car bindings)) ++ (binding-forms (mapcar #'cadr bindings))) ++ (apply ++ (the function ++ (eval `(lambda ,vars ,@(cddr form)))) ++ (mapcar #'eval binding-forms)))) ++ ((and (eq op 'let*) (cadr form)) ++ (let* ((bindings (loop for b in (cadr form) ++ collect (if (consp b) b (list b nil)))) ++ (vars (mapcar #'car bindings)) ++ (binding-forms (mapcar #'cadr bindings))) ++ (funcall ++ (the function ++ (eval `(lambda (,(car vars) &aux ,@(cdr bindings)) ,@(cddr form)))) ++ (eval (car binding-forms))))) ++ ((eq op 'progn) ++ (loop for e on (cdr form) ++ do (if (null (cdr e)) (return (eval (car e))) ++ (eval (car e))))) ++ ((and (symbolp op) (fboundp op) ++ (not (macro-function op)) ++ (not (special-operator-p op))) ++ (apply (symbol-function op) ++ (mapcar #'eval (cdr form)))) ++ (t (eval form)))))) ++ + (defun continue-testing () + (if *in-test* + (throw '*in-test* nil) + (do-entries *standard-output*))) + +-(defun do-tests (&optional +- (out *standard-output*)) ++(defun do-tests (&key (out *standard-output*) ++ ((:catch-errors *catch-errors*) *catch-errors*) ++ ((:compile *compile-tests*) *compile-tests*)) ++ (setq *failed-tests* nil ++ *passed-tests* nil) + (dolist (entry (cdr *entries*)) + (setf (pend entry) t)) + (if (streamp out) +@@ -219,13 +352,19 @@ them.") + (defun do-entries (s) + (format s "~&Doing ~A pending test~:P ~ + of ~A tests total.~%" +- (count t (cdr *entries*) +- :key #'pend) ++ (count t (the list (cdr *entries*)) :key #'pend) + (length (cdr *entries*))) ++ (finish-output s) + (dolist (entry (cdr *entries*)) +- (when (pend entry) +- (format s "~@[~<~%~:; ~:@(~S~)~>~]" +- (do-entry entry s)))) ++ (when (and (pend entry) ++ (not (has-disabled-note entry))) ++ (let ((success? (do-entry entry s))) ++ (if success? ++ (push (name entry) *passed-tests*) ++ (push (name entry) *failed-tests*)) ++ (format s "~@[~<~%~:; ~:@(~S~)~>~]" success?)) ++ (finish-output s) ++ )) + (let ((pending (pending-tests)) + (expected-table (make-hash-table :test #'equal))) + (dolist (ex *expected-failures*) +@@ -252,19 +391,46 @@ them.") + ~^, ~}~)." + (length new-failures) + new-failures))) +- (when *expected-failures* +- (let ((pending-table (make-hash-table :test #'equal))) +- (dolist (ex pending) +- (setf (gethash ex pending-table) t)) +- (let ((unexpected-successes +- (loop :for ex :in *expected-failures* +- :unless (gethash ex pending-table) :collect ex))) +- (if unexpected-successes +- (format t "~&~:D unexpected successes: ~ +- ~:@(~{~<~% ~1:;~S~>~ +- ~^, ~}~)." +- (length unexpected-successes) +- unexpected-successes) +- (format t "~&No unexpected successes."))))) + )) ++ (finish-output s) + (null pending)))) ++ ++;;; Note handling functions and macros ++ ++(defmacro defnote (name contents &optional disabled) ++ `(eval-when (:load-toplevel :execute) ++ (let ((note (make-note :name ',name ++ :contents ',contents ++ :disabled ',disabled))) ++ (setf (gethash (note-name note) *notes*) note) ++ note))) ++ ++(defun disable-note (n) ++ (let ((note (if (note-p n) n ++ (setf n (gethash n *notes*))))) ++ (unless note (error "~A is not a note or note name." n)) ++ (setf (note-disabled note) t) ++ note)) ++ ++(defun enable-note (n) ++ (let ((note (if (note-p n) n ++ (setf n (gethash n *notes*))))) ++ (unless note (error "~A is not a note or note name." n)) ++ (setf (note-disabled note) nil) ++ note)) ++ ++;;; Extended random regression ++ ++(defun do-extended-tests (&key (tests *passed-tests*) (count nil) ++ ((:catch-errors *catch-errors*) *catch-errors*) ++ ((:compile *compile-tests*) *compile-tests*)) ++ "Execute randomly chosen tests from TESTS until one fails or until ++ COUNT is an integer and that many tests have been executed." ++ (let ((test-vector (coerce tests 'simple-vector))) ++ (let ((n (length test-vector))) ++ (when (= n 0) (error "Must provide at least one test.")) ++ (loop for i from 0 ++ for name = (svref test-vector (random n)) ++ until (eql i count) ++ do (print name) ++ unless (do-test name) return (values name (1+ i)))))) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/stream-element-type.lsp +@@ -0,0 +1,102 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 13 20:09:50 2004 ++;;;; Contains: Tests for STREAM-ELEMENT-TYPE ++ ++(in-package :cl-test) ++ ++(deftest stream-element-type.1 ++ (loop for s in (list *debug-io* *error-output* *query-io* ++ *standard-input* *standard-output* ++ *trace-output* *terminal-io*) ++ for results = (multiple-value-list (stream-element-type s)) ++ unless (and (eql (length results) 1) ++ (car results)) ++ collect s) ++ nil) ++ ++(deftest stream-element-type.2 ++ (let ((pn "foo.txt")) ++ (loop for i from 1 to 100 ++ for etype = `(unsigned-byte ,i) ++ for s = (progn (delete-all-versions pn) ++ (open pn :direction :output ++ :element-type etype)) ++ unless ++ (multiple-value-bind (sub good) ++ (subtypep etype (stream-element-type s)) ++ (close s) ++ (or sub (not good))) ++ collect i)) ++ nil) ++ ++(deftest stream-element-type.3 ++ (let ((pn "foo.txt")) ++ (loop for i from 1 to 100 ++ for etype = `(signed-byte ,i) ++ for s = (progn (delete-all-versions pn) ++ (open pn :direction :output ++ :element-type etype)) ++ unless ++ (multiple-value-bind (sub good) ++ (subtypep etype (stream-element-type s)) ++ (close s) ++ (or sub (not good))) ++ collect i)) ++ nil) ++ ++(deftest stream-element-type.4 ++ (let ((pn "foo.txt")) ++ (loop for i from 1 to 100 ++ for etype = `(integer 0 ,i) ++ for s = (progn (delete-all-versions pn) ++ (open pn :direction :output ++ :element-type etype)) ++ unless ++ (multiple-value-bind (sub good) ++ (subtypep etype (stream-element-type s)) ++ (close s) ++ (or sub (not good))) ++ collect i)) ++ nil) ++ ++ ++(deftest stream-element-type.5 ++ :notes (:assume-no-simple-streams) ++ (let ((pn "foo.txt")) ++ (delete-all-versions pn) ++ (let ((s (open pn :direction :output))) ++ (let ((etype (stream-element-type s))) ++ (unwind-protect ++ (equalt (multiple-value-list (subtypep* 'character etype)) ++ '(nil t)) ++ (close s))))) ++ nil) ++ ++(deftest stream-element-type.6 ++ :notes (:assume-no-simple-streams) ++ (let ((pn "foo.txt")) ++ (delete-all-versions pn) ++ (let ((s (open pn :direction :output ++ :element-type :default))) ++ (let ((etype (stream-element-type s))) ++ (unwind-protect ++ (multiple-value-bind (sub1 good1) (subtypep* etype 'integer) ++ (multiple-value-bind (sub2 good2) (subtypep* etype 'character) ++ (or (not good1) ++ (not good2) ++ sub1 sub2))) ++ (close s))))) ++ t) ++ ++(deftest stream-element-type.error.1 ++ (signals-error (stream-element-type) program-error) ++ t) ++ ++(deftest stream-element-type.error.2 ++ (signals-error (stream-element-type *standard-input* nil) program-error) ++ t) ++ ++(deftest stream-element-type.error.3 ++ (check-type-error #'stream-element-type #'streamp) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/stream-error-stream.lsp +@@ -0,0 +1,34 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Feb 14 20:51:33 2004 ++;;;; Contains: Tests of STREAM-ERROR-STREAM ++ ++(in-package :cl-test) ++ ++(deftest stream-error-stream.1 ++ (with-input-from-string ++ (s "") ++ (handler-case ++ (read-char s) ++ (stream-error (c) (eqlt (stream-error-stream c) s)))) ++ t) ++ ++;;; Error tests ++ ++(deftest stream-error-stream.error.1 ++ (signals-error (stream-error-stream) program-error) ++ t) ++ ++ ++(deftest stream-error-stream.error.2 ++ (signals-error ++ (with-input-from-string ++ (s "") ++ (handler-case ++ (read-char s) ++ (stream-error (c) (stream-error-stream c nil)))) ++ program-error) ++ t) ++ ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/stream-external-format.lsp +@@ -0,0 +1,24 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 27 20:53:21 2004 ++;;;; Contains: Tests of STREAM-EXTERNAL-FORMAT ++ ++(in-package :cl-test) ++ ++;;; This is tested in open.lsp ++ ++;;; Error tests ++ ++(deftest stream-external-format.error.1 ++ (signals-error (stream-external-format) program-error) ++ t) ++ ++(deftest stream-external-format.error.2 ++ (signals-error ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (with-open-file ++ (s pn :direction :output :if-exists :supersede) ++ (stream-external-format s nil))) ++ program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/streamp.lsp +@@ -0,0 +1,44 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Jan 17 17:12:38 2004 ++;;;; Contains: Tests for STREAMP ++ ++(in-package :cl-test) ++ ++(deftest streamp.1 ++ (loop for s in (list *debug-io* *error-output* *query-io* ++ *standard-input* *standard-output* ++ *trace-output* *terminal-io*) ++ unless (equal (multiple-value-list (notnot-mv (streamp s))) ++ '(t)) ++ collect s) ++ nil) ++ ++(deftest streamp.2 ++ (check-type-predicate #'streamp 'stream) ++ 0) ++ ++(deftest streamp.3 ++ (let ((s (open "foo.txt" :direction :output ++ :if-exists :supersede))) ++ (close s) ++ (notnot-mv (streamp s))) ++ t) ++ ++(deftest streamp.4 ++ (let ((s (open "foo.txt" :direction :output ++ :if-exists :supersede))) ++ (unwind-protect ++ (notnot-mv (streamp s)) ++ (close s))) ++ t) ++ ++;;; Error tests ++ ++(deftest streamp.error.1 ++ (signals-error (streamp) program-error) ++ t) ++ ++(deftest streamp.error.2 ++ (signals-error (streamp *standard-input* nil) program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/synonym-stream-symbol.lsp +@@ -0,0 +1,23 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Jan 29 21:21:06 2004 ++;;;; Contains: Tests of SYNONYM-STREAM-SYMBOL ++ ++(in-package :cl-test) ++ ++(deftest synonym-stream-symbol.1 ++ (synonym-stream-symbol (make-synonym-stream '*standard-input*)) ++ *standard-input*) ++ ++(deftest synonym-stream-symbol.error.1 ++ (signals-error (synonym-stream-symbol) program-error) ++ t) ++ ++(deftest synonym-stream-symbol.error.2 ++ (signals-error (synonym-stream-symbol ++ (make-synonym-stream '*terminal-io*) ++ nil) ++ program-error) ++ t) ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/terpri.lsp +@@ -0,0 +1,62 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Jan 18 20:35:57 2004 ++;;;; Contains: Tests of TERPRI ++ ++(in-package :cl-test) ++ ++(deftest terpri.1 ++ (let (result) ++ (values ++ (with-output-to-string ++ (*standard-output*) ++ (write-char #\a) ++ (setq result (terpri))) ++ result)) ++ #.(concatenate 'string "a" (string #\Newline)) ++ nil) ++ ++(deftest terpri.2 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (write-char #\a s) ++ (setq result (terpri s))) ++ result)) ++ #.(concatenate 'string "a" (string #\Newline)) ++ nil) ++ ++(deftest terpri.3 ++ (with-output-to-string ++ (s) ++ (write-char #\x s) ++ (terpri s) ++ (terpri s) ++ (write-char #\y s)) ++ #.(concatenate 'string "x" (string #\Newline) (string #\Newline) "y")) ++ ++(deftest terpri.4 ++ (with-output-to-string ++ (os) ++ (let ((*terminal-io* (make-two-way-stream *standard-input* os))) ++ (terpri t) ++ (finish-output t))) ++ #.(string #\Newline)) ++ ++(deftest terpri.5 ++ (with-output-to-string ++ (*standard-output*) ++ (terpri nil)) ++ #.(string #\Newline)) ++ ++;;; Error tests ++ ++(deftest terpri.error.1 ++ (signals-error ++ (with-output-to-string ++ (s) ++ (terpri s nil)) ++ program-error) ++ t) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/translate-logical-pathname.lsp +@@ -0,0 +1,48 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Mon Dec 29 14:45:50 2003 ++;;;; Contains: Tests for TRANSLATE-LOGICAL-PATHNAME ++ ++(in-package :cl-test) ++ ++;; On physical pathnames, t-l-p returns the pathname itself ++ ++;;; Every physical pathname is converted to itself ++(deftest translate-logical-pathname.1 ++ (loop for p in *pathnames* ++ unless (or (typep p 'logical-pathname) ++ (eq p (translate-logical-pathname p))) ++ collect p) ++ nil) ++ ++;;; &key arguments are allowed ++(deftest translate-logical-pathname.2 ++ (loop for p in *pathnames* ++ unless (or (typep p 'logical-pathname) ++ (eq p (translate-logical-pathname ++ p :allow-other-keys t))) ++ collect p) ++ nil) ++ ++(deftest translate-logical-pathname.3 ++ (loop for p in *pathnames* ++ unless (or (typep p 'logical-pathname) ++ (eq p (translate-logical-pathname ++ p :allow-other-keys nil))) ++ collect p) ++ nil) ++ ++(deftest translate-logical-pathname.4 ++ (loop for p in *pathnames* ++ unless (or (typep p 'logical-pathname) ++ (eq p (translate-logical-pathname ++ p :foo 1 :allow-other-keys t :bar 2))) ++ collect p) ++ nil) ++ ++ ++;;; errors ++ ++(deftest translate-logical-pathname.error.1 ++ (signals-error (translate-logical-pathname) program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/translate-pathname.lsp +@@ -0,0 +1,50 @@ ++;-*- Mode: Lisp -*- ++ ++(in-package :cl-test) ++ ++(deftest translate-pathname.1 (translate-pathname "foobar" "foobar" "foobar") #P"foobar") ++(deftest translate-pathname.2 (translate-pathname "foobar" "foobar" "foo*") #P"foo") ++(deftest translate-pathname.3 (translate-pathname "foobar" "foobar" "*") #P"foobar") ++(deftest translate-pathname.4 (translate-pathname "foobar" "foobar" "") #P"foobar") ++ ++(deftest translate-pathname.5 (translate-pathname "foobar" "foo*r" "foobar") #P"foobar") ++(deftest translate-pathname.6 (translate-pathname "foobar" "foo*r" "foo*") #P"fooba") ++(deftest translate-pathname.7 (translate-pathname "foobar" "foo*r" "*") #P"foobar") ++(deftest translate-pathname.8 (translate-pathname "foobar" "foo*r" "") #P"foobar") ++ ++(deftest translate-pathname.9 (translate-pathname "foobar" "*" "foobar") #P"foobar") ++(deftest translate-pathname.10 (translate-pathname "foobar" "*" "foo*") #P"foofoobar") ++(deftest translate-pathname.11 (translate-pathname "foobar" "*" "*") #P"foobar") ++(deftest translate-pathname.12 (translate-pathname "foobar" "*" "") #P"foobar") ++ ++(deftest translate-pathname.13 (translate-pathname "foobar" "" "foobar") #P"foobar") ++(deftest translate-pathname.14 (translate-pathname "foobar" "" "foo*") #P"foofoobar") ++(deftest translate-pathname.15 (translate-pathname "foobar" "" "*") #P"foobar") ++(deftest translate-pathname.16 (translate-pathname "foobar" "" "") #P"foobar") ++ ++(deftest translate-pathname.17 (translate-pathname "/a/bbfb/c/d/" "/a/bbfb/c/d/" "/a/qc/c/d/") #P"/a/qc/c/d/") ++(deftest translate-pathname.18 (translate-pathname "/a/bbfb/c/d/" "/a/bbfb/c/d/" "/a/q*c*/c/d/") #P"/a/qc/c/d/") ++(deftest translate-pathname.19 (translate-pathname "/a/bbfb/c/d/" "/a/bbfb/c/d/" "/a/*/c/d/") #P"/a/c/d/") ++(deftest translate-pathname.20 (translate-pathname "/a/bbfb/c/d/" "/a/bbfb/c/d/" "/a/**/d/") #P"/a/d/") ++ ++(deftest translate-pathname.21 (translate-pathname "/a/bbfb/c/d/" "/a/b*f*/c/d/" "/a/qc/c/d/") #P"/a/qc/c/d/") ++(deftest translate-pathname.22 (translate-pathname "/a/bbfb/c/d/" "/a/b*f*/c/d/" "/a/q*c*/c/d/") #P"/a/qbcb/c/d/") ++(deftest translate-pathname.23 (translate-pathname "/a/bbfb/c/d/" "/a/b*f*/c/d/" "/a/*/c/d/") #P"/a/bbfb/c/d/") ++(deftest translate-pathname.24 (translate-pathname "/a/bbfb/c/d/" "/a/b*f*/c/d/" "/a/**/d/") #P"/a/bbfb/d/") ++ ++(deftest translate-pathname.25 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "/a/qc/c/d/") #P"/a/qc/c/d/") ++(deftest translate-pathname.26 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "/a/q*c*/c/d/") #P"/a/qc/c/d/") ++(deftest translate-pathname.27 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "/a/*/d/") #P"/a/bbfb/d/") ++(deftest translate-pathname.28 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "/a/**/d/") #P"/a/bbfb/c/d/") ++ ++(deftest translate-pathname.29 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "a/qc/c/d/") #P"a/qc/c/d/") ++(deftest translate-pathname.30 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "a/q*c*/c/d/") #P"a/qc/c/d/") ++(deftest translate-pathname.31 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "a/*/d/") #P"a/bbfb/d/") ++(deftest translate-pathname.32 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "a/**/d/") #P"a/bbfb/c/d/") ++ ++(deftest translate-pathname.33 (translate-pathname "/a/bbfb/c/d/" "/a/bbfb/c/d/" "a") #P"/a/bbfb/c/d/a") ++(deftest translate-pathname.34 (translate-pathname "/a/bbfb/c/d/" "/a/b*f*/c/d/" "a") #P"/a/bbfb/c/d/a") ++(deftest translate-pathname.35 (translate-pathname "/a/bbfb/c/d/" "/a/*/c/d/" "a") #P"/a/bbfb/c/d/a") ++(deftest translate-pathname.36 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "a") #P"/a/bbfb/c/d/a") ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/truename.lsp +@@ -0,0 +1,108 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 6 05:32:37 2004 ++;;;; Contains: Tests of TRUENAME ++ ++(in-package :cl-test) ++ ++(deftest truename.1 ++ (let* ((pn #p"truename.lsp") ++ (tn (truename pn))) ++ (values ++ (notnot (pathnamep pn)) ++ (typep pn 'logical-pathname) ++ (equalt (pathname-name pn) (pathname-name tn)) ++ (equalt (pathname-type pn) (pathname-type tn)) ++ )) ++ t nil t t) ++ ++(deftest truename.2 ++ (let* ((name "truename.lsp") ++ (pn (pathname name)) ++ (tn (truename name))) ++ (values ++ (notnot (pathnamep pn)) ++ (typep pn 'logical-pathname) ++ (equalt (pathname-name pn) (pathname-name tn)) ++ (equalt (pathname-type pn) (pathname-type tn)) ++ )) ++ t nil t t) ++ ++(deftest truename.3 ++ (let* ((pn #p"truename.lsp")) ++ (with-open-file ++ (s pn :direction :input) ++ (let ((tn (truename s))) ++ (values ++ (notnot (pathnamep pn)) ++ (typep pn 'logical-pathname) ++ (equalt (pathname-name pn) (pathname-name tn)) ++ (equalt (pathname-type pn) (pathname-type tn)) ++ )))) ++ t nil t t) ++ ++(deftest truename.4 ++ (let* ((pn #p"truename.lsp")) ++ (let ((s (open pn :direction :input))) ++ (close s) ++ (let ((tn (truename s))) ++ (values ++ (notnot (pathnamep pn)) ++ (typep pn 'logical-pathname) ++ (equalt (pathname-name pn) (pathname-name tn)) ++ (equalt (pathname-type pn) (pathname-type tn)) ++ )))) ++ t nil t t) ++ ++(deftest truename.5 ++ (let* ((lpn "CLTEST:foo.txt") ++ (pn (translate-logical-pathname lpn))) ++ (unless (probe-file lpn) ++ (with-open-file (s lpn :direction :output) (format s "Stuff~%"))) ++ (let ((tn (truename lpn))) ++ (values ++ (notnot (pathnamep pn)) ++ (if (equalt (pathname-name pn) (pathname-name tn)) ++ t (list (pathname-name pn) (pathname-name tn))) ++ (if (equalt (pathname-type pn) (pathname-type tn)) ++ t (list (pathname-type pn) (pathname-type tn))) ++ ))) ++ t t t) ++ ++;;; Specialized string tests ++ ++(deftest truename.6 ++ (do-special-strings ++ (s "truename.lsp" nil) ++ (assert (equalp (truename s) (truename "truename.lsp")))) ++ nil) ++ ++;;; Error tests ++ ++(deftest truename.error.1 ++ (signals-error (truename) program-error) ++ t) ++ ++(deftest truename.error.2 ++ (signals-error (truename "truename.lsp" nil) program-error) ++ t) ++ ++(deftest truename.error.3 ++ (signals-error-always (truename "nonexistent") file-error) ++ t t) ++ ++(deftest truename.error.4 ++ (signals-error-always (truename #p"nonexistent") file-error) ++ t t) ++ ++(deftest truename.error.5 ++ (signals-error-always (truename (logical-pathname "CLTESTROOT:NONEXISTENT")) file-error) ++ t t) ++ ++(deftest truename.error.6 ++ (signals-error-always ++ (let ((pn (make-pathname :name :wild ++ :defaults *default-pathname-defaults*))) ++ (truename pn)) ++ file-error) ++ t t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/two-way-stream-input-stream.lsp +@@ -0,0 +1,26 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Feb 12 04:22:50 2004 ++;;;; Contains: Tests of TWO-WAY-STREAM-INPUT-STREAM ++ ++(in-package :cl-test) ++ ++(deftest two-way-stream-input-stream.1 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (equalt (multiple-value-list (two-way-stream-input-stream s)) ++ (list is))) ++ t) ++ ++(deftest two-way-stream-input-stream.error.1 ++ (signals-error (two-way-stream-input-stream) program-error) ++ t) ++ ++(deftest two-way-stream-input-stream.error.2 ++ (signals-error (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (two-way-stream-input-stream s nil)) ++ program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/two-way-stream-output-stream.lsp +@@ -0,0 +1,26 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Feb 12 04:25:59 2004 ++;;;; Contains: Tests off TWO-WAY-STREAM-OUTPUT-STREAM ++ ++(in-package :cl-test) ++ ++(deftest two-way-stream-output-stream.1 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (equalt (multiple-value-list (two-way-stream-output-stream s)) ++ (list os))) ++ t) ++ ++(deftest two-way-stream-output-stream.error.1 ++ (signals-error (two-way-stream-output-stream) program-error) ++ t) ++ ++(deftest two-way-stream-output-stream.error.2 ++ (signals-error (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (two-way-stream-output-stream s nil)) ++ program-error) ++ t) +--- gcl-2.6.12.orig/ansi-tests/universe.lsp ++++ gcl-2.6.12/ansi-tests/universe.lsp +@@ -307,15 +307,50 @@ + #-(or GCL CMU ECL) (make-hash-table :test #'equalp) + )) + +-(defvar *pathnames* +- (list +- (make-pathname :name "foo") +- (make-pathname :name "bar") +- (make-pathname :name "foo" :type "txt") +- (make-pathname :name "bar" :type "txt") +- (make-pathname :name :wild) +- (make-pathname :name :wild :type "txt") +- )) ++(defparameter *pathnames* ++ (locally ++ (declare (optimize safety)) ++ (loop for form in '((make-pathname :name "foo") ++ (make-pathname :name "FOO" :case :common) ++ (make-pathname :name "bar") ++ (make-pathname :name "foo" :type "txt") ++ (make-pathname :name "bar" :type "txt") ++ (make-pathname :name "XYZ" :type "TXT" :case :common) ++ (make-pathname :name nil) ++ (make-pathname :name :wild) ++ (make-pathname :name nil :type "txt") ++ (make-pathname :name :wild :type "txt") ++ (make-pathname :name :wild :type "TXT" :case :common) ++ (make-pathname :name :wild :type "abc" :case :common) ++ (make-pathname :directory :wild) ++ (make-pathname :type :wild) ++ (make-pathname :version :wild) ++ (make-pathname :version :newest)) ++ append (ignore-errors (eval `(list ,form)))))) ++ ++(eval-when (:compile-toplevel :load-toplevel :execute) ++ (locally ++ (declare (optimize safety)) ++ (ignore-errors ++ (setf (logical-pathname-translations "CLTESTROOT") ++ `(("**;*.*.*" ,(make-pathname :directory '(:absolute :wild-inferiors) ++ :name :wild :type :wild))))) ++ (ignore-errors ++ (setf (logical-pathname-translations "CLTEST") ++ `(("**;*.*.*" ,(make-pathname ++ :directory (append ++ (pathname-directory ++ (truename (make-pathname))) ++ '(:wild-inferiors)) ++ :name :wild :type :wild))))) ++ )) ++ ++(defparameter *logical-pathnames* ++ (locally ++ (declare (optimize safety)) ++ (append ++ (ignore-errors (list (logical-pathname "CLTESTROOT:"))) ++ ))) + + (defvar *streams* + (remove-duplicates +--- /dev/null ++++ gcl-2.6.12/ansi-tests/unread-char.lsp +@@ -0,0 +1,92 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Jan 18 20:05:36 2004 ++;;;; Contains: Tests of UNREAD-CHAR ++ ++(in-package :cl-test) ++ ++(deftest unread-char.1 ++ (with-input-from-string ++ (*standard-input* "abc") ++ (values ++ (read-char) ++ (unread-char #\a) ++ (read-char) ++ (read-char) ++ (unread-char #\b) ++ (read-char) ++ (read-char))) ++ #\a nil #\a #\b nil #\b #\c) ++ ++(deftest unread-char.2 ++ (with-input-from-string ++ (s "abc") ++ (values ++ (read-char s) ++ (unread-char #\a s) ++ (read-char s) ++ (read-char s) ++ (unread-char #\b s) ++ (read-char s) ++ (read-char s))) ++ #\a nil #\a #\b nil #\b #\c) ++ ++(deftest unread-char.3 ++ (with-input-from-string ++ (is "abc") ++ (with-output-to-string ++ (os) ++ (let ((s (make-echo-stream is os))) ++ (read-char s) ++ (unread-char #\a s) ++ (read-char s) ++ (read-char s) ++ (read-char s) ++ (unread-char #\c s) ++ (read-char s)))) ++ "abc") ++ ++(deftest unread-char.4 ++ (with-input-from-string ++ (*standard-input* "abc") ++ (values ++ (read-char) ++ (unread-char #\a nil) ++ (read-char) ++ (read-char) ++ (unread-char #\b nil) ++ (read-char) ++ (read-char))) ++ #\a nil #\a #\b nil #\b #\c) ++ ++(deftest unread-char.5 ++ (with-input-from-string ++ (is "abc") ++ (let ((*terminal-io* (make-two-way-stream ++ is (make-string-output-stream)))) ++ (values ++ (read-char t) ++ (unread-char #\a t) ++ (read-char t) ++ (read-char t) ++ (unread-char #\b t) ++ (read-char t) ++ (read-char t)))) ++ #\a nil #\a #\b nil #\b #\c) ++ ++;;; Error tests ++ ++(deftest unread-char.error.1 ++ (signals-error (unread-char) program-error) ++ t) ++ ++(deftest unread-char.error.2 ++ (signals-error ++ (with-input-from-string ++ (s "abc") ++ (read-char s) ++ (unread-char #\a s nil)) ++ program-error) ++ t) ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/wild-pathname-p.lsp +@@ -0,0 +1,234 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Wed Dec 31 16:54:55 2003 ++;;;; Contains: Tests of WILD-PATHNAME-P ++ ++(in-package :cl-test) ++ ++(compile-and-load "pathnames-aux.lsp") ++ ++(deftest wild-pathname-p.1 ++ (wild-pathname-p (make-pathname)) ++ nil) ++ ++(deftest wild-pathname-p.2 ++ (loop for key in '(:host :device :directory :name :type :version nil) ++ when (wild-pathname-p (make-pathname) key) ++ collect key) ++ nil) ++ ++(deftest wild-pathname-p.3 ++ (let ((p (make-pathname :directory :wild))) ++ (notnot-mv (wild-pathname-p p))) ++ t) ++ ++(deftest wild-pathname-p.4 ++ (let ((p (make-pathname :directory :wild))) ++ (notnot-mv (wild-pathname-p p nil))) ++ t) ++ ++(deftest wild-pathname-p.5 ++ (let ((p (make-pathname :directory :wild))) ++ (notnot-mv (wild-pathname-p p :directory))) ++ t) ++ ++(deftest wild-pathname-p.6 ++ (let ((p (make-pathname :directory :wild))) ++ (loop for key in '(:host :device :name :type :version) ++ when (wild-pathname-p p key) ++ collect key)) ++ nil) ++ ++ ++(deftest wild-pathname-p.7 ++ (let ((p (make-pathname :directory '(:absolute :wild)))) ++ (notnot-mv (wild-pathname-p p))) ++ t) ++ ++(deftest wild-pathname-p.8 ++ (let ((p (make-pathname :directory '(:absolute :wild)))) ++ (notnot-mv (wild-pathname-p p nil))) ++ t) ++ ++(deftest wild-pathname-p.9 ++ (let ((p (make-pathname :directory '(:absolute :wild)))) ++ (notnot-mv (wild-pathname-p p :directory))) ++ t) ++ ++(deftest wild-pathname-p.10 ++ (let ((p (make-pathname :directory '(:absolute :wild)))) ++ (loop for key in '(:host :device :name :type :version) ++ when (wild-pathname-p p key) ++ collect key)) ++ nil) ++ ++ ++(deftest wild-pathname-p.11 ++ (let ((p (make-pathname :directory '(:relative :wild)))) ++ (notnot-mv (wild-pathname-p p))) ++ t) ++ ++(deftest wild-pathname-p.12 ++ (let ((p (make-pathname :directory '(:relative :wild)))) ++ (notnot-mv (wild-pathname-p p nil))) ++ t) ++ ++(deftest wild-pathname-p.13 ++ (let ((p (make-pathname :directory '(:relative :wild)))) ++ (notnot-mv (wild-pathname-p p :directory))) ++ t) ++ ++(deftest wild-pathname-p.14 ++ (let ((p (make-pathname :directory '(:relative :wild)))) ++ (loop for key in '(:host :device :name :type :version) ++ when (wild-pathname-p p key) ++ collect key)) ++ nil) ++ ++;;; ++ ++(deftest wild-pathname-p.15 ++ (let ((p (make-pathname :name :wild))) ++ (notnot-mv (wild-pathname-p p))) ++ t) ++ ++(deftest wild-pathname-p.16 ++ (let ((p (make-pathname :name :wild))) ++ (notnot-mv (wild-pathname-p p nil))) ++ t) ++ ++(deftest wild-pathname-p.17 ++ (let ((p (make-pathname :name :wild))) ++ (notnot-mv (wild-pathname-p p :name))) ++ t) ++ ++(deftest wild-pathname-p.18 ++ (let ((p (make-pathname :name :wild))) ++ (loop for key in '(:host :device :directory :type :version) ++ when (wild-pathname-p p key) ++ collect key)) ++ nil) ++ ++;;; ++ ++(deftest wild-pathname-p.19 ++ (let ((p (make-pathname :type :wild))) ++ (notnot-mv (wild-pathname-p p))) ++ t) ++ ++(deftest wild-pathname-p.20 ++ (let ((p (make-pathname :type :wild))) ++ (notnot-mv (wild-pathname-p p nil))) ++ t) ++ ++(deftest wild-pathname-p.21 ++ (let ((p (make-pathname :type :wild))) ++ (notnot-mv (wild-pathname-p p :type))) ++ t) ++ ++(deftest wild-pathname-p.22 ++ (let ((p (make-pathname :type :wild))) ++ (loop for key in '(:host :device :directory :name :version) ++ when (wild-pathname-p p key) ++ collect key)) ++ nil) ++ ++;;; ++ ++ (deftest wild-pathname-p.23 ++ (let ((p (make-pathname :version :wild))) ++ (notnot-mv (wild-pathname-p p))) ++ t) ++ ++(deftest wild-pathname-p.24 ++ (let ((p (make-pathname :version :wild))) ++ (notnot-mv (wild-pathname-p p nil))) ++ t) ++ ++(deftest wild-pathname-p.25 ++ (let ((p (make-pathname :version :wild))) ++ (notnot-mv (wild-pathname-p p :version))) ++ t) ++ ++(deftest wild-pathname-p.26 ++ (let ((p (make-pathname :version :wild))) ++ (loop for key in '(:host :device :directory :name :type) ++ when (wild-pathname-p p key) ++ collect key)) ++ nil) ++ ++;;; ++ ++(deftest wild-pathname-p.27 ++ (loop for p in (append *pathnames* *logical-pathnames*) ++ unless (if (wild-pathname-p p) (wild-pathname-p p nil) ++ (not (wild-pathname-p p nil))) ++ collect p) ++ nil) ++ ++(deftest wild-pathname-p.28 ++ (loop for p in (append *pathnames* *logical-pathnames*) ++ when (and (loop for key in '(:host :device :directory ++ :name :type :version) ++ thereis (wild-pathname-p p key)) ++ (not (wild-pathname-p p))) ++ collect p) ++ nil) ++ ++;;; On streams associated with files ++ ++(deftest wild-pathname-p.29 ++ (with-open-file (s "foo.lsp" ++ :direction :output ++ :if-exists :append ++ :if-does-not-exist :create) ++ (wild-pathname-p s)) ++ nil) ++ ++(deftest wild-pathname-p.30 ++ (let ((s (open "foo.lsp" ++ :direction :output ++ :if-exists :append ++ :if-does-not-exist :create))) ++ (close s) ++ (wild-pathname-p s)) ++ nil) ++ ++;;; logical pathname designators ++ ++(deftest wild-pathname-p.31 ++ (wild-pathname-p "CLTEST:FOO.LISP") ++ nil) ++ ++;;; Odd strings ++ ++(deftest wild-pathname-p.32 ++ (do-special-strings ++ (s "CLTEST:FOO.LISP" nil) ++ (let ((vals (multiple-value-list (wild-pathname-p s)))) ++ (assert (equal vals '(nil))))) ++ nil) ++ ++;;; ++ ++(deftest wild-pathname-p.error.1 ++ (signals-error (wild-pathname-p) program-error) ++ t) ++ ++(deftest wild-pathname-p.error.2 ++ (signals-error (wild-pathname-p *default-pathname-defaults* nil nil) ++ program-error) ++ t) ++ ++(deftest wild-pathname-p.error.3 ++ (check-type-error #'wild-pathname-p ++ (typef '(or pathname string file-stream ++ synonym-stream))) ++ nil) ++ ++(deftest wild-pathname-p.error.4 ++ (check-type-error #'(lambda (x) (declare (optimize (safety 0))) ++ (wild-pathname-p x)) ++ (typef '(or pathname string file-stream ++ synonym-stream))) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/with-input-from-string.lsp +@@ -0,0 +1,245 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Feb 14 20:13:02 2004 ++;;;; Contains: Tests of WITH-INPUT-FROM-STRING ++ ++(in-package :cl-test) ++ ++(deftest with-input-from-string.1 ++ (with-input-from-string ++ (s "abc") ++ (values (read-char s) (read-char s) (read-char s) (read-char s nil :eof))) ++ #\a #\b #\c :eof) ++ ++(deftest with-input-from-string.2 ++ (with-input-from-string (s "abc")) ++ nil) ++ ++(deftest with-input-from-string.3 ++ (with-input-from-string (s "abc") (declare (optimize speed))) ++ nil) ++ ++(deftest with-input-from-string.3a ++ (with-input-from-string (s "abc") ++ (declare (optimize speed)) ++ (declare (optimize space))) ++ nil) ++ ++(deftest with-input-from-string.4 ++ (with-input-from-string ++ (s "abc") ++ (declare (optimize safety)) ++ (read-char s) ++ (read-char s)) ++ #\b) ++ ++(deftest with-input-from-string.5 ++ (let ((i nil)) ++ (values ++ (with-input-from-string ++ (s "abc" :index i)) ++ i)) ++ nil 0) ++ ++(deftest with-input-from-string.6 ++ (let ((i (list nil))) ++ (values ++ (with-input-from-string ++ (s "abc" :index (car i))) ++ i)) ++ nil (0)) ++ ++(deftest with-input-from-string.7 ++ (let ((i nil)) ++ (values ++ (with-input-from-string ++ (s "abc" :index i) ++ (list i (read-char s) i (read-char s) i)) ++ i)) ++ (nil #\a nil #\b nil) 2) ++ ++(deftest with-input-from-string.9 ++ (with-input-from-string ++ (s "abc") ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (notnot (open-stream-p s)) ++ (notnot (input-stream-p s)) ++ (output-stream-p s))) ++ t t t t nil) ++ ++(deftest with-input-from-string.10 ++ :notes (:nil-vectors-are-strings) ++ (with-input-from-string ++ (s (make-array 0 :element-type nil)) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (notnot (open-stream-p s)) ++ (notnot (input-stream-p s)) ++ (output-stream-p s))) ++ t t t t nil) ++ ++(deftest with-input-from-string.11 ++ (with-input-from-string ++ (s (make-array 3 :element-type 'character :initial-contents "abc")) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (notnot (open-stream-p s)) ++ (notnot (input-stream-p s)) ++ (output-stream-p s) ++ (read-line s))) ++ t t t t nil "abc") ++ ++(deftest with-input-from-string.12 ++ (with-input-from-string ++ (s (make-array 3 :element-type 'base-char :initial-contents "abc")) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (notnot (open-stream-p s)) ++ (notnot (input-stream-p s)) ++ (output-stream-p s) ++ (read-line s))) ++ t t t t nil "abc") ++ ++(deftest with-input-from-string.13 ++ (with-input-from-string ++ (s "abcdef" :start 2) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (notnot (open-stream-p s)) ++ (notnot (input-stream-p s)) ++ (output-stream-p s) ++ (read-line s))) ++ t t t t nil "cdef") ++ ++(deftest with-input-from-string.14 ++ (with-input-from-string ++ (s "abcdef" :end 3) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (notnot (open-stream-p s)) ++ (notnot (input-stream-p s)) ++ (output-stream-p s) ++ (read-line s))) ++ t t t t nil "abc") ++ ++(deftest with-input-from-string.15 ++ (with-input-from-string ++ (s "abcdef" :start 1 :end 5) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (notnot (open-stream-p s)) ++ (notnot (input-stream-p s)) ++ (output-stream-p s) ++ (read-line s))) ++ t t t t nil "bcde") ++ ++(deftest with-input-from-string.16 ++ (with-input-from-string ++ (s "abcdef" :start 1 :end nil) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (notnot (open-stream-p s)) ++ (notnot (input-stream-p s)) ++ (output-stream-p s) ++ (read-line s))) ++ t t t t nil "bcdef") ++ ++(deftest with-input-from-string.17 ++ (let ((i 2)) ++ (values ++ (with-input-from-string ++ (s "abcdef" :index i :start i) ++ (read-char s)) ++ i)) ++ #\c 3) ++ ++;;; Test that there is no implicit tagbody ++ ++(deftest with-input-from-string.18 ++ (block done ++ (tagbody ++ (with-input-from-string ++ (s "abc") ++ (go 1) ++ 1 ++ (return-from done :bad)) ++ 1 ++ (return-from done :good))) ++ :good) ++ ++;;; Free declaration scope ++ ++(deftest with-input-from-string.19 ++ (block done ++ (let ((x :bad)) ++ (declare (special x)) ++ (let ((x :good)) ++ (with-input-from-string (s (return-from done x)) ++ (declare (special x)))))) ++ :good) ++ ++(deftest with-input-from-string.20 ++ (block done ++ (let ((x :bad)) ++ (declare (special x)) ++ (let ((x :good)) ++ (with-input-from-string (s "abc" :start (return-from done x)) ++ (declare (special x)))))) ++ :good) ++ ++(deftest with-input-from-string.21 ++ (block done ++ (let ((x :bad)) ++ (declare (special x)) ++ (let ((x :good)) ++ (with-input-from-string (s "abc" :end (return-from done x)) ++ (declare (special x)))))) ++ :good) ++ ++;;; index is not updated if the form exits abnormally ++ ++(deftest with-input-from-string.22 ++ (let ((i nil)) ++ (values ++ (block done ++ (with-input-from-string (s "abcde" :index i) (return-from done (read-char s)))) ++ i)) ++ #\a nil) ++ ++;;; Test that explicit calls to macroexpand in subforms ++;;; are done in the correct environment ++ ++(deftest with-input-from-string.23 ++ (macrolet ++ ((%m (z) z)) ++ (with-input-from-string (s (expand-in-current-env (%m "123"))) ++ (read-char s))) ++ #\1) ++ ++(deftest with-input-from-string.24 ++ (macrolet ++ ((%m (z) z)) ++ (with-input-from-string (s "123" :start (expand-in-current-env (%m 1))) ++ (read-char s))) ++ #\2) ++ ++(deftest with-input-from-string.25 ++ (macrolet ++ ((%m (z) z)) ++ (with-input-from-string (s "123" :start 0 ++ :end (expand-in-current-env (%m 0))) ++ (read-char s nil nil))) ++ nil) ++ ++ ++;;; FIXME: Add more tests on specialized strings. ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/with-open-file.lsp +@@ -0,0 +1,98 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 27 20:57:05 2004 ++;;;; Contains: Tests of WITH-OPEN-FILE ++ ++(in-package :cl-test) ++ ++;;; For now, omit most of the options combinations, assuming they will ++;;; be tested in OPEN. The tests of OPEN should be ported to here at some ++;;; point. ++ ++(deftest with-open-file.1 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (with-open-file (s pn :direction :output))) ++ nil) ++ ++(deftest with-open-file.2 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (with-open-file ++ (s pn :direction :output) ++ (notnot-mv (output-stream-p s)))) ++ t) ++ ++(deftest with-open-file.3 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (with-open-file ++ (s pn :direction :output) ++ (values)))) ++ ++(deftest with-open-file.4 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (with-open-file ++ (s pn :direction :output) ++ (values 1 2 3 4 5 6 7 8))) ++ 1 2 3 4 5 6 7 8) ++ ++(deftest with-open-file.5 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (with-open-file ++ (s pn :direction :output) ++ (declare (ignore s)) ++ (declare (optimize)))) ++ nil) ++ ++(deftest with-open-file.6 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (with-open-file ++ (s pn (cdr '(nil . :direction)) (car '(:output))) ++ (format s "foo!~%")) ++ (with-open-file (s pn) (read-line s))) ++ "foo!" nil) ++ ++;;; Free declaration scope tests ++ ++(deftest with-open-file.7 ++ (block done ++ (let ((x :bad)) ++ (declare (special x)) ++ (let ((x :good)) ++ (with-open-file (s (return-from done x)) ++ (declare (special x)))))) ++ :good) ++ ++(deftest with-open-file.8 ++ (block done ++ (let ((x :bad)) ++ (declare (special x)) ++ (let ((x :good)) ++ (with-open-file (s "with-open-file.lsp" (return-from done x) :input) ++ (declare (special x)))))) ++ :good) ++ ++(deftest with-open-file.9 ++ (block done ++ (let ((x :bad)) ++ (declare (special x)) ++ (let ((x :good)) ++ (with-open-file (s "with-open-file.lsp" :direction (return-from done x)) ++ (declare (special x)))))) ++ :good) ++ ++;;; Test that explicit calls to macroexpand in subforms ++;;; are done in the correct environment ++ ++(deftest with-open-file.10 ++ (macrolet ++ ((%m (z) z)) ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (with-open-file (s (expand-in-current-env (%m pn)) ++ :direction :output)))) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/with-open-stream.lsp +@@ -0,0 +1,77 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Mon Dec 13 01:42:59 2004 ++;;;; Contains: Tests of WITH-OPEN-STREAM ++ ++(in-package :cl-test) ++ ++(deftest with-open-stream.1 ++ (with-open-stream (os (make-string-output-stream))) ++ nil) ++ ++(deftest with-open-stream.2 ++ (with-open-stream (os (make-string-output-stream)) ++ (declare (ignore os))) ++ nil) ++ ++(deftest with-open-stream.3 ++ (with-open-stream (os (make-string-output-stream)) ++ (declare (ignore os)) ++ (declare (type string-stream os))) ++ nil) ++ ++(deftest with-open-stream.4 ++ (with-open-stream (os (make-string-output-stream)) ++ (declare (ignore os)) ++ (values))) ++ ++(deftest with-open-stream.5 ++ (with-open-stream (os (make-string-output-stream)) ++ (declare (ignore os)) ++ (values 'a 'b)) ++ a b) ++ ++(deftest with-open-stream.6 ++ (let ((s (make-string-output-stream))) ++ (values ++ (with-open-stream (os s)) ++ (notnot (typep s 'string-stream)) ++ (open-stream-p s))) ++ nil t nil) ++ ++(deftest with-open-stream.7 ++ (let ((s (make-string-input-stream "123"))) ++ (values ++ (with-open-stream (is s) (read-char s)) ++ (notnot (typep s 'string-stream)) ++ (open-stream-p s))) ++ #\1 t nil) ++ ++(deftest with-open-stream.8 ++ (let ((s (make-string-output-stream))) ++ (values ++ (block done ++ (with-open-stream (os s) (return-from done nil))) ++ (notnot (typep s 'string-stream)) ++ (open-stream-p s))) ++ nil t nil) ++ ++(deftest with-open-stream.9 ++ (let ((s (make-string-output-stream))) ++ (values ++ (catch 'done ++ (with-open-stream (os s) (throw 'done nil))) ++ (notnot (typep s 'string-stream)) ++ (open-stream-p s))) ++ nil t nil) ++ ++;;; Free declaration scope ++ ++(deftest with-open-stream.10 ++ (block done ++ (let ((x :bad)) ++ (declare (special x)) ++ (let ((x :good)) ++ (with-open-stream (s (return-from done x)) ++ (declare (special x)))))) ++ :good) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/with-output-to-string.lsp +@@ -0,0 +1,129 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Feb 14 20:33:51 2004 ++;;;; Contains: Tests of WITH-OUTPUT-TO-STRING ++ ++(in-package :cl-test) ++ ++ ++(deftest with-output-to-string.1 ++ (with-output-to-string (s)) ++ "") ++ ++(deftest with-output-to-string.2 ++ (with-output-to-string (s) (write-char #\3 s)) ++ "3") ++ ++(deftest with-output-to-string.3 ++ (with-output-to-string (s (make-array 10 :fill-pointer 0 ++ :element-type 'character))) ++ nil) ++ ++(deftest with-output-to-string.4 ++ :notes (:allow-nil-arrays :nil-vectors-are-strings) ++ (let ((str (make-array 10 :fill-pointer 0 :element-type 'character))) ++ (values ++ (with-output-to-string ++ (s str :element-type nil) ++ (write-string "abcdef" s)) ++ str)) ++ "abcdef" "abcdef") ++ ++(deftest with-output-to-string.5 ++ (with-output-to-string (s (make-array 10 :fill-pointer 0 ++ :element-type 'character)) ++ (values))) ++ ++(deftest with-output-to-string.6 ++ (with-output-to-string (s (make-array 10 :fill-pointer 0 ++ :element-type 'character)) ++ (values 'a 'b 'c 'd)) ++ a b c d) ++ ++(deftest with-output-to-string.7 ++ (with-output-to-string (s nil :element-type 'character) ++ (write-char #\& s)) ++ "&") ++ ++(deftest with-output-to-string.8 ++ (let ((str (with-output-to-string (s nil :element-type 'base-char) ++ (write-char #\8 s)))) ++ (assert (typep str 'simple-base-string)) ++ str) ++ "8") ++ ++(deftest with-output-to-string.9 ++ :notes (:allow-nil-arrays :nil-vectors-are-strings) ++ (with-output-to-string (s nil :element-type nil)) ++ "") ++ ++(deftest with-output-to-string.10 ++ (let* ((s1 (make-array 20 :element-type 'character ++ :initial-element #\.)) ++ (s2 (make-array 10 :element-type 'character ++ :displaced-to s1 ++ :displaced-index-offset 5 ++ :fill-pointer 0))) ++ ++ (values ++ (with-output-to-string ++ (s s2) ++ (write-string "0123456789" s)) ++ s1 ++ s2)) ++ "0123456789" ++ ".....0123456789....." ++ "0123456789") ++ ++(deftest with-output-to-string.11 ++ (with-output-to-string (s) (declare (optimize safety))) ++ "") ++ ++(deftest with-output-to-string.12 ++ (with-output-to-string (s) (declare (optimize safety)) ++ (declare (optimize (speed 0)))) ++ "") ++ ++(deftest with-output-to-string.13 ++ (with-output-to-string ++ (s) ++ (write-char #\0 s) ++ (write-char #\4 s) ++ (write-char #\9 s)) ++ "049") ++ ++(deftest with-output-to-string.14 ++ (let* ((str1 (make-array '(256) :element-type 'base-char :fill-pointer 0)) ++ (str2 (with-output-to-string ++ (s nil :element-type 'base-char) ++ (loop for i below 256 ++ for c = (code-char i) ++ when (typep c 'base-char) ++ do (progn (write-char c s) ++ (vector-push c str1)))))) ++ (if (string= str1 str2) :good ++ (list str1 str2))) ++ :good) ++ ++;;; Free declaration scope ++ ++(deftest with-output-to-string.15 ++ (block done ++ (let ((x :bad)) ++ (declare (special x)) ++ (let ((x :good)) ++ (with-output-to-string (s (return-from done x)) ++ (declare (special x)))))) ++ :good) ++ ++(deftest with-output-to-string.16 ++ (block done ++ (let ((x :bad)) ++ (declare (special x)) ++ (let ((x :good) ++ (str (make-array '(10) :element-type 'character ++ :fill-pointer 0))) ++ (with-output-to-string (s str :element-type (return-from done x)) ++ (declare (special x)))))) ++ :good) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/write-char.lsp +@@ -0,0 +1,51 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Jan 18 20:50:31 2004 ++;;;; Contains: Tests of WRITE-CHAR ++ ++(in-package :cl-test) ++ ++(deftest write-char.1 ++ (loop for i from 0 to 255 ++ for c = (code-char i) ++ when c ++ unless (string= (with-output-to-string ++ (*standard-output*) ++ (write-char c)) ++ (string c)) ++ collect c) ++ nil) ++ ++(deftest write-char.2 ++ (with-input-from-string ++ (is "abcd") ++ (with-output-to-string ++ (os) ++ (let ((*terminal-io* (make-two-way-stream is os))) ++ (write-char #\$ t) ++ (close *terminal-io*)))) ++ "$") ++ ++(deftest write-char.3 ++ (with-output-to-string ++ (*standard-output*) ++ (write-char #\: nil)) ++ ":") ++ ++;;; Error tests ++ ++(deftest write-char.error.1 ++ (signals-error (write-char) program-error) ++ t) ++ ++(deftest write-char.error.2 ++ (signals-error ++ (with-output-to-string ++ (s) ++ (write-char #\a s nil)) ++ program-error) ++ t) ++ ++;;; More tests in other files ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/write-line.lsp +@@ -0,0 +1,165 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Mon Jan 19 06:49:26 2004 ++;;;; Contains: Tests of WRITE-LINE ++ ++(in-package :cl-test) ++ ++(deftest write-line.1 ++ (let (result) ++ (values ++ (with-output-to-string ++ (*standard-output*) ++ (setq result (multiple-value-list (write-line "")))) ++ result)) ++ #.(string #\Newline) ++ ("")) ++ ++(deftest write-line.2 ++ :notes (:nil-vectors-are-strings) ++ (let (result) ++ (values ++ (with-output-to-string ++ (*standard-output*) ++ (setq result ++ (multiple-value-list ++ (write-line (make-array '(0) :element-type nil))))) ++ result)) ++ #.(string #\Newline) ++ ("")) ++ ++(deftest write-line.3 ++ (let (result) ++ (values ++ (with-output-to-string ++ (*standard-output*) ++ (setq result (multiple-value-list (write-line "abcde")))) ++ result)) ++ #.(concatenate 'string "abcde" (string #\Newline)) ++ ("abcde")) ++ ++(deftest write-line.4 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list (write-line "abcde" s :start 1)))) ++ result)) ++ #.(concatenate 'string "bcde" (string #\Newline)) ++ ("abcde")) ++ ++(deftest write-line.5 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list ++ (write-line "abcde" s :start 1 :end 3)))) ++ result)) ++ #.(concatenate 'string "bc" (string #\Newline)) ++ ("abcde")) ++ ++(deftest write-line.6 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list ++ (write-line "abcde" s :start 1 :end nil)))) ++ result)) ++ #.(concatenate 'string "bcde" (string #\Newline)) ++ ("abcde")) ++ ++(deftest write-line.7 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list (write-line "abcde" s :end 3)))) ++ result)) ++ #.(concatenate 'string "abc" (string #\Newline)) ++ ("abcde")) ++ ++(deftest write-line.8 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list ++ (write-line "abcde" s :end 3 :allow-other-keys nil)))) ++ result)) ++ #.(concatenate 'string "abc" (string #\Newline)) ++ ("abcde")) ++ ++(deftest write-line.9 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result ++ (multiple-value-list ++ (write-line "abcde" s :end 3 :allow-other-keys t :foo 'bar)))) ++ result)) ++ #.(concatenate 'string "abc" (string #\Newline)) ++ ("abcde")) ++ ++(deftest write-line.10 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list ++ (write-line "abcde" s :end 3 :end 2)))) ++ result)) ++ #.(concatenate 'string "abc" (string #\Newline)) ++ ("abcde")) ++ ++(deftest write-line.11 ++ (with-input-from-string ++ (is "abcd") ++ (with-output-to-string ++ (os) ++ (let ((*terminal-io* (make-two-way-stream is os))) ++ (write-line "951" t) ++ (close *terminal-io*)))) ++ #.(concatenate 'string "951" (string #\Newline))) ++ ++(deftest write-line.12 ++ (with-output-to-string ++ (*standard-output*) ++ (write-line "-=|!" nil)) ++ #.(concatenate 'string "-=|!" (string #\Newline))) ++ ++;;; Specialized string tests ++ ++(deftest write-line.13 ++ (do-special-strings ++ (s "abcde" nil) ++ (assert (equal ++ (with-output-to-string ++ (*standard-output*) ++ (multiple-value-list (write-line "abcde"))) ++ #.(concatenate 'string "abcde" (string #\Newline))))) ++ nil) ++ ++;;; Error tests ++ ++(deftest write-line.error.1 ++ (signals-error (write-line) program-error) ++ t) ++ ++(deftest write-line.error.2 ++ (signals-error (write-line "" *standard-output* :start) program-error) ++ t) ++ ++(deftest write-line.error.3 ++ (signals-error (write-line "" *standard-output* :foo nil) program-error) ++ t) ++ ++(deftest write-line.error.4 ++ (signals-error (write-line "" *standard-output* ++ :allow-other-keys nil ++ :foo nil) ++ program-error) ++ t) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/write-sequence.lsp +@@ -0,0 +1,225 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Wed Jan 21 04:07:58 2004 ++;;;; Contains: Tests of WRITE-SEQUENCE ++ ++(in-package :cl-test) ++ ++(defmacro def-write-sequence-test (name input args &rest expected) ++ `(deftest ,name ++ (let ((s ,input)) ++ (with-output-to-string ++ (os) ++ (assert (eq (write-sequence s os ,@args) s)))) ++ ,@expected)) ++ ++;;; on strings ++ ++(def-write-sequence-test write-sequence.string.1 "abcde" () "abcde") ++(def-write-sequence-test write-sequence.string.2 "abcde" (:start 1) "bcde") ++(def-write-sequence-test write-sequence.string.3 "abcde" (:end 3) "abc") ++(def-write-sequence-test write-sequence.string.4 "abcde" ++ (:start 1 :end 4) "bcd") ++(def-write-sequence-test write-sequence.string.5 "abcde" (:end nil) "abcde") ++(def-write-sequence-test write-sequence.string.6 "abcde" (:start 3 :end 3) "") ++(def-write-sequence-test write-sequence.string.7 "abcde" ++ (:end nil :start 1) "bcde") ++(def-write-sequence-test write-sequence.string.8 "abcde" ++ (:allow-other-keys nil) "abcde") ++(def-write-sequence-test write-sequence.string.9 "abcde" ++ (:allow-other-keys t :foo nil) "abcde") ++(def-write-sequence-test write-sequence.string.10 "abcde" ++ (:allow-other-keys t :allow-other-keys nil :foo nil) "abcde") ++(def-write-sequence-test write-sequence.string.11 "abcde" ++ (:bar 'x :allow-other-keys t) "abcde") ++(def-write-sequence-test write-sequence.string.12 "abcde" ++ (:start 1 :end 4 :start 2 :end 3) "bcd") ++(def-write-sequence-test write-sequence.string.13 "" () "") ++ ++(defmacro def-write-sequence-special-test (name string args expected) ++ `(deftest ,name ++ (let ((str ,string) ++ (expected ,expected)) ++ (do-special-strings ++ (s str nil) ++ (let ((out (with-output-to-string ++ (os) ++ (assert (eq (write-sequence s os ,@args) s))))) ++ (assert (equal out expected))))) ++ nil)) ++ ++(def-write-sequence-special-test write-sequence.string.14 "12345" () "12345") ++(def-write-sequence-special-test write-sequence.string.15 "12345" (:start 1 :end 3) "23") ++ ++;;; on lists ++ ++(def-write-sequence-test write-sequence.list.1 (coerce "abcde" 'list) ++ () "abcde") ++(def-write-sequence-test write-sequence.list.2 (coerce "abcde" 'list) ++ (:start 1) "bcde") ++(def-write-sequence-test write-sequence.list.3 (coerce "abcde" 'list) ++ (:end 3) "abc") ++(def-write-sequence-test write-sequence.list.4 (coerce "abcde" 'list) ++ (:start 1 :end 4) "bcd") ++(def-write-sequence-test write-sequence.list.5 (coerce "abcde" 'list) ++ (:end nil) "abcde") ++(def-write-sequence-test write-sequence.list.6 (coerce "abcde" 'list) ++ (:start 3 :end 3) "") ++(def-write-sequence-test write-sequence.list.7 (coerce "abcde" 'list) ++ (:end nil :start 1) "bcde") ++(def-write-sequence-test write-sequence.list.8 () () "") ++ ++ ++;;; on vectors ++ ++(def-write-sequence-test write-sequence.simple-vector.1 ++ (coerce "abcde" 'simple-vector) () "abcde") ++(def-write-sequence-test write-sequence.simple-vector.2 ++ (coerce "abcde" 'simple-vector) (:start 1) "bcde") ++(def-write-sequence-test write-sequence.simple-vector.3 ++ (coerce "abcde" 'simple-vector) (:end 3) "abc") ++(def-write-sequence-test write-sequence.simple-vector.4 ++ (coerce "abcde" 'simple-vector) (:start 1 :end 4) "bcd") ++(def-write-sequence-test write-sequence.simple-vector.5 ++ (coerce "abcde" 'simple-vector) (:end nil) "abcde") ++(def-write-sequence-test write-sequence.simple-vector.6 ++ (coerce "abcde" 'simple-vector) (:start 3 :end 3) "") ++(def-write-sequence-test write-sequence.simple-vector.7 ++ (coerce "abcde" 'simple-vector) (:end nil :start 1) "bcde") ++(def-write-sequence-test write-sequence.simple-vector.8 #() () "") ++ ++;;; on vectors with fill pointers ++ ++(def-write-sequence-test write-sequence.fill-vector.1 ++ (make-array 10 :initial-contents "abcde " :fill-pointer 5) () "abcde") ++(def-write-sequence-test write-sequence.fill-vector.2 ++ (make-array 10 :initial-contents "abcde " :fill-pointer 5) ++ (:start 1) "bcde") ++(def-write-sequence-test write-sequence.fill-vector.3 ++ (make-array 10 :initial-contents "abcde " :fill-pointer 5) ++ (:end 3) "abc") ++(def-write-sequence-test write-sequence.fill-vector.4 ++ (make-array 10 :initial-contents "abcde " :fill-pointer 5) ++ (:start 1 :end 4) "bcd") ++(def-write-sequence-test write-sequence.fill-vector.5 ++ (make-array 10 :initial-contents "abcde " :fill-pointer 5) ++ (:end nil) "abcde") ++(def-write-sequence-test write-sequence.fill-vector.6 ++ (make-array 10 :initial-contents "abcde " :fill-pointer 5) ++ (:start 3 :end 3) "") ++(def-write-sequence-test write-sequence.fill-vector.7 ++ (make-array 10 :initial-contents "abcde " :fill-pointer 5) ++ (:end nil :start 1) "bcde") ++ ++;;; on bit vectors ++ ++(defmacro def-write-sequence-bv-test (name input args expected) ++ `(deftest ,name ++ (let ((s ,input) ++ (expected ,expected)) ++ (with-open-file ++ (os "tmp.dat" :direction :output ++ :element-type '(unsigned-byte 8) ++ :if-exists :supersede) ++ (assert (eq (write-sequence s os ,@args) s))) ++ (with-open-file ++ (is "tmp.dat" :direction :input ++ :element-type '(unsigned-byte 8)) ++ (loop for i from 0 below (length expected) ++ for e = (elt expected i) ++ always (eql (read-byte is) e)))) ++ t)) ++ ++(def-write-sequence-bv-test write-sequence.bv.1 #*00111010 ++ () #*00111010) ++(def-write-sequence-bv-test write-sequence.bv.2 #*00111010 ++ (:start 1) #*0111010) ++(def-write-sequence-bv-test write-sequence.bv.3 #*00111010 ++ (:end 5) #*00111) ++(def-write-sequence-bv-test write-sequence.bv.4 #*00111010 ++ (:start 1 :end 6) #*01110) ++(def-write-sequence-bv-test write-sequence.bv.5 #*00111010 ++ (:start 1 :end nil) #*0111010) ++(def-write-sequence-bv-test write-sequence.bv.6 #*00111010 ++ (:start 1 :end nil :end 4) #*0111010) ++ ++ ++;;; Error tests ++ ++(deftest write-sequence.error.1 ++ (signals-error (write-sequence) program-error) ++ t) ++ ++(deftest write-sequence.error.2 ++ (signals-error (write-sequence "abcde") program-error) ++ t) ++ ++(deftest write-sequence.error.3 ++ (signals-error (write-sequence '(#\a . #\b) *standard-output*) type-error) ++ t) ++ ++(deftest write-sequence.error.4 ++ (signals-error (write-sequence #\a *standard-output*) type-error) ++ t) ++ ++(deftest write-sequence.error.5 ++ (signals-error (write-sequence "ABC" *standard-output* :start -1) type-error) ++ t) ++ ++(deftest write-sequence.error.6 ++ (signals-error (write-sequence "ABC" *standard-output* :start 'x) type-error) ++ t) ++ ++(deftest write-sequence.error.7 ++ (signals-error (write-sequence "ABC" *standard-output* :start 0.0) ++ type-error) ++ t) ++ ++(deftest write-sequence.error.8 ++ (signals-error (write-sequence "ABC" *standard-output* :end -1) ++ type-error) ++ t) ++ ++(deftest write-sequence.error.9 ++ (signals-error (write-sequence "ABC" *standard-output* :end 'x) ++ type-error) ++ t) ++ ++(deftest write-sequence.error.10 ++ (signals-error (write-sequence "ABC" *standard-output* :end 2.0) ++ type-error) ++ t) ++ ++(deftest write-sequence.error.11 ++ (signals-error (write-sequence "abcde" *standard-output* ++ :foo nil) program-error) ++ t) ++ ++(deftest write-sequence.error.12 ++ (signals-error (write-sequence "abcde" *standard-output* ++ :allow-other-keys nil :foo t) ++ program-error) ++ t) ++ ++(deftest write-sequence.error.13 ++ (signals-error (write-sequence "abcde" *standard-output* :start) ++ program-error) ++ t) ++ ++(deftest write-sequence.error.14 ++ (check-type-error #'(lambda (x) (write-sequence x *standard-output*)) ++ #'sequencep) ++ nil) ++ ++(deftest write-sequence.error.15 ++ (check-type-error #'(lambda (x) (write-sequence "abcde" *standard-output* ++ :start x)) ++ (typef 'unsigned-byte)) ++ nil) ++ ++(deftest write-sequence.error.16 ++ (check-type-error #'(lambda (x) (write-sequence "abcde" *standard-output* ++ :end x)) ++ (typef '(or null unsigned-byte))) ++ nil) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/write-string.lsp +@@ -0,0 +1,156 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Jan 18 21:13:32 2004 ++;;;; Contains: Tests of WRITE-STRING ++ ++(in-package :cl-test) ++ ++(deftest write-string.1 ++ (let (result) ++ (values ++ (with-output-to-string ++ (*standard-output*) ++ (setq result (multiple-value-list (write-string "")))) ++ result)) ++ "" ("")) ++ ++(deftest write-string.2 ++ :notes (:nil-vectors-are-strings) ++ (let (result) ++ (values ++ (with-output-to-string ++ (*standard-output*) ++ (setq result ++ (multiple-value-list ++ (write-string (make-array '(0) :element-type nil))))) ++ result)) ++ "" ("")) ++ ++(deftest write-string.3 ++ (let (result) ++ (values ++ (with-output-to-string ++ (*standard-output*) ++ (setq result (multiple-value-list (write-string "abcde")))) ++ result)) ++ "abcde" ("abcde")) ++ ++(deftest write-string.4 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list (write-string "abcde" s :start 1)))) ++ result)) ++ "bcde" ("abcde")) ++ ++(deftest write-string.5 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list ++ (write-string "abcde" s :start 1 :end 3)))) ++ result)) ++ "bc" ("abcde")) ++ ++(deftest write-string.6 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list ++ (write-string "abcde" s :start 1 :end nil)))) ++ result)) ++ "bcde" ("abcde")) ++ ++(deftest write-string.7 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list (write-string "abcde" s :end 3)))) ++ result)) ++ "abc" ("abcde")) ++ ++(deftest write-string.8 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list ++ (write-string "abcde" s :end 3 :allow-other-keys nil)))) ++ result)) ++ "abc" ("abcde")) ++ ++(deftest write-string.9 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result ++ (multiple-value-list ++ (write-string "abcde" s :end 3 :allow-other-keys t :foo 'bar)))) ++ result)) ++ "abc" ("abcde")) ++ ++(deftest write-string.10 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list ++ (write-string "abcde" s :end 3 :end 2)))) ++ result)) ++ "abc" ("abcde")) ++ ++(deftest write-string.11 ++ (with-input-from-string ++ (is "abcd") ++ (with-output-to-string ++ (os) ++ (let ((*terminal-io* (make-two-way-stream is os))) ++ (write-string "951" t) ++ (close *terminal-io*)))) ++ "951") ++ ++(deftest write-string.12 ++ (with-output-to-string ++ (*standard-output*) ++ (write-string "-=|!" nil)) ++ "-=|!") ++ ++;;; Specialized string tests ++ ++(deftest write-string.13 ++ (let (result) ++ (do-special-strings ++ (s "abcde" nil) ++ (assert (equal ++ (with-output-to-string ++ (*standard-output*) ++ (setq result (multiple-value-list (write-string "abcde")))) ++ "abcde")) ++ (assert (equal result '("abcde"))))) ++ nil) ++ ++;;; Error tests ++ ++(deftest write-string.error.1 ++ (signals-error (write-string) program-error) ++ t) ++ ++(deftest write-string.error.2 ++ (signals-error (write-string "" *standard-output* :start) program-error) ++ t) ++ ++(deftest write-string.error.3 ++ (signals-error (write-string "" *standard-output* :foo nil) program-error) ++ t) ++ ++(deftest write-string.error.4 ++ (signals-error (write-string "" *standard-output* ++ :allow-other-keys nil ++ :foo nil) ++ program-error) ++ t) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpfun.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpfun.lsp +@@ -556,6 +556,14 @@ + ((null type) nil) + ((setq f (assoc type *type-alist* :test 'equal)) + (list (cdr f) x)) ++ ((setq f (when (symbolp type) (get type 'si::type-predicate))) ++ (list f x)) ++ ((and (consp type) (eq (car type) 'or)) ++ `(or ,@(mapcar (lambda (y) `(typep ,x ',y)) (cdr type)))) ++ ((and (consp type) (eq (car type) 'member)) ++ `(or ,@(mapcar (lambda (y) `(eql ,x ',y)) (cdr type)))) ++ ((and (consp type) (eq (car type) 'eql)) ++ `(eql ,x ',(cadr type))) + ((and (consp type) + (or (and (eq (car type) 'vector) + (null (cddr type))) +--- gcl-2.6.12.orig/cmpnew/gcl_cmplabel.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmplabel.lsp +@@ -44,7 +44,7 @@ + `(when (cdr ,label) (wt-nl "goto T" (car ,label) ";")(wt-nl1 "T" (car ,label) ":;"))) + + (defmacro wt-go (label) +- `(progn (rplacd ,label t) (wt "goto T" (car ,label) ";"))) ++ `(progn (rplacd ,label t) (wt "goto T" (car ,label) ";")(wt-nl))) + + + (defvar *restore-avma* nil) +--- gcl-2.6.12.orig/cmpnew/gcl_cmplam.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmplam.lsp +@@ -407,6 +407,12 @@ + (c2lambda-expr-without-key lambda-list body))) + )) + ++(defun decl-body-safety (body) ++ (case (car body) ++ (decl-body (or (cadr (assoc 'safety (caddr body))) 0)) ++ ((let let*) (decl-body-safety (car (last body)))) ++ (otherwise 0))) ++ + (defun c2lambda-expr-without-key + (lambda-list body + &aux (requireds (car lambda-list)) +@@ -439,7 +445,7 @@ + (when rest (do-decl rest)) + ) + ;;; check arguments +- (when (or *safe-compile* *compiler-check-args*) ++ (when (or *safe-compile* *compiler-check-args* (plusp (decl-body-safety body)));FIXME + (cond ((or rest optionals) + (when requireds + (wt-nl "if(vs_top-vs_base<" (length requireds) +@@ -448,7 +454,7 @@ + (wt-nl "if(vs_top-vs_base>" + (+ (length requireds) (length optionals)) + ") too_many_arguments();"))) +- (t (wt-nl "check_arg(" (length requireds) ");")))) ++ (t (when requireds (wt-nl "check_arg(" (length requireds) ");"))))) + + ;;; Allocate the parameters. + (dolist** (var requireds) (setf (var-ref var) (vs-push))) +@@ -562,7 +568,7 @@ + (when (cadddr kwd) (do-decl (cadddr kwd)))) + ) + ;;; Check arguments. +- (when (and (or *safe-compile* *compiler-check-args*) requireds) ++ (when (and (or *safe-compile* *compiler-check-args* (plusp (decl-body-safety body))) requireds);FIXME + (when requireds + (wt-nl "if(vs_top-vs_base<" (length requireds) + ") too_few_arguments();"))) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -52,7 +52,7 @@ + (defvar *cmpinclude-string* + (si::file-to-string + (namestring +- (make-pathname :directory (append (pathname-directory si::*system-directory*) (list :parent "h")) ++ (make-pathname :directory (append (pathname-directory si::*system-directory*) (list :back "h")) + :name "cmpinclude" :type "h")))) + + +@@ -160,7 +160,7 @@ + + + (defun compile-file1 (input-pathname +- &key (output-file (truename input-pathname)) ++ &key (output-file (merge-pathnames ".o" (truename input-pathname))) + (o-file t) + (c-file *default-c-file*) + (h-file *default-h-file*) +@@ -175,7 +175,7 @@ + (*c-debug* c-debug) + (*compile-print* (or print *compile-print*)) + (*package* *package*) +- (*DEFAULT-PATHNAME-DEFAULTS* #"") ++ (*DEFAULT-PATHNAME-DEFAULTS* #p"") + (*data* (list (make-array 50 :fill-pointer 0 :adjustable t) nil nil)) + *init-name* + (*fasd-data* *fasd-data*) +@@ -186,25 +186,25 @@ + (cond (*compiler-in-use* + (format t "~&The compiler was called recursively.~%~ + Cannot compile ~a.~%" +- (namestring (merge-pathnames input-pathname #".lsp"))) ++ (namestring (merge-pathnames input-pathname #p".lsp"))) + (setq *error-p* t) + (return-from compile-file1 (values))) + (t (setq *error-p* nil) + (setq *compiler-in-use* t))) + +- (unless (probe-file (merge-pathnames input-pathname #".lsp")) ++ (unless (probe-file (merge-pathnames input-pathname #p".lsp")) + (format t "~&The source file ~a is not found.~%" +- (namestring (merge-pathnames input-pathname #".lsp"))) ++ (namestring (merge-pathnames input-pathname #p".lsp"))) + (setq *error-p* t) + (return-from compile-file1 (values))) + + (when *compile-verbose* +- (format t "~&Compiling ~a.~%" (namestring (merge-pathnames input-pathname #".lsp")))) ++ (format t "~&Compiling ~a.~%" (namestring (merge-pathnames input-pathname #p".lsp")))) + + (and *record-call-info* (clear-call-table)) + + (with-open-file +- (*compiler-input* (merge-pathnames input-pathname #".lsp")) ++ (*compiler-input* (merge-pathnames input-pathname #p".lsp")) + + + (cond ((numberp *split-files*) +@@ -232,8 +232,11 @@ Cannot compile ~a.~%" + (device (or (and (not (null output-file)) + (pathname-device output-file)) + (pathname-device input-pathname))) ++ (typ (or (and (not (null output-file)) ++ (pathname-type output-file)) ++ "o")) + +- (o-pathname (get-output-pathname o-file "o" name dir device)) ++ (o-pathname (get-output-pathname o-file typ name dir device)) + (c-pathname (get-output-pathname c-file "c" name dir device)) + (h-pathname (get-output-pathname h-file "h" name dir device)) + (data-pathname (get-output-pathname data-file "data" name dir device))) +@@ -351,7 +354,7 @@ Cannot compile ~a.~%" + (wt-data1 form) ;; this binds all the print stuff + )) + +-(defun compile (name &optional def &aux tem gaz (*default-pathname-defaults* #".")) ++(defun compile (name &optional def &aux tem gaz (*default-pathname-defaults* #p".")) + + (cond ((not(symbolp name)) (error "Must be a name")) + ((and (consp def) +@@ -797,7 +800,7 @@ Cannot compile ~a.~%" + + (with-open-file (st (namestring map) :direction :output)) + (safe-system +- (let* ((par (namestring (make-pathname :directory '(:parent)))) ++ (let* ((par (namestring (make-pathname :directory '(:back)))) + (i (concatenate 'string " " par)) + (j (concatenate 'string " " si::*system-directory* par))) + (format nil "~a ~a ~a ~a -L~a ~a ~a ~a" +--- gcl-2.6.12.orig/cmpnew/gcl_cmpopt.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpopt.lsp +@@ -1170,6 +1170,14 @@ type_of(#0)==t_complex") + (push '((t) t #.(flags ans)"coerce_to_string(#0)") + (get 'string 'inline-always)) + ++;;PATHNAME-DESIGNATORP ++(push '((t) boolean #.(flags)"pathname_designatorp(#0)") ++ (get 'si::pathname-designatorp 'inline-always)) ++ ++;;PATHNAMEP ++(push '((t) boolean #.(flags)"pathnamep(#0)") ++ (get 'pathnamep 'inline-always)) ++ + ;;STRINGP + (push '((t) boolean #.(flags)"type_of(#0)==t_string") + (get 'stringp 'inline-always)) +--- gcl-2.6.12.orig/cmpnew/gcl_cmptop.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmptop.lsp +@@ -209,7 +209,7 @@ + + (cond ((not sp) "code") + ((not (pathnamep p)) (init-name (pathname p) sp gp dc nt)) +- (gp (init-name (truename (merge-pathnames p #".lsp")) sp nil dc nt)) ++ (gp (init-name (truename (merge-pathnames p #p".lsp")) sp nil dc nt)) + ((pathname-type p) + (init-name (make-pathname + :host (pathname-host p) +--- gcl-2.6.12.orig/cmpnew/gcl_collectfn.lsp ++++ gcl-2.6.12/cmpnew/gcl_collectfn.lsp +@@ -240,22 +240,20 @@ + + (defvar *warn-on-multiple-fn-definitions* t) + +-(defun add-fn-data (lis &aux tem file) +- (let ((file (and (setq file (si::fp-input-stream *standard-input*)) +- (truename file)))) ++(defun add-fn-data (lis &aux tem (file *load-truename*)) + (dolist (v lis) +- (cond ((eql (fn-name v) 'other-form) +- (setf (fn-name v) (intern +- (concatenate 'string "OTHER-FORM-" +- (namestring file)))) +- (setf (get (fn-name v) 'other-form) t))) +- (setf (gethash (fn-name v) *call-table*) v) +- (when *warn-on-multiple-fn-definitions* +- (when (setq tem (gethash (fn-name v) *file-table*)) +- (unless (equal tem file) +- (warn 'simple-warning :format-control "~% ~a redefined in ~a. Originally in ~a." +- :format-arguments (list (fn-name v) file tem))))) +- (setf (gethash (fn-name v) *file-table*) file)))) ++ (cond ((eql (fn-name v) 'other-form) ++ (setf (fn-name v) (intern ++ (concatenate 'string "OTHER-FORM-" ++ (namestring file)))) ++ (setf (get (fn-name v) 'other-form) t))) ++ (setf (gethash (fn-name v) *call-table*) v) ++ (when *warn-on-multiple-fn-definitions* ++ (when (setq tem (gethash (fn-name v) *file-table*)) ++ (unless (equal tem file) ++ (warn 'simple-warning :format-control "~% ~a redefined in ~a. Originally in ~a." ++ :format-arguments (list (fn-name v) file tem))))) ++ (setf (gethash (fn-name v) *file-table*) file))) + + (defun dump-fn-data (&optional (file "fn-data.lsp") + &aux (*package* (find-package "COMPILER")) +--- gcl-2.6.12.orig/cmpnew/gcl_lfun_list.lsp ++++ gcl-2.6.12/cmpnew/gcl_lfun_list.lsp +@@ -20,7 +20,6 @@ + (DEFSYSFUN 'CHAR-NAME "Lchar_name" '(T) 'T NIL NIL) + (DEFSYSFUN 'RASSOC-IF "Lrassoc_if" '(T T) 'T NIL NIL) + (DEFSYSFUN 'MAKE-LIST "Lmake_list" '(T *) 'T NIL NIL) +-(DEFSYSFUN 'HOST-NAMESTRING "Lhost_namestring" '(T) 'STRING NIL NIL) + (DEFSYSFUN 'MAKE-ECHO-STREAM "Lmake_echo_stream" '(T T) 'T NIL NIL) + ;(DEFSYSFUN 'NTH "Lnth" '(T T) 'T NIL NIL) + (DEFSYSFUN 'SIN "Lsin" '(T) 'T NIL NIL) +@@ -31,8 +30,6 @@ + ;#-clcs (DEFSYSFUN 'OPEN "Lopen" '(T *) 'T NIL NIL) + (DEFSYSFUN 'BOTH-CASE-P "Lboth_case_p" '(T) 'T NIL T) + (DEFSYSFUN 'NULL "Lnull" '(T) 'T NIL T) +-(DEFSYSFUN 'RENAME-FILE "Lrename_file" '(T T) 'T NIL NIL) +-(DEFSYSFUN 'FILE-AUTHOR "Lfile_author" '(T) 'T NIL NIL) + (DEFSYSFUN 'STRING-CAPITALIZE "Lstring_capitalize" '(T *) 'STRING NIL + NIL) + (DEFSYSFUN 'MACROEXPAND "Lmacroexpand" '(T *) '(VALUES T T) NIL NIL) +@@ -45,7 +42,6 @@ + (DEFSYSFUN 'LENGTH "Llength" '(T) 'FIXNUM T NIL) + (DEFSYSFUN 'RASSOC "Lrassoc" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'PPRINT "Lpprint" '(T *) 'T NIL NIL) +-(DEFSYSFUN 'PATHNAME-HOST "Lpathname_host" '(T) 'T NIL NIL) + (DEFSYSFUN 'NSUBST-IF-NOT "Lnsubst_if_not" '(T T T *) 'T NIL NIL) + (DEFSYSFUN 'FILE-POSITION "Lfile_position" '(T *) 'T NIL NIL) + (DEFSYSFUN 'STRING< "Lstring_l" '(T T *) 'T NIL NIL) +@@ -58,14 +54,11 @@ + (DEFSYSFUN 'STRING>= "Lstring_ge" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'REALPART "Lrealpart" '(T) 'T NIL NIL) + ;;broken on suns.. +-;(DEFSYSFUN 'USER-HOMEDIR-PATHNAME "Luser_homedir_pathname" '(*) 'T NIL +-; NIL) + (DEFSYSFUN 'NBUTLAST "Lnbutlast" '(T *) 'T NIL NIL) + (DEFSYSFUN 'ARRAY-DIMENSION "Larray_dimension" '(T T) 'FIXNUM NIL NIL) + (DEFSYSFUN 'CDR "Lcdr" '(T) 'T NIL NIL) + ;(DEFSYSFUN 'EQL "Leql" '(T T) 'T NIL T) + (DEFSYSFUN 'LOG "Llog" '(T *) 'T NIL NIL) +-(DEFSYSFUN 'DIRECTORY "Ldirectory" '(T) 'T NIL NIL) + (DEFSYSFUN 'STRING-NOT-EQUAL "Lstring_not_equal" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'SHADOWING-IMPORT "Lshadowing_import" '(T *) 'T NIL NIL) + (DEFSYSFUN 'MAPC "Lmapc" '(T T *) 'T NIL NIL) +@@ -78,8 +71,6 @@ + (DEFSYSFUN 'MAKE-SYMBOL "Lmake_symbol" '(T) 'T NIL NIL) + (DEFSYSFUN 'STRING-RIGHT-TRIM "Lstring_right_trim" '(T T) 'STRING NIL + NIL) +-(DEFSYSFUN 'ENOUGH-NAMESTRING "Lenough_namestring" '(T *) 'STRING NIL +- NIL) + (DEFSYSFUN 'PRINT "Lprint" '(T *) 'T NIL NIL) + (DEFSYSFUN 'CDDAAR "Lcddaar" '(T) 'T NIL NIL) + (DEFSYSFUN 'CDADAR "Lcdadar" '(T) 'T NIL NIL) +@@ -187,7 +178,6 @@ + NIL) + (DEFSYSFUN 'COPY-ALIST "Lcopy_alist" '(T) 'T NIL NIL) + (DEFSYSFUN 'ATAN "Latan" '(T *) 'T NIL NIL) +-(DEFSYSFUN 'DELETE-FILE "Ldelete_file" '(T) 'T NIL NIL) + (DEFSYSFUN 'FLOAT-RADIX "Lfloat_radix" '(T) 'FIXNUM NIL NIL) + (DEFSYSFUN 'SYMBOL-NAME "Lsymbol_name" '(T) 'STRING NIL NIL) + (DEFSYSFUN 'CLEAR-INPUT "Lclear_input" '(*) 'T NIL NIL) +@@ -215,8 +205,6 @@ + (DEFSYSFUN 'SXHASH "Lsxhash" '(T) 'FIXNUM NIL NIL) + (DEFSYSFUN 'LISTEN "Llisten" '(*) 'T NIL NIL) + (DEFSYSFUN 'ARRAYP "Larrayp" '(T) 'T NIL T) +-(DEFSYSFUN 'MAKE-PATHNAME "Lmake_pathname" '(*) 'T NIL NIL) +-(DEFSYSFUN 'PATHNAME-TYPE "Lpathname_type" '(T) 'T NIL NIL) + (DEFSYSFUN 'FUNCALL "Lfuncall" '(T *) 'T NIL NIL) + (DEFSYSFUN 'CLRHASH "Lclrhash" '(T) 'T NIL NIL) + (DEFSYSFUN 'GRAPHIC-CHAR-P "Lgraphic_char_p" '(T) 'T NIL T) +@@ -227,14 +215,12 @@ + (DEFSYSFUN 'SUBST-IF "Lsubst_if" '(T T T *) 'T NIL NIL) + (DEFSYSFUN 'COMPLEXP "Lcomplexp" '(T) 'T NIL T) + (DEFSYSFUN 'READ-LINE "Lread_line" '(*) '(VALUES T T) NIL NIL) +-(DEFSYSFUN 'PATHNAMEP "Lpathnamep" '(T) 'T NIL T) + (DEFSYSFUN 'MAX "Lmax" '(T *) 'T NIL NIL) + (DEFSYSFUN 'IN-PACKAGE "Lin_package" '(T *) 'T NIL NIL) + (DEFSYSFUN 'READTABLEP "Lreadtablep" '(T) 'T NIL T) + (DEFSYSFUN 'FLOAT-SIGN "Lfloat_sign" '(T *) 'T NIL NIL) + (DEFSYSFUN 'CHARACTERP "Lcharacterp" '(T) 'T NIL T) + (DEFSYSFUN 'READ "Lread" '(*) 'T NIL NIL) +-(DEFSYSFUN 'NAMESTRING "Lnamestring" '(T) 'T NIL NIL) + (DEFSYSFUN 'UNREAD-CHAR "Lunread_char" '(T *) 'T NIL NIL) + (DEFSYSFUN 'CDAAR "Lcdaar" '(T) 'T NIL NIL) + (DEFSYSFUN 'CADAR "Lcadar" '(T) 'T NIL NIL) +@@ -267,10 +253,8 @@ + (DEFSYSFUN 'PACKAGEP "Lpackagep" '(T) 'T NIL T) + (DEFSYSFUN 'INPUT-STREAM-P "Linput_stream_p" '(T) 'T NIL T) + (DEFSYSFUN '>= "Lmonotonically_nonincreasing" '(T *) 'T NIL T) +-(DEFSYSFUN 'PATHNAME "Lpathname" '(T) 'T NIL NIL) + ;(DEFSYSFUN 'EQ "Leq" '(T T) 'T NIL T) + (DEFSYSFUN 'MAKE-CHAR "Lmake_char" '(T *) 'CHARACTER NIL NIL) +-(DEFSYSFUN 'FILE-NAMESTRING "Lfile_namestring" '(T) 'STRING NIL NIL) + (DEFSYSFUN 'CHARACTER "Lcharacter" '(T) 'CHARACTER NIL NIL) + (DEFSYSFUN 'SYMBOL-FUNCTION "Lsymbol_function" '(T) 'T NIL NIL) + (DEFSYSFUN 'CONSTANTP "Lconstantp" '(T) 'T NIL T) +@@ -307,13 +291,9 @@ + (DEFSYSFUN 'NUMBERP "Lnumberp" '(T) 'T NIL T) + (DEFSYSFUN 'COPY-READTABLE "Lcopy_readtable" '(*) 'T NIL NIL) + (DEFSYSFUN 'RANDOM-STATE-P "Lrandom_state_p" '(T) 'T NIL T) +-(DEFSYSFUN 'DIRECTORY-NAMESTRING "Ldirectory_namestring" '(T) 'STRING +- NIL NIL) + (DEFSYSFUN 'STANDARD-CHAR-P "Lstandard_char_p" '(T) 'T NIL T) +-(DEFSYSFUN 'TRUENAME "Ltruename" '(T) 'T NIL NIL) + (DEFSYSFUN 'IDENTITY "Lidentity" '(T) 'T NIL NIL) + (DEFSYSFUN 'NREVERSE "Lnreverse" '(T) 'T NIL NIL) +-(DEFSYSFUN 'PATHNAME-DEVICE "Lpathname_device" '(T) 'T NIL NIL) + (DEFSYSFUN 'UNINTERN "Lunintern" '(T *) 'T NIL NIL) + (DEFSYSFUN 'UNEXPORT "Lunexport" '(T *) 'T NIL NIL) + (DEFSYSFUN 'FLOAT-PRECISION "Lfloat_precision" '(T) 'FIXNUM NIL NIL) +@@ -324,7 +304,7 @@ + (DEFSYSFUN 'READ-CHAR-NO-HANG "Lread_char_no_hang" '(*) 'T NIL NIL) + (DEFSYSFUN 'FRESH-LINE "Lfresh_line" '(*) 'T NIL NIL) + (DEFSYSFUN 'WRITE-CHAR "Lwrite_char" '(T *) 'T NIL NIL) +-(DEFSYSFUN 'PARSE-NAMESTRING "Lparse_namestring" '(T *) 'T NIL NIL) ++;(DEFSYSFUN 'PARSE-NAMESTRING "Lparse_namestring" '(T *) 'T NIL NIL) + (DEFSYSFUN 'STRING-NOT-LESSP "Lstring_not_lessp" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'CHAR "Lchar" '(T T) 'CHARACTER NIL NIL) + (DEFSYSFUN 'AREF "Laref" '(T *) 'T NIL NIL) +@@ -338,7 +318,6 @@ + (DEFSYSFUN 'DIGIT-CHAR-P "Ldigit_char_p" '(T *) 'T NIL NIL) + ;; #-clcs (DEFSYSFUN 'ERROR "Lerror" '(T *) 'T NIL NIL) + (DEFSYSFUN 'CHAR/= "Lchar_neq" '(T *) 'T NIL T) +-(DEFSYSFUN 'PATHNAME-DIRECTORY "Lpathname_directory" '(T) 'T NIL NIL) + (DEFSYSFUN 'CDAAAR "Lcdaaar" '(T) 'T NIL NIL) + (DEFSYSFUN 'CADAAR "Lcadaar" '(T) 'T NIL NIL) + (DEFSYSFUN 'CAADAR "Lcaadar" '(T) 'T NIL NIL) +@@ -349,7 +328,6 @@ + (DEFSYSFUN 'FORMAT "Lformat" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'COMPILED-FUNCTION-P "Lcompiled_function_p" '(T) 'T NIL T) + (DEFSYSFUN 'SUBLIS "Lsublis" '(T T *) 'T NIL NIL) +-(DEFSYSFUN 'PATHNAME-NAME "Lpathname_name" '(T) 'T NIL NIL) + (DEFSYSFUN 'IMPORT "Limport" '(T *) 'T NIL NIL) + (DEFSYSFUN 'LOGXOR "Llogxor" '(*) 'T NIL NIL) + (DEFSYSFUN 'RASSOC-IF-NOT "Lrassoc_if_not" '(T T) 'T NIL NIL) +@@ -366,9 +344,7 @@ + (DEFSYSFUN 'GET-PROPERTIES "Lget_properties" '(T T) '* NIL NIL) + (DEFSYSFUN 'STRING<= "Lstring_le" '(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) + (DEFSYSFUN 'MEMBER-IF "Lmember_if" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'READ-BYTE "Lread_byte" '(T *) 'T NIL NIL) + (DEFSYSFUN 'SIMPLE-VECTOR-P "Lsimple_vector_p" '(T) 'T NIL T) +@@ -381,10 +357,8 @@ + (DEFSYSFUN 'GET "Lget" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'MOD "Lmod" '(T T) 'T NIL NIL) + (DEFSYSFUN 'DIGIT-CHAR "Ldigit_char" '(T *) 'CHARACTER NIL NIL) +-(DEFSYSFUN 'PROBE-FILE "Lprobe_file" '(T) 'T NIL NIL) + (DEFSYSFUN 'STRING-LEFT-TRIM "Lstring_left_trim" '(T T) 'STRING NIL + NIL) +-(DEFSYSFUN 'PATHNAME-VERSION "Lpathname_version" '(T) 'T NIL NIL) + (DEFSYSFUN 'WRITE-LINE "Lwrite_line" '(T *) 'T NIL NIL) + (DEFSYSFUN 'EVAL "Leval" '(T) 'T NIL NIL) + (DEFSYSFUN 'ATOM "Latom" '(T) 'T NIL T) +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4183,7 +4183,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu + #fi + # subst GCC not only under 386-linux, but where available -- CM + +-TCFLAGS="-fsigned-char" ++TCFLAGS="-fsigned-char -fno-builtin-malloc -fno-builtin-free" + + if test "$GCC" = "yes" ; then + +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -483,7 +483,7 @@ AC_SUBST(CC) + #fi + # subst GCC not only under 386-linux, but where available -- CM + +-TCFLAGS="-fsigned-char" ++TCFLAGS="-fsigned-char -fno-builtin-malloc -fno-builtin-free" + + if test "$GCC" = "yes" ; then + +--- gcl-2.6.12.orig/h/att_ext.h ++++ gcl-2.6.12/h/att_ext.h +@@ -116,25 +116,14 @@ float object_to_float(); + double object_to_double(); + + /* error.c */ +-EXTER object sKerror; +-EXTER object sKwrong_type_argument; + EXTER object sKcatch; + EXTER object sKprotect; + EXTER object sKcatchall; +-EXTER object sKtoo_few_arguments; +-EXTER object sKtoo_many_arguments; +-EXTER object sKunexpected_keyword; +-EXTER object sKinvalid_form; +-EXTER object sKunbound_variable; +-EXTER object sKinvalid_variable; +-EXTER object sKundefined_function; +-EXTER object sKinvalid_function; + EXTER object sKdatum; + EXTER object sKexpected_type; + EXTER object sKpackage; + EXTER object sKformat_control; + EXTER object sKformat_arguments; +-EXTER object sKpackage_error; + object wrong_type_argument(); + EXTER object sSuniversal_error_handler; + +@@ -394,10 +383,11 @@ EXTER object sKname; + EXTER object sKtype; + EXTER object sKversion; + EXTER object sKdefaults; +-EXTER object sKroot; +-EXTER object sKcurrent; +-EXTER object sKparent; +-EXTER object sKper; ++ ++EXTER object sKabsolute; ++EXTER object sKrelative; ++EXTER object sKup; ++ + /* object parse_namestring(); */ + object coerce_to_pathname(); + /* object default_device(); */ +--- gcl-2.6.12.orig/h/compdefs.h ++++ gcl-2.6.12/h/compdefs.h +@@ -115,3 +115,5 @@ SIGNED_CHAR(x) + FEerror(x,y...) + FEwrong_type_argument(x,y) + BIT_ENDIAN(x) ++pathname_designatorp(x) ++pathnamep(x) +--- gcl-2.6.12.orig/h/error.h ++++ gcl-2.6.12/h/error.h +@@ -22,6 +22,7 @@ PFN(numberp) + PFN(characterp) + PFN(symbolp) + PFN(stringp) ++PFN(pathnamep) + PFN(string_symbolp) + PFN(packagep) + PFN(consp) +@@ -52,6 +53,7 @@ PFN(functionp) + #define check_type_character(a_) TPE(a_,characterp_fn,sLcharacter) + #define check_type_sym(a_) TPE(a_,symbolp_fn,sLsymbol) + #define check_type_string(a_) TPE(a_,stringp_fn,sLstring) ++#define check_type_pathname(a_) TPE(a_,pathnamep_fn,sLpathname) + #define check_type_or_string_symbol(a_) TPE(a_,string_symbolp_fn,TSor_symbol_string) + #define check_type_or_symbol_string(a_) TPE(a_,string_symbolp_fn,TSor_symbol_string) + #define check_type_or_pathname_string_symbol_stream(a_) TPE(a_,pathname_string_symbol_streamp_fn,TSor_pathname_string_symbol_stream) +@@ -79,12 +81,6 @@ PFN(functionp) + set_type_of((a_),t_fixnum);\ + (a_)->FIX.FIXVAL=(b_);} + +-/*FIXME the stack stuff is dangerous It works for error handling, but +- simple errors may evan pass the format tring up the stack as a slot +- in ansi*/ +-/* #define TYPE_ERROR(a_,b_) {stack_string(tp_err,"~S is not of type ~S.");\ */ +-/* Icall_error_handler(sKwrong_type_argument,tp_err,2,(a_),(b_));} */ +- + object ihs_top_function_name(ihs_ptr h); + #define FEerror(a_,b_...) Icall_error_handler(sLerror,null_string,\ + 4,sKformat_control,make_simple_string(a_),sKformat_arguments,list(b_)) +--- gcl-2.6.12.orig/h/lu.h ++++ gcl-2.6.12/h/lu.h +@@ -301,7 +301,7 @@ struct pathname { + object pn_name; + object pn_type; + object pn_version; +- SPAD; ++ object pn_namestring; + }; + + struct cfun { +--- gcl-2.6.12.orig/h/notcomp.h ++++ gcl-2.6.12/h/notcomp.h +@@ -47,12 +47,6 @@ EXTER object user_package; + else *__p++ = va_arg(ap,object);} \ + va_end(ap) + +-/* #undef endp */ +- +-/* #define endp(obje) ((enum type)((endp_temp = (obje))->d.t) == t_cons ? \ */ +-/* FALSE : endp_temp == Cnil ? TRUE : \ */ +-/* endp1(endp_temp)) */ +- + #ifndef NO_DEFUN + #undef DEFUN + #define DEFUN(string,ret,fname,pack,min,max, flags, ret0a0,a12,a34,a56,doc) ret fname +@@ -234,7 +228,7 @@ EXTER bool left_trim; + EXTER bool right_trim; + int (*casefun)(); + +-#define Q_SIZE 128 ++#define Q_SIZE 256 + #define IS_SIZE 256 + + struct printStruct { +@@ -300,6 +294,8 @@ gcl_init_cmp_anon(void); + + #include "gmp_wrappers.h" + ++char FN1[PATH_MAX],FN2[PATH_MAX],FN3[PATH_MAX],FN4[PATH_MAX],FN5[PATH_MAX]; ++ + #include + #define massert(a_) ({errno=0;if (!(a_)||errno) assert_error(#a_,__LINE__,__FILE__,__FUNCTION__);}) + +--- gcl-2.6.12.orig/h/object.h ++++ gcl-2.6.12/h/object.h +@@ -163,24 +163,6 @@ enum aelttype { /* array element type + #define STREF(type,x,i) (*((type *)(((char *)((x)->str.str_self))+(i)))) + #define STSET(type,x,i,val) do{SGC_TOUCH(x);STREF(type,x,i) = (val);} while(0) + +- +- +-enum smmode { /* stream mode */ +- smm_input, /* input */ +- smm_output, /* output */ +- smm_io, /* input-output */ +- smm_probe, /* probe */ +- smm_synonym, /* synonym */ +- smm_broadcast, /* broadcast */ +- smm_concatenated, /* concatenated */ +- smm_two_way, /* two way */ +- smm_echo, /* echo */ +- smm_string_input, /* string input */ +- smm_string_output, /* string output */ +- smm_user_defined, /* for user defined */ +- smm_socket /* Socket stream */ +-}; +- + /* for any stream that takes writec_char, directly (not two_way or echo) + ie. smm_output,smm_io, smm_string_output, smm_socket + */ +@@ -217,9 +199,9 @@ enum gcl_sm_flags { + gcl_sm_tcp_async, + gcl_sm_input, + gcl_sm_output, ++ gcl_sm_closed, + gcl_sm_had_error + +- + }; + + enum chattrib { /* character attribute */ +@@ -496,8 +478,11 @@ object make_si_sfun(); + Used by the C function to set optionals */ + + #define VFUN_NARGS fcall.argd ++#define RETURN4(x,y,z,w) do{/* object _x = (void *) x; */ \ ++ fcall.values[1]=y;fcall.values[2]=z;fcall.values[3]=w;fcall.nvalues=4; \ ++ return (x) ;} while(0) + #define RETURN2(x,y) do{/* object _x = (void *) x; */\ +- fcall.values[2]=y;fcall.nvalues=2; \ ++ fcall.values[1]=y;fcall.nvalues=2; \ + return (x) ;} while(0) + #define RETURN1(x) do{fcall.nvalues=1; return (x) ;} while(0) + #define RETURN0 do{fcall.nvalues=0; return Cnil ;} while(0) +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -88,7 +88,7 @@ + /* big.c:85:OF */ extern void zero_big (object x); /* (x) object x; */ + /* bind.c:74:OF */ extern void lambda_bind (object *arg_top); /* (arg_top) object *arg_top; */ + /* bind.c:564:OF */ extern void bind_var (object var, object val, object spp); /* (var, val, spp) object var; object val; object spp; */ +-/* bind.c:610:OF */ extern object find_special (object body, struct bind_temp *start, struct bind_temp *end); /* (body, start, end) object body; struct bind_temp *start; struct bind_temp *end; */ ++/* bind.c:610:OF */ extern object find_special (object body, struct bind_temp *start, struct bind_temp *end,object *s); /* (body, start, end) object body; struct bind_temp *start; struct bind_temp *end; */ + /* bind.c:670:OF */ extern object let_bind (object body, struct bind_temp *start, struct bind_temp *end); /* (body, start, end) object body; struct bind_temp *start; struct bind_temp *end; */ + /* bind.c:688:OF */ extern object letA_bind (object body, struct bind_temp *start, struct bind_temp *end); /* (body, start, end) object body; struct bind_temp *start; struct bind_temp *end; */ + /* bind.c:712:OF */ extern void parse_key (object *base, bool rest, bool allow_other_keys, register int n, ... ); +--- gcl-2.6.12.orig/h/type.h ++++ gcl-2.6.12/h/type.h +@@ -7,6 +7,7 @@ enum type { + t_shortfloat, + t_longfloat, + t_complex, ++ t_stream, + t_pathname, + t_string, + t_bitvector, +@@ -17,7 +18,6 @@ enum type { + t_character, + t_symbol, + t_package, +- t_stream, + t_random, + t_readtable, + t_cfun, +@@ -36,6 +36,23 @@ enum type { + }; + + ++enum smmode { /* stream mode */ ++ smm_input, /* input */ ++ smm_output, /* output */ ++ smm_io, /* input-output */ ++ smm_probe, /* probe */ ++ smm_file_synonym, /* synonym stream to file_stream */ ++ smm_synonym, /* synonym */ ++ smm_broadcast, /* broadcast */ ++ smm_concatenated, /* concatenated */ ++ smm_two_way, /* two way */ ++ smm_echo, /* echo */ ++ smm_string_input, /* string input */ ++ smm_string_output, /* string output */ ++ smm_user_defined, /* for user defined */ ++ smm_socket /* Socket stream */ ++}; ++ + #define Zcdr(a_) (*(object *)(a_))/* ((a_)->c.c_cdr) */ /*FIXME*/ + + #ifndef WIDE_CONS +@@ -82,7 +99,7 @@ enum type { + #else + #define TYPEWORD_TYPE_P(y_) (y_!=t_cons) + #endif +- ++ + /*Note preserve sgc flag here VVV*/ + #define set_type_of(x,y) ({object _x=(object)(x);enum type _y=(y);_x->d.f=0;\ + if (TYPEWORD_TYPE_P(_y)) {_x->d.e=1;_x->d.t=_y;_x->fw|=(fixnum)OBJNULL;}}) +@@ -113,6 +130,7 @@ enum type { + #define randomp(a_) SPP(a_,random) + #define characterp(a_) SPP(a_,character) + #define symbolp(a_) SPP(a_,symbol) ++#define pathnamep(a_) SPP(a_,pathname) + #define stringp(a_) SPP(a_,string) + #define fixnump(a_) SPP(a_,fixnum) + #define readtablep(a_) SPP(a_,readtable) +@@ -133,3 +151,6 @@ enum type { + || _tp == t_symbol;}) + #define pathname_string_symbol_streamp(a_) ({enum type _tp=type_of(a_); _tp==t_pathname || _tp == t_string\ + || _tp == t_symbol || _tp==t_stream;}) ++ ++#define pathname_designatorp(a_) ({object _a=(a_);enum type _tp=type_of(a_);\ ++ _tp==t_pathname||_tp==t_string||(_tp==t_stream && _a->sm.sm_mode>=smm_input && _a->sm.sm_mode<=smm_file_synonym);}) +--- gcl-2.6.12.orig/lsp/gcl_autoload.lsp ++++ gcl-2.6.12/lsp/gcl_autoload.lsp +@@ -410,10 +410,3 @@ Good luck! The GCL Development Team" + (setf (get 'with-open-file 'si:pretty-print-format) 1) + (setf (get 'with-open-stream 'si:pretty-print-format) 1) + (setf (get 'with-output-to-string 'si:pretty-print-format) 1) +- +- +-(in-package :si) +- +-(defvar *lib-directory* (namestring (truename "../"))) +- +-(import '(*lib-directory* *load-path* *system-directory*) :user) +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_directory.lsp +@@ -0,0 +1,67 @@ ++(in-package :si) ++ ++(defconstant +d-type-alist+ (d-type-list)) ++ ++(defun ?push (x tp) ++ (when (and x (eq tp :directory)) (vector-push-extend #\/ x)) ++ x) ++ ++(defun wreaddir (x s &optional y (ls (length s) lsp) &aux (y (if (rassoc y +d-type-alist+) y :unknown))) ++ (when lsp (setf (fill-pointer s) ls)) ++ (let ((r (readdir x (car (rassoc y +d-type-alist+)) s))) ++ (typecase r ++ (fixnum (wreaddir x (adjust-array s (+ 100 (ash (array-dimension s 0) 1))) y)) ++ (cons (let ((tp (cdr (assoc (cdr r) +d-type-alist+)))) (cons (?push (car r) tp) tp))) ++ (otherwise (?push r y))))) ++ ++(defun dot-dir-p (r l) (member-if (lambda (x) (string= x r :start2 l)) '("./" "../"))) ++ ++(defun vector-push-string (x s &optional (ss 0) (lx (length x)) &aux (ls (- (length s) ss))) ++ (let ((x (if (> ls (- (array-dimension x 0) lx)) (adjust-array x (+ ls (ash lx 1))) x))) ++ (setf (fill-pointer x) (+ lx ls)) ++ (replace x s :start1 lx :start2 ss))) ++ ++(defun walk-dir (s e f &optional (y :unknown) (d (opendir s)) (l (length s)) (le (length e)) ++ &aux (r (wreaddir d s y l))) ++ (cond (r (unless (dot-dir-p r l) (funcall f r (vector-push-string e r l le) l)) ++ (walk-dir s e f y d l le)) ++ ((setf (fill-pointer s) l (fill-pointer e) le) (closedir d)))) ++ ++(defun recurse-dir (x y f) ++ (funcall f x y) ++ (walk-dir x y (lambda (x y l) (declare (ignore l)) (recurse-dir x y f)) :directory)) ++ ++(defun make-frame (s &aux (l (length s))) ++ (replace (make-array l :element-type 'character :adjustable t :fill-pointer l) s)) ++ ++(defun expand-wild-directory (l f zz &optional (yy (make-frame zz))) ++ (let* ((x (member-if 'wild-dir-element-p l)) ++ (s (namestring (make-pathname :directory (ldiff l x)))) ++ (z (vector-push-string zz s)) ++ (l (length yy)) ++ (y (link-expand (vector-push-string yy s) l)) ++ (y (if (eq y yy) y (make-frame y)))) ++ (when (or (eq (stat z) :directory) (zerop (length z))) ++ (cond ((eq (car x) :wild-inferiors) (recurse-dir z y f)) ++ (x (walk-dir z y (lambda (q e l) ++ (declare (ignore l)) ++ (expand-wild-directory (cons :relative (cdr x)) f q e)) :directory));FIXME ++ ((funcall f z y)))))) ++ ++(defun directory (p &key &aux (p (translate-logical-pathname p))(d (pathname-directory p)) ++ (c (unless (eq (car d) :absolute) (make-frame (concatenate 'string (getcwd) "/")))) ++ (lc (when c (length c))) ++ (filesp (or (pathname-name p) (pathname-type p))) ++ (v (compile-regexp (to-regexp p)))(*up-key* :back) r) ++ (expand-wild-directory d ++ (lambda (dir exp &aux (pexp (pathname (if c (vector-push-string c exp 0 lc) exp)))) ++ (if filesp ++ (walk-dir dir exp ++ (lambda (dir exp pos) ++ (declare (ignore exp)) ++ (when (pathname-match-p dir v) ++ (push (merge-pathnames (parse-namestring dir nil *default-pathname-defaults* :start pos) pexp nil) r))) ++ :file) ++ (when (pathname-match-p dir v) (push pexp r)))) ++ (make-frame (if c "./" ""))) ++ r) +--- gcl-2.6.12.orig/lsp/gcl_fpe.lsp ++++ gcl-2.6.12/lsp/gcl_fpe.lsp +@@ -60,7 +60,7 @@ + + + (defun rf (addr w) +- (ecase w (4 (*float addr)) (8 (*double addr)))) ++ (ecase w (4 (*float addr 0 nil nil)) (8 (*double addr 0 nil nil)))) + + (defun ref (addr p w &aux (i -1)) + (if p +@@ -71,7 +71,7 @@ + (f (eql #\F (aref z 0)))) + (ref addr (unless f (eql (aref z (- lz 2)) #\P)) (if (or f (eql (aref z (1- lz)) #\D)) 8 4))) + +-(defun reg-lookup (x) (*fixnum (+ (car *context*) (symbol-value x)))) ++(defun reg-lookup (x) (*fixnum (+ (car *context*) (symbol-value x)) 0 nil nil)) + + (defun st-lookup (x) (fld (+ (cadr *context*) (symbol-value x)))) + (defun xmm-lookup (x) (gref (+ (caddr *context*) (symbol-value x)))) +--- gcl-2.6.12.orig/lsp/gcl_fpe_test.lsp ++++ gcl-2.6.12/lsp/gcl_fpe_test.lsp +@@ -1,6 +1,6 @@ +-#.`(defun test-fpe (f a r &optional chk &aux cc (o (mapcan (lambda (x) (list x t)) (si::break-on-floating-point-exceptions)))) ++#.`(defun test-fpe (f a r &optional chk &aux cc (o (mapcan (lambda (x) (list x t)) (break-on-floating-point-exceptions)))) + (flet ((set-break (x) (when (keywordp r) +- (apply 'si::break-on-floating-point-exceptions (append (unless x o) (list r x)))))) ++ (apply 'break-on-floating-point-exceptions (append (unless x o) (list r x)))))) + (let* ((rr (handler-case (unwind-protect (progn (set-break t) (apply f a)) (set-break nil)) + ,@(mapcar (lambda (x &aux (x (car x))) `(,x (c) (setq cc c) ,(intern (symbol-name x) :keyword))) + (append si::+fe-list+ '((arithmetic-error)(error))))))) +--- gcl-2.6.12.orig/lsp/gcl_info.lsp ++++ gcl-2.6.12/lsp/gcl_info.lsp +@@ -8,28 +8,6 @@ + (,op (the fixnum ,x) (the fixnum ,y)))) + (defmacro fcr (x) `(load-time-value (compile-regexp ,x)))) + +-(eval-when (compile eval load) +-(defun sharp-u-reader (stream subchar arg) +- subchar arg +- (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 +- (let ((ch (read-char stream))) +- (cond ((eql ch #\") (return tem)) +- ((eql ch #\\) +- (setq ch (read-char stream)) +- (setq ch (or (cdr (assoc ch '((#\n . #\newline) +- (#\t . #\tab) +- (#\r . #\return)))) +- ch)))) +- (vector-push-extend ch tem))) +- tem)) +- +-(set-dispatch-macro-character #\# #\u 'sharp-u-reader) +- +-) +- + (defconstant +crlu+ (compile-regexp #u"")) + (defconstant +crnp+ (compile-regexp #u"[ ]")) + +--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp ++++ gcl-2.6.12/lsp/gcl_iolib.lsp +@@ -1,3 +1,4 @@ ++;; -*-Lisp-*- + ;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + + ;; This file is part of GNU Common Lisp, herein referred to as GCL +@@ -24,130 +25,229 @@ + + (in-package :si) + +-(proclaim '(optimize (safety 2) (space 3))) ++(defun concatenated-stream-streams (stream) ++ (declare (optimize (safety 2))) ++ (check-type stream concatenated-stream) ++ (c-stream-object0 stream)) ++(defun broadcast-stream-streams (stream) ++ (declare (optimize (safety 2))) ++ (check-type stream broadcast-stream) ++ (c-stream-object0 stream)) ++(defun two-way-stream-input-stream (stream) ++ (declare (optimize (safety 2))) ++ (check-type stream two-way-stream) ++ (c-stream-object0 stream)) ++(defun echo-stream-input-stream (stream) ++ (declare (optimize (safety 2))) ++ (check-type stream echo-stream) ++ (c-stream-object0 stream)) ++(defun two-way-stream-output-stream (stream) ++ (declare (optimize (safety 2))) ++ (check-type stream two-way-stream) ++ (c-stream-object1 stream)) ++(defun echo-stream-output-stream (stream) ++ (declare (optimize (safety 2))) ++ (check-type stream echo-stream) ++ (c-stream-object1 stream)) ++(defun synonym-stream-symbol (stream) ++ (declare (optimize (safety 2))) ++ (check-type stream synonym-stream) ++ (c-stream-object0 stream)) + ++(defun maybe-clear-input (&optional (x *standard-input*)) ++ (typecase x ++ (synonym-stream (maybe-clear-input (symbol-value (synonym-stream-symbol x)))) ++ (two-way-stream (maybe-clear-input (two-way-stream-input-stream x))) ++ (stream (when (terminal-input-stream-p x) (clear-input t))))) + + (defmacro with-open-stream ((var stream) . body) +- (multiple-value-bind (ds b) +- (find-declarations body) ++ (declare (optimize (safety 1))) ++ (multiple-value-bind (ds b) (find-declarations body) + `(let ((,var ,stream)) + ,@ds + (unwind-protect +- (progn ,@b) ++ (progn ,@b) + (close ,var))))) + +- + (defmacro with-input-from-string ((var string &key index start end) . body) +- (let ((x (sgen "X"))) +- (multiple-value-bind (ds b) +- (find-declarations body) +- `(let ((,var (make-string-input-stream ,string ,start ,end))) +- ,@ds +- (unwind-protect +- ,(let ((f `(progn ,@b))) +- (if index +- `(let ((,x (multiple-value-list ,f))) (setf ,index (get-string-input-stream-index ,var)) (values-list ,x)) +- f)) +- (close ,var)))))) ++ (declare (optimize (safety 1))) ++ (multiple-value-bind (ds b) (find-declarations body) ++ `(let ((,var (make-string-input-stream ,string ,start ,end))) ++ ,@ds ++ (unwind-protect ++ (multiple-value-prog1 ++ (progn ,@b) ++ ,@(when index `((setf ,index (get-string-input-stream-index ,var))))) ++ (close ,var))))) + + (defmacro with-output-to-string ((var &optional string &key element-type) . body) +- (let ((s (sgen "STRING"))(bl (sgen "BLOCK"))(e (sgen "ELEMENT-TYPE"))(x (sgen "X"))) +- (multiple-value-bind (ds b) +- (find-declarations body) +- `(let* ((,s ,string)(,e ,element-type) +- (,var (if ,s (make-string-output-stream-from-string ,s) (make-string-output-stream :element-type ,e)))) ++ (declare (optimize (safety 1))) ++ (let ((s (sgen "STRING"))) ++ (multiple-value-bind (ds b) (find-declarations body) ++ `(let* ((,s ,string) ++ (,var (if ,s (make-string-output-stream-from-string ,s) (make-string-output-stream :element-type ,element-type)))) + ,@ds + (unwind-protect +- (let ((,x (multiple-value-list (progn ,@b)))) (if ,s (values-list ,x) (get-output-stream-string ,var))) ++ (block nil ++ (multiple-value-prog1 ++ (progn ,@b) ++ (unless ,s (return (get-output-stream-string ,var))))) + (close ,var)))))) + + +-(defun read-from-string (string +- &optional (eof-error-p t) eof-value +- &key (start 0) (end (length string)) +- preserve-whitespace) +- (let ((stream (make-string-input-stream string start end))) +- (if preserve-whitespace +- (values (read-preserving-whitespace stream eof-error-p eof-value) +- (si:get-string-input-stream-index stream)) +- (values (read stream eof-error-p eof-value) +- (si:get-string-input-stream-index stream))))) +- ++(defun read-from-string (string &optional (eof-error-p t) eof-value ++ &key (start 0) end preserve-whitespace) ++ (declare (optimize (safety 1))) ++ (check-type string string) ++ (check-type start seqind) ++ (check-type end (or null seqind)) ++ (let ((stream (make-string-input-stream string start (or end (length string))))) ++ (values (if preserve-whitespace ++ (read-preserving-whitespace stream eof-error-p eof-value) ++ (read stream eof-error-p eof-value)) ++ (get-string-input-stream-index stream)))) ++ ++;; (defun write (x &key stream ++;; (array *print-array*) ++;; (base *print-base*) ++;; (case *print-case*) ++;; (circle *print-circle*) ++;; (escape *print-escape*) ++;; (gensym *print-gensym*) ++;; (length *print-length*) ++;; (level *print-level*) ++;; (lines *print-lines*) ++;; (miser-width *print-miser-width*) ++;; (pprint-dispatch *print-pprint-dispatch*) ++;; (pretty *print-pretty*) ++;; (radix *print-radix*) ++;; (readably *print-readably*) ++;; (right-margin *print-right-margin*)) ++;; (write-int x stream array base case circle escape gensym ++;; length level lines miser-width pprint-dispatch ++;; pretty radix readably right-margin)) + + (defun write-to-string (object &rest rest +- &key escape radix base +- circle pretty level length +- case gensym array +- &aux (stream (make-string-output-stream))) +- (declare (ignore escape radix base +- circle pretty level length +- case gensym array)) ++ &key (escape *print-escape*)(radix *print-radix*)(base *print-base*) ++ (circle *print-circle*)(pretty *print-pretty*)(level *print-level*) ++ (length *print-length*)(case *print-case*)(gensym *print-gensym*) ++ (array *print-array*)(lines *print-lines*)(miser-width *print-miser-width*) ++ (pprint-dispatch *print-pprint-dispatch*)(readably *print-readably*) ++ (right-margin *print-right-margin*) ++ &aux (stream (make-string-output-stream)) ++ (*print-escape* escape)(*print-radix* radix)(*print-base* base) ++ (*print-circle* circle)(*print-pretty* pretty)(*print-level* level) ++ (*print-length* length)(*print-case* case)(*print-gensym* gensym) ++ (*print-array* array)(*print-lines* lines)(*print-miser-width* miser-width) ++ (*print-pprint-dispatch* pprint-dispatch)(*print-readably* readably ) ++ (*print-right-margin* right-margin)) ++ (declare (optimize (safety 1))(dynamic-extent rest)) + (apply #'write object :stream stream rest) + (get-output-stream-string stream)) + ++(defun prin1-to-string (object &aux (stream (make-string-output-stream))) ++ (declare (optimize (safety 1))) ++ (prin1 object stream) ++ (get-output-stream-string stream)) + +-(defun prin1-to-string (object +- &aux (stream (make-string-output-stream))) +- (prin1 object stream) +- (get-output-stream-string stream)) +- +- +-(defun princ-to-string (object +- &aux (stream (make-string-output-stream))) ++(defun princ-to-string (object &aux (stream (make-string-output-stream))) ++ (declare (optimize (safety 1))) + (princ object stream) + (get-output-stream-string stream)) + ++;; (defun file-string-length (ostream object) ++;; (declare (optimize (safety 2))) ++;; (let ((ostream (if (typep ostream 'broadcast-stream) ++;; (car (last (broadcast-stream-streams ostream))) ++;; ostream))) ++;; (cond ((not ostream) 1) ++;; ((subtypep1 (stream-element-type ostream) 'character) ++;; (length (let ((*print-escape* nil)) (write-to-string object))))))) ++ ++;; (defmacro with-temp-file ((s pn) (tmp ext) &rest body) ++;; (multiple-value-bind ++;; (doc decls ctps body) ++;; (parse-body-header body) ++;; (declare (ignore doc)) ++;; `(let* ((,s (temp-stream ,tmp ,ext)) ++;; (,pn (stream-object1 ,s))) ++;; ,@decls ++;; ,@ctps ++;; (unwind-protect (progn ,@body) (progn (close ,s) (delete-file ,s)))))) ++ + + (defmacro with-open-file ((stream . filespec) . body) +- (multiple-value-bind (ds b) +- (find-declarations body) ++ (declare (optimize (safety 1))) ++ (multiple-value-bind (ds b) (find-declarations body) + `(let ((,stream (open ,@filespec))) + ,@ds + (unwind-protect +- (progn ,@b) +- (if ,stream (close ,stream)))))) ++ (progn ,@b) ++ (when ,stream (close ,stream)))))) + ++;; (defun pprint-dispatch (obj &optional (table *print-pprint-dispatch*)) ++;; (declare (optimize (safety 2))) ++;; (let ((fun (si:get-pprint-dispatch obj table))) ++;; (if fun (values fun t) (values 'si:default-pprint-object nil)))) ++ ++;; (setq *print-pprint-dispatch* '(pprint-dispatch . nil)) ++ ++;; (defun set-pprint-dispatch (type-spec function &optional ++;; (priority 0) ++;; (table *print-pprint-dispatch*)) ++;; (declare (optimize (safety 2))) ++;; (unless (typep priority 'real) ++;; (error 'type-error :datum priority :expected-type 'real)) ++;; (let ((a (assoc type-spec (cdr table) :test 'equal))) ++;; (if a (setf (cdr a) (list function priority)) ++;; (rplacd (last table) `((,type-spec ,function ,priority))))) ++;; nil) ++ ++;; (defun copy-pprint-dispatch (&optional table) ++;; (declare (optimize (safety 2))) ++;; (unless table ++;; (setq table *print-pprint-dispatch*)) ++;; (unless (and (eq (type-of table) 'cons) ++;; (eq (car table) 'pprint-dispatch)) ++;; (error 'type-error :datum table :expected-type 'pprint-dispatch)) ++;; (copy-seq table )) + +-(defun y-or-n-p (&optional string &rest args) +- (do ((reply)) +- (nil) +- (when string (format *query-io* "~&~? (Y or N) " string args)) +- (setq reply (read *query-io*)) +- (cond ((string-equal (symbol-name reply) "Y") +- (return-from y-or-n-p t)) +- ((string-equal (symbol-name reply) "N") +- (return-from y-or-n-p nil))))) + ++(defun y-or-n-p (&optional string &rest args) ++ (declare (optimize (safety 1))) ++ (when string (format *query-io* "~&~? (Y or N) " string args)) ++ (let ((reply (symbol-name (read *query-io*)))) ++ (cond ((string-equal reply "Y") t) ++ ((string-equal reply "N") nil) ++ ((apply 'y-or-n-p string args))))) + + (defun yes-or-no-p (&optional string &rest args) +- (do ((reply)) +- (nil) +- (when string (format *query-io* "~&~? (Yes or No) " string args)) +- (setq reply (read *query-io*)) +- (cond ((string-equal (symbol-name reply) "YES") +- (return-from yes-or-no-p t)) +- ((string-equal (symbol-name reply) "NO") +- (return-from yes-or-no-p nil))))) +- ++ (declare (optimize (safety 1))) ++ (when string (format *query-io* "~&~? (Yes or No) " string args)) ++ (let ((reply (symbol-name (read *query-io*)))) ++ (cond ((string-equal reply "YES") t) ++ ((string-equal reply "NO") nil) ++ ((apply 'yes-or-no-p string args))))) + + (defun sharp-a-reader (stream subchar arg) + (declare (ignore subchar)) + (let ((initial-contents (read stream nil nil t))) +- (if *read-suppress* +- nil +- (do ((i 0 (1+ i)) +- (d nil (cons (length ic) d)) +- (ic initial-contents (if (zerop (length ic)) ic (elt ic 0)))) +- ((>= i arg) +- (make-array (nreverse d) +- :initial-contents initial-contents)))))) ++ (unless *read-suppress* ++ (do ((i 0 (1+ i)) ++ (d nil (cons (length ic) d)) ++ (ic initial-contents (if (zerop (length ic)) ic (elt ic 0)))) ++ ((>= i arg) (make-array (nreverse d) :initial-contents initial-contents)))))) + + (set-dispatch-macro-character #\# #\a 'sharp-a-reader) ++(set-dispatch-macro-character #\# #\a 'sharp-a-reader (standard-readtable)) + (set-dispatch-macro-character #\# #\A 'sharp-a-reader) ++(set-dispatch-macro-character #\# #\A 'sharp-a-reader (standard-readtable)) + + ;; defined in defstruct.lsp + (set-dispatch-macro-character #\# #\s 'sharp-s-reader) ++(set-dispatch-macro-character #\# #\s 'sharp-s-reader (standard-readtable)) + (set-dispatch-macro-character #\# #\S 'sharp-s-reader) ++(set-dispatch-macro-character #\# #\S 'sharp-s-reader (standard-readtable)) + + (defvar *dribble-stream* nil) + (defvar *dribble-io* nil) +@@ -155,6 +255,7 @@ + (defvar *dribble-saved-terminal-io* nil) + + (defun dribble (&optional (pathname "DRIBBLE.LOG" psp) (f :supersede)) ++ (declare (optimize (safety 1))) + (cond ((not psp) + (when (null *dribble-stream*) (error "Not in dribble.")) + (if (eq *dribble-io* *terminal-io*) +@@ -183,73 +284,18 @@ + (format t "~&Starts dribbling to ~A (~d/~d/~d, ~d:~d:~d)." + namestring year month day hour min sec)))))) + +-(defconstant char-length 8) +- +-(defun get-byte-stream-nchars (s) +- (check-type s stream) +- (let* ((tp (stream-element-type s)) +- (tp (if (consp tp) (cadr tp) char-length)) +- (nc (ceiling tp char-length))) +- nc)) +- +-(defun write-byte (j s) +- (declare (optimize (safety 1))) +- (let ((nc (get-byte-stream-nchars s)) +- (ff (1- (expt 2 char-length)))) +- (do ((k 0 (1+ k))(i j (ash i (- char-length)))) ((>= k nc) j) +- (write-char (code-char (logand i ff)) s)))) +- +-(defun read-byte (s &optional (eof-error-p t) eof-value) +- (declare (optimize (safety 1))) +- (let ((nc (get-byte-stream-nchars s))) +- (do ((j 0 (1+ j)) +- (i 0 (logior i +- (ash (char-code (let ((ch (read-char s eof-error-p eof-value))) +- (if (and (not eof-error-p) (eq ch eof-value)) +- (return-from read-byte ch) +- ch))) (* j char-length))))) +- ((>= j nc) i)))) +- +- +-(defun read-sequence (seq strm &key (start 0) end) +- (declare (optimize (safety 1))) +- (check-type seq sequence) +- (check-type start (integer 0)) +- (check-type end (or null (integer 0))) +- (let* ((start (min start array-dimension-limit)) +- (end (if end (min end array-dimension-limit) (length seq))) +- (l (listp seq)) +- (seq (if (and l (> start 0)) (nthcdr start seq) seq)) +- (tp (subtypep (stream-element-type strm) 'character))) +- (do ((i start (1+ i))(seq seq (if l (cdr seq) seq))) +- ((or (>= i end) (when l (endp seq))) i) +- (declare (fixnum i)) +- (let ((el (if tp (read-char strm nil 'eof) (read-byte strm nil 'eof)))) +- (when (eq el 'eof) (return i)) +- (if l (setf (car seq) el) (setf (aref seq i) el)))))) +- ++;; (defmacro formatter ( control-string ) ++;; (declare (optimize (safety 2))) ++;; `(progn ++;; (lambda (*standard-output* &rest arguments) ++;; (let ((*format-unused-args* nil)) ++;; (apply 'format t ,control-string arguments) ++;; *format-unused-args*)))) + +-(defun write-sequence (seq strm &key (start 0) end) ++(defun stream-external-format (s) + (declare (optimize (safety 1))) +- (check-type seq sequence) +- (check-type start (integer 0)) +- (check-type end (or null (integer 0))) +- (let* ((start (min start array-dimension-limit)) +- (end (if end (min end array-dimension-limit) (length seq))) +- (l (listp seq)) +- (tp (subtypep (stream-element-type strm) 'character))) +- (do ((i start (1+ i)) +- (seq (if (and l (> start 0)) (nthcdr start seq) seq) (if l (cdr seq) seq))) +- ((or (>= i end) (when l (endp seq)))) +- (declare (fixnum i)) +- (let ((el (if l (car seq) (aref seq i)))) +- (if tp (write-char el strm) (write-byte el strm)))) +- seq)) +- +-(defmacro with-compilation-unit (opt &rest body) +- (declare (optimize (safety 2))) +- (declare (ignore opt)) +- `(progn ,@body)) ++ (check-type s stream) ++ :default) + + (defvar *print-lines* nil) + (defvar *print-miser-width* nil) +@@ -257,7 +303,7 @@ + (defvar *print-right-margin* nil) + + (defmacro with-standard-io-syntax (&body body) +- (declare (optimize (safety 2))) ++ (declare (optimize (safety 1))) + `(let* ((*package* (find-package :cl-user)) + (*print-array* t) + (*print-base* 10) +@@ -269,7 +315,7 @@ + (*print-level* nil) + (*print-lines* nil) + (*print-miser-width* nil) +- (*print-pprint-dispatch* *print-pprint-dispatch*) ++ (*print-pprint-dispatch* *print-pprint-dispatch*);FIXME + (*print-pretty* nil) + (*print-radix* nil) + (*print-readably* t) +@@ -278,37 +324,163 @@ + (*read-default-float-format* 'single-float) + (*read-eval* t) + (*read-suppress* nil) +- (*readtable* (copy-readtable (si::standard-readtable))));FIXME copy? ++ (*readtable* (copy-readtable (standard-readtable)))) + ,@body)) + ++;; (defmacro print-unreadable-object ++;; ((object stream &key type identity) &body body) ++;; (declare (optimize (safety 2))) ++;; (let ((q `(princ " " ,stream))) ++;; `(if *print-readably* ++;; (error 'print-not-readable :object ,object) ++;; (progn ++;; (princ "#<" ,stream) ++;; ,@(when type `((prin1 (type-of ,object) ,stream) ,q)) ++;; ,@body ++;; ,@(when identity ++;; (let ((z `(princ (address ,object) ,stream))) ++;; (if (and (not body) type) (list z) (list q z)))) ++;; (princ ">" ,stream) ++;; nil)))) ++ ++;; (defmacro with-compile-file-syntax (&body body) ++;; `(let ((*print-radix* nil) ++;; (*print-base* 10) ++;; (*print-circle* t) ++;; (*print-pretty* nil) ++;; (*print-level* nil) ++;; (*print-length* nil) ++;; (*print-case* :downcase) ++;; (*print-gensym* t) ++;; (*print-array* t) ++;; (*print-package* t) ++;; (*print-structure* t)) ++;; ,@body)) ++ ++(defmacro with-compilation-unit (opt &rest body) ++ (declare (optimize (safety 1))) ++ (declare (ignore opt)) ++ `(progn ,@body)) ++ ++(defconstant char-length 8) ++ ++(defun get-byte-stream-nchars (s) ++ (let* ((tp (stream-element-type s))) ++ (ceiling (if (consp tp) (cadr tp) char-length) char-length))) ++ ++;; (defun parse-integer (s &key start end (radix 10) junk-allowed) ++;; (declare (optimize (safety 1))) ++;; (parse-integer-int s start end radix junk-allowed)) ++ ++(defun write-byte (j s &aux (i j)) ++ (declare (optimize (safety 1))) ++ (check-type j integer) ++ (check-type s stream) ++ (dotimes (k (get-byte-stream-nchars s) j) ++ (write-char (code-char (logand i #.(1- (ash 1 char-length)))) s) ++ (setq i (ash i #.(- char-length))))) ++ ++ ++(defun read-byte (s &optional (eof-error-p t) eof-value &aux (i 0)) ++ (declare (optimize (safety 1))) ++ (check-type s stream) ++ (dotimes (k (get-byte-stream-nchars s) i) ++ (setq i (logior i (ash (let ((ch (read-char s eof-error-p eof-value))) ++ (if (eq ch eof-value) (return ch) (char-code ch))) ++ (* k char-length)))))) ++ ++ ++(defun read-sequence (seq strm &rest r &key (start 0) end ++ &aux (l (listp seq))(seqp (when l (nthcdr start seq))) ++ (cp (eq (stream-element-type strm) 'character))) ++ (declare (optimize (safety 1))(dynamic-extent r)) ++ (check-type seq sequence) ++ (check-type strm stream) ++ (check-type start (integer 0)) ++ (check-type end (or null (integer 0))) ++ (apply 'reduce (lambda (y x &aux (z (if cp (read-char strm nil 'eof) (read-byte strm nil 'eof)))) ++ (declare (seqind y)(ignorable x)) ++ (when (eq z 'eof) (return-from read-sequence y)) ++ (if l (setf (car seqp) z seqp (cdr seqp)) (setf (aref seq y) z)) ++ (1+ y)) seq :initial-value start r)) ++ ++ ++(defun write-sequence (seq strm &rest r &key (start 0) end ++ &aux (l (listp seq))(cp (eq (stream-element-type strm) 'character))) ++ (declare (optimize (safety 1))(dynamic-extent r)) ++ (check-type seq sequence) ++ (check-type strm stream) ++ (check-type start (integer 0)) ++ (check-type end (or null (integer 0))) ++ (apply 'reduce (lambda (y x) ++ (declare (seqind y)) ++ (if cp (write-char x strm) (write-byte x strm)) ++ (1+ y)) seq :initial-value start r) ++ seq) ++ ++(defun restrict-stream-element-type (tp) ++ (cond ((or (member tp '(character :default)) (subtypep tp 'character)) 'character) ++ ((subtypep tp 'integer) ++ (let* ((ntp (car (expand-ranges (normalize-type tp)))) ++ (min (or (cadr ntp) '*))(max (or (caddr ntp) '*)) ++ (s (if (or (eq min '*) (< min 0)) 'signed-byte 'unsigned-byte)) ++ (lim (unless (or (eq min '*) (eq max '*)) (max (integer-length min) (integer-length max)))) ++ (lim (if (and lim (eq s 'signed-byte)) (1+ lim) lim))) ++ (if lim `(,s ,lim) s))) ++ ((check-type tp (member character integer))))) ++ ++(defun open (f &key (direction :input) ++ (element-type 'character) ++ (if-exists nil iesp) ++ (if-does-not-exist nil idnesp) ++ (external-format :default) &aux (pf (pathname f))) ++ (declare (optimize (safety 1))) ++ (check-type f pathname-designator) ++ (when (wild-pathname-p pf) ++ (error 'file-error :pathname pf :format-control "Pathname is wild.")) ++ (let* ((s (open-int (namestring (translate-logical-pathname pf)) direction ++ (restrict-stream-element-type element-type) ++ if-exists iesp if-does-not-exist idnesp external-format))) ++ (when (typep s 'stream) (c-set-stream-object1 s pf) s))) ++ ++(defun load-pathname (p print if-does-not-exist external-format ++ &aux (pp (merge-pathnames p)) ++ (epp (reduce (lambda (y x) (or y (probe-file (translate-pathname x "" p)))) ++ '(#P".o" #P".lsp" #P".lisp" #P"") :initial-value nil)));FIXME newest? ++ (if epp ++ (let* ((*load-pathname* pp)(*load-truename* epp)) ++ (with-open-file ++ (s epp :external-format external-format) ++ (if (member (peek-char nil s nil 'eof) '#.(mapcar 'code-char (list 127 #xfe #xff #x4c))) ++ (load-fasl s print) ++ (let ((*standard-input* s)) (load-stream s print))))) ++ (when if-does-not-exist ++ (error 'file-error :pathname pp :format-control "File does not exist.")))) ++ ++(defun load (p &key (verbose *load-verbose*) (print *load-print*) (if-does-not-exist :error) ++ (external-format :default) &aux (*readtable* *readtable*)(*package* *package*)) ++ (declare (optimize (safety 1))) ++ (check-type p (or stream pathname-designator)) ++ (when verbose (format t ";; Loading ~s~%" p)) ++ (prog1 ++ (typecase p ++ (pathname-designator (load-pathname (pathname p) print if-does-not-exist external-format)) ++ (stream (load-stream p print))) ++ (when verbose (format t ";; Finished loading ~s~%" p)))) ++ + (defun ensure-directories-exist (ps &key verbose &aux created) ++ (declare (optimize (safety 1))) ++ (check-type ps pathname-designator) + (when (wild-pathname-p ps) + (error 'file-error :pathname ps :format-control "Pathname is wild")) +- (labels ((d (x y &aux (z (ldiff x y)) (p (make-pathname :directory z))) ++ (labels ((d (x y &aux (z (ldiff x y)) (n (namestring (make-pathname :directory z)))) + (when (when z (stringp (car (last z)))) +- (unless (eq :directory (car (stat p))) +- (mkdir (namestring p)) ++ (unless (eq :directory (stat n)) ++ (mkdir n) + (setq created t) +- (when verbose (format *standard-output* "Creating directory ~s~%" p)))) ++ (when verbose (format *standard-output* "Creating directory ~s~%" n)))) + (when y (d x (cdr y))))) + (let ((pd (pathname-directory ps))) + (d pd (cdr pd))) + (values ps created))) + +-#.(let ((g '(:host :device :directory :name :type :version))) +- `(defun wild-pathname-p (pd &optional f &aux (p (pathname pd))) +- (declare (optimize (safety 1))) +- (check-type f (or null (member ,@g))) +- (labels ((w-f (x) +- (case x +- ,@(mapcar (lambda (x &aux (f (intern (string-concatenate "PATHNAME-" (string-upcase x))))) +- `(,x ,(if (eq x :directory) `(when (member :wild (,f p)) t) `(eq :wild (,f p))))) g)))) +- (if f +- (w-f f) +- (reduce (lambda (z x) (or z (w-f x))) ',g :initial-value nil))))) +- +-(defun maybe-clear-input (&optional (x *standard-input*)) +- (cond ((not (typep x 'stream)) nil) +- ((typep x 'synonym-stream) (maybe-clear-input (symbol-value (synonym-stream-symbol x)))) +- ((typep x 'two-way-stream) (maybe-clear-input (two-way-stream-input-stream x))) +- ((terminal-input-stream-p x) (clear-input t)))) +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_logical_pathname_translations.lsp +@@ -0,0 +1,28 @@ ++(in-package :si) ++ ++(defvar *pathname-logical* nil) ++ ++(defun setf-logical-pathname-translations (v k) ++ (declare (optimize (safety 1))) ++ (check-type v list) ++ (check-type k string) ++ (setf (cdr (or (assoc k *pathname-logical* :test 'string-equal) (car (push (cons k t) *pathname-logical*)))) ;(cons k nil) ++ (mapcar (lambda (x) (list (parse-namestring (car x) k) (parse-namestring (cadr x)))) v))) ++ ++(defsetf logical-pathname-translations (x) (y) `(setf-logical-pathname-translations ,y ,x)) ++(remprop 'logical-pathname-translations 'si::setf-update-fn) ++ ++(defun logical-pathname-translations (k) ++ (declare (optimize (safety 1))) ++ (check-type k string) ++ (cdr (assoc k *pathname-logical* :test 'string-equal))) ++ ++ ++(defun load-logical-pathname-translations (k) ++ (declare (optimize (safety 1))) ++ (unless (logical-pathname-translations k) ++ (error "No translations found for ~s" k))) ++ ++(defun logical-pathname-host-p (host) ++ (when host ++ (logical-pathname-translations host))) +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_make_pathname.lsp +@@ -0,0 +1,155 @@ ++(in-package :si) ++ ++;; (defun pathnamep (x) ++;; (declare (optimize (safety 1))) ++;; (when (typep x 'pathname) t)) ++ ++(defun msub (a x) (if a (msub (cdr a) (substitute (caar a) (cdar a) x)) x)) ++ ++(defvar *glob-to-regexp-alist* (list (cons #v"{[^}]*}" (lambda (x) (msub '((#\| . #\,)(#\( . #\{)(#\) . #\})) x))) ++ (cons #v"\\[[^\\]*\\]" (lambda (x) ++ (concatenate 'string "(" ++ (substitute #\^ #\! (subseq x 0 2)) ++ (subseq x 2) ")"))) ++ (cons #v"\\*" (lambda (x) "([^/.]*)")) ++ (cons #v"\\?" (lambda (x) "([^/.])")) ++ (cons #v"\\." (lambda (x) "\\.")))) ++ ++(defun mglist (x &optional (b 0)) ++ (let* ((y (mapcan (lambda (z &aux (w (string-match (car z) x b))) ++ (unless (eql w -1) ++ (list (list w (match-end 0) z)))) ++ *glob-to-regexp-alist*)) ++ (z (when y (reduce (lambda (y x) (if (< (car x) (car y)) x y)) y)))) ++ (when z ++ (cons z (mglist x (cadr z)))))) ++ ++(defun mgsub (x &optional (l (mglist x)) (b 0) &aux (w (pop l))) ++ (if w ++ (concatenate 'string ++ (subseq x b (car w)) ++ (funcall (cdaddr w) (subseq x (car w) (cadr w))) ++ (mgsub x l (cadr w))) ++ (subseq x b))) ++ ++ ++(defun elsub (el x rp lp &aux (y x) (pref (pop y))(dflt (pop y))(post (pop y))) ++; (destructuring-bind (pref dflt post &rest y) x ++ (etypecase el ++ (string (let ((x (list pref el post))) (unless (zerop (length dflt)) (if rp (mapcar 'mgsub x) x)))) ++ (integer (elsub (write-to-string el) x rp lp)) ++ ((eql :wild-inferiors) (if rp (list "(" dflt "*)") (elsub "**" x rp lp))) ++ ((eql :wild) (if rp (list dflt) (elsub "*" x rp lp))) ++ ((eql :newest) (elsub (if rp "(newest|NEWEST)" "NEWEST") x rp lp)) ++ ((member :up :back) (elsub ".." x rp lp)) ++ ((member nil :unspecific) (when rp (list dflt))) ++ (cons (cons ++ (if (eq (car el) :absolute) (if lp "" "/") (if lp ";" "")) ++ (mapcan (lambda (z) (elsub z y rp lp)) (cdr el))))) ++; ) ++) ++ ++(defconstant +physical-pathname-defaults+ '(("" "" "") ++ ("" "" "") ++ ("" "(/?([^/]+/)*)" "" "" "([^/]+/)" "/") ++ ("" "([^/.]*)" "") ++ ("." "(\\.[^/]*)?" "") ++ ("" "" ""))) ++(defconstant +logical-pathname-defaults+ '(("" "([-0-9A-Z]+:)?" ":") ++ ("" "" "") ++ ("" "(;?((\\*?([-0-9A-Z]+\\*?)+|\\*|\\*\\*);)*)" "" "" "((\\*?([-0-9A-Z]+\\*?)+|\\*);)" ";") ++ ("" "(\\*?([-0-9A-Z]+\\*?)+|\\*)?" "") ++ ("." "(\\.(\\*?([-0-9A-Z]+\\*?)+|\\*))?" "") ++ ("." "(\\.([1-9][0-9]*|newest|NEWEST|\\*))?" ""))) ++ ++(defun to-regexp-or-namestring (x rp lp) ++ (apply 'concatenate 'string ++ (mapcan (lambda (x y) (elsub x y rp lp)) ++ x (if lp +logical-pathname-defaults+ +physical-pathname-defaults+)))) ++ ++(defun directory-list-check (l) ++ (when (listp l) ++ (when (member (car l) '(:absolute :relative)) ++ (mapl (lambda (x &aux (c (car x))(d (cadr x))) ++ (when (and (member d '(:up :back)) (member c '(:absolute :wild-inferiors))) ++ (return-from directory-list-check nil))) l)))) ++ ++(defun canonicalize-pathname-directory (l) ++ (cond ((eq l :wild) (canonicalize-pathname-directory '(:absolute :wild-inferiors))) ++ ((stringp l) (canonicalize-pathname-directory (list :absolute l))) ++ ((mapl (lambda (x &aux (c (car x))) ++ (when (and (or (stringp c) (eq c :wild)) (eq (cadr x) :back)) ++ (return-from canonicalize-pathname-directory ++ (canonicalize-pathname-directory (nconc (ldiff l x) (cddr x)))))) l)))) ++ ++(defvar *default-pathname-defaults* (init-pathname nil nil nil nil nil nil "")) ++(declaim (type pathname *default-pathname-defaults*)) ++ ++(defun toggle-case (x) ++ (cond ((symbolp x) x) ++ ((listp x) (mapcar 'toggle-case x)) ++ ((find-if 'upper-case-p x) (if (find-if 'lower-case-p x) x (string-downcase x))) ++ ((find-if 'lower-case-p x) (string-upcase x)) ++ (x))) ++ ++(defun logical-pathname (spec &aux (p (pathname spec))) ++ (declare (optimize (safety 1))) ++ (check-type spec pathname-designator) ++ (check-type p logical-pathname) ++ p) ++ ++(eval-when (compile eval) ++ (defun strsym (p &rest r) ++ (declare (:dynamic-extent r)) ++ (intern (apply 'concatenate 'string (mapcar 'string-upcase r)) p))) ++ ++#.`(defun make-pathname (&key (host nil hostp) (device nil devicep) (directory nil directoryp) ++ (name nil namep) (type nil typep) (version nil versionp) ++ defaults (case :local) namestring &aux defaulted (def (when defaults (pathname defaults)))) ++ (declare (optimize (safety 1))) ++ (check-type host (or (member nil :unspecific) string)) ++ (check-type device (member nil :unspecific)) ++ (check-type directory (or (member nil :unspecific :wild) string list)) ++ (check-type name (or string (member nil :unspecific :wild))) ++ (check-type type (or string (member nil :unspecific :wild))) ++ (check-type version (or (integer 1) (member nil :unspecific :wild :newest))) ++ (check-type defaults (or null pathname-designator)) ++ (check-type case (member :common :local)) ++ ,(flet ((def? (k) `(let* (,@(when (eq k 'host) `((def (or def *default-pathname-defaults*)))) ++ (nk (if ,(strsym :si k "P") ,k (progn (setq defaulted t) (when def (,(strsym :si "C-PATHNAME-" k) def))))) ++ (nk (if (eq case :local) nk (progn (setq defaulted t) (toggle-case nk))))) ++ nk))) ++ `(let* ((h ,(def? 'host)) ++ (h (let ((h1 (when (logical-pathname-host-p h) h))) (unless (eq h h1) (setq defaulted t)) h1)) ++ (dev ,(def? 'device)) ++ (d ,(def? 'directory)) ++ (d (let ((d1 (canonicalize-pathname-directory d))) (unless (eq d d1) (setq defaulted t)) d1)) ++ (n ,(def? 'name)) ++ (typ ,(def? 'type)) ++ (v ,(def? 'version)) ++ (p (init-pathname h dev d n typ v ++ (or (unless defaulted namestring) (to-regexp-or-namestring (list h dev d n typ v) nil h))))) ++ (when h (c-set-t-tt p 1)) ++ (unless (eq d (directory-list-check d)) ++ (error 'file-error :pathname p :format-control "Bad directory list")) ++ p))) ++ ++(macrolet ((pn-accessor (k &aux (f (strsym :si "PATHNAME-" k)) (c (strsym :si "C-PATHNAME-" k))) ++ `(defun ,f (p &key (case :local) &aux (pn (pathname p))) ++ (declare (optimize (safety 1))) ++ (check-type p pathname-designator) ++ (let ((x (,c pn))) (if (eq case :local) x (toggle-case x)))))) ++ (pn-accessor host) ++ (pn-accessor device) ++ (pn-accessor directory) ++ (pn-accessor name) ++ (pn-accessor type) ++ (pn-accessor version)) ++ ++(defconstant +pathname-keys+ '(:host :device :directory :name :type :version)) ++ ++#.`(defun mlp (p) ++ (list ,@(mapcar (lambda (x) `(,(strsym :si "C-PATHNAME-" x) p)) +pathname-keys+))) ++ ++(defun pnl1 (x) (list* (pop x) (pop x) (append (pop x) x))) ++(defun lnp (x) (list* (pop x) (pop x) (let ((q (last x 3))) (cons (ldiff x q) q)))) +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_merge_pathnames.lsp +@@ -0,0 +1,18 @@ ++(in-package :si) ++ ++(defun merge-pathnames (p &optional (def *default-pathname-defaults*) (def-v :newest) ++ &aux dflt (pn (pathname p))(def-pn (pathname def))) ++ (declare (optimize (safety 1))) ++ (check-type p pathname-designator) ++ (check-type def pathname-designator) ++ (check-type def-v (or null (eql :newest) seqind)) ++ (labels ((def (x) (when x (setq dflt t) x))) ++ (make-pathname ++ :host (or (pathname-host pn) (def (pathname-host def-pn))) ++ :device (or (pathname-device pn) (def (pathname-device def-pn))) ++ :directory (let ((d (pathname-directory pn))(defd (pathname-directory def-pn))) ++ (or (def (when (and defd (eq (car d) :relative)) (append defd (cdr d)))) d (def defd))) ++ :name (or (pathname-name pn) (def (pathname-name def-pn))) ++ :type (or (pathname-type pn) (def (pathname-type def-pn))) ++ :version (or (pathname-version pn) (def (unless (pathname-name pn) (pathname-version def-pn))) (def def-v)) ++ :version (unless dflt (return-from merge-pathnames pn))))) +--- gcl-2.6.12.orig/lsp/gcl_mislib.lsp ++++ gcl-2.6.12/lsp/gcl_mislib.lsp +@@ -114,13 +114,15 @@ + (* (+ h tz) 3600) (* min 60) sec)) + + (defun compile-file-pathname (pathname) +-(make-pathname :defaults pathname :type "o")) ++ (make-pathname :defaults pathname :type "o")) ++ + (defun constantly (x) +-#'(lambda (&rest args) ++ (lambda (&rest args) + (declare (ignore args) (:dynamic-extent args)) +-x)) ++ x)) ++ + (defun complement (fn) +-#'(lambda (&rest args) (not (apply fn args)))) ++ (lambda (&rest args) (not (apply fn args)))) + + (defun default-system-banner () + (let (gpled-modules) +--- gcl-2.6.12.orig/lsp/gcl_module.lsp ++++ gcl-2.6.12/lsp/gcl_module.lsp +@@ -40,13 +40,13 @@ + + (defun require (module-name + &optional (pathname (string-downcase (string module-name)))) +- (let ((*default-pathname-defaults* #"")) ++ (let ((*default-pathname-defaults* (make-pathname))) + (unless (member (string module-name) + *modules* + :test #'string=) + (if (atom pathname) + (load pathname) +- (do ((p pathname (cdr p))) ++ (do ((p pathname (cdr p))) + ((endp p)) + (load (car p))))))) + +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_namestring.lsp +@@ -0,0 +1,39 @@ ++(in-package :si) ++ ++(defun namestring (x) ++ (declare (optimize (safety 1))) ++ (check-type x pathname-designator) ++ (typecase x ++ (string x) ++ (pathname (c-pathname-namestring x)) ++ (stream (namestring (c-stream-object1 x))))) ++ ++(defun file-namestring (x &aux (px (pathname x))) ++ (declare (optimize (safety 1))) ++ (check-type x pathname-designator) ++ (namestring (make-pathname :name (pathname-name px) :type (pathname-type px) :version (pathname-version px)))) ++ ++(defun directory-namestring (x &aux (px (pathname x))) ++ (declare (optimize (safety 1))) ++ (check-type x pathname-designator) ++ (namestring (make-pathname :directory (pathname-directory px)))) ++ ++(defun host-namestring (x &aux (px (pathname x))) ++ (declare (optimize (safety 1))) ++ (check-type x pathname-designator) ++ (or (pathname-host px) "")) ++ ++#.`(defun enough-namestring (x &optional (def *default-pathname-defaults*) &aux (px (pathname x))(pdef (pathname def))) ++ (declare (optimize (safety 1))) ++ (check-type x pathname-designator) ++ (check-type def pathname-designator) ++ ,(labels ((new? (k &aux (f (intern (concatenate 'string "PATHNAME-" (string k)) :si))) ++ `(let ((k (,f px))) (unless (equal k (,f pdef)) k)))) ++ `(namestring (make-pathname ++ ,@(mapcan (lambda (x) (list x (new? x))) +pathname-keys+))))) ++ ++(defun faslink (file name &aux (pfile (namestring (merge-pathnames (make-pathname :type "o") (pathname file))))(*package* *package*));FIXME ++ (declare (optimize (safety 1))) ++ (check-type file pathname-designator) ++ (check-type name string) ++ (faslink-int pfile name)) +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_parse_namestring.lsp +@@ -0,0 +1,139 @@ ++(in-package :si) ++ ++(deftype seqind nil `fixnum) ++ ++(defun match-beginning (i &aux (v *match-data*)) ++ (declare ((vector fixnum) v)(seqind i)) ++ (the (or (integer -1 -1 ) seqind) (aref v i))) ++(defun match-end (i &aux (v *match-data*)) ++ (declare ((vector fixnum) v)(seqind i)) ++ (the (or (integer -1 -1 ) seqind) (aref v (+ i (ash (length v) -1))))) ++ ++(declaim (inline match-beginning match-end)) ++ ++(defun dir-conj (x) (if (eq x :relative) :absolute :relative)) ++ ++(defvar *up-key* :up) ++ ++(defun mfr (x b i) (subseq x b i)); (make-array (- i b) :element-type 'character :displaced-to x :displaced-index-offset b) ++ ++(defvar *sym-sub-alist* '((:host . nil) ++ (:device . nil) ++ (:directory . (("." . nil)(".." . :up)("*" . :wild)("**" . :wild-inferiors))) ++ (:name . (("*" . :wild))) ++ (:type . (("*" . :wild))) ++ (:version . (("*" . :wild)("NEWEST" . :newest))))) ++ ++(defun element (x b i key) ++ (let* ((z (when (> i b) (mfr x b i))) ++ (w (assoc z (cdr (assoc key *sym-sub-alist*)) :test 'string-equal)) ++ (z (if w (cdr w) z))) ++ (if (eq z :up) *up-key* z))) ++ ++(defun dir-parse (x sep sepfirst &optional (b 0)) ++ (when (stringp x) ++ (let ((i (search sep x :start2 b)));string-match spoils outer match results ++ (when i ++ (let* ((y (dir-parse x sep sepfirst (1+ i))) ++ (z (element x b i :directory)) ++ (y (if z (cons z y) y))) ++ (if (zerop b) ++ (cons (if (zerop i) sepfirst (dir-conj sepfirst)) y) ++ y)))))) ++ ++(defun match-component (x i k &optional (boff 0) (eoff 0)) ++ (element x (+ (match-beginning i) boff) (+ (match-end i) eoff) k)) ++ ++(defun version-parse (x) ++ (typecase x ++ (string (version-parse (parse-integer x))) ++; (integer (locally (check-type x (integer 1)) x)) ++ (otherwise x))) ++ ++(defconstant +generic-logical-pathname-regexp+ (compile-regexp (to-regexp-or-namestring (make-list (length +logical-pathname-defaults+)) t t))) ++ ++(defun expand-home-dir (dir) ++ (cond ((and (eq (car dir) :relative) (stringp (cadr dir)) (eql #\~ (aref (cadr dir) 0))) ++ (append (dir-parse (home-namestring (cadr dir)) "/" :absolute) (cddr dir))) ++ (dir))) ++ ++(defun logical-pathname-parse (x &optional host def (b 0) (e (length x))) ++ (when (and (eql b (string-match +generic-logical-pathname-regexp+ x b e)) (eql (match-end 0) e)) ++ (let ((mhost (match-component x 1 :host 0 -1))) ++ (when (and host mhost) ++ (unless (string-equal host mhost) ++ (error 'error :format-control "Host part of ~s does not match ~s" :format-arguments (list x host)))) ++ (let ((host (or host mhost (pathname-host def)))) ++ (when (logical-pathname-host-p host) ++ (let* ((dir (dir-parse (match-component x 2 :none) ";" :relative)) ++ (edir (expand-home-dir dir))) ++ (make-pathname :host host ++ :device :unspecific ++ :directory edir ++ :name (match-component x 6 :name) ++ :type (match-component x 8 :type 1) ++ :version (version-parse (match-component x 11 :version 1)) ++ :namestring (when (and mhost (eql b 0) (eql e (length x)) (eq dir edir)) x)))))))) ++ ++(defconstant +generic-physical-pathname-regexp+ (compile-regexp (to-regexp-or-namestring (make-list (length +physical-pathname-defaults+)) t nil))) ++ ++(defun pathname-parse (x b e) ++ (when (and (eql b (string-match +generic-physical-pathname-regexp+ x b e)) (eql (match-end 0) e)) ++ (let* ((dir (dir-parse (match-component x 1 :none) "/" :absolute)) ++ (edir (expand-home-dir dir))) ++ (make-pathname :directory edir ++ :name (match-component x 3 :name) ++ :type (match-component x 4 :type 1) ++ :namestring (when (and (eql b 0) (eql e (length x)) (eq dir edir)) x))))) ++ ++ ++(defun path-stream-name (x) ++ (check-type x pathname-designator) ++ (typecase x ++ (synonym-stream (path-stream-name (symbol-value (synonym-stream-symbol x)))) ++ (stream (path-stream-name (c-stream-object1 x))) ++ (otherwise x))) ++ ++(defun parse-namestring (thing &optional host (default-pathname *default-pathname-defaults*) &rest r &key (start 0) end junk-allowed) ++ (declare (optimize (safety 1))(dynamic-extent r)) ++ (check-type thing pathname-designator) ++ (check-type host (or null (satisfies logical-pathname-translations))) ++ (check-type default-pathname pathname-designator) ++ (check-type start seqind) ++ (check-type end (or null seqind)) ++ ++ (typecase thing ++ (string (let* ((e (or end (length thing))) ++ (l (logical-pathname-parse thing host default-pathname start e)) ++ (l (or l (unless host (pathname-parse thing start e))))) ++ (cond (junk-allowed (values l (max 0 (match-end 0)))) ++ (l (values l e)) ++ ((error 'parse-error :format-control "~s is not a valid pathname on host ~s" :format-arguments (list thing host)))))) ++ (stream (apply 'parse-namestring (path-stream-name thing) host default-pathname r)) ++ (pathname ++ (when host ++ (unless (string-equal host (pathname-host thing)) ++ (error 'file-error :pathname thing :format-control "Host does not match ~s" :format-arguments (list host)))) ++ (values thing start)))) ++ ++(defun pathname (spec) ++ (declare (optimize (safety 1))) ++ (check-type spec pathname-designator) ++ (if (typep spec 'pathname) spec (values (parse-namestring spec)))) ++ ++(defun sharp-p-reader (stream subchar arg) ++ (declare (ignore subchar arg)) ++ (let ((x (parse-namestring (read stream)))) x)) ++ ++(defun sharp-dq-reader (stream subchar arg);FIXME arg && read-suppress ++ (declare (ignore subchar arg)) ++ (unread-char #\" stream) ++ (let ((x (parse-namestring (read stream)))) x)) ++ ++(set-dispatch-macro-character #\# #\p 'sharp-p-reader) ++(set-dispatch-macro-character #\# #\p 'sharp-p-reader (standard-readtable)) ++(set-dispatch-macro-character #\# #\P 'sharp-p-reader) ++(set-dispatch-macro-character #\# #\P 'sharp-p-reader (standard-readtable)) ++(set-dispatch-macro-character #\# #\" 'sharp-dq-reader) ++(set-dispatch-macro-character #\# #\" 'sharp-dq-reader (standard-readtable)) ++ +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_pathname_match_p.lsp +@@ -0,0 +1,14 @@ ++(in-package :si) ++ ++(defun to-regexp (x &optional (rp t) &aux (px (pathname x))(lp (typep px 'logical-pathname))) ++ (to-regexp-or-namestring (mlp px) rp lp)) ++ ++(deftype compiled-regexp nil `(vector unsigned-char)) ++ ++(defun pathname-match-p (p w &aux (s (namestring p))) ++ (declare (optimize (safety 1))) ++ (check-type p pathname-designator) ++ (check-type w (or compiled-regexp pathname-designator)) ++ (and (zerop (string-match (if (typep w 'compiled-regexp) w (to-regexp w)) s)) ++ (eql (match-end 0) (length s)))) ++ +--- gcl-2.6.12.orig/lsp/gcl_predlib.lsp ++++ gcl-2.6.12/lsp/gcl_predlib.lsp +@@ -110,6 +110,7 @@ + (not (array-has-fill-pointer-p x)) + (not (si:displaced-array-p x)))) + ++(defun logical-pathnamep (x) (when (pathnamep x) (eql (c-t-tt x) 1))) + + (do ((l '((null . null) + (symbol . symbolp) +@@ -124,7 +125,15 @@ + (character . characterp) + (package . packagep) + (stream . streamp) ++ (file-stream . file-stream-p) ++ (synonym-stream . synonym-stream-p) ++ (broadcast-stream . broadcast-stream-p) ++ (concatenated-stream . concatenated-stream-p) ++ (two-way-stream . two-way-stream-p) ++ (echo-stream . echo-stream-p) + (pathname . pathnamep) ++ (pathname-designator . pathname-designatorp) ++ (logical-pathname . logical-pathnamep) + (readtable . readtablep) + (hash-table . hash-table-p) + (random-state . random-state-p) +@@ -196,6 +205,8 @@ + ((null l) t) + (unless (typep object (car l)) (return nil)))) + (satisfies (funcall (car i) object)) ++ (eql (eql (car i) object)) ++ (member (member object i)) + ((t) t) + ((nil) nil) + (boolean (or (eq object 't) (eq object 'nil))) +@@ -280,6 +291,40 @@ + (typep object (apply tem i))))))) + + ++ ++(defun minmax (i1 i2 low-p e &aux (fn (if low-p (if e '< '>) (if e '> '<)))) ++ (cond ((eq i1 '*) (if e i1 i2)) ++ ((eq i2 '*) (if e i2 i1)) ++ ((funcall fn i1 i2) i1) ++ (i2))) ++ ++(defun expand-range (low high bottom top) ++ (let ((low (minmax low bottom t t))(high (minmax high top nil t))) ++ (when (or (eq low '*) (eq high '*) (<= low high)) (list low high)))) ++ ++(defun nc (tp) ++ (when (consp tp) ++ (case (car tp) ++ ;; (immfix (let ((m (cadr tp))(x (caddr tp)) ++ ;; (list (list 'integer (if (eq m '*) most-negative-immfix m) (if (eq x '*) most-positive-immfix x))))) ++ ;; (bfix (let* ((m (cadr tp))(x (caddr tp))(m (if (eq m '*) most-negative-fixnum m))(x (if (eq x '*) most-positive-fixnum x))) ++ ;; (if (< (* m x) 0) ++ ;; `((integer ,m ,(1- most-negative-immfix))(integer ,(1+ most-positive-immfix) ,x)) ++ ;; `((integer ,m ,x))))) ++ ;; (bignum (let* ((m (cadr tp))(x (caddr tp))(sm (or (eq m '*) (< m 0)))(sx (or (eq x '*) (>= x 0)))) ++ ;; (if (and sm sx) ++ ;; `((integer ,m ,(1- most-negative-fixnum))(integer ,(1+ most-positive-fixnum) ,x)) ++ ;; `((integer ,m ,x))))) ++ ((integer ratio short-float long-float) (list tp)) ++ (otherwise (append (nc (car tp)) (nc (cdr tp))))))) ++ ++ ++(defun expand-ranges (type) ++ (reduce (lambda (y x &aux (z (assoc (car x) y))) ++ (if z (subst (cons (car z) (apply 'expand-range (cadr x) (caddr x) (cdr z))) z y) ++ (cons x y))) (nc type) :initial-value nil)) ++ ++ + ;;; NORMALIZE-TYPE normalizes the type using the DEFTYPE definitions. + ;;; The result is always a list. + (defun normalize-type (type &aux tp i ) +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_rename_file.lsp +@@ -0,0 +1,47 @@ ++(in-package :si) ++ ++(defun set-path-stream-name (x y) ++ (check-type x pathname-designator) ++ (typecase x ++ (synonym-stream (set-path-stream-name (symbol-value (synonym-stream-symbol x)) y)) ++ (stream (c-set-stream-object1 x y)))) ++ ++(defun rename-file (f n &aux (pf (pathname f))(pn (merge-pathnames n pf nil)) ++ (tpf (truename pf))(nf (namestring tpf)) ++ (tpn (translate-logical-pathname pn))(nn (namestring tpn))) ++ (declare (optimize (safety 1))) ++ (check-type f pathname-designator) ++ (check-type n (and pathname-designator (not stream))) ++ (unless (rename nf nn) ++ (error 'file-error :pathname pf :format-control "Cannot rename ~s to ~s." :format-arguments (list nf nn))) ++ (set-path-stream-name f pn) ++ (values pn tpf (truename tpn))) ++ ++(defun user-homedir-pathname (&optional (host :unspecific hostp)) ++ (declare (optimize (safety 1))) ++ (check-type host (or string list (eql :unspecific))) ++ (unless hostp ++ (pathname (home-namestring "~")))) ++ ++(defun delete-file (f &aux (pf (truename f))(nf (namestring pf))) ++ (declare (optimize (safety 1))) ++ (check-type f pathname-designator) ++ (unless (if (eq :directory (stat nf)) (rmdir nf) (unlink nf)) ++ (error 'file-error :pathname (pathname nf) :format-control "Cannot delete pathname.")) ++ t) ++ ++(defun file-write-date (spec) ++ (declare (optimize (safety 1))) ++ (check-type spec pathname-designator) ++ (multiple-value-bind ++ (tp sz tm) (stat (namestring (truename spec))) ++ (+ tm (* (+ 17 (* 70 365)) (* 24 60 60))))) ++ ++ ++(defun file-author (spec) ++ (declare (optimize (safety 1))) ++ (check-type spec pathname-designator) ++ (multiple-value-bind ++ (tp sz tm uid) (stat (namestring (truename spec))) ++ (uid-to-name uid))) ++ +--- gcl-2.6.12.orig/lsp/gcl_sharp.lsp ++++ gcl-2.6.12/lsp/gcl_sharp.lsp +@@ -61,4 +61,6 @@ + (otherwise x))) + + (set-dispatch-macro-character #\# #\= #'sharp-eq-reader) ++(set-dispatch-macro-character #\# #\= #'sharp-eq-reader (standard-readtable)) + (set-dispatch-macro-character #\# #\# #'sharp-sharp-reader) ++(set-dispatch-macro-character #\# #\# #'sharp-sharp-reader (standard-readtable)) +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_sharp_uv.lsp +@@ -0,0 +1,29 @@ ++(in-package :si) ++ ++(defun regexp-conv (stream) ++ ++ (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 ++ (let ((ch (read-char stream))) ++ (cond ((eql ch #\") (return tem)) ++ ((eql ch #\\) ++ (setq ch (read-char stream)) ++ (setq ch (or (cdr (assoc ch '((#\n . #\newline) ++ (#\t . #\tab) ++ (#\r . #\return)))) ++ ch)))) ++ (vector-push-extend ch tem))) ++ tem)) ++ ++(defun sharp-u-reader (stream subchar arg) ++ (declare (ignore subchar arg)) ++ (regexp-conv stream)) ++ ++(defun sharp-v-reader (stream subchar arg) ++ (declare (ignore subchar arg)) ++ `(load-time-value (compile-regexp ,(regexp-conv stream)))) ++ ++(set-dispatch-macro-character #\# #\u 'sharp-u-reader) ++(set-dispatch-macro-character #\# #\v 'sharp-v-reader) +--- gcl-2.6.12.orig/lsp/gcl_top.lsp ++++ gcl-2.6.12/lsp/gcl_top.lsp +@@ -83,7 +83,7 @@ + (progn + (cond + (*multiply-stacks* (setq *multiply-stacks* nil)) +- ((probe-file "init.lsp") (load "init.lsp")))) ++ ((when (fboundp 'probe-file) (probe-file "init.lsp")) (load "init.lsp")))) + (when (if (symbolp *top-level-hook*) (fboundp *top-level-hook*) (functionp *top-level-hook*)) + (funcall *top-level-hook*))) + +@@ -122,6 +122,8 @@ + + (defvar *error-p* nil) + ++(defvar *lib-directory* nil) ++ + (defun process-some-args (args &optional compile &aux *load-verbose*) + (when args + (let ((x (pop args))) +@@ -148,7 +150,7 @@ + (file (cdr (assoc :compile compile))) + (o (cdr (assoc :o compile))) + (compile (remove :o (remove :compile compile :key 'car) :key 'car)) +- (compile (cons (cons :output-file (or o file)) compile)) +++ (compile (cons (cons :output-file (or o (merge-pathnames ".o" file))) compile)) + (result (system:error-set `(apply 'compile-file ,file ',(mapcan (lambda (x) (list (car x) (cdr x))) compile))))) + (bye (if (or *error-p* (equal result '(nil))) 1 0))))) + +@@ -520,15 +522,12 @@ add a new one, add a 'si::break-command + + ;;make sure '/' terminated + +-(defun coerce-slash-terminated (v ) +- (declare (string v)) +- (or (stringp v) (error "not a string ~a" v)) ++(defun coerce-slash-terminated (v) + (let ((n (length v))) +- (declare (fixnum n)) +- (unless (and (> n 0) (eql +- (the character(aref v (the fixnum (- n 1)))) #\/)) +- (setf v (format nil "~a/" v)))) +- v) ++ (if (and (> n 0) (eql (aref v (1- n)) #\/)) ++ v ++ (string-concatenate v "/")))) ++ + (defun fix-load-path (l) + (when (not (equal l *fixed-load-path*)) + (do ((x l (cdr x)) ) +@@ -587,19 +586,17 @@ First directory is checked for first nam + (when (and s (symbol-value s)) + (list *system-directory*)))) + +- +-(defun get-temp-dir nil +- (dolist (x `(,@(wine-tmp-redirect) ,@(mapcar 'getenv '("TMPDIR" "TMP" "TEMP")) "/tmp" "")) +- (when (or (stringp x) (pathnamep x)) +- (let* ((x (truename (pathname x))) +- (y (namestring (make-pathname :name (pathname-name x) :type (pathname-type x) :version (pathname-version x)))) +- (y (unless (zerop (length y)) (list y)))) +- (when (eq :directory (car (stat x))) +- (return-from get-temp-dir +- (namestring +- (make-pathname +- :device (pathname-device x) +- :directory (append (pathname-directory x) y))))))))) ++(defun ensure-dir-string (str) ++ (if (eq (stat str) :directory) ++ (coerce-slash-terminated str) ++ str)) ++ ++(defun get-temp-dir () ++ (dolist (x `(,@(wine-tmp-redirect) ,@(mapcar 'si::getenv '("TMPDIR" "TMP" "TEMP")) "/tmp" "")) ++ (when x ++ (let ((x (coerce-slash-terminated x))) ++ (when (eq (stat x) :directory) ++ (return-from get-temp-dir x)))))) + + (defun get-path (s &aux (m (string-match "([^/ ]*)( |$)" s))(b (match-beginning 1))(e (match-end 1)) + (r (with-open-file (s (concatenate 'string "|which " (subseq s b e))) (read s nil 'eof)))) +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_translate_pathname.lsp +@@ -0,0 +1,90 @@ ++(in-package :si) ++ ++(defun lenel (x lp) ++ (case x (:wild 1)(:wild-inferiors 2)(:absolute (if lp -1 0))(:relative (if lp 0 -1)) ++ ((:unspecific nil :newest) -1)(otherwise (length x)))) ++ ++(defun next-match (&optional (i 1) (k -1) (m (1- (ash (length *match-data*) -1)))) ++ (cond ((< k (match-beginning i) (match-end i)) i) ++ ((< i m) (next-match (1+ i) k m)) ++ (i))) ++ ++(defun mme2 (s lel lp &optional (b 0) (i (next-match)) r el ++ &aux (e (+ b (lenel (car lel) lp)))(j (match-beginning i))(k (match-end i))) ++ (cond ++ ((< (- b 2) j k (+ e 2)) ++ (let* ((z (car lel))(b1 (max b j))(e1 (min k e)) ++ (z (if (or (< b b1) (< e1 e)) (subseq z (- b1 b) (- e1 b)) z)) ++ (r (if el r (cons nil r)))) ++ (mme2 s lel lp b (next-match i k) (cons (cons z (car r)) (cdr r)) (or el (car lel))))) ++ ((< (1- j) b e (1+ k)) ++ (let ((r (if el r (cons nil r)))) ++ (mme2 s (cdr lel) lp (1+ e) i (cons (cons (car lel) (car r)) (cdr r)) (or el (list (car lel)))))) ++ ((consp el) ++ (let* ((cr (nreverse (car r)))) ++ (mme2 s lel lp b (next-match i k) (cons (cons (car el) (list cr)) (cdr r))))) ++ (el ++ (let* ((cr (nreverse (car r)))) ++ (mme2 s (cdr lel) lp (1+ e) i (cons (cons el cr) (cdr r))))) ++ (lel (mme2 s (cdr lel) lp (1+ e) i (cons (car lel) r))) ++ ((nreverse r)))) ++ ++(defun do-repl (x y) ++ (labels ((r (x l &optional (b 0) &aux (f (string-match #v"\\*" x b))) ++ (if (eql f -1) (if (eql b 0) x (subseq x b)) ++ (concatenate 'string (subseq x b f) (or (car l) "") (r x (cdr l) (1+ f)))))) ++ (r y x))) ++ ++(defun dir-p (x) (when (consp x) (member (car x) '(:absolute :relative)))) ++ ++(defun source-portion (x y) ++ (cond ++ ((or (dir-p x) (dir-p y)) ++ (mapcan (lambda (z &aux (w (source-portion ++ (if y (when (wild-dir-element-p z) (setf x (member-if 'listp x)) (pop x)) z) ++ (when y z)))) ++ (if (listp w) w (list w))) (or y x))) ++ ((if y (eq y :wild-inferiors) t) (if (listp x) (if (listp (cadr x)) (cadr x) (car x)) x));(or y) ++ ((eq y :wild) (if (listp x) (car x) x));(or y) ++ ((stringp y) (do-repl (when (listp x) (unless (listp (cadr x)) (cdr x))) y)) ++ (y))) ++ ++(defun list-toggle-case (x f) ++ (typecase x ++ (string (funcall f x)) ++ (cons (mapcar (lambda (x) (list-toggle-case x f)) x)) ++ (otherwise x))) ++ ++(defun mme3 (sx px flp tlp) ++ (list-toggle-case ++ (lnp (mme2 sx (pnl1 (mlp px)) flp)) ++ (cond ((eq flp tlp) 'identity) ++ (flp 'string-downcase) ++ (tlp 'string-upcase)))) ++ ++(defun translate-pathname (source from to &key ++ &aux (psource (pathname source)) ++ (pto (pathname to)) ++ (match (pathname-match-p source from))) ++ (declare (optimize (safety 1))) ++ (check-type source pathname-designator) ++ (check-type from pathname-designator) ++ (check-type to pathname-designator) ++ (check-type match (not null)) ++ (apply 'make-pathname :host (pathname-host pto) :device (pathname-device pto) ++ (mapcan 'list +pathname-keys+ ++ (mapcar 'source-portion ++ (mme3 (namestring source) psource (typep psource 'logical-pathname) (typep pto 'logical-pathname)) ++ (mlp pto))))) ++ ++(defun translate-logical-pathname (spec &key &aux (p (pathname spec))) ++ (declare (optimize (safety 1))) ++ (check-type spec pathname-designator) ++ (typecase p ++ (logical-pathname ++ (let ((rules (assoc p (logical-pathname-translations (pathname-host p)) :test 'pathname-match-p))) ++ (unless rules ++ (error 'file-error :pathname p :format-control "No matching translations")) ++ (translate-logical-pathname (apply 'translate-pathname p rules)))) ++ (otherwise p))) ++ +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_truename.lsp +@@ -0,0 +1,43 @@ ++(in-package :si) ++ ++(defun link-expand (str &optional (b 0) (n (length str)) fr) ++ (labels ((frame (b e) (make-array (- n b) :element-type 'character ++ :displaced-to str :displaced-index-offset b :fill-pointer (- e b))) ++ (set-fr (fr e &aux (fr (or fr (frame 0 b)))) (setf (fill-pointer fr) e) fr)) ++ (let* ((i (string-match #v"/" str b)) ++ (fr (set-fr fr (if (eql i -1) n i))) ++ (l (when (eq (stat fr) :link) (readlinkat 0 fr)))) ++ (cond (l (let ((b (if (eql #\/ (aref l 0)) 0 b))) ++ (link-expand (concatenate 'string (set-fr fr b) l (frame (if (eql i -1) n i) n)) b))) ++ ((eql i -1) str) ++ ((link-expand str (1+ i) n fr)))))) ++ ++(defun logical-pathname-designator-p (x) ++ (typecase x ++ (string (logical-pathname-parse x)) ++ (pathname (typep x 'logical-pathname)) ++ (stream (logical-pathname-designator-p (pathname x))))) ++ ++;(defvar *current-dir* (pathname (concatenate 'string (getcwd) "/"))) FIXME sync with chdir ++ ++(defun truename (pd &aux (ppd (translate-logical-pathname pd))(ns (namestring ppd))) ++ (declare (optimize (safety 1))) ++ (check-type pd pathname-designator) ++ (when (wild-pathname-p ns) ++ (error 'file-error :pathname pd :format-control "Pathname is wild")) ++ (let* ((ns (ensure-dir-string (link-expand ns)))) ++ (unless (or (zerop (length ns)) (stat ns)) ++ (error 'file-error :pathname ns :format-control "Pathname does not exist")) ++ (let* ((d (pathname-directory ppd)) ++ (d1 (subst :back :up d)) ++ (ppd (if (eq d d1) ppd (make-pathname :directory d1 :defaults ppd)))) ++ (if (eq (car d) :absolute) ppd (merge-pathnames ppd (concatenate 'string (getcwd) "/") nil))))) ++ ++ ++(defun probe-file (pd &aux (pn (translate-logical-pathname pd))) ++ (declare (optimize (safety 1))) ++ (check-type pd pathname-designator) ++ (when (wild-pathname-p pn) ++ (error 'file-error :pathname pn :format-control "Pathname is wild")) ++ (when (eq (stat (namestring pn)) :file) ++ (truename pn))) +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_wild_pathname_p.lsp +@@ -0,0 +1,28 @@ ++(in-package :si) ++ ++(defun wild-namestring-p (x) ++ (when (stringp x) (>= (string-match #v"(\\*|\\?|\\[|\\{)" x) 0))) ++ ++(defun wild-dir-element-p (x) ++ (or (eq x :wild) (eq x :wild-inferiors) (wild-namestring-p x))) ++ ++(defun wild-path-element-p (x) ++ (or (eq x :wild) (wild-namestring-p x))) ++ ++#.`(defun wild-pathname-p (pd &optional f) ++ (declare (optimize (safety 1))) ++ (check-type pd pathname-designator) ++ (check-type f (or null (member ,@+pathname-keys+))) ++ (case f ++ ((nil) (or (wild-namestring-p (namestring pd)) ++ (when (typep pd 'pathname);FIXME stream ++ (eq :wild (pathname-version pd))))) ++ ;; ((nil) (if (stringp pd) (wild-namestring-p pd) ++ ;; (let ((p (pathname pd))) ++ ;; (when (member-if (lambda (x) (wild-pathname-p p x)) +pathname-keys+) t)))) ++ ((:host :device) nil) ++ (:directory (when (member-if 'wild-dir-element-p (pathname-directory pd)) t)) ++ (:name (wild-path-element-p (pathname-name pd))) ++ (:type (wild-path-element-p (pathname-type pd))) ++ (:version (wild-path-element-p (pathname-version pd))))) ++ +--- gcl-2.6.12.orig/lsp/makefile ++++ gcl-2.6.12/lsp/makefile +@@ -13,9 +13,12 @@ OBJS = gcl_sharp.o gcl_arraylib.o gcl_as + gcl_describe.o gcl_evalmacros.o gcl_fpe.o \ + gcl_iolib.o gcl_listlib.o gcl_mislib.o gcl_module.o gcl_numlib.o \ + gcl_packlib.o gcl_predlib.o \ ++ gcl_parse_namestring.o gcl_make_pathname.o gcl_namestring.o gcl_translate_pathname.o\ ++ gcl_logical_pathname_translations.o gcl_directory.o gcl_merge_pathnames.o gcl_truename.o gcl_sharp_uv.o\ + gcl_seq.o gcl_seqlib.o gcl_setf.o gcl_top.o gcl_trace.o gcl_sloop.o \ + gcl_debug.o gcl_info.o gcl_serror.o gcl_restart.o \ +- gcl_destructuring_bind.o gcl_defpackage.o gcl_make_defpackage.o gcl_loop.o $(EXTRA_LOBJS) ++ gcl_rename_file.o gcl_pathname_match_p.o gcl_wild_pathname_p.o \ ++ gcl_destructuring_bind.o gcl_defpackage.o gcl_make_defpackage.o gcl_loop.o $(EXTRA_LOBJS) + # export.o autoload.o auto_new.o + + LISP=$(PORTDIR)/saved_pre_gcl$(EXE) +--- gcl-2.6.12.orig/lsp/sys-proclaim.lisp ++++ gcl-2.6.12/lsp/sys-proclaim.lisp +@@ -2,361 +2,223 @@ + (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::DBL-RPL-LOOP +- 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::FUNCTION ++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++ COMMON-LISP::*) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::FIXNUM) ++ SYSTEM::ATOI)) + (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::FUNCTION (COMMON-LISP::T) ++ (COMMON-LISP::OR COMMON-LISP::NULL ++ COMMON-LISP::HASH-TABLE)) ++ SYSTEM::CONTEXT-HASH)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) +- COMMON-LISP::FIXNUM) +- SYSTEM::DBL-WHAT-FRAME FPE::FE-ENABLE)) ++ (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::*) + 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::SUBTYPEP COMMON-LISP::REDUCE ++ SLOOP::FIND-IN-ORDERED-LIST SYSTEM::PARSE-BODY ++ COMMON-LISP::STABLE-SORT COMMON-LISP::SORT)) + (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)) ++ SYSTEM::SHARP-+-READER SYSTEM::SHARP---READER ++ SYSTEM::SHARP-S-READER ANSI-LOOP::LOOP-GET-COLLECTION-INFO ++ SYSTEM::VERIFY-KEYWORDS SYSTEM::LIST-MERGE-SORT ++ SYSTEM::RESTART-PRINT SYSTEM::READ-INSPECT-COMMAND)) + (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::*) +- SYSTEM::PUSH-OPTIONAL-BINDING)) ++ SYSTEM::TRACE-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::*) ++ COMMON-LISP::*) + COMMON-LISP::*) +- SYSTEM::PARSE-DEFMACRO-LAMBDA-LIST SYSTEM::PARSE-DEFMACRO)) ++ SYSTEM::EXPAND-WILD-DIRECTORY SYSTEM::MASET)) + (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)) ++ SYSTEM::MME3)) + (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::T COMMON-LISP::T COMMON-LISP::T ++ 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)) ++ SYSTEM::PUSH-OPTIONAL-BINDING)) + (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::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) + 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 ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ 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::*) ++ COMMON-LISP::T) ++ COMMON-LISP::EVERY COMMON-LISP::SET-DIFFERENCE ++ SYSTEM::VECTOR-PUSH-STRING SYSTEM::PROCESS-ERROR ++ COMMON-LISP::POSITION-IF-NOT COMMON-LISP::FIND-IF ++ SLOOP::LOOP-ADD-BINDING COMMON-LISP::BIT-ORC1 ++ COMMON-LISP::READ-SEQUENCE SYSTEM::INTERNAL-COUNT-IF ++ COMMON-LISP::COUNT COMMON-LISP::MISMATCH ++ COMMON-LISP::ADJUST-ARRAY COMMON-LISP::INTERSECTION ++ COMMON-LISP::UNION COMMON-LISP::DELETE-IF-NOT ++ COMMON-LISP::NINTERSECTION COMMON-LISP::BIT-ANDC1 ++ COMMON-LISP::REMOVE-IF-NOT COMMON-LISP::TYPEP ++ COMMON-LISP::NUNION COMMON-LISP::WRITE-SEQUENCE ++ COMMON-LISP::VECTOR-PUSH-EXTEND COMMON-LISP::REMOVE ++ COMMON-LISP::BIT-IOR SLOOP::PARSE-LOOP-MACRO ++ COMMON-LISP::SEARCH COMMON-LISP::SUBSETP ++ COMMON-LISP::SET-EXCLUSIVE-OR SYSTEM::WREADDIR ++ COMMON-LISP::POSITION-IF COMMON-LISP::DELETE ++ COMMON-LISP::BIT-EQV COMMON-LISP::BIT-ANDC2 ++ COMMON-LISP::BIT-AND COMMON-LISP::NSET-EXCLUSIVE-OR ++ SLOOP::IN-ARRAY-SLOOP-FOR ANSI-LOOP::LOOP-CHECK-DATA-TYPE ++ COMMON-LISP::POSITION COMMON-LISP::MAKE-SEQUENCE ++ COMMON-LISP::NOTEVERY COMMON-LISP::MAP-INTO ++ COMMON-LISP::REPLACE COMMON-LISP::NSET-DIFFERENCE ++ COMMON-LISP::FIND-IF-NOT COMMON-LISP::BIT-ORC2 ++ COMMON-LISP::DELETE-IF COMMON-LISP::CERROR ++ COMMON-LISP::BIT-XOR COMMON-LISP::FIND COMMON-LISP::FILL ++ SYSTEM::INTERNAL-COUNT-IF-NOT COMMON-LISP::REMOVE-IF ++ COMMON-LISP::BIT-NAND COMMON-LISP::BIT-NOR COMMON-LISP::SOME ++ COMMON-LISP::COUNT-IF SYSTEM::BREAK-CALL ++ COMMON-LISP::COUNT-IF-NOT SYSTEM::FIND-IHS COMMON-LISP::NOTANY ++ SYSTEM::INTERNAL-COUNT)) ++(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::PATHNAME-PARSE ANSI-LOOP::LOOP-TRANSLATE ++ SYSTEM::CHECK-S-DATA SYSTEM::MFR FPE::REF ++ ANSI-LOOP::LOOP-STANDARD-EXPANSION ANSI-LOOP::LOOP-FOR-ON ++ ANSI-LOOP::LOOP-SUM-COLLECTION SYSTEM::SHARP-DQ-READER ++ COMMON-LISP::DPB SYSTEM::CHECK-TRACE-ARGS ++ SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS SYSTEM::RECURSE-DIR ++ SYSTEM::SHARP-U-READER SYSTEM::FLOATING-POINT-ERROR ++ ANSI-LOOP::LOOP-FOR-IN ANSI-LOOP::HIDE-VARIABLE-REFERENCE ++ SYSTEM::GET-SLOT-POS SYSTEM::APPLY-DISPLAY-FUN + 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)) ++ SYSTEM::MAKE-BREAK-POINT SYSTEM::TO-REGEXP-OR-NAMESTRING ++ COMMON-LISP::DEPOSIT-FIELD SYSTEM::SHARP-V-READER ++ SYSTEM::MAKE-T-TYPE ANSI-LOOP::LOOP-FOR-ACROSS ++ ANSI-LOOP::LOOP-ANSI-FOR-EQUALS ANSI-LOOP::PRINT-LOOP-UNIVERSE ++ ANSI-LOOP::LOOP-FOR-BEING SYSTEM::SHARP-P-READER SYSTEM::DM-VL ++ SYSTEM::SHARP-A-READER ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE ++ SYSTEM::DEFMACRO* SYSTEM::SETF-EXPAND-1 SYSTEM::WARN-VERSION)) + (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::FIRST-USE-SLOOP-FOR SYSTEM::COERCE-TO-CONDITION SYSTEM::DO-BREAK-LEVEL +- SLOOP::FIRST-SLOOP-FOR ANSI-LOOP::LOOP-FOR-ARITHMETIC +- SYSTEM::MAYBE-BREAK SYSTEM::SETF-STRUCTURE-ACCESS +- SYSTEM::CALL-TEST SYSTEM::FIND-LINE-IN-FUN)) ++ SYSTEM::MME2 COMMON-LISP::NSUBSTITUTE SYSTEM::MATCH-COMPONENT ++ SYSTEM::COMPLETE-PROP SYSTEM::WALK-DIR ++ COMMON-LISP::TRANSLATE-PATHNAME ANSI-LOOP::ADD-LOOP-PATH ++ SYSTEM::DIR-PARSE ANSI-LOOP::LOOP-MAKE-VARIABLE ++ COMMON-LISP::SUBSTITUTE-IF COMMON-LISP::NSUBSTITUTE-IF ++ SYSTEM::PUSH-LET-BINDING COMMON-LISP::SUBSTITUTE ++ ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH COMMON-LISP::MAP ++ COMMON-LISP::SUBSTITUTE-IF-NOT COMMON-LISP::NSUBSTITUTE-IF-NOT ++ ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH ++ SLOOP::LOOP-DECLARE-BINDING ++ ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH ++ SYSTEM::CHECK-TYPE-SYMBOL)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::T COMMON-LISP::T ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) + 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)) ++ SYSTEM::SHARP-EQ-READER SYSTEM::SHARP-SHARP-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) +- SYSTEM::PUSH-SUB-LIST-BINDING SYSTEM::DO-ARG-COUNT-ERROR)) ++ SYSTEM::ELSUB SLOOP::FIRST-USE-SLOOP-FOR ++ SLOOP::FIRST-SLOOP-FOR SYSTEM::SETF-STRUCTURE-ACCESS ++ SYSTEM::FIND-LINE-IN-FUN SYSTEM::COERCE-TO-CONDITION ++ ANSI-LOOP::LOOP-FOR-ARITHMETIC SYSTEM::MAYBE-BREAK ++ SYSTEM::ELEMENT SYSTEM::DO-BREAK-LEVEL SYSTEM::CALL-TEST)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) ++ 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::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)) ++ ANSI-LOOP::LOOP-SEQUENCER)) + (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::MAKE-CONSTRUCTOR)) ++ SYSTEM::MAKE-CONSTRUCTOR SYSTEM::MAKE-PREDICATE)) + (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 COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- SYSTEM::SHARP-SHARP-READER SYSTEM::SHARP-EQ-READER)) ++ 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::T COMMON-LISP::*) + COMMON-LISP::T) +- SLOOP::DEF-LOOP-INTERNAL SYSTEM::PRINT-STACK-FRAME +- COMMON-LISP::MERGE)) ++ SLOOP::DEF-LOOP-INTERNAL COMMON-LISP::MERGE ++ SYSTEM::PRINT-STACK-FRAME)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -369,154 +231,389 @@ + '(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 COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- ANSI-LOOP::LOOP-SEQUENCER)) ++ SYSTEM::UNIVERSAL-ERROR-HANDLER)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ COMMON-LISP::MERGE-PATHNAMES ++ COMMON-LISP::TRANSLATE-LOGICAL-PATHNAME ANSI-LOOP::LOOP-ERROR ++ COMMON-LISP::WILD-PATHNAME-P SLOOP::LOOP-ADD-TEMPS ++ SYSTEM::FILE-SEARCH SYSTEM::INFO-SEARCH ++ COMMON-LISP::PATHNAME-VERSION COMMON-LISP::WARN SYSTEM::MGSUB ++ COMMON-LISP::ARRAY-ROW-MAJOR-INDEX ++ COMMON-LISP::REMOVE-DUPLICATES COMMON-LISP::PATHNAME-NAME ++ COMMON-LISP::BIT COMMON-LISP::FIND-RESTART SYSTEM::TO-REGEXP ++ SYSTEM::PROCESS-SOME-ARGS COMMON-LISP::ERROR ++ COMMON-LISP::REQUIRE COMMON-LISP::OPEN ++ COMMON-LISP::UPGRADED-ARRAY-ELEMENT-TYPE SLOOP::ADD-FROM-DATA ++ SYSTEM::BREAK-LEVEL SYSTEM::LIST-MATCHES ++ COMMON-LISP::DELETE-DUPLICATES ANSI-LOOP::LOOP-WARN ++ COMMON-LISP::PATHNAME-DEVICE COMMON-LISP::LOAD ++ COMMON-LISP::PATHNAME-HOST COMMON-LISP::SBIT SYSTEM::NLOAD ++ COMMON-LISP::BIT-NOT COMMON-LISP::ENOUGH-NAMESTRING ++ COMMON-LISP::SIGNAL COMMON-LISP::ARRAY-IN-BOUNDS-P ++ COMMON-LISP::PATHNAME-TYPE SYSTEM::FILE-TO-STRING ++ SYSTEM::LOGICAL-PATHNAME-PARSE SYSTEM::NTH-STACK-FRAME ++ ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES SYSTEM::MGLIST ++ COMMON-LISP::DIRECTORY SYSTEM::BAD-SEQ-LIMIT ++ COMMON-LISP::PATHNAME-DIRECTORY COMMON-LISP::READ-BYTE ++ SYSTEM::LINK-EXPAND COMMON-LISP::CONCATENATE ++ COMMON-LISP::MAKE-ARRAY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ SYSTEM::NEWLINE SYSTEM::LIST-TOGGLE-CASE ++ COMMON-LISP::RENAME-FILE ANSI-LOOP::ESTIMATE-CODE-SIZE ++ SYSTEM::SOURCE-PORTION SYSTEM::RESTART-REPORT SYSTEM::DO-REPL ++ SYSTEM::FIND-DOC ANSI-LOOP::ESTIMATE-CODE-SIZE-1 ++ SYSTEM::NEW-SEMI-COLON-READER)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::STRING COMMON-LISP::FIXNUM) ++ ((COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) + COMMON-LISP::FIXNUM) +- SYSTEM::ATOI)) ++ FPE::FE-ENABLE SYSTEM::DBL-WHAT-FRAME)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ SYSTEM::INFO SYSTEM::GET-SETF-METHOD-MULTIPLE-VALUE ++ COMMON-LISP::FTRUNCATE COMMON-LISP::USE-VALUE ++ COMMON-LISP::INVOKE-RESTART COMMON-LISP::WRITE-TO-STRING ++ COMMON-LISP::FCEILING COMMON-LISP::FROUND ++ COMMON-LISP::READ-FROM-STRING COMMON-LISP::FFLOOR ++ SYSTEM::PARSE-BODY-HEADER SYSTEM::BREAK-FUNCTION ++ SYSTEM::APROPOS-DOC COMMON-LISP::APROPOS ++ COMMON-LISP::APROPOS-LIST ++ ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE ++ COMMON-LISP::GET-SETF-EXPANSION SYSTEM::PRINT-DOC ++ COMMON-LISP::PARSE-NAMESTRING ++ COMMON-LISP::ENSURE-DIRECTORIES-EXIST ++ COMMON-LISP::DECODE-UNIVERSAL-TIME SYSTEM::SHOW-INFO ++ COMMON-LISP::STORE-VALUE SYSTEM::STEPPER)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ COMMON-LISP::VECTOR-PUSH SYSTEM::DM-NTH COMMON-LISP::LOGORC1 ++ SLOOP::L-EQUAL SLOOP::NEVER-SLOOP-COLLECT ++ COMMON-LISP::LDB-TEST COMMON-LISP::LDB COMMON-LISP::LOGORC2 ++ SLOOP::COUNT-SLOOP-COLLECT SLOOP::MAXIMIZE-SLOOP-COLLECT ++ SYSTEM::ALL-MATCHES ANSI-LOOP::LOOP-TMEMBER SLOOP::THE-TYPE ++ SYSTEM::?PUSH SYSTEM::INCREMENT-CURSOR SYSTEM::SET-DIR ++ SYSTEM::DM-NTH-CDR SYSTEM::IN-INTERVAL-P SLOOP::MAKE-VALUE ++ SYSTEM::DBL-UP COMMON-LISP::COERCE SYSTEM::MATCH-DIMENSIONS ++ COMMON-LISP::LOGNAND SLOOP::=-SLOOP-FOR ++ SYSTEM::KEYWORD-SUPPLIED-P SYSTEM::OVERWRITE-SLOT-DESCRIPTIONS ++ SYSTEM::LEFT-PARENTHESIS-READER ++ ANSI-LOOP::LOOP-MAYBE-BIND-FORM SYSTEM::COERCE-TO-STRING ++ SYSTEM::ADD-FILE SLOOP::PARSE-LOOP-MAP COMMON-LISP::LOGNOR ++ SYSTEM::MSUB SYSTEM::SET-BACK SYSTEM::SUPER-GO ++ SYSTEM::SUBSTRINGP ANSI-LOOP::LOOP-TEQUAL ++ ANSI-LOOP::LOOP-DO-WHILE SYSTEM::GET-LINE-OF-FORM ++ FPE::READ-INSTRUCTION SYSTEM::SUB-INTERVAL-P ++ SYSTEM::CHECK-SEQ-START-END SYSTEM::*BREAK-POINTS* ++ ANSI-LOOP::MAKE-LOOP-MINIMAX SLOOP::IN-PACKAGE-SLOOP-MAP ++ SYSTEM::DM-V SYSTEM::INFO-AUX ++ ANSI-LOOP::HIDE-VARIABLE-REFERENCES ++ SLOOP::COLLATE-SLOOP-COLLECT COMMON-LISP::PATHNAME-MATCH-P ++ SYSTEM::SET-PATH-STREAM-NAME SLOOP::SUM-SLOOP-COLLECT ++ ANSI-LOOP::LOOP-LOOKUP-KEYWORD ++ ANSI-LOOP::LOOP-DECLARE-VARIABLE SYSTEM::BREAK-STEP-NEXT ++ FPE::RF SLOOP::IN-TABLE-SLOOP-MAP SYSTEM::OBJLT ++ FPE::READ-OPERANDS SYSTEM::BREAK-STEP-INTO COMMON-LISP::BYTE ++ SYSTEM::SEQUENCE-CURSOR SYSTEM::LIST-DELQ ++ SYSTEM::SETF-LOGICAL-PATHNAME-TRANSLATIONS ++ SYSTEM::CONDITION-PASS SYSTEM::SETF-HELPER FPE::0-READER ++ SYSTEM::DISPLAY-COMPILED-ENV COMMON-LISP::NTH ++ COMPILER::COMPILER-DEF-HOOK SYSTEM::DOT-DIR-P ++ COMMON-LISP::LOGTEST SYSTEM::QUOTATION-READER ++ SYSTEM::ITERATE-OVER-BKPTS COMMON-LISP::LOGANDC1 ++ SLOOP::ALWAYS-SLOOP-COLLECT SLOOP::DESETQ1 ++ SYSTEM::GET-INFO-CHOICES COMMON-LISP::WRITE-BYTE ++ ANSI-LOOP::LOOP-DO-IF ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION ++ ANSI-LOOP::LOOP-TASSOC SLOOP::IN-CAREFULLY-SLOOP-FOR ++ COMMON-LISP::DOCUMENTATION FPE::PAREN-READER SYSTEM::GET-NODES ++ SYSTEM::PARSE-SLOT-DESCRIPTION SLOOP::IN-FRINGE-SLOOP-MAP ++ SYSTEM::SAFE-EVAL SYSTEM::DISPLAY-ENV FPE::%-READER ++ SLOOP::THEREIS-SLOOP-COLLECT SYSTEM::LOOKUP-KEYWORD ++ COMMON-LISP::LOGANDC2 COMMON-LISP::NTHCDR ++ SLOOP::MINIMIZE-SLOOP-COLLECT SYSTEM::GET-MATCH ++ SYSTEM::SETF-EXPAND SLOOP::LOGXOR-SLOOP-COLLECT ++ ANSI-LOOP::LOOP-DO-ALWAYS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::FIXNUM) ++ SYSTEM::ROUND-UP)) + (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::Y-OR-N-P COMMON-LISP::YES-OR-NO-P ++ COMMON-LISP::DRIBBLE COMMON-LISP::VECTOR SYSTEM::NEXT-MATCH ++ SYSTEM::MAKE-S-DATA SYSTEM::LOC SYSTEM::BREAK-LOCALS ++ SLOOP::PARSE-LOOP-WITH COMMON-LISP::USER-HOMEDIR-PATHNAME ++ SYSTEM::STEP-INTO SYSTEM::MAYBE-CLEAR-INPUT ++ ANSI-LOOP::MAKE-LOOP-PATH SYSTEM::STEP-NEXT ++ ANSI-LOOP::LOOP-GENTEMP COMMON-LISP::COMPUTE-RESTARTS ++ SYSTEM::CURRENT-STEP-FUN SYSTEM::MAKE-INSTREAM ++ ANSI-LOOP::MAKE-LOOP-COLLECTOR SYSTEM::MAKE-RESTART ++ SYSTEM::DESCRIBE-ENVIRONMENT SYSTEM::TRANSFORM-KEYWORDS ++ COMMON-LISP::ABORT ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE ++ ANSI-LOOP::MAKE-LOOP-UNIVERSE SLOOP::PARSE-LOOP-DECLARE ++ COMMON-LISP::BREAK ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL ++ SYSTEM::MAKE-CONTEXT SYSTEM::DBL-READ ++ COMMON-LISP::MAKE-PATHNAME ++ ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL)) + (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)) ++ ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES SYSTEM::BREAK-GO ++ COMMON-LISP::FILE-AUTHOR SYSTEM::ENSURE-DIR-STRING ++ SYSTEM::INFO-SUBFILE COMMON-LISP::DESCRIBE SYSTEM::END-WAITING ++ COMMON-LISP::PRIN1-TO-STRING SYSTEM::FIND-DECLARATIONS ++ COMMON-LISP::INSPECT ANSI-LOOP::NAMED-VARIABLE ++ SYSTEM::GET-&ENVIRONMENT SYSTEM::INSPECT-OBJECT ++ COMMON-LISP::PRINC-TO-STRING ANSI-LOOP::LOOP-LIST-STEP ++ SYSTEM::INSTREAM-NAME SYSTEM::BREAK-LEVEL-INVOKE-RESTART ++ SYSTEM::WAITING COMMON-LISP::INVOKE-RESTART-INTERACTIVELY)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ SYSTEM::IHS-NOT-INTERPRETED-ENV COMMON-LISP::NINTH ++ SYSTEM::FIND-KCL-TOP-RESTART COMMON-LISP::TRUENAME ++ SYSTEM::DIRECTORY-LIST-CHECK SYSTEM::REAL-ASINH ++ SYSTEM::SHOW-ENVIRONMENT SYSTEM::PRINT-FRS ++ SYSTEM::REWRITE-RESTART-CASE-CLAUSE ++ COMMON-LISP::TWO-WAY-STREAM-OUTPUT-STREAM ++ ANSI-LOOP::LOOP-COLLECTOR-DATA SLOOP::POINTER-FOR-COLLECT ++ SYSTEM::MLP SYSTEM::WILD-PATH-ELEMENT-P SYSTEM::LNP ++ ANSI-LOOP::LOOP-MINIMAX-OPERATIONS SYSTEM::FRS-KIND ++ SYSTEM::BKPT-FILE COMMON-LISP::FIFTH ++ ANSI-LOOP::LOOP-COLLECTOR-P ANSI-LOOP::LOOP-UNIVERSE-ANSI ++ ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS SYSTEM::IDESCRIBE ++ ANSI-LOOP::LOOP-CONSTANTP ++ ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS COMMON-LISP::PROBE-FILE ++ ANSI-LOOP::LOOP-UNIVERSE-P COMMON-LISP::SINH SYSTEM::RESTART-P ++ SYSTEM::S-DATA-DOCUMENTATION ++ COMMON-LISP::ECHO-STREAM-OUTPUT-STREAM ++ SYSTEM::FIND-DOCUMENTATION SYSTEM::INFO-GET-FILE ++ SLOOP::PARSE-NO-BODY COMMON-LISP::FILE-NAMESTRING ++ COMMON-LISP::COMPILER-MACRO-FUNCTION SYSTEM::PROCESS-ARGS ++ ANSI-LOOP::LOOP-COLLECTOR-DTYPE COMMON-LISP::PHASE ++ SYSTEM::MAKE-FRAME SYSTEM::INSTREAM-STREAM ++ ANSI-LOOP::LOOP-COLLECTOR-HISTORY SYSTEM::FIX-LOAD-PATH ++ SYSTEM::COMPUTING-ARGS-P ++ ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE COMMON-LISP::TENTH ++ ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE SYSTEM::WILD-NAMESTRING-P ++ SYSTEM::BEST-ARRAY-ELEMENT-TYPE SYSTEM::DM-BAD-KEY ++ SYSTEM::TERMINAL-INTERRUPT SYSTEM::REGEXP-CONV ++ COMMON-LISP::FILE-WRITE-DATE SLOOP::PARSE-LOOP ++ ANSI-LOOP::LOOP-CONSTRUCT-RETURN SYSTEM::DWIM ++ ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS ++ SLOOP::RETURN-SLOOP-MACRO SLOOP::AVERAGING-SLOOP-MACRO ++ SYSTEM::S-DATA-NAME SYSTEM::CHECK-TRACE-SPEC ++ SYSTEM::RESTRICT-STREAM-ELEMENT-TYPE SLOOP::TRANSLATE-NAME ++ SYSTEM::ADD-TO-HOTLIST SYSTEM::S-DATA-CONC-NAME ++ ANSI-LOOP::LOOP-MINIMAX-TYPE SYSTEM::PRINT-IHS ++ SYSTEM::DBL-RPL-LOOP SYSTEM::CANONICALIZE-PATHNAME-DIRECTORY ++ SYSTEM::INSPECT-CONS SYSTEM::INSTREAM-STREAM-NAME ++ SYSTEM::S-DATA-P SYSTEM::EVAL-FEATURE ++ COMMON-LISP::ARRAY-DIMENSIONS SYSTEM::IHS-VISIBLE ++ ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE ++ SYSTEM::CHECK-DECLARATIONS COMMON-LISP::TANH ++ ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS ++ COMMON-LISP::COMPILE-FILE-PATHNAME SYSTEM::INSPECT-PACKAGE ++ SLOOP::LOOP-LET-BINDINGS COMMON-LISP::CIS SYSTEM::SETUP-INFO ++ SYSTEM::NORMALIZE-TYPE ANSI-LOOP::LOOP-PSEUDO-BODY ++ SYSTEM::PATH-STREAM-NAME SYSTEM::INFO-GET-TAGS FPE::ST-LOOKUP ++ SYSTEM::BREAK-BACKWARD-SEARCH-STACK ++ ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE SYSTEM::SIMPLE-ARRAY-P ++ SYSTEM::S-DATA-TYPE COMMON-LISP::CONCATENATED-STREAM-STREAMS ++ SYSTEM::INSPECT-CHARACTER ANSI-LOOP::DESTRUCTURING-SIZE ++ SYSTEM::GET-BYTE-STREAM-NCHARS ANSI-LOOP::LOOP-PATH-P ++ COMMON-LISP::FIRST COMMON-LISP::SECOND ++ COMMON-LISP::TWO-WAY-STREAM-INPUT-STREAM ++ SYSTEM::MAKE-DEFPACKAGE-FORM SYSTEM::INSPECT-SYMBOL ++ SYSTEM::INSPECT-VECTOR ++ COMMON-LISP::LOAD-LOGICAL-PATHNAME-TRANSLATIONS ++ SYSTEM::RESTART-INTERACTIVE-FUNCTION SYSTEM::INSPECT-STRING ++ SYSTEM::DIR-P ANSI-LOOP::LOOP-COLLECTOR-CLASS ++ SYSTEM::S-DATA-CONSTRUCTORS SYSTEM::NODES-FROM-INDEX ++ SYSTEM::VERSION-PARSE SYSTEM::BKPT-FILE-LINE COMMON-LISP::ABS ++ SYSTEM::IHS-FNAME ANSI-LOOP::LOOP-MAKE-PSETQ ++ SYSTEM::LEAP-YEAR-P ANSI-LOOP::LOOP-EMIT-FINAL-VALUE ++ SYSTEM::GET-PATH SYSTEM::ALOAD SYSTEM::DM-KEY-NOT-ALLOWED ++ SYSTEM::MAKE-KCL-TOP-RESTART SYSTEM::S-DATA-SLOT-DESCRIPTIONS ++ COMMON-LISP::VECTOR-POP ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS ++ ANSI-LOOP::LOOP-PATH-USER-DATA SYSTEM::S-DATA-SLOT-POSITION ++ COMMON-LISP::BROADCAST-STREAM-STREAMS ++ SYSTEM::LOGICAL-PATHNAMEP SYSTEM::BREAK-FORWARD-SEARCH-STACK ++ SLOOP::SLOOP-SLOOP-MACRO COMMON-LISP::SIGNUM ++ SYSTEM::RESET-TRACE-DECLARATIONS SYSTEM::CONTEXT-P ++ SYSTEM::S-DATA-FROZEN SYSTEM::NUMBER-OF-DAYS-FROM-1900 ++ SYSTEM::S-DATA-STATICP ANSI-LOOP::LOOP-PATH-FUNCTION ++ SYSTEM::KNOWN-TYPE-P COMMON-LISP::PROVIDE SYSTEM::PNL1 ++ ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD ++ SYSTEM::COERCE-SLASH-TERMINATED COMMON-LISP::LOGICAL-PATHNAME ++ SYSTEM::DIR-CONJ SYSTEM::BKPT-FORM ++ SYSTEM::LOGICAL-PATHNAME-HOST-P SYSTEM::INSPECT-STRUCTURE ++ ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED ++ COMMON-LISP::FIND-ALL-SYMBOLS ++ ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS ++ ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED ++ COMMON-LISP::LOGICAL-PATHNAME-TRANSLATIONS ++ SYSTEM::TRACE-ONE-PREPROCESS COMMON-LISP::CONSTANTLY ++ COMMON-LISP::ACOS SYSTEM::S-DATA-OFFSET COMMON-LISP::ASINH ++ SYSTEM::SHORT-NAME SYSTEM::S-DATA-INCLUDED SYSTEM::DBL-EVAL ++ SYSTEM::BKPT-FUNCTION SYSTEM::INSPECT-NUMBER ++ SYSTEM::GET-INSTREAM SYSTEM::SHOW-BREAK-POINT FPE::LOOKUP ++ SYSTEM::NEXT-STACK-FRAME SYSTEM::INSPECT-ARRAY ++ SYSTEM::S-DATA-RAW ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA ++ SYSTEM::RESTART-REPORT-FUNCTION SYSTEM::TOGGLE-CASE ++ SYSTEM::NODE-OFFSET SYSTEM::INSTREAM-P ++ ANSI-LOOP::LOOP-PATH-NAMES SYSTEM::FREEZE-DEFSTRUCT ++ COMMON-LISP::SEVENTH SYSTEM::SEARCH-STACK COMMON-LISP::SIXTH ++ ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS FPE::GREF ++ FPE::XMM-LOOKUP COMMON-LISP::HOST-NAMESTRING ++ ANSI-LOOP::LOOP-TYPED-INIT ++ SYSTEM::LOGICAL-PATHNAME-DESIGNATOR-P ++ ANSI-LOOP::LOOP-DO-THEREIS COMMON-LISP::EIGHTH ++ SYSTEM::UNIQUE-ID COMMON-LISP::THIRD ++ COMMON-LISP::BYTE-POSITION COMMON-LISP::SYNONYM-STREAM-SYMBOL ++ SYSTEM::PATCH-SHARP SYSTEM::PRINT-SYMBOL-APROPOS ++ COMMON-LISP::LOGNOT SLOOP::REPEAT-SLOOP-MACRO ++ COMMON-LISP::FOURTH SLOOP::SUBSTITUTE-SLOOP-BODY ++ COMMON-LISP::ATANH SLOOP::LOOP-COLLECT-KEYWORD-P ++ SYSTEM::SEQTYPE SYSTEM::RE-QUOTE-STRING COMMON-LISP::ISQRT ++ SYSTEM::DO-F SYSTEM::S-DATA-HAS-HOLES ++ ANSI-LOOP::LOOP-HACK-ITERATION ANSI-LOOP::LOOP-COLLECTOR-NAME ++ COMMON-LISP::RESTART-NAME COMMON-LISP::DIRECTORY-NAMESTRING ++ ANSI-LOOP::LOOP-EMIT-BODY COMMON-LISP::ACOSH ++ SYSTEM::RESTART-FUNCTION SYSTEM::INFO-NODE-FROM-POSITION ++ COMMON-LISP::ASIN ANSI-LOOP::LOOP-LIST-COLLECTION ++ SYSTEM::S-DATA-INCLUDES SYSTEM::GET-NEXT-VISIBLE-FUN ++ COMMON-LISP::BYTE-SIZE COMMON-LISP::PATHNAME ++ ANSI-LOOP::LOOP-MINIMAX-P SLOOP::PARSE-LOOP-INITIALLY ++ COMMON-LISP::COSH SYSTEM::EXPAND-HOME-DIR ++ COMMON-LISP::ECHO-STREAM-INPUT-STREAM ++ SYSTEM::INSERT-BREAK-POINT SYSTEM::RESTART-TEST-FUNCTION ++ SYSTEM::S-DATA-PRINT-FUNCTION SYSTEM::WILD-DIR-ELEMENT-P ++ SYSTEM::S-DATA-NAMED COMMON-LISP::INVOKE-DEBUGGER ++ COMMON-LISP::NAMESTRING ANSI-LOOP::LOOP-MAKE-DESETQ ++ COMMON-LISP::COMPLEMENT SYSTEM::WALK-THROUGH ++ COMMON-LISP::RATIONAL ANSI-LOOP::LOOP-MAXMIN-COLLECTION ++ COMMON-LISP::DELETE-FILE ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++ SYSTEM::BREAK-QUIT SYSTEM::BREAK-BDS SYSTEM::DBL-BACKTRACE ++ SYSTEM::BREAK-LOCAL SYSTEM::INFO-ERROR ++ SYSTEM::SHOW-BREAK-VARIABLES SYSTEM::BREAK-VS ++ COMMON-LISP::CONTINUE COMMON-LISP::MUFFLE-WARNING ++ SYSTEM::IHS-BACKTRACE ANSI-LOOP::LOOP-OPTIONAL-TYPE ++ SYSTEM::BREAK-PREVIOUS SYSTEM::BREAK-NEXT)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ 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)) ++ SYSTEM::SMALLNTHCDR)) + (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::FUNCTION (COMMON-LISP::T) ++ COMMON-LISP::HASH-TABLE) ++ SYSTEM::CONTEXT-SPICE)) + (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::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++ SYSTEM::S-DATA-SIZE FPE::REG-LOOKUP SYSTEM::INSTREAM-LINE ++ SYSTEM::S-DATA-LENGTH SYSTEM::THE-START)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM COMMON-LISP::T) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) ++ SYSTEM::MATCH-BEGINNING SYSTEM::MATCH-END)) ++(COMMON-LISP::MAPC ++ (COMMON-LISP::LAMBDA (COMPILER::X) ++ (COMMON-LISP::SETF ++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) ++ COMMON-LISP::T)) ++ '(SYSTEM::CONDITION-CLASS-P SYSTEM::WARNINGP SYSTEM::SI-CLASS-OF ++ SYSTEM::SI-FIND-CLASS SYSTEM::DEFINE-STRUCTURE ++ FPE::BREAK-ON-FLOATING-POINT-EXCEPTIONS ++ SYSTEM::SIMPLE-CONDITION-CLASS-P SYSTEM::AUTOLOAD ++ SYSTEM::SI-CLASS-PRECEDENCE-LIST SYSTEM::SI-CLASS-NAME ++ SYSTEM::TRACE-ONE SYSTEM::MAKE-ACCESS-FUNCTION ++ SYSTEM::UNTRACE-ONE SYSTEM::SI-CLASSP SYSTEM::CONDITIONP ++ SYSTEM::AUTOLOAD-MACRO)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) + COMMON-LISP::T) +- SYSTEM::SMALLNTHCDR)) ++ SYSTEM::GET-CONTEXT SYSTEM::PUSH-CONTEXT)) + (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)) ++ SYSTEM::RELATIVE-LINE SYSTEM::LENEL SYSTEM::THE-END ++ ANSI-LOOP::DUPLICATABLE-CODE-P SYSTEM::FASLINK ++ SYSTEM::GET-NODE-INDEX)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++ SLOOP::PARSE-ONE-WHEN-CLAUSE ANSI-LOOP::LOOP-DO-FINALLY ++ SLOOP::LOOP-PEEK ANSI-LOOP::LOOP-DO-INITIALLY SLOOP::LOOP-POP ++ ANSI-LOOP::LOOP-GET-PROGN SYSTEM::KCL-TOP-RESTARTS ++ SYSTEM::INSPECT-READ-LINE SLOOP::PARSE-LOOP-WHEN ++ ANSI-LOOP::LOOP-GET-FORM SYSTEM::DEFAULT-SYSTEM-BANNER ++ SYSTEM::SET-UP-TOP-LEVEL SYSTEM::GET-INDEX-NODE ++ ANSI-LOOP::LOOP-DO-DO ANSI-LOOP::LOOP-WHEN-IT-VARIABLE ++ SYSTEM::SETUP-LINEINFO COMMON-LISP::TYPE-ERROR ++ SYSTEM::READ-EVALUATED-FORM SYSTEM::INSPECT-INDENT-1 ++ SLOOP::LOOP-UN-POP SLOOP::PARSE-LOOP-DO ++ ANSI-LOOP::LOOP-DO-WITH SYSTEM::INSPECT-INDENT ++ SYSTEM::GET-TEMP-DIR ANSI-LOOP::LOOP-ITERATION-DRIVER ++ SYSTEM::WINE-TMP-REDIRECT SLOOP::PARSE-LOOP-COLLECT ++ SYSTEM::DEFAULT-INFO-HOTLIST SLOOP::PARSE-LOOP1 ++ SYSTEM::CLEANUP ANSI-LOOP::LOOP-DO-NAMED SYSTEM::DBL ++ SYSTEM::ALL-TRACE-DECLARATIONS SYSTEM::TEST-ERROR ++ ANSI-LOOP::LOOP-BIND-BLOCK ANSI-LOOP::LOOP-DO-REPEAT ++ SYSTEM::ILLEGAL-BOA SYSTEM::SET-ENV SYSTEM::SET-CURRENT ++ SYSTEM::INIT-BREAK-POINTS SYSTEM::GET-SIG-FN-NAME ++ ANSI-LOOP::LOOP-DO-RETURN ANSI-LOOP::LOOP-CONTEXT ++ SYSTEM::SHOW-RESTARTS SYSTEM::STEP-READ-LINE ++ SLOOP::PARSE-LOOP-FOR SYSTEM::DM-TOO-MANY-ARGUMENTS ++ COMMON-LISP::LISP-IMPLEMENTATION-VERSION SYSTEM::TOP-LEVEL ++ ANSI-LOOP::LOOP-POP-SOURCE SYSTEM::DM-TOO-FEW-ARGUMENTS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM) +- COMMON-LISP::FIXNUM) +- SYSTEM::ROUND-UP)) ++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++ COMMON-LISP::*)) ++ COMMON-LISP::T) ++ SYSTEM::RESET-SYS-PATHS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ (COMMON-LISP::VECTOR COMMON-LISP::T)) ++ SYSTEM::CONTEXT-VEC)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) ++ SYSTEM::BREAK-HELP SYSTEM::BREAK-MESSAGE ++ SYSTEM::SIMPLE-BACKTRACE ANSI-LOOP::LOOP-DO-FOR ++ SYSTEM::BREAK-CURRENT SYSTEM::GCL-TOP-LEVEL ++ SYSTEM::BREAK-RESUME)) +\ No newline at end of file +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -447,7 +447,6 @@ set_tm_maxpage(struct typemanager *tm,fi + + 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(rb_start)>real_maxpage) return 0; + available_pages-=z; + tm->tm_adjgbccnt*=((double)j+1)/(n+1); + tm->tm_maxpage=n; +@@ -909,7 +908,7 @@ alloc_after_reclaiming_pages(struct type + + fixnum m=tpage(tm,n),reloc_min; + +- if (tm->tm_type>=t_end) return NULL; ++ if (tm->tm_type>t_end) return NULL; + + reloc_min=npage(rb_pointer-rb_start); + +@@ -925,6 +924,8 @@ alloc_after_reclaiming_pages(struct type + + } + ++ if (tm->tm_type>=t_end) return NULL; ++ + maybe_reallocate_page(tm,tm->tm_percent_free*tm->tm_npage); + + return alloc_from_freelist(tm,n); +@@ -1093,8 +1094,7 @@ DEFUNM_NEW("ALLOCATED",object,fSallocate + RV(make_fixnum(tm->tm_maxpage)), + RV(make_fixnum(tm->tm_nppage)), + RV(make_fixnum(tm->tm_gbccount)), +- RV(make_fixnum(tm->tm_npage*tm->tm_nppage-tm->tm_nfree)) +- )); ++ RV(make_fixnum(tm->tm_npage*tm->tm_nppage-tm->tm_nfree)))); + } + + #ifdef SGC_CONT_DEBUG +@@ -1658,7 +1658,7 @@ DEFUN_NEW("GPROF-QUIT",object,fSgprof_qu + massert(getcwd(b,sizeof(b))); + massert(!chdir(P_tmpdir)); + _mcleanup(); +- massert(snprintf(b1,sizeof(b1),"gprof %s",kcl_self)>0); ++ massert(snprintf(b1,sizeof(b1),"gprof '%s'",kcl_self)>0); + massert((pp=popen(b1,"r"))); + while ((n=fread(b1,1,sizeof(b1),pp))) + massert(fwrite(b1,1,n,stdout)); +--- gcl-2.6.12.orig/o/array.c ++++ gcl-2.6.12/o/array.c +@@ -1139,9 +1139,9 @@ Icheck_displaced(object displaced_list, + /* } */ + /* } */ + +-DEFUNO_NEW("REPLACE-ARRAY",object,fSreplace_array,SI,2,2,NONE, +- OO,OO,OO,OO,void,siLreplace_array,(object old,object new),"") +-{ struct dummy fw ; ++DEFUN_NEW("REPLACE-ARRAY",object,fSreplace_array,SI,2,2,NONE,OO,OO,OO,OO,(object old,object new),"") { ++ ++ struct dummy fw; + fw = old->d; + + old = IisArray(old); +--- gcl-2.6.12.orig/o/bind.c ++++ gcl-2.6.12/o/bind.c +@@ -24,7 +24,6 @@ Foundation, 675 Mass Ave, Cambridge, MA + */ + + #include "include.h" +-#include + + static void + illegal_lambda(void); +@@ -95,17 +94,19 @@ lambda_bind(object *arg_top) + struct aux *aux=NULL; + int naux; + bool special_processed; ++ object s[1],ss; + vs_mark; + + bds_check; + lambda = vs_head; +- if (type_of(lambda) != t_cons) ++ if (!consp(lambda)) + FEerror("No lambda list.", 0); + lambda_list = lambda->c.c_car; + body = lambda->c.c_cdr; + + required = (struct required *)vs_top; + nreq = 0; ++ s[0]=Cnil; + for (;;) { + if (endp(lambda_list)) + goto REQUIRED_ONLY; +@@ -152,7 +153,7 @@ OPTIONAL: + goto SEARCH_DECLARE; + x = lambda_list->c.c_car; + lambda_list = lambda_list->c.c_cdr; +- if (type_of(x) == t_cons) { ++ if (consp(x)) { + check_symbol(x->c.c_car); + check_var(x->c.c_car); + vs_push(x->c.c_car); +@@ -226,9 +227,9 @@ KEYWORD: + goto SEARCH_DECLARE; + x = lambda_list->c.c_car; + lambda_list = lambda_list->c.c_cdr; +- if (type_of(x) == t_cons) { +- if (type_of(x->c.c_car) == t_cons) { +- if (!keywordp(x->c.c_car->c.c_car)) ++ if (consp(x)) { ++ if (consp(x->c.c_car)) { ++ if (type_of(x->c.c_car->c.c_car)!=t_symbol) + /* FIXME better message */ + FEunexpected_keyword(x->c.c_car->c.c_car); + vs_push(x->c.c_car->c.c_car); +@@ -296,7 +297,7 @@ AUX_L: + goto SEARCH_DECLARE; + x = lambda_list->c.c_car; + lambda_list = lambda_list->c.c_cdr; +- if (type_of(x) == t_cons) { ++ if (consp(x)) { + check_symbol(x->c.c_car); + check_var(x->c.c_car); + vs_push(x->c.c_car); +@@ -336,10 +337,10 @@ SEARCH_DECLARE: + break; + continue; + } +- if (type_of(form)!=t_cons || !isdeclare(form->c.c_car)) ++ if (!consp(form) || !isdeclare(form->c.c_car)) + break; + for (ds = form->c.c_cdr; !endp(ds); ds = ds->c.c_cdr) { +- if (type_of(ds->c.c_car) != t_cons) ++ if (!consp(ds->c.c_car)) + illegal_declare(form); + if (ds->c.c_car->c.c_car == sLspecial) { + vs = ds->c.c_car->c.c_cdr; +@@ -381,8 +382,7 @@ SEARCH_DECLARE: + } + if (special_processed) + continue; +- /* lex_special_bind(v); */ +- lex_env[0] = MMcons(MMcons(v, Cnil), lex_env[0]); ++ s[0] = MMcons(MMcons(v, Cnil), s[0]); + + /**/ + } +@@ -437,17 +437,20 @@ SEARCH_DECLARE: + bind_var(rest->rest_var, vs_head, rest->rest_spp); + } + if (key_flag) { ++ int allow_other_keys_found=0; + i = narg - nreq - nopt; + if (i >= 0 && i%2 != 0) + /* FIXME better message */ + FEunexpected_keyword(Cnil); + other_keys_appeared = FALSE; + for (i = nreq + nopt; i < narg; i += 2) { +- if (!keywordp(base[i])) ++ if (type_of(base[i])!=t_symbol) + FEunexpected_keyword(base[i]); +- if (base[i] == sKallow_other_keys && +- base[i+1] != Cnil) ++ if (base[i] == sKallow_other_keys && !allow_other_keys_found) { ++ allow_other_keys_found=1; ++ if (base[i+1] != Cnil) + allow_other_keys_flag = TRUE; ++ } + for (j = 0; j < nkey; j++) { + if (keyword[j].key_word == base[i]) { + if (keyword[j].key_svar_val +@@ -460,7 +463,8 @@ SEARCH_DECLARE: + goto NEXT_ARG; + } + } +- other_keys_appeared = TRUE; ++ if (base[i] != sKallow_other_keys) ++ other_keys_appeared = TRUE; + + NEXT_ARG: + continue; +@@ -492,7 +496,7 @@ SEARCH_DECLARE: + eval_assign(temporary, aux[i].aux_init); + bind_var(aux[i].aux_var, temporary, aux[i].aux_spp); + } +- if (type_of(body) != t_cons || body->c.c_car == form) { ++ if (!consp(body) || body->c.c_car == form) { + vs_reset; + vs_head = body; + } else { +@@ -500,6 +504,13 @@ SEARCH_DECLARE: + vs_reset; + vs_head = body; + } ++ ++ if (s[0]!=Cnil) { ++ for (ss=s[0];ss->c.c_cdr!=Cnil;ss=ss->c.c_cdr); ++ ss->c.c_cdr=lex_env[0]; ++ lex_env[0]=s[0]; ++ } ++ + return; + + REQUIRED_ONLY: +@@ -515,10 +526,10 @@ REQUIRED_ONLY: + break; + continue; + } +- if (type_of(form)!=t_cons || !isdeclare(form->c.c_car)) ++ if (!consp(form) || !isdeclare(form->c.c_car)) + break; + for (ds = form->c.c_cdr; !endp(ds); ds = ds->c.c_cdr) { +- if (type_of(ds->c.c_car) != t_cons) ++ if (!consp(ds->c.c_car)) + illegal_declare(form); + if (ds->c.c_car->c.c_car == sLspecial) { + vs = ds->c.c_car->c.c_cdr; +@@ -537,7 +548,7 @@ REQUIRED_ONLY: + continue; + /* lex_special_bind(v); */ + temporary = MMcons(v, Cnil); +- lex_env[0] = MMcons(temporary, lex_env[0]); ++ s[0] = MMcons(temporary, s[0]); + + /**/ + } +@@ -555,7 +566,7 @@ REQUIRED_ONLY: + bind_var(required[i].req_var, + base[i], + required[i].req_spp); +- if (type_of(body) != t_cons || body->c.c_car == form) { ++ if (!consp(body) || body->c.c_car == form) { + vs_reset; + vs_head = body; + } else { +@@ -563,6 +574,13 @@ REQUIRED_ONLY: + vs_reset; + vs_head = body; + } ++ ++ if (s[0]!=Cnil) { ++ for (ss=s[0];ss->c.c_cdr!=Cnil;ss=ss->c.c_cdr); ++ ss->c.c_cdr=lex_env[0]; ++ lex_env[0]=s[0]; ++ } ++ + } + + void +@@ -612,7 +630,7 @@ struct bind_temp { + */ + + object +-find_special(object body, struct bind_temp *start, struct bind_temp *end) ++find_special(object body, struct bind_temp *start, struct bind_temp *end,object *s) + { + object temporary; + object form=Cnil; +@@ -622,6 +640,7 @@ find_special(object body, struct bind_te + vs_mark; + + vs_push(Cnil); ++ s=s ? s : lex_env; + for (; !endp(body); body = body->c.c_cdr) { + form = body->c.c_car; + +@@ -634,10 +653,10 @@ find_special(object body, struct bind_te + break; + continue; + } +- if (type_of(form)!=t_cons || !isdeclare(form->c.c_car)) ++ if (!consp(form) || !isdeclare(form->c.c_car)) + break; + for (ds = form->c.c_cdr; !endp(ds); ds = ds->c.c_cdr) { +- if (type_of(ds->c.c_car) != t_cons) ++ if (!consp(ds->c.c_car)) + illegal_declare(form); + if (ds->c.c_car->c.c_car == sLspecial) { + vs = ds->c.c_car->c.c_cdr; +@@ -655,14 +674,14 @@ find_special(object body, struct bind_te + continue; + /* lex_special_bind(v); */ + temporary = MMcons(v, Cnil); +- lex_env[0] = MMcons(temporary, lex_env[0]); ++ s[0] = MMcons(temporary, s[0]); + /**/ + } + } + } + } + +- if (body != Cnil && body->c.c_car != form) ++ if (body != Cnil && body->c.c_car != form && type_of(form)==t_cons && isdeclare(form->c.c_car))/*FIXME*/ + body = make_cons(form, body->c.c_cdr); + vs_reset; + return(body); +@@ -674,10 +693,10 @@ let_bind(object body, struct bind_temp * + struct bind_temp *bt; + + bds_check; +- vs_push(find_special(body, start, end)); + for (bt = start; bt < end; bt++) { + eval_assign(bt->bt_init, bt->bt_init); + } ++ vs_push(find_special(body, start, end,NULL)); + for (bt = start; bt < end; bt++) { + bind_var(bt->bt_var, bt->bt_init, bt->bt_spp); + } +@@ -688,13 +707,20 @@ object + letA_bind(object body, struct bind_temp *start, struct bind_temp *end) + { + struct bind_temp *bt; +- ++ object s[1],ss; ++ + bds_check; +- vs_push(find_special(body, start, end)); ++ s[0]=Cnil; ++ vs_push(find_special(body, start, end,s)); + for (bt = start; bt < end; bt++) { + eval_assign(bt->bt_init, bt->bt_init); + bind_var(bt->bt_var, bt->bt_init, bt->bt_spp); + } ++ if (s[0]!=Cnil) { ++ for (ss=s[0];ss->c.c_cdr!=Cnil;ss=ss->c.c_cdr); ++ ss->c.c_cdr=lex_env[0]; ++ lex_env[0]=s[0]; ++ } + return(vs_pop); + } + +@@ -703,12 +729,12 @@ letA_bind(object body, struct bind_temp + + #endif + +-#define NOT_YET 10 +-#define FOUND 11 ++#define NOT_YET stp_ordinary ++#define FOUND stp_special + #define NOT_KEYWORD 1 + + void +-parse_key(object *base, bool rest, bool allow_other_keys,int n, ...) ++parse_key(object *base, bool rest, bool allow_other_keys, int n, ...) + { + object temporary; + va_list ap; +@@ -735,7 +761,7 @@ parse_key(object *base, bool rest, bool + FEunexpected_keyword(Cnil); + if (narg == 2) { + k = base[0]; +- if (!keywordp(k)) ++ if (type_of(k)!=t_symbol) + FEunexpected_keyword(k); + if (k == sKallow_other_keys && ! allow_other_keys_found) { + allow_other_keys_found=1; +@@ -777,7 +803,7 @@ parse_key(object *base, bool rest, bool + va_end(ap); + for (v = base; v < vs_top; v += 2) { + k = v[0]; +- if (!keywordp(k)) { ++ if (type_of(k)!=t_symbol) { + error_flag = NOT_KEYWORD; + other_key = k; + continue; +@@ -827,16 +853,19 @@ check_other_key(object l, int n, ...) + object k; + int i; + bool allow_other_keys = FALSE; ++ int allow_other_keys_found=0; + + for (; !endp(l); l = l->c.c_cdr->c.c_cdr) { + k = l->c.c_car; +- if (!keywordp(k)) ++ if (type_of(k)!=t_symbol) + FEunexpected_keyword(k); + if (endp(l->c.c_cdr)) + /* FIXME better message */ + FEunexpected_keyword(Cnil); +- if (k == sKallow_other_keys && l->c.c_cdr->c.c_car != Cnil) { +- allow_other_keys = TRUE; ++ if (k == sKallow_other_keys && !allow_other_keys_found) { ++ allow_other_keys_found=1; ++ if (l->c.c_cdr->c.c_car != Cnil) ++ allow_other_keys = TRUE; + } else { + char buf [100]; + bzero(buf,n); +@@ -1110,7 +1139,7 @@ gcl_init_bind(void) + make_cons(make_ordinary("&BODY"), Cnil))))))))); + + make_constant("LAMBDA-PARAMETERS-LIMIT", +- make_fixnum(64)); ++ make_fixnum(MAX_ARGS+1)); + + + +--- gcl-2.6.12.orig/o/error.c ++++ gcl-2.6.12/o/error.c +@@ -490,49 +490,78 @@ vfun_wrong_number_of_args(object x) + + + void +-check_arg_range(int n, int m) +-{ +- object x,x1; ++check_arg_range(int n, int m) { + +- x=make_fixnum(n); +- x1=make_fixnum(VFUN_NARGS); + if (VFUN_NARGS < n) +- Icall_error_handler( +- sKtoo_few_arguments, +- make_simple_string("Needed at least ~D args, but received ~d"), +- 2,x,x1); +- else if (VFUN_NARGS > m) +- Icall_error_handler( +- sKtoo_many_arguments, +- make_simple_string("Needed no more than ~D args, but received ~d"), +- 2,x,x1); +- } ++ FEtoo_few_arguments(0,VFUN_NARGS); ++ if (VFUN_NARGS > m) ++ FEtoo_many_arguments(0,VFUN_NARGS); ++ ++} + + + DEF_ORDINARY("TERMINAL-INTERRUPT",sSterminal_interrupt,SI,""); +-DEF_ORDINARY("WRONG-TYPE-ARGUMENT",sKwrong_type_argument,KEYWORD,""); +-DEF_ORDINARY("TOO-FEW-ARGUMENTS",sKtoo_few_arguments,KEYWORD,""); +-DEF_ORDINARY("TOO-MANY-ARGUMENTS",sKtoo_many_arguments,KEYWORD,""); +-DEF_ORDINARY("UNEXPECTED-KEYWORD",sKunexpected_keyword,KEYWORD,""); +-DEF_ORDINARY("INVALID-FORM",sKinvalid_form,KEYWORD,""); +-DEF_ORDINARY("UNBOUND-VARIABLE",sKunbound_variable,KEYWORD,""); +-DEF_ORDINARY("INVALID-VARIABLE",sKinvalid_variable,KEYWORD,""); +-DEF_ORDINARY("UNDEFINED-FUNCTION",sKundefined_function,KEYWORD,""); +-DEF_ORDINARY("INVALID-FUNCTION",sKinvalid_function,KEYWORD,""); +-DEF_ORDINARY("PACKAGE-ERROR",sKpackage_error,KEYWORD,""); +-DEF_ORDINARY("DATUM",sKdatum,KEYWORD,""); +-DEF_ORDINARY("EXPECTED-TYPE",sKexpected_type,KEYWORD,""); +-DEF_ORDINARY("PACKAGE",sKpackage,KEYWORD,""); +-DEF_ORDINARY("FORMAT-CONTROL",sKformat_control,KEYWORD,""); +-DEF_ORDINARY("FORMAT-ARGUMENTS",sKformat_arguments,KEYWORD,""); + DEF_ORDINARY("CATCH",sKcatch,KEYWORD,""); + DEF_ORDINARY("PROTECT",sKprotect,KEYWORD,""); + DEF_ORDINARY("CATCHALL",sKcatchall,KEYWORD,""); + + ++DEF_ORDINARY("CONDITION",sLcondition,LISP,""); ++DEF_ORDINARY("SERIOUS-CONDITION",sLserious_condition,LISP,""); ++DEF_ORDINARY("SIMPLE-CONDITION",sLsimple_condition,LISP,""); ++ ++DEF_ORDINARY("ERROR",sLerror,LISP,""); ++DEF_ORDINARY("SIMPLE-ERROR",sLsimple_error,LISP,""); ++DEF_ORDINARY("FORMAT-CONTROL",sKformat_control,KEYWORD,""); ++DEF_ORDINARY("FORMAT-ARGUMENTS",sKformat_arguments,KEYWORD,""); ++ ++DEF_ORDINARY("TYPE-ERROR",sLtype_error,LISP,""); ++DEF_ORDINARY("DATUM",sKdatum,KEYWORD,""); ++DEF_ORDINARY("EXPECTED-TYPE",sKexpected_type,KEYWORD,""); ++DEF_ORDINARY("SIMPLE-TYPE-ERROR",sLsimple_type_error,LISP,""); ++ ++DEF_ORDINARY("PROGRAM-ERROR",sLprogram_error,LISP,""); ++DEF_ORDINARY("CONTROL-ERROR",sLcontrol_error,LISP,""); ++DEF_ORDINARY("PACKAGE-ERROR",sLpackage_error,LISP,""); ++DEF_ORDINARY("PACKAGE",sKpackage,KEYWORD,""); ++ ++DEF_ORDINARY("STREAM-ERROR",sLstream_error,LISP,""); ++DEF_ORDINARY("STREAM",sKstream,KEYWORD,""); ++DEF_ORDINARY("END-OF-FILE",sLend_of_file,LISP,""); ++ ++DEF_ORDINARY("FILE-ERROR",sLfile_error,LISP,""); ++DEF_ORDINARY("PATHNAME",sKpathname,KEYWORD,""); ++ ++DEF_ORDINARY("CELL-ERROR",sLcell_error,LISP,""); ++DEF_ORDINARY("NAME",sKname,KEYWORD,""); ++DEF_ORDINARY("UNBOUND-SLOT",sLunbound_slot,LISP,""); ++DEF_ORDINARY("UNBOUND-VARIABLE",sLunbound_variable,LISP,""); ++DEF_ORDINARY("UNDEFINED-FUNCTION",sLundefined_function,LISP,""); ++ ++DEF_ORDINARY("ARITHMETIC-ERROR",sLarithmetic_error,LISP,""); ++DEF_ORDINARY("OPERATION",sKoperation,KEYWORD,""); ++DEF_ORDINARY("OPERANDS",sKoperands,KEYWORD,""); ++DEF_ORDINARY("DIVISION-BY-ZERO",sLdivision_by_zero,LISP,""); ++DEF_ORDINARY("FLOATING-POINT-OVERFLOW",sLfloating_point_overflow,LISP,""); ++DEF_ORDINARY("FLOATING-POINT-UNDERFLOW",sLfloating_point_underflow,LISP,""); ++DEF_ORDINARY("FLOATING-POINT-INEXACT",sLfloating_point_inexact,LISP,""); ++DEF_ORDINARY("FLOATING-POINT-INVALID-OPERATION",sLfloating_point_invalid_operation,LISP,""); ++ ++DEF_ORDINARY("PARSE-ERROR",sLparse_error,LISP,""); ++ ++DEF_ORDINARY("PRINT-NOT-READABLE",sLprint_not_readable,LISP,""); ++ ++DEF_ORDINARY("READER-ERROR",sLreader_error,LISP,""); ++DEF_ORDINARY("PATHNAME-ERROR",sLpathname_error,SI,""); ++ ++DEF_ORDINARY("STORAGE-CONDITION",sLstorage_condition,LISP,""); ++ ++DEF_ORDINARY("WARNING",sLwarning,LISP,""); ++DEF_ORDINARY("SIMPLE-WARNING",sLsimple_warning,LISP,""); ++DEF_ORDINARY("STYLE-WARNING",sLstyle_warning,LISP,""); ++ + void +-gcl_init_error(void) +-{ +- null_string = make_simple_string(""); +- enter_mark_origin(&null_string); ++gcl_init_error(void) { ++ null_string = make_simple_string(""); ++ enter_mark_origin(&null_string); + } +--- gcl-2.6.12.orig/o/fasdump.c ++++ gcl-2.6.12/o/fasdump.c +@@ -1501,14 +1501,12 @@ read_fasl_vector(object in) + object d; + int tem; + if (((tem=getc(((FILE *)in->sm.sm_fp))) == EOF) && feof(((FILE *)in->sm.sm_fp))) +- { d = coerce_to_pathname(in); +- d = make_pathname(d->pn.pn_host, +- d->pn.pn_device, +- d->pn.pn_directory, +- d->pn.pn_name, +- make_simple_string("data"), +- d->pn.pn_version); +- d = coerce_to_namestring(d); ++ { char *pf; ++ coerce_to_filename(in,FN1); ++ for (pf=FN1+strlen(FN1);pf>FN1 && pf[-1]!='.';pf--); ++ if (pf==FN1) {pf=FN1+strlen(FN1);*pf++='.';} ++ snprintf(pf,sizeof(FN1)-(pf-FN1),"data"); ++ d=make_simple_string(FN1); + in = open_stream(d,smm_input,Cnil,Cnil); + if (in == Cnil) + FEerror("Can't open file ~s",1,d); +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -138,7 +138,7 @@ void + end_of_stream(strm) + object strm; + { +- FEerror("Unexpected end of ~S.", 1, strm); ++ END_OF_FILE(strm); + } + + /* +@@ -167,6 +167,7 @@ BEGIN: + case smm_probe: + return(FALSE); + ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -223,6 +224,7 @@ BEGIN: + case smm_probe: + return(FALSE); + ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -270,6 +272,7 @@ BEGIN: + case smm_socket: + return (sLcharacter); + ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -341,220 +344,208 @@ cannot_create(object); + Fn is a namestring. + */ + object +-open_stream(fn, smm, if_exists, if_does_not_exist) +-object fn; +-enum smmode smm; +-object if_exists, if_does_not_exist; +-{ +- object x; +- FILE *fp=NULL; +- char fname[PATH_MAX]; +- object unzipped = 0; +- vs_mark; ++open_stream(object fn,enum smmode smm, object if_exists, object if_does_not_exist) { + +-/* +- if (type_of(fn) != t_string) +- FEwrong_type_argument(sLstring, fn); +-*/ +- /* if (fn->st.st_fillp > BUFSIZ - 1) */ +- /* too_long_file_name(fn); */ +- /* for (i = 0; i < fn->st.st_fillp; i++) */ +- /* fname[i] = fn->st.st_self[i]; */ +- +- /* fname[i] = '\0'; */ +- coerce_to_filename(fn,fname); +- if (smm == smm_input || smm == smm_probe) { +- if(fname[0]=='|') +- fp = popen(fname+1,"r"); +- else +- fp = fopen_not_dir(fname, "r"); +- +- AGAIN: +- if (fp == NULL) { +- if (sSAallow_gzipped_fileA->s.s_dbind != sLnil) +- { +- static struct string st; +- char buf[256]; +- if (snprintf(buf,sizeof(buf),"%s.gz",fname)<=0) +- FEerror("Cannot write .gz filename",0); +- st.st_self=buf; +- st.st_dim=st.st_fillp=strlen(buf); +- set_type_of(&st,t_string); +- if (file_exists((object)&st)) { +- FILE *pp; +- int n; +- if (!(fp=tmpfile())) +- FEerror("Cannot create temporary file",0); +- if (snprintf(buf,sizeof(buf),"zcat %s.gz",fname)<=0) +- FEerror("Cannot write zcat pipe name",0); +- if (!(pp=popen(buf,"r"))) +- FEerror("Cannot open zcat pipe",0); +- while((n=fread(buf,1,sizeof(buf),pp))) +- if (!fwrite(buf,1,n,fp)) +- FEerror("Cannot write pipe output to temporary file",0); +- if (pclose(pp)<0) +- FEerror("Cannot close zcat pipe",0); +- if (fseek(fp,0,SEEK_SET)) +- FEerror("Cannot rewind temporary file\n",0); +- goto AGAIN; +- } +- } +- +-/* fp = fopen_not_dir(buf,"r"); */ +-/* if (fp) */ +-/* { */ +-/* #ifdef NO_MKSTEMP */ +-/* char *tmp; */ +-/* #else */ +-/* char tmp[200]; */ +-/* #endif */ +-/* char command [500]; */ +-/* fclose(fp); */ +-/* #ifdef NO_MKSTEMP */ +-/* tmp = tmpnam(0); */ +-/* #else */ +-/* snprintf(tmp,sizeof(tmp),"uzipXXXXXX"); */ +- /* mkstemp(tmp); */ /* fixme: catch errors */ +-/* #endif */ +-/* unzipped = make_simple_string(tmp); */ +-/* sprintf(command,"gzip -dc %s > %s",buf,tmp); */ +-/* fp = 0; */ +-/* if (0 == system(command)) */ +-/* { */ +-/* fp = fopen_not_dir(tmp,"r"); */ +-/* if (fp) */ +-/* goto AGAIN; */ +-/* /\* should not get here *\/ */ +-/* else { unlink(tmp);}} */ +-/* }} */ +- if (if_does_not_exist == sKerror) +- cannot_open(fn); +- else if (if_does_not_exist == sKcreate) { +- fp = fopen_not_dir(fname, "w"); +- if (fp == NULL) +- cannot_create(fn); +- fclose(fp); +- fp = fopen_not_dir(fname, "r"); +- if (fp == NULL) +- cannot_open(fn); +- } else if (if_does_not_exist == Cnil) +- return(Cnil); +- else +- FEerror("~S is an illegal IF-DOES-NOT-EXIST option.", +- 1, if_does_not_exist); +- } +- } else if (smm == smm_output || smm == smm_io) { +- if (if_exists == sKnew_version && if_does_not_exist == sKcreate) +- goto CREATE; +- fp = fopen_not_dir(fname, "r"); +- if (fp != NULL) { +- fclose(fp); +- if (if_exists == sKerror) +- FEerror("The file ~A already exists.", 1, fn); +- else if (if_exists == sKrename) { +- if (smm == smm_output) +- fp = backup_fopen(fname, "w"); +- else +- fp = backup_fopen(fname, "w+"); +- if (fp == NULL) +- cannot_create(fn); +- } else if (if_exists == sKrename_and_delete || +- if_exists == sKnew_version || +- if_exists == sKsupersede) { +- if (smm == smm_output) +- fp = fopen_not_dir(fname, "w"); +- else +- fp = fopen_not_dir(fname, "w+"); +- if (fp == NULL) +- cannot_create(fn); +- } else if (if_exists == sKoverwrite) { +- fp = fopen_not_dir(fname, "r+"); +- if (fp == NULL) +- cannot_open(fn); +- } else if (if_exists == sKappend) { +- if (smm == smm_output) +- fp = fopen_not_dir(fname, "a"); +- else +- fp = fopen_not_dir(fname, "a+"); +- if (fp == NULL) +- FEerror("Cannot append to the file ~A.",1,fn); +- } else if (if_exists == Cnil) +- return(Cnil); +- else +- FEerror("~S is an illegal IF-EXISTS option.", +- 1, if_exists); +- } else { +- if (if_does_not_exist == sKerror) +- FEerror("The file ~A does not exist.", 1, fn); +- else if (if_does_not_exist == sKcreate) { +- CREATE: +- if (smm == smm_output) +- { +- if(fname[0]=='|') +- fp = popen(fname+1,"w"); +- else +- fp = fopen_not_dir(fname, "w"); +- } +- else +- fp = fopen_not_dir(fname, "w+"); +- if (fp == NULL) +- cannot_create(fn); +- } else if (if_does_not_exist == Cnil) +- return(Cnil); +- else +- FEerror("~S is an illegal IF-DOES-NOT-EXIST option.", +- 1, if_does_not_exist); +- } ++ object x; ++ FILE *fp=NULL; ++ vs_mark; ++ ++ coerce_to_filename(fn,FN1); ++ if (smm == smm_input || smm == smm_probe) { ++ if(FN1[0]=='|') ++ fp = popen(FN1+1,"r"); ++ else ++ fp = fopen_not_dir(FN1, "r"); ++ ++ if ((fp == NULL) && ++ (sSAallow_gzipped_fileA->s.s_dbind != sLnil)) { ++ union lispunion st; ++ char buf[256]; ++ if (snprintf(buf,sizeof(buf),"%s.gz",FN1)<=0) ++ FEerror("Cannot write .gz filename",0); ++ st.st.st_self=buf; ++ st.st.st_dim=st.st.st_fillp=strlen(buf); ++ set_type_of(&st,t_string); ++ if (fSstat((object)&st)!=Cnil) { ++ FILE *pp; ++ int n; ++ if (!(fp=tmpfile())) ++ FEerror("Cannot create temporary file",0); ++ if (snprintf(buf,sizeof(buf),"zcat %s.gz",FN1)<=0) ++ FEerror("Cannot write zcat pipe name",0); ++ if (!(pp=popen(buf,"r"))) ++ FEerror("Cannot open zcat pipe",0); ++ while((n=fread(buf,1,sizeof(buf),pp))) ++ if (!fwrite(buf,1,n,fp)) ++ FEerror("Cannot write pipe output to temporary file",0); ++ if (pclose(pp)<0) ++ FEerror("Cannot close zcat pipe",0); ++ if (fseek(fp,0,SEEK_SET)) ++ FEerror("Cannot rewind temporary file\n",0); ++ } ++ } ++ if (fp == NULL) { ++ if (if_does_not_exist == sKerror) ++ cannot_open(fn); ++ else if (if_does_not_exist == sKcreate) { ++ fp = fopen_not_dir(FN1, "w"); ++ if (fp == NULL) ++ cannot_create(fn); ++ fclose(fp); ++ fp = fopen_not_dir(FN1, "r"); ++ if (fp == NULL) ++ cannot_open(fn); ++ } else if (if_does_not_exist == Cnil) ++ return(Cnil); ++ else ++ FEerror("~S is an illegal IF-DOES-NOT-EXIST option.", ++ 1, if_does_not_exist); ++ } ++ } else if (smm == smm_output || smm == smm_io) { ++ if (FN1[0] == '|') ++ fp = NULL; ++ else ++ fp = fopen_not_dir(FN1, "r"); ++ if (fp != NULL) { ++ fclose(fp); ++ if (if_exists == sKerror) ++ FILE_ERROR(fn,"File exists"); ++ else if (if_exists == sKrename) { ++ massert(snprintf(FN2,sizeof(FN2),"%s.BAK",FN1)>=0); ++ massert(!rename(FN1,FN2)); ++ if (smm == smm_output) ++ fp = fopen(FN1, "w"); ++ else ++ fp = fopen(FN1, "w+"); ++ if (fp == NULL) ++ cannot_create(fn); ++ } else if (if_exists == sKrename_and_delete || ++ if_exists == sKnew_version || ++ if_exists == sKsupersede) { ++ if (smm == smm_output) ++ fp = fopen_not_dir(FN1, "w"); ++ else ++ fp = fopen_not_dir(FN1, "w+"); ++ if (fp == NULL) ++ cannot_create(fn); ++ } else if (if_exists == sKoverwrite) { ++ fp = fopen_not_dir(FN1, "r+"); ++ if (fp == NULL) ++ cannot_open(fn); ++ } else if (if_exists == sKappend) { ++ if (smm == smm_output) ++ fp = fopen_not_dir(FN1, "a"); ++ else ++ fp = fopen_not_dir(FN1, "a+"); ++ if (fp == NULL) ++ FEerror("Cannot append to the file ~A.",1,fn); ++ } else if (if_exists == Cnil) ++ return(Cnil); ++ else ++ FEerror("~S is an illegal IF-EXISTS option.", ++ 1, if_exists); ++ } else { ++ if (if_does_not_exist == sKerror) ++ FILE_ERROR(fn,"The file does not exist"); ++ else if (if_does_not_exist == sKcreate) { ++ if (smm == smm_output) { ++ if(FN1[0]=='|') ++ fp = popen(FN1+1,"w"); ++ else ++ fp = fopen_not_dir(FN1, "w"); + } else +- error("illegal stream mode"); +- x = alloc_object(t_stream); +- x->sm.sm_mode = (short)smm; +- x->sm.sm_fp = fp; ++ fp = fopen_not_dir(FN1, "w+"); ++ if (fp == NULL) ++ cannot_create(fn); ++ } else if (if_does_not_exist == Cnil) ++ return(Cnil); ++ else ++ FEerror("~S is an illegal IF-DOES-NOT-EXIST option.", ++ 1, if_does_not_exist); ++ } ++ } else ++ FEerror("Illegal open mode for ~S.",1,fn); ++ ++ vs_push(make_simple_string(FN1)); ++ x = alloc_object(t_stream); ++ x->sm.sm_mode = (short)smm; ++ x->sm.sm_fp = fp; ++ x->sm.sm_buffer = 0; ++ x->sm.sm_object0 = sLcharacter; ++ x->sm.sm_object1 = vs_head; ++ x->sm.sm_int0 = x->sm.sm_int1 = 0; ++ x->sm.sm_flags=0; ++ vs_push(x); ++ ++ setup_stream_buffer(x); ++ vs_reset; ++ ++ if (smm==smm_probe) ++ close_stream(x); ++ ++ return(x); + +- x->sm.sm_buffer = 0; +- 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); +- setup_stream_buffer(x); +- vs_reset; +- return(x); + } + + static void + gclFlushSocket(object); + ++DEFUN_NEW("OPEN-INT",object,fSopen_int,SI,8,8,NONE,OO,OO,OO,OO, ++ (object fn,object direction,object element_type,object if_exists, ++ object iesp,object if_does_not_exist,object idnesp, ++ object external_format),"") { ++ ++ enum smmode smm=0; ++ vs_mark; ++ object strm,filename; ++ ++ filename=fn; ++ if (direction == sKinput) { ++ smm = smm_input; ++ if (idnesp==Cnil) ++ if_does_not_exist = sKerror; ++ } else if (direction == sKoutput) { ++ smm = smm_output; ++ if (iesp==Cnil) ++ if_exists = sKnew_version; ++ if (idnesp==Cnil) { ++ if (if_exists == sKoverwrite || ++ if_exists == sKappend) ++ if_does_not_exist = sKerror; ++ else ++ if_does_not_exist = sKcreate; ++ } ++ } else if (direction == sKio) { ++ smm = smm_io; ++ if (iesp==Cnil) ++ if_exists = sKnew_version; ++ if (idnesp==Cnil) { ++ if (if_exists == sKoverwrite || ++ if_exists == sKappend) ++ if_does_not_exist = sKerror; ++ else ++ if_does_not_exist = sKcreate; ++ } ++ } else if (direction == sKprobe) { ++ smm = smm_probe; ++ if (idnesp==Cnil) ++ if_does_not_exist = Cnil; ++ } else ++ FEerror("~S is an illegal DIRECTION for OPEN.", 1, direction); ++ strm = open_stream(filename, smm, if_exists, if_does_not_exist); ++ if (type_of(strm) == t_stream) { ++ strm->sm.sm_object0 = element_type; ++ strm->sm.sm_object1 = fn; ++ } ++ vs_reset; ++ RETURN1(strm); ++} + + DEFUN_NEW("OPEN-STREAM-P",object,fLopen_stream_p,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") { + + check_type_stream(&x); + +- switch(x->sm.sm_mode) { +- case smm_output: +- case smm_input: +- case smm_io: +- case smm_probe: +- case smm_socket: +- case smm_string_input: +- case smm_string_output: +- return x->d.tt==1 ? Cnil : Ct; +- case smm_synonym: +- return FFN(fLopen_stream_p)(symbol_value(x->sm.sm_object0)); +- case smm_broadcast: +- case smm_concatenated: +- for (x=x->sm.sm_object0;!endp(x);x=x->c.c_cdr) +- if (!FFN(fLopen_stream_p)(x)) +- return Cnil; +- return Ct; +- case smm_two_way: +- case smm_echo: +- if (FFN(fLopen_stream_p)(STREAM_INPUT_STREAM(x))==Cnil) +- return Cnil; +- return FFN(fLopen_stream_p)(STREAM_OUTPUT_STREAM(x)); +- default: +- error("illegal stream mode"); +- return Cnil; +- } ++ return GET_STREAM_FLAG(x,gcl_sm_closed) ? Cnil : Ct; + + } + /* +@@ -562,94 +553,132 @@ DEFUN_NEW("OPEN-STREAM-P",object,fLopen_ + The abort_flag is not used now. + */ + void +-close_stream(strm) +-object strm; +-/*bool abort_flag; */ /* Not used now! */ +-{ +- object x; ++close_stream(object strm) { + +-BEGIN: +- strm->d.tt=1; ++ object x; + +- switch (strm->sm.sm_mode) { +- case smm_output: +- if (strm->sm.sm_fp == stdout) +- FEerror("Cannot close the standard output.", 0); +- if (strm->sm.sm_fp == NULL) break; +- fflush(strm->sm.sm_fp); +- deallocate_stream_buffer(strm); +- fclose(strm->sm.sm_fp); +- strm->sm.sm_fp = NULL; +- break; ++ if (FFN(fLopen_stream_p)(strm)==Cnil) ++ return; + ++ switch (strm->sm.sm_mode) { ++ case smm_output: ++ if (strm->sm.sm_fp == stdout) ++ FEerror("Cannot close the standard output.", 0); ++ fflush(strm->sm.sm_fp); ++ deallocate_stream_buffer(strm); ++ fclose(strm->sm.sm_fp); ++ strm->sm.sm_fp = NULL; ++ strm->sm.sm_fd = -1; ++ break; + +- case smm_socket: +- if (SOCKET_STREAM_FD(strm) < 2) +- emsg("tried Closing %d ! as socket \n",SOCKET_STREAM_FD(strm)); +- else { ++ case smm_socket: ++ if (SOCKET_STREAM_FD(strm) < 2) ++ emsg("tried Closing %d ! as socket \n",SOCKET_STREAM_FD(strm)); ++ else { + #ifdef HAVE_NSOCKET +- if (GET_STREAM_FLAG(strm,gcl_sm_output)) +- { +- gclFlushSocket(strm); +- /* there are two for one fd so close only one */ +- tcpCloseSocket(SOCKET_STREAM_FD(strm)); +- } ++ if (GET_STREAM_FLAG(strm,gcl_sm_output)) { ++ gclFlushSocket(strm); ++ /* there are two for one fd so close only one */ ++ tcpCloseSocket(SOCKET_STREAM_FD(strm)); ++ } + #endif +- SOCKET_STREAM_FD(strm)=-1; +- } ++ SOCKET_STREAM_FD(strm)=-1; ++ } + +- case smm_input: +- if (strm->sm.sm_fp == stdin) +- FEerror("Cannot close the standard input.", 0); +- +- case smm_io: +- case smm_probe: +- if (strm->sm.sm_fp == NULL) break; +- deallocate_stream_buffer(strm); +- if (strm->sm.sm_object1 && +- type_of(strm->sm.sm_object1)==t_string && +- strm->sm.sm_object1->st.st_self[0] =='|') +- pclose(strm->sm.sm_fp); +- else +- fclose(strm->sm.sm_fp); +- strm->sm.sm_fp = NULL; +- if (strm->sm.sm_object0 && +- type_of(strm->sm.sm_object0 ) == t_cons && +- Mcar(strm->sm.sm_object0 ) == sSAallow_gzipped_fileA) +- fLdelete_file(Mcdr(strm->sm.sm_object0)); +- break; ++ case smm_input: ++ if (strm->sm.sm_fp == stdin) ++ FEerror("Cannot close the standard input.", 0); + +- case smm_synonym: +- strm = symbol_value(strm->sm.sm_object0); +- if (type_of(strm) != t_stream) +- FEwrong_type_argument(sLstream, strm); +- goto BEGIN; ++ case smm_io: ++ case smm_probe: ++ deallocate_stream_buffer(strm); ++ if (strm->sm.sm_object1 && ++ type_of(strm->sm.sm_object1)==t_string && ++ strm->sm.sm_object1->st.st_self[0] =='|') ++ pclose(strm->sm.sm_fp); ++ else ++ fclose(strm->sm.sm_fp); ++ strm->sm.sm_fp = NULL; ++ strm->sm.sm_fd = -1; ++ if (strm->sm.sm_object0 && ++ type_of(strm->sm.sm_object0 )==t_cons && ++ Mcar(strm->sm.sm_object0)==sSAallow_gzipped_fileA) ++ ifuncall1(sLdelete_file,Mcdr(strm->sm.sm_object0)); ++ break; + +- case smm_broadcast: +- for (x = strm->sm.sm_object0; !endp(x); x = x->c.c_cdr) +- close_stream(x->c.c_car); +- break; ++ case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++ TYPE_ERROR(strm,sLstream); ++ close_stream(strm); ++ break; + +- case smm_concatenated: +- for (x = strm->sm.sm_object0; !endp(x); x = x->c.c_cdr) +- close_stream(x->c.c_car); +- break; ++ case smm_broadcast: ++ case smm_concatenated: ++ for (x = strm->sm.sm_object0; !endp(x); x = x->c.c_cdr) ++ close_stream(x->c.c_car); ++ break; + +- case smm_two_way: +- case smm_echo: +- close_stream(STREAM_INPUT_STREAM(strm)); +- close_stream(STREAM_OUTPUT_STREAM(strm)); +- break; ++ case smm_two_way: ++ case smm_echo: ++ close_stream(STREAM_INPUT_STREAM(strm)); ++ close_stream(STREAM_OUTPUT_STREAM(strm)); ++ break; + +- case smm_string_input: +- break; /* There is nothing to do. */ ++ case smm_string_input: ++ case smm_string_output: ++ break; + +- case smm_string_output: +- break; /* There is nothing to do. */ ++ default: ++ error("Illegal stream mode"); ++ } ++ ++ SET_STREAM_FLAG(strm,gcl_sm_closed,1); ++ ++} ++ ++DEFUN_NEW("INTERACTIVE-STREAM-P",object,fLinteractive_stream_p,LISP,1,1,NONE,OO,OO,OO,OO,(object strm),"") { ++ ++ check_type_stream(&strm); ++ ++ switch (strm->sm.sm_mode) { ++ case smm_output: ++ case smm_input: ++ case smm_io: ++ case smm_probe: ++ if ((strm->sm.sm_fp == stdin) || ++ (strm->sm.sm_fp == stdout) || ++ (strm->sm.sm_fp == stderr)) ++ return Ct; ++ return Cnil; ++ break; ++ case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++ FEwrong_type_argument(sLstream, strm); ++ break; ++ ++ case smm_broadcast: ++ case smm_concatenated: ++ if (( consp(strm->sm.sm_object0) ) && ++ ( type_of(strm->sm.sm_object0->c.c_car) == t_stream )) ++ strm=strm->sm.sm_object0->c.c_car; ++ else ++ return Cnil; ++ break; ++ ++ case smm_two_way: ++ case smm_echo: ++ strm=STREAM_INPUT_STREAM(strm); ++ break; ++ default: ++ return Cnil; ++ } ++ ++ return Cnil; + +- default: +- error("illegal stream mode"); +- } + } + + object +@@ -665,6 +694,7 @@ object istrm, ostrm; + STREAM_INPUT_STREAM(strm) = istrm; + STREAM_OUTPUT_STREAM(strm) = ostrm; + strm->sm.sm_int0 = strm->sm.sm_int1 = 0; ++ strm->sm.sm_flags=0; + return(strm); + } + +@@ -694,6 +724,7 @@ int istart, iend; + strm->sm.sm_object1 = OBJNULL; + STRING_INPUT_STREAM_NEXT(strm)= istart; + STRING_INPUT_STREAM_END(strm)= iend; ++ strm->sm.sm_flags=0; + return(strm); + } + +@@ -729,6 +760,7 @@ int line_length; + STRING_STREAM_STRING(strm) = strng; + strm->sm.sm_object1 = OBJNULL; + strm->sm.sm_int0 = STREAM_FILE_COLUMN(strm) = 0; ++ strm->sm.sm_flags=0; + vs_reset; + return(strm); + } +@@ -782,6 +814,7 @@ BEGIN: + /* strm->sm.sm_int0++; */ + return(c==EOF ? c : (c&0377)); + ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -884,6 +917,7 @@ BEGIN: + /* --strm->sm.sm_int0; */ /* use ftell now for position */ + break; + ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -985,6 +1019,7 @@ BEGIN: + + break; + ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -1095,6 +1130,7 @@ BEGIN: + #endif + closed_stream(strm); + break; ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -1183,6 +1219,7 @@ BEGIN: + case smm_probe: + return(FALSE); + ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + check_stream(strm); +@@ -1308,6 +1345,7 @@ BEGIN: + #endif + return TRUE; + ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -1363,6 +1401,7 @@ BEGIN: + case smm_string_output: + return(STRING_STREAM_STRING(strm)->st.st_fillp); + ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -1412,6 +1451,7 @@ BEGIN: + } + return(0); + ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -1448,6 +1488,7 @@ BEGIN: + + + ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -1487,6 +1528,7 @@ BEGIN: + case smm_two_way: + strm=STREAM_OUTPUT_STREAM(strm); + goto BEGIN; ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -1553,6 +1595,22 @@ load(const char *s) { + + + ++static int ++file_synonym_stream_p(object x) { ++ switch(x->sm.sm_mode) { ++ case smm_input: ++ case smm_output: ++ case smm_io: ++ case smm_probe: ++ case smm_file_synonym: ++ return 1; ++ case smm_synonym: ++ return file_synonym_stream_p(x->sm.sm_object0->s.s_dbind); ++ default: ++ return 0; ++ } ++} ++ + LFD(Lmake_synonym_stream)() + { + object x; +@@ -1560,12 +1618,13 @@ LFD(Lmake_synonym_stream)() + check_arg(1); + check_type_sym(&vs_base[0]); + x = alloc_object(t_stream); +- x->sm.sm_mode = (short)smm_synonym; ++ x->sm.sm_mode = file_synonym_stream_p(vs_base[0]) ? (short)smm_file_synonym : (short)smm_synonym; + x->sm.sm_fp = NULL; + x->sm.sm_buffer = 0; + x->sm.sm_object0 = vs_base[0]; + x->sm.sm_object1 = OBJNULL; + x->sm.sm_int0 = x->sm.sm_int1 = 0; ++ x->sm.sm_flags=0; + vs_base[0] = x; + } + +@@ -1589,6 +1648,7 @@ LFD(Lmake_broadcast_stream)() + x->sm.sm_object0 = vs_base[0]; + x->sm.sm_object1 = OBJNULL; + x->sm.sm_int0 = x->sm.sm_int1 = 0; ++ x->sm.sm_flags=0; + vs_base[0] = x; + } + +@@ -1612,6 +1672,7 @@ LFD(Lmake_concatenated_stream)() + x->sm.sm_object0 = vs_base[0]; + x->sm.sm_object1 = OBJNULL; + x->sm.sm_int0 = x->sm.sm_int1 = 0; ++ x->sm.sm_flags=0; + vs_base[0] = x; + } + +@@ -1700,6 +1761,38 @@ LFD(siLoutput_stream_string)() + vs_base[0] = vs_base[0]->sm.sm_object0; + } + ++DEFUN_NEW("FILE-STREAM-P",object,fSfile_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ RETURN1(type_of(x)==t_stream && ++ (x->sm.sm_mode==smm_input || x->sm.sm_mode==smm_output || x->sm.sm_mode==smm_io || x->sm.sm_mode==smm_probe) ++ ? Ct : Cnil); ++} ++ ++DEFUN_NEW("SYNONYM-STREAM-P",object,fSsynonym_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ RETURN1(type_of(x)==t_stream && (x->sm.sm_mode==smm_file_synonym || x->sm.sm_mode==smm_synonym) ? Ct : Cnil); ++} ++ ++DEFUN_NEW("TERMINAL-INPUT-STREAM-P",object,fSterminal_input_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_input && x->sm.sm_fp && isatty(fileno((FILE *)x->sm.sm_fp)) ? Ct : Cnil); ++} ++ ++DEFUN_NEW("BROADCAST-STREAM-P",object,fSbroadcast_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_broadcast ? Ct : Cnil); ++} ++ ++DEFUN_NEW("ECHO-STREAM-P",object,fSecho_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_echo ? Ct : Cnil); ++} ++ ++DEFUN_NEW("TWO-WAY-STREAM-P",object,fStwo_way_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_two_way ? Ct : Cnil); ++} ++ ++DEFUN_NEW("CONCATENATED-STREAM-P",object,fSconcatenated_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_concatenated ? Ct : Cnil); ++} ++ ++ ++ + LFD(Lstreamp)() + { + check_arg(1); +@@ -1747,54 +1840,6 @@ LFD(Lstream_element_type)() + @(return Ct) + @) + +-@(static defun open (filename +- &key (direction sKinput) +- (element_type sLcharacter) +- (if_exists Cnil iesp) +- (if_does_not_exist Cnil idnesp) +- &aux strm) +- enum smmode smm=0; +-@ +- check_type_or_pathname_string_symbol_stream(&filename); +- filename = coerce_to_namestring(filename); +- if (direction == sKinput) { +- smm = smm_input; +- if (!idnesp) +- if_does_not_exist = sKerror; +- } else if (direction == sKoutput) { +- smm = smm_output; +- if (!iesp) +- if_exists = sKnew_version; +- if (!idnesp) { +- if (if_exists == sKoverwrite || +- if_exists == sKappend) +- if_does_not_exist = sKerror; +- else +- if_does_not_exist = sKcreate; +- } +- } else if (direction == sKio) { +- smm = smm_io; +- if (!iesp) +- if_exists = sKnew_version; +- if (!idnesp) { +- if (if_exists == sKoverwrite || +- if_exists == sKappend) +- if_does_not_exist = sKerror; +- else +- if_does_not_exist = sKcreate; +- } +- } else if (direction == sKprobe) { +- smm = smm_probe; +- if (!idnesp) +- if_does_not_exist = Cnil; +- } else +- FEerror("~S is an illegal DIRECTION for OPEN.", +- 1, direction); +- strm = open_stream(filename, smm, if_exists, if_does_not_exist); +- if (type_of(strm) == t_stream) +- strm->sm.sm_object0 = element_type; +- @(return strm) +-@) + + @(defun file_position (file_stream &o position) + int i=0; +@@ -1838,175 +1883,72 @@ object sLAload_pathnameA; + DEFVAR("*COLLECT-BINARY-MODULES*",sSAcollect_binary_modulesA,SI,sLnil,""); + DEFVAR("*BINARY-MODULES*",sSAbinary_modulesA,SI,Cnil,""); + +-@(static defun load (pathname +- &key (verbose `symbol_value(sLAload_verboseA)`) +- print +- (if_does_not_exist sKerror) +- &aux pntype fasl_filename lsp_filename filename +- defaults strm stdoutput x +- package) +- bds_ptr old_bds_top; +- int i; +- object strm1; +-@ +- check_type_or_pathname_string_symbol_stream(&pathname); +- pathname = coerce_to_pathname(pathname); +- defaults = symbol_value(Vdefault_pathname_defaults); +- defaults = coerce_to_pathname(defaults); +- pathname = merge_pathnames(pathname, defaults, sKnewest); +- pntype = pathname->pn.pn_type; +- filename = coerce_to_namestring(pathname); +- if (user_match(filename->st.st_self,filename->st.st_fillp)) +- @(return Cnil) +- old_bds_top=bds_top; +- if (pntype == Cnil || pntype == sKwild || +- (type_of(pntype) == t_string && +-#ifdef UNIX +- string_eq(pntype, FASL_string))) { +-#endif +-#ifdef AOSVS ++DEFUN_NEW("LOAD-STREAM",object,fSload_stream,SI,2,2,NONE,OO,OO,OO,OO,(object strm,object print),"") { + +-#endif +- pathname->pn.pn_type = FASL_string; +- fasl_filename = coerce_to_namestring(pathname); +- } +- if (pntype == Cnil || pntype == sKwild || +- (type_of(pntype) == t_string && +-#ifdef UNIX +- string_eq(pntype, LSP_string))) { +-#endif +-#ifdef AOSVS ++ object x; + +-#endif +- pathname->pn.pn_type = LSP_string; +- lsp_filename = coerce_to_namestring(pathname); +- } +- if (fasl_filename != Cnil && file_exists(fasl_filename)) { +- if (verbose != Cnil) { +- SETUP_PRINT_DEFAULT(fasl_filename); +- if (file_column(PRINTstream) != 0) +- write_str("\n"); +- write_str("Loading "); +- PRINTescape = FALSE; +- write_object(fasl_filename, 0); +- write_str("\n"); +- CLEANUP_PRINT_DEFAULT; +- flush_stream(PRINTstream); +- } +- package = symbol_value(sLApackageA); +- bds_bind(sLApackageA, package); +- bds_bind(sLAload_pathnameA,fasl_filename); +- if (sSAcollect_binary_modulesA->s.s_dbind==Ct) { +- object _x=sSAbinary_modulesA->s.s_dbind; +- object _y=Cnil; +- while (_x!=Cnil) { +- _y=_x; +- _x=_x->c.c_cdr; +- } +- if (_y==Cnil) +- sSAbinary_modulesA->s.s_dbind=make_cons(fasl_filename,Cnil); +- else +- _y->c.c_cdr=make_cons(fasl_filename,Cnil); +- } +- i = fasload(fasl_filename); +- if (print != Cnil) { +- SETUP_PRINT_DEFAULT(Cnil); +- vs_top = PRINTvs_top; +- if (file_column(PRINTstream) != 0) +- write_str("\n"); +- write_str("Fasload successfully ended."); +- write_str("\n"); +- CLEANUP_PRINT_DEFAULT; +- flush_stream(PRINTstream); +- } +- bds_unwind(old_bds_top); +- if (verbose != Cnil) { +- SETUP_PRINT_DEFAULT(fasl_filename); +- if (file_column(PRINTstream) != 0) +- write_str("\n"); +- write_str("Finished loading "); +- PRINTescape = FALSE; +- write_object(fasl_filename, 0); +- write_str("\n"); +- CLEANUP_PRINT_DEFAULT; +- flush_stream(PRINTstream); +- } +- @(return `make_fixnum(i)`) +- } +- if (lsp_filename != Cnil && file_exists(lsp_filename)) { +- filename = lsp_filename; +- } +- if (if_does_not_exist != Cnil) +- if_does_not_exist = sKerror; +- strm1 = strm +- = open_stream(filename, smm_input, Cnil, if_does_not_exist); +- if (strm == Cnil) +- @(return Cnil) +- if (verbose != Cnil) { +- SETUP_PRINT_DEFAULT(filename); +- if (file_column(PRINTstream) != 0) +- write_str("\n"); +- write_str("Loading "); +- PRINTescape = FALSE; +- write_object(filename, 0); +- write_str("\n"); +- CLEANUP_PRINT_DEFAULT; +- flush_stream(PRINTstream); +- } +- package = symbol_value(sLApackageA); +- bds_bind(sLAload_pathnameA,pathname); +- bds_bind(sLApackageA, package); +- bds_bind(sLAstandard_inputA, strm); +- frs_push(FRS_PROTECT, Cnil); +- if (nlj_active) { +- close_stream(strm1); +- nlj_active = FALSE; +- frs_pop(); +- bds_unwind(old_bds_top); +- unwind(nlj_fr, nlj_tag); +- } +- for (;;) { +- preserving_whitespace_flag = FALSE; +- detect_eos_flag = TRUE; +- x = read_object_non_recursive(strm); +- if (x == OBJNULL) +- break; +- { +- object *base = vs_base, *top = vs_top, *lex = lex_env; +- object xx; +- +- lex_new(); +- eval(x); +- xx = vs_base[0]; +- lex_env = lex; +- vs_top = top; +- vs_base = base; +- x = xx; +- } +- if (print != Cnil) { +- SETUP_PRINT_DEFAULT(x); +- write_object(x, 0); +- write_str("\n"); +- CLEANUP_PRINT_DEFAULT; +- flush_stream(PRINTstream); +- } +- } +- close_stream(strm); +- frs_pop(); +- bds_unwind(old_bds_top); +- if (verbose != Cnil) { +- SETUP_PRINT_DEFAULT(filename); +- if (file_column(PRINTstream) != 0) +- write_str("\n"); +- write_str("Finished loading "); +- PRINTescape = FALSE; +- write_object(filename, 0); +- write_str("\n"); +- CLEANUP_PRINT_DEFAULT; +- flush_stream(PRINTstream); +- } +- @(return Ct) +-@) ++ for (;;) { ++ preserving_whitespace_flag = FALSE; ++ detect_eos_flag = TRUE; ++ x = read_object_non_recursive(strm); ++ if (x == OBJNULL) ++ break; ++ { ++ object *base = vs_base, *top = vs_top, *lex = lex_env; ++ object xx; ++ ++ lex_new(); ++ eval(x); ++ xx = vs_base[0]; ++ lex_env = lex; ++ vs_top = top; ++ vs_base = base; ++ x = xx; ++ } ++ if (print != Cnil) { ++ SETUP_PRINT_DEFAULT(x); ++ write_object(x, 0); ++ write_str("\n"); ++ CLEANUP_PRINT_DEFAULT; ++ flush_stream(PRINTstream); ++ } ++ } ++ ++ RETURN1(Ct); ++ ++} ++ ++DEFUN_NEW("LOAD-FASL",object,fSload_fasl,SI,2,2,NONE,OO,OO,OO,OO,(object fasl_filename,object print),"") { ++ ++ int i; ++ ++ if (sSAcollect_binary_modulesA->s.s_dbind==Ct) { ++ object _x=sSAbinary_modulesA->s.s_dbind; ++ object _y=Cnil; ++ while (_x!=Cnil) { ++ _y=_x; ++ _x=_x->c.c_cdr; ++ } ++ if (_y==Cnil) ++ sSAbinary_modulesA->s.s_dbind=make_cons(fasl_filename,Cnil); ++ else ++ _y->c.c_cdr=make_cons(fasl_filename,Cnil); ++ } ++ i = fasload(fasl_filename); ++ if (print != Cnil) { ++ SETUP_PRINT_DEFAULT(Cnil); ++ vs_top = PRINTvs_top; ++ if (file_column(PRINTstream) != 0) ++ write_str("\n"); ++ write_str(";; Fasload successfully ended."); ++ write_str("\n"); ++ CLEANUP_PRINT_DEFAULT; ++ flush_stream(PRINTstream); ++ } ++ ++ RETURN1(make_fixnum(i)); ++ ++} + + static void + FFN(siLget_string_input_stream_index)() +@@ -2018,9 +1960,6 @@ FFN(siLget_string_input_stream_index)() + vs_base[0] = make_fixnum(STRING_INPUT_STREAM_NEXT(vs_base[0])); + } + +-DEFUN_NEW("TERMINAL-INPUT-STREAM-P",object,fSterminal_input_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +- RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_input && x->sm.sm_fp && isatty(fileno((FILE *)x->sm.sm_fp)) ? Ct : Cnil); +-} + + LFD(siLmake_string_output_stream_from_string)() + { +@@ -2038,6 +1977,7 @@ LFD(siLmake_string_output_stream_from_st + strm->sm.sm_object1 = OBJNULL; + /* strm->sm.sm_int0 = strng->st.st_fillp; */ + STREAM_FILE_COLUMN(strm) = 0; ++ strm->sm.sm_flags=0; + vs_base[0] = strm; + } + +@@ -2071,14 +2011,14 @@ static void + cannot_open(fn) + object fn; + { +- FEerror("Cannot open the file ~A.", 1, fn); ++ FILE_ERROR(fn,"Cannot open"); + } + + static void + cannot_create(fn) + object fn; + { +- FEerror("Cannot create the file ~A.", 1, fn); ++ FILE_ERROR(fn,"Cannot create"); + } + + static void +@@ -2141,6 +2081,7 @@ int out; + if (type_of(strm) != t_stream) + FEwrong_type_argument(sLstream, strm); + switch (strm->sm.sm_mode){ ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -2566,6 +2507,7 @@ gcl_init_file(void) + #endif + standard_input->sm.sm_int0 = 0; /* unused */ + standard_input->sm.sm_int1 = 0; /* unused */ ++ standard_input->sm.sm_flags=0; + + standard_output = alloc_object(t_stream); + standard_output->sm.sm_mode = (short)smm_output; +@@ -2578,18 +2520,20 @@ gcl_init_file(void) + #endif + standard_output->sm.sm_int0 = 0; /* unused */ + STREAM_FILE_COLUMN(standard_output) = 0; ++ standard_output->sm.sm_flags=0; + + terminal_io = standard + = make_two_way_stream(standard_input, standard_output); + enter_mark_origin(&terminal_io); + + x = alloc_object(t_stream); +- x->sm.sm_mode = (short)smm_synonym; ++ x->sm.sm_mode = (short)smm_file_synonym; + x->sm.sm_fp = NULL; + x->sm.sm_buffer = 0; + x->sm.sm_object0 = sLAterminal_ioA; + x->sm.sm_object1 = OBJNULL; + x->sm.sm_int0 = x->sm.sm_int1 = 0; /* unused */ ++ x->sm.sm_flags=0; + standard_io = x; + enter_mark_origin(&standard_io); + +@@ -2597,7 +2541,9 @@ gcl_init_file(void) + + DEFVAR("*IGNORE-EOF-ON-TERMINAL-IO*",sSAignore_eof_on_terminal_ioA,SI,Cnil,""); + DEFVAR("*LOAD-PATHNAME*",sLAload_pathnameA,LISP,Cnil,""); ++DEFVAR("*LOAD-TRUENAME*",sSAload_truenameA,LISP,Cnil,""); + DEFVAR("*LOAD-VERBOSE*",sLAload_verboseA,LISP,Ct,""); ++DEFVAR("*LOAD-PRINT*",sLAload_printA,LISP,Cnil,""); + + DEF_ORDINARY("ABORT",sKabort,KEYWORD,""); + DEF_ORDINARY("APPEND",sKappend,KEYWORD,""); +@@ -2622,6 +2568,7 @@ DEF_ORDINARY("SUPERSEDE",sKsupersede,KEY + DEF_ORDINARY("VERBOSE",sKverbose,KEYWORD,""); + + ++DEF_ORDINARY("DELETE-FILE",sLdelete_file,LISP,""); + + + void +@@ -2673,13 +2620,9 @@ gcl_init_file_function() + make_function("STREAM-ELEMENT-TYPE", Lstream_element_type); + make_function("CLOSE", Lclose); + +- make_function("OPEN", Lopen); +- + make_function("FILE-POSITION", Lfile_position); + make_function("FILE-LENGTH", Lfile_length); + +- make_function("LOAD", Lload); +- + make_si_function("GET-STRING-INPUT-STREAM-INDEX", + siLget_string_input_stream_index); + make_si_function("MAKE-STRING-OUTPUT-STREAM-FROM-STRING", +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -57,7 +57,7 @@ mark_contblock(void *, int); + since this is more portable and faster lets use them --W. Schelter + These assume that DBEGIN is divisible by 32, or else we should have + #define Shamt(x) (((((int) x -DBEGIN) >> 2) & ~(~0 << 5))) +-*/ ++*/ + #define LOG_BITS_CHAR 3 + + #if CPTR_SIZE == 8 +@@ -72,7 +72,7 @@ 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; +@@ -84,7 +84,7 @@ int + cb_print(void) { + struct contblock **cbpp; + int i; +- ++ + for (cbpp=&cb_pointer,i=0;*cbpp;cbpp=&((*cbpp)->cb_link),i++) + emsg("%lu at %p\n",(*cbpp)->cb_size,*cbpp); + emsg("%u blocks\n",i); +@@ -146,7 +146,7 @@ pageinfo_p(void *v) { + (!pi->next || (void *)pi->next>=v+(pi->type==t_contiguous ? pi->in_use : 1)*PAGESIZE); + + } +- ++ + static inline char + get_bit(char *v,struct pageinfo *pi,void *x) { + void *ve=CB_DATA_START(pi); +@@ -157,16 +157,6 @@ get_bit(char *v,struct pageinfo *pi,void + return (v[i]>>s)&0x1; + } + +-/* static inline void */ +-/* set_bit(char *v,struct pageinfo *pi,void *x) { */ +-/* void *ve=CB_DATA_START(pi); */ +-/* fixnum off=(x-ve)>>LOG_BYTES_CONTBLOCK,i=off>>LOG_BITS_CHAR,s=off&~(~0UL<>s)&0x1) + #define bit_set(v,i,s) (v[i]|=(1UL<d.st>=ngc_thresh && + (dp=alloc_contblock_no_gc(s,static_promotion_limit))) { +- ++ + *pp=memcpy(dp,p,s); + x->d.st=0; + + return; + +- } ++ } + + if (x && x->d.std.st++; + +@@ -460,7 +440,7 @@ mark_leaf_data(object x,void **pp,ufixnu + + 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) { + +@@ -468,7 +448,7 @@ mark_object_address(object *o,int f) { + static ufixnum lr; + + ufixnum p=page(o); +- ++ + if (lp!=p || !f) { + lp=p; + lr= +@@ -496,7 +476,7 @@ mark_object_array(object *o,object *oe) + + static void + mark_object1(object x) { +- ++ + fixnum i,j=0;/*FIXME*/ + + if (is_marked_or_free(x)) +@@ -567,7 +547,7 @@ mark_object1(object x) { + break; + + case t_array: +- MARK_LEAF_DATA(x,x->a.a_dims,sizeof(int)*x->a.a_rank); ++ MARK_LEAF_DATA(x,x->a.a_dims,sizeof(*x->a.a_dims)*x->a.a_rank); + + case t_vector: + case t_bitvector: +@@ -615,7 +595,7 @@ mark_object1(object x) { + x->v.v_self=p; + adjust_displaced(x,j); + } +- } ++ } + mark_object(x->v.v_displaced); + break; + +@@ -627,7 +607,7 @@ mark_object1(object x) { + mark_object(x->str.str_def); + if (x->str.str_self) + for (i=0,j=S_DATA(def)->length;istr.str_self,S_DATA(def)->size); + } +@@ -646,7 +626,8 @@ mark_object1(object x) { + MARK_LEAF_DATA(x,x->sm.sm_buffer,BUFSIZ); + } + break; +- ++ ++ case smm_file_synonym: + case smm_synonym: + mark_object(x->sm.sm_object0); + break; +@@ -676,7 +657,7 @@ mark_object1(object x) { + error("mark stream botch"); + } + break; +- ++ + case t_random: + 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; +@@ -700,6 +681,7 @@ mark_object1(object x) { + mark_object(x->pn.pn_name); + mark_object(x->pn.pn_type); + mark_object(x->pn.pn_version); ++ mark_object(x->pn.pn_namestring); + break; + + case t_closure: +@@ -854,24 +836,6 @@ mark_phase(void) { + } + #endif + +- /* +- if (what_to_collect != t_symbol && +- (int)what_to_collect < (int)t_contiguous) { +- */ +- +- /* {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]); */ +- /* }} */ +- + /* mark the c stack */ + #ifndef N_RECURSION_REQD + #define N_RECURSION_REQD 2 +@@ -979,15 +943,15 @@ mark_c_stack(jmp_buf env1, int n, void ( + 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 +@@ -1035,7 +999,7 @@ contblock_sweep_phase(void) { + struct pageinfo *v; + STATIC char *s, *e, *p, *q; + ufixnum i; +- ++ + reset_contblock_freelist(); + + for (i=0;iv.v_fillp && (v=(void *)contblock_array->v.v_self[i]);i++) { +@@ -1045,7 +1009,7 @@ contblock_sweep_phase(void) { + #ifdef SGC + if (sgc_enabled && !(v->sgc_flags&SGC_PAGE_FLAG)) continue; + #endif +- ++ + s=CB_DATA_START(v); + e=(void *)v+v->in_use*PAGESIZE; + +@@ -1070,25 +1034,6 @@ contblock_sweep_phase(void) { + int (*GBC_enter_hook)() = NULL; + int (*GBC_exit_hook)() = NULL; + +-/* void */ +-/* ttss(void) { */ +- +-/* struct typemanager *tm; */ +-/* void *x,*y; */ +- +-/* for (tm=tm_table;tmtm_free;x!=OBJNULL;x=(void *)((struct freelist *)x)->f_link) { */ +-/* if (x==Cnil) */ +-/* printf("barr\n"); */ +-/* /\* for (y=(void *)((struct freelist *)x)->f_link;y!=OBJNULL && y!=x;y=(void *)((struct freelist *)y)->f_link); *\/ */ +-/* /\* if (y==x) *\/ */ +-/* /\* printf("circle\n"); *\/ */ +-/* } */ +-/* } */ +- +-/* } */ +- + fixnum fault_pages=0; + + static ufixnum +@@ -1102,7 +1047,7 @@ count_contblocks(void) { + return ncb; + + } +- ++ + + void + GBC(enum type t) { +@@ -1120,7 +1065,7 @@ GBC(enum type t) { + + ngc_thresh=fix(sSAleaf_collection_thresholdA->s.s_dbind); + recent_allocation=0; +- ++ + if (in_signal_handler && t == t_relocatable) + error("cant gc relocatable in signal handler"); + +@@ -1146,7 +1091,6 @@ GBC(enum type t) { + close_stream(o); + } + +- /* t = t_relocatable; */ + gc_time = -1; + } + +@@ -1265,54 +1209,6 @@ 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;pst.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) { + int i,j; +@@ -1361,8 +1257,6 @@ GBC(enum type t) { + + CHECK_INTERRUPT; + +- /* ttss(); */ +- + } + + static void +@@ -1472,7 +1366,7 @@ mark_contblock(void *p, int s) { + STATIC char *q; + STATIC char *x, *y; + struct pageinfo *v; +- ++ + if (NULL_OR_ON_C_STACK(p)) + return; + +@@ -1495,17 +1389,17 @@ DEFUN_NEW("CONTIGUOUS-REPORT",object,fSc + 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); + emsg("%lu %lu starting at %p\n",k,s,p); + } + emsg("\nTotal free %lu in %lu pieces\n\n",i,j); +- +- for (i=j=k=0;kv.v_fillp && (v=(void *)contblock_array->v.v_self[k]);k++,i+=v->in_use,j++) ++ ++ for (i=j=k=0;kv.v_fillp && (v=(void *)contblock_array->v.v_self[k]);k++,i+=v->in_use,j++) + emsg("%lu pages at %p\n",(unsigned long)v->in_use,v); + emsg("\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; +@@ -1520,7 +1414,7 @@ DEFUN_NEW("CONTIGUOUS-REPORT",object,fSc + } + } + emsg("\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; +@@ -1589,15 +1483,13 @@ DEFUN_NEW("CONTIGUOUS-REPORT",object,fSc + } + } + emsg("\nTotal leaf bytes %lu in %lu pieces\n",i,j); +- ++ + return Cnil; + + } + + DEFUN_NEW("GBC",object,fSgbc,SI,1,1,NONE,OO,OO,OO,OO,(object x0),"") { + +- /* 1 args */ +- + if (x0 == Ct) { + tm_table[t_contiguous].tm_adjgbccnt--; + GBC(t_other); +@@ -1644,5 +1536,5 @@ gcl_init_GBC(void) { + #ifdef SGC + make_si_function("SGC-ON",siLsgc_on); + #endif +- ++ + } +--- gcl-2.6.12.orig/o/iteration.c ++++ gcl-2.6.12/o/iteration.c +@@ -95,7 +95,7 @@ do_var_list(object var_list) + + + +- if (type_of(x) != t_cons) ++ if (!consp(x)) + FEinvalid_form("The index, ~S, is illegal.", x); + y = MMcar(x); + check_var(y); +@@ -326,7 +326,7 @@ FFN(Fdolist)(VOL object arg) + } + + eval_assign(start->bt_init, listform); +- body = find_special(MMcdr(arg), start, start+1); ++ body = find_special(MMcdr(arg), start, start+1,NULL); /*?*/ + vs_push(body); + bind_var(start->bt_var, Cnil, start->bt_spp); + if ((enum stype)start->bt_var->s.s_stype != stp_ordinary) +@@ -410,7 +410,7 @@ FFN(Fdotimes)(VOL object arg) + if (type_of(start->bt_init) != t_fixnum && + type_of(start->bt_init) != t_bignum) + FEwrong_type_argument(sLinteger, start->bt_init); +- body = find_special(MMcdr(arg), start, start+1); ++ body = find_special(MMcdr(arg), start, start+1,NULL); /*?*/ + vs_push(body); + bind_var(start->bt_var, make_fixnum(0), start->bt_spp); + if ((enum stype)start->bt_var->s.s_stype != stp_ordinary) { +--- gcl-2.6.12.orig/o/let.c ++++ gcl-2.6.12/o/let.c +@@ -151,7 +151,7 @@ FFN(Fmultiple_value_bind)(object form) + } + { + object *vt = vs_top; +- vs_push(find_special(body, start, (struct bind_temp *)vt)); ++ vs_push(find_special(body, start, (struct bind_temp *)vt,NULL)); /*?*/ + } + for (i = 0; i < n; i++) + bind_var(start[i].bt_var, +@@ -230,7 +230,7 @@ is an illegal function definition in FLE + lex_fun_bind(MMcar(def), top[0]); + def_list = MMcdr(def_list); + } +- vs_push(find_special(MMcdr(args), NULL, NULL)); ++ vs_push(find_special(MMcdr(args), NULL, NULL,NULL)); + Fprogn(vs_head); + lex_env = lex; + } +@@ -271,7 +271,7 @@ is an illegal function definition in LAB + MMcaar(closure_list) = lex_env[1]; + closure_list = MMcdr(closure_list); + } +- vs_push(find_special(MMcdr(args), NULL, NULL)); ++ vs_push(find_special(MMcdr(args), NULL, NULL,NULL)); + Fprogn(vs_head); + lex_env = lex; + } +@@ -304,7 +304,7 @@ is an illegal macro definition in MACROF + lex_macro_bind(MMcar(def), MMcaddr(top[0])); + def_list = MMcdr(def_list); + } +- vs_push(find_special(MMcdr(args), NULL, NULL)); ++ vs_push(find_special(MMcdr(args), NULL, NULL,NULL)); + Fprogn(vs_head); + lex_env = lex; + } +--- gcl-2.6.12.orig/o/pathname.d ++++ gcl-2.6.12/o/pathname.d +@@ -28,744 +28,93 @@ Foundation, 675 Mass Ave, Cambridge, MA + #include + #include "include.h" + ++DEFUN_NEW("C-SET-T-TT",object,fSc_set_t_tt,SI,2,2,NONE,OO,IO,OO,OO,(object x,fixnum y),"") { ++ x->d.tt=y; ++ RETURN1(x); ++} ++ ++ ++DEFUN_NEW("C-T-TT",object,fSc_t_tt,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") { ++ RETURN1((object)(fixnum)x->d.tt); ++} ++ ++ ++DEFUN_NEW("C-SET-PATHNAME-NAMESTRING",object,fSc_set_pathname_namestring,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { ++ check_type_pathname(&x); ++ x->pn.pn_namestring=y; ++ RETURN1(x); ++} ++ ++DEFUN_NEW("C-PATHNAME-HOST",object,fSc_pathname_host,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ check_type_pathname(&x); ++ RETURN1(x->pn.pn_host); ++} ++DEFUN_NEW("C-PATHNAME-DEVICE",object,fSc_pathname_device,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ check_type_pathname(&x); ++ RETURN1(x->pn.pn_device); ++} ++DEFUN_NEW("C-PATHNAME-DIRECTORY",object,fSc_pathname_directory,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ check_type_pathname(&x); ++ RETURN1(x->pn.pn_directory); ++} ++DEFUN_NEW("C-PATHNAME-NAME",object,fSc_pathname_name,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ check_type_pathname(&x); ++ RETURN1(x->pn.pn_name); ++} ++DEFUN_NEW("C-PATHNAME-TYPE",object,fSc_pathname_type,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ check_type_pathname(&x); ++ RETURN1(x->pn.pn_type); ++} ++DEFUN_NEW("C-PATHNAME-VERSION",object,fSc_pathname_version,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ check_type_pathname(&x); ++ RETURN1(x->pn.pn_version); ++} ++DEFUN_NEW("C-PATHNAME-NAMESTRING",object,fSc_pathname_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ check_type_pathname(&x); ++ RETURN1(x->pn.pn_namestring); ++} + +-object +-make_pathname(host, device, directory, name, type, version) +-object host, device, directory, name, type, version; +-{ +- object x; +- +- x = alloc_object(t_pathname); +- x->pn.pn_host = host; +- x->pn.pn_device = device; +- x->pn.pn_directory = directory; +- x->pn.pn_name = name; +- x->pn.pn_type = type; +- x->pn.pn_version = version; +- return(x); +-} +- +-static void +-make_one(s, end) +-char *s; +-int end; +-{ +- int i; +- +-#ifdef UNIX +- for (i = 0; i < end; i++) +- token->st.st_self[i] = s[i]; +-#endif +-#ifdef AOSVS +- +- +- +-#endif +- token->st.st_fillp = end; +- vs_push(copy_simple_string(token)); +-} +- +-/* The function below does not attempt to handle DOS pathnames +- which use backslashes as directory separators. It needs +- TLC from someone who feels pedantic. MJT */ +- +-/* !!!!! Bug Fix. NLG */ +-object +-parse_namestring(s, start, end, ep) +-object s; +-int start, end, *ep; +-{ +- int i, j, k, founddosdev = FALSE, oldstart=start, oldend=end, justdevice = FALSE; +- int d; +- object *vsp; +- object x; +- vs_mark; +- +-#ifndef IS_DIR_SEPARATOR +-#define IS_DIR_SEPARATOR(x) (x == '/') +-#endif +- +- *ep=oldend; +- vsp = vs_top + 1; +- for (;--end >= start && isspace((int)s->st.st_self[end]);); +- +- /* Check for a DOS path and process later */ +- if ( ( (start+1) <= end) && (s->st.st_self[start+1] == ':' )) { +- start+=2; +- founddosdev = TRUE; +- } +- if ( start > end ) { +- make_one(&s->st.st_self[0], 0); +- justdevice = TRUE; +- } else { +- for (i = j = start; i <= end; ) { +-#ifdef UNIX +- if (IS_DIR_SEPARATOR(s->st.st_self[i])) { +-#endif +- if (j == start && i == start) { +- i++; +- vs_push(sKroot); +- j = i; +- continue; +- } +-#ifdef UNIX +- if (i-j == 1 && s->st.st_self[j] == '.') { +- vs_push(sKcurrent); +- } else if (i-j == 1 && s->st.st_self[j] == '*') { +- vs_push(sKwild); +- } else if (i-j==2 && s->st.st_self[j]=='.' && s->st.st_self[j+1]=='.') { +- vs_push(sKparent); +- } else { +- make_one(&s->st.st_self[j], i-j); +- } +-#endif +- i++; +- j = i; +- } else { +- i++; +- } +- } +- *ep = i; +- vs_push(Cnil); +- while (vs_top > vsp) +- stack_cons(); +- if (i == j) { +- /* no file and no type */ +- vs_push(Cnil); +- vs_push(Cnil); +- goto L; +- } +- for (k = j, d = -1; k < i; k++) +- if (s->st.st_self[k] == '.') +- d = k; +- if (d == -1) { +- /* no file type */ +-#ifdef UNIX +- if (i-j == 1 && s->st.st_self[j] == '*') +-#endif +- vs_push(sKwild); +- else +- make_one(&s->st.st_self[j], i-j); +- +- vs_push(Cnil); +- } else if (d == j) { +- /* no file name */ +- vs_push(Cnil); +-#ifdef UNIX +- if (i-d-1 == 1 && s->st.st_self[d+1] == '*') +-#endif +- vs_push(sKwild); +- else +- make_one(&s->st.st_self[d+1], i-d-1); +- } else { +- /* file name and file type */ +-#ifdef UNIX +- if (d-j == 1 && s->st.st_self[j] == '*') +-#endif +- vs_push(sKwild); +- else { +- make_one(&s->st.st_self[j], d-j); +- } +-#ifdef UNIX +- if (i-d-1 == 1 && s->st.st_self[d+1] == '*') +-#endif +- vs_push(sKwild); +- else +- make_one(&s->st.st_self[d+1], i-d-1); +- } +- } +-L: +- /* Process DOS device name found earlier, build a string in a list and push it */ +- if ( founddosdev ) { +- /* Drive letter */ +- token->st.st_self[0] = s->st.st_self[oldstart]; +- /* Colon */ +- token->st.st_self[1] = s->st.st_self[oldstart+1]; +- /* Fill pointer */ +- token->st.st_fillp = 2; +- /* Push */ +- vs_push(make_cons(copy_simple_string(token),Cnil)); +- } else { +- /* No device name */ +- vs_push(Cnil); +- } +- if ( justdevice ) { +- x = make_pathname ( Cnil, vs_top[-1], Cnil, Cnil, Cnil, Cnil ); +- } else { +- x = make_pathname ( Cnil, vs_top[-1], vs_top[-4], vs_top[-3], vs_top[-2], Cnil ); +- } +- vs_reset; +- return(x); +-} +- +-object +-coerce_to_pathname(x) +-object x; +-{ +- object y; +- int e; +- +-L: +- switch (type_of(x)) { +- case t_symbol: +- case t_string: +- /* !!!!! Bug Fix. NLG */ +- y = parse_namestring(x, 0, x->st.st_fillp, &e); +- if (y == OBJNULL || e != x->st.st_fillp) +- goto CANNOT_COERCE; +- return(y); +- +- case t_pathname: +- return(x); +- +- case t_stream: +- switch (x->sm.sm_mode) { +- case smm_input: +- case smm_output: +- case smm_probe: +- case smm_io: +- x = x->sm.sm_object1; +- /* +- The file was stored in sm.sm_object1. +- See open. +- */ +- goto L; +- +- case smm_synonym: +- x = symbol_value(x->sm.sm_object0); +- goto L; +- +- default: +- goto CANNOT_COERCE; +- } +- +- default: +- CANNOT_COERCE: +- FEerror("~S cannot be coerced to a pathname.", 1, x); +- return(Cnil); +- } +-} +- +-static object +-default_device(host) +-object host; +-{ +- return(Cnil); +- /* not implemented yet */ +-} +- +-object +-merge_pathnames(path, defaults, default_version) +-object path, defaults, default_version; +-{ +- object host, device, directory, name, type, version; +- +- if (path->pn.pn_host == Cnil) +- host = defaults->pn.pn_host; +- else +- host = path->pn.pn_host; +- if (path->pn.pn_device == Cnil) +- if (path->pn.pn_host == Cnil) +- device = defaults->pn.pn_device; +- else if (path->pn.pn_host == defaults->pn.pn_host) +- device = defaults->pn.pn_device; +- else +- device = default_device(path->pn.pn_host); +- else +- device = path->pn.pn_device; +- +- if (defaults->pn.pn_directory==Cnil || +- (type_of(path->pn.pn_directory)==t_cons +- && path->pn.pn_directory->c.c_car==sKroot)) +- directory=path->pn.pn_directory; +- else +- directory=path->pn.pn_directory==Cnil ? +- defaults->pn.pn_directory : +- append(defaults->pn.pn_directory,path->pn.pn_directory); +- +- if (path->pn.pn_name == Cnil) +- name = defaults->pn.pn_name; +- else +- name = path->pn.pn_name; +- if (path->pn.pn_type == Cnil) +- type = defaults->pn.pn_type; +- else +- type = path->pn.pn_type; +- version = Cnil; +- /* +- In this implimentation, version is not counted +- */ +- return(make_pathname(host,device,directory,name,type,version)); +-} +- +-/* +- Namestring(x) converts a pathname to a namestring. +-*/ +-object +-namestring(x) +-object x; +-{ +- +- int i, j; +- object l, y; +- +- i = 0; +- +- l = x->pn.pn_device; +- if (endp(l)) { +- goto D; +- } +- y = l->c.c_car; +- y = coerce_to_string(y); +- for (j = 0; j < y->st.st_fillp; j++) { +- token->st.st_self[i++] = y->st.st_self[j]; +- } +- +-D: l = x->pn.pn_directory; +- if (endp(l)) +- goto L; +- y = l->c.c_car; +- if (y == sKroot) { +-#ifdef UNIX +- token->st.st_self[i++] = '/'; +-#endif +- l = l->c.c_cdr; +- } +- for (; !endp(l); l = l->c.c_cdr) { +- y = l->c.c_car; +-#ifdef UNIX +- if (y == sKcurrent) { +- token->st.st_self[i++] = '.'; +- token->st.st_self[i++] = '/'; +- continue; +- } else if (y == sKwild) { +- token->st.st_self[i++] = '*'; +- token->st.st_self[i++] = '/'; +- continue; +- } else if (y == sKparent) { +- token->st.st_self[i++] = '.'; +- token->st.st_self[i++] = '.'; +- token->st.st_self[i++] = '/'; +- continue; +- } +-#endif +- y = coerce_to_string(y); +- for (j = 0; j < y->st.st_fillp; j++) +- token->st.st_self[i++] +- = y->st.st_self[j]; +-#ifdef UNIX +- token->st.st_self[i++] = '/'; +-#endif +-#ifdef AOSVS +- +-#endif +- } +-L: +- y = x->pn.pn_name; +- if (y == Cnil) +- goto M; +- if (y == sKwild) { +-#ifdef UNIX +- token->st.st_self[i++] = '*'; +-#endif +-#ifdef AOSVS +- +-#endif +- goto M; +- } +- if (type_of(y) != t_string) +- FEerror("~S is an illegal pathname name.", 1, y); +- for (j = 0; j < y->st.st_fillp; j++) +- token->st.st_self[i++] = y->st.st_self[j]; +-M: +- y = x->pn.pn_type; +- if (y == Cnil) +- goto N; +- if (y == sKwild) { +- token->st.st_self[i++] = '.'; +-#ifdef UNIX +- token->st.st_self[i++] = '*'; +-#endif +-#ifdef AOSVS +- +-#endif +- goto N; +- } +- if (type_of(y) != t_string) +- FEerror("~S is an illegal pathname name.", 1, y); +- token->st.st_self[i++] = '.'; +- for (j = 0; j < y->st.st_fillp; j++) +- token->st.st_self[i++] = y->st.st_self[j]; +-N: +- token->st.st_fillp = i; +-#ifdef FIX_FILENAME +- {char buf[MAXPATHLEN]; +- if (i > MAXPATHLEN-1) i =MAXPATHLEN-1; +- memcpy(buf,token->st.st_self,i); +- buf[i]=0; +- FIX_FILENAME(x,buf); +- return (make_simple_string(buf)); +- } +-#endif +- return(copy_simple_string(token)); +-} +- +-object +-coerce_to_namestring(x) +-object x; +-{ +- +-L: +- switch (type_of(x)) { +- case t_symbol: +- {BEGIN_NO_INTERRUPT; +- vs_push(alloc_simple_string(x->s.s_fillp)); +- /* By Nick Gall */ +- vs_head->st.st_self = alloc_relblock(x->s.s_fillp); +- { +- int i; +- for (i = 0; i < x->s.s_fillp; i++) +- vs_head->st.st_self[i] = x->s.s_self[i]; +- } +- END_NO_INTERRUPT;} +- return(vs_pop); +- +- case t_string: +- return(x); +- +- case t_pathname: +- return(namestring(x)); +- +- case t_stream: +- switch (x->sm.sm_mode) { +- case smm_input: +- case smm_output: +- case smm_probe: +- case smm_io: +- x = x->sm.sm_object1; +- /* +- The file was stored in sm.sm_object1. +- See open. +- */ +- goto L; +- +- case smm_synonym: +- x = symbol_value(x->sm.sm_object0); +- goto L; +- +- default: +- goto CANNOT_COERCE; +- } +- +- default: +- CANNOT_COERCE: +- FEerror("~S cannot be coerced to a namestring.", 1, x); +- return(Cnil); +- } +-} +- +-LFD(Lpathname)(void) +-{ +- check_arg(1); +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +-} +- +-@(defun parse_namestring (thing +- &o host +- (defaults `symbol_value(Vdefault_pathname_defaults)`) +- &k start end junk_allowed +- &a x y) +- int s, e, ee; +-@ +- check_type_or_pathname_string_symbol_stream(&thing); +- check_type_or_pathname_string_symbol_stream(&defaults); +- defaults = coerce_to_pathname(defaults); +- x = thing; +-L: +- switch (type_of(x)) { +- case t_symbol: +- case t_string: +- get_string_start_end(x, start, end, &s, &e); +- for (; s < e && isspace((int)x->st.st_self[s]); s++) +- ; +- y +- /* !!!!! Bug Fix. NLG */ +- = parse_namestring(x, +- s, +- e - s, +- &ee); +- if (junk_allowed == Cnil) { +- for (; ee < e - s; ee++) +- if (!isspace((int)x->st.st_self[s + ee])) +- break; +- if (y == OBJNULL || ee != e - s) +- FEerror("Cannot parse the namestring ~S~%\ +-from ~S to ~S.", +- 3, x, start, end); +- } else +- if (y == OBJNULL) +- @(return Cnil `make_fixnum(s + ee)`) +- start = make_fixnum(s + ee); +- break; +- +- case t_pathname: +- y = x; +- break; +- +- case t_stream: +- switch (x->sm.sm_mode) { +- case smm_input: +- case smm_output: +- case smm_probe: +- case smm_io: +- x = x->sm.sm_object1; +- /* +- The file was stored in sm.sm_object1. +- See open. +- */ +- goto L; +- +- case smm_synonym: +- x = symbol_value(x->sm.sm_object0); +- goto L; +- +- default: +- goto CANNOT_PARSE; +- } +- +- default: +- CANNOT_PARSE: +- FEerror("Cannot parse the namestring ~S.", 1, x); +- } +- if (host != Cnil && y->pn.pn_host != Cnil && +- host != y->pn.pn_host) +- FEerror("The hosts ~S and ~S do not match.", +- 2, host, y->pn.pn_host); +- @(return y start) +-@) +- +-@(defun merge_pathnames (path +- &o (defaults `symbol_value(Vdefault_pathname_defaults)`) +- (default_version sKnewest)) +-@ +- check_type_or_pathname_string_symbol_stream(&path); +- check_type_or_pathname_string_symbol_stream(&defaults); +- path = coerce_to_pathname(path); +- defaults = coerce_to_pathname(defaults); +- @(return `merge_pathnames(path, defaults, default_version)`) +-@) +- +-@(defun make_pathname (&key +- (host `Cnil` host_supplied_p) +- (device `Cnil` device_supplied_p) +- (directory `Cnil` directory_supplied_p) +- (name `Cnil` name_supplied_p) +- (type `Cnil` type_supplied_p) +- (version `Cnil` version_supplied_p) +- defaults +- &aux x) +-@ +- if ( defaults == Cnil ) { +- defaults = symbol_value ( Vdefault_pathname_defaults ); +- defaults = coerce_to_pathname ( defaults ); +- defaults = make_pathname ( defaults->pn.pn_host, +- Cnil, Cnil, Cnil, Cnil, Cnil); +- } else { +- defaults = coerce_to_pathname(defaults); +- } +- x = make_pathname(host, device, directory, name, type, version); +- x = merge_pathnames(x, defaults, Cnil); +- if ( host_supplied_p) x->pn.pn_host = host; +- if (device_supplied_p) x->pn.pn_device = device; +- if (directory_supplied_p) x->pn.pn_directory = directory; +- if (name_supplied_p) x->pn.pn_name = name; +- if (type_supplied_p) x->pn.pn_type = type; +- if (version_supplied_p) x->pn.pn_version = version; +- @(return x) +-@) +- +-LFD(Lpathnamep)(void) +-{ +- check_arg(1); +- +- if (type_of(vs_base[0]) == t_pathname) +- vs_base[0] = Ct; +- else +- vs_base[0] = Cnil; +-} +- +-LFD(Lpathname_host)(void) +-{ +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_base[0] = vs_base[0]->pn.pn_host; +-} +- +-LFD(Lpathname_device)(void) +-{ +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_base[0] = vs_base[0]->pn.pn_device; +-} +- +-LFD(Lpathname_directory)(void) +-{ +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_base[0] = vs_base[0]->pn.pn_directory; +-} +- +-LFD(Lpathname_name)(void) +-{ +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_base[0] = vs_base[0]->pn.pn_name; +-} +- +-LFD(Lpathname_type)(void) +-{ +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_base[0] = vs_base[0]->pn.pn_type; +-} +- +-LFD(Lpathname_version)(void) +-{ +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_base[0] = vs_base[0]->pn.pn_version; +-} +- +-LFD(Lnamestring)(void) +-{ +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_namestring(vs_base[0]); +-} +- +-LFD(Lfile_namestring)(void) +-{ +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_base[0] +- = make_pathname(Cnil, Cnil, Cnil, +- vs_base[0]->pn.pn_name, +- vs_base[0]->pn.pn_type, +- vs_base[0]->pn.pn_version); +- vs_base[0] = namestring(vs_base[0]); +-} +- +-LFD(Ldirectory_namestring)(void) +-{ +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_base[0] +- = make_pathname(Cnil, Cnil, +- vs_base[0]->pn.pn_directory, +- Cnil, Cnil, Cnil); +- vs_base[0] = namestring(vs_base[0]); +-} +- +-LFD(Lhost_namestring)(void) +-{ +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_base[0] = vs_base[0]->pn.pn_host; +- if (vs_base[0] == Cnil || vs_base[0] == sKwild) +- vs_base[0] = make_simple_string(""); +-} +- +-@(defun enough_namestring (path +- &o (defaults `symbol_value(Vdefault_pathname_defaults)`)) +-@ +- check_type_or_pathname_string_symbol_stream(&path); +- check_type_or_pathname_string_symbol_stream(&defaults); +- defaults = coerce_to_pathname(defaults); +- path = coerce_to_pathname(path); +- path +- = make_pathname(equalp(path->pn.pn_host, defaults->pn.pn_host) ? +- Cnil : path->pn.pn_host, +- equalp(path->pn.pn_device, +- defaults->pn.pn_device) ? +- Cnil : path->pn.pn_device, +- equalp(path->pn.pn_directory, +- defaults->pn.pn_directory) ? +- Cnil : path->pn.pn_directory, +- equalp(path->pn.pn_name, defaults->pn.pn_name) ? +- Cnil : path->pn.pn_name, +- equalp(path->pn.pn_type, defaults->pn.pn_type) ? +- Cnil : path->pn.pn_type, +- equalp(path->pn.pn_version, +- defaults->pn.pn_version) ? +- Cnil : path->pn.pn_version); +- @(return `namestring(path)`) +-@) ++ ++DEFUN_NEW("C-STREAM-OBJECT0",object,fSc_stream_object0,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ RETURN1(x->sm.sm_object0); ++} ++ ++DEFUN_NEW("C-STREAM-OBJECT1",object,fSc_stream_object1,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ RETURN1(x->sm.sm_object1); ++} ++ ++DEFUN_NEW("C-SET-STREAM-OBJECT1",object,fSc_set_stream_object1,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { ++ x->sm.sm_object1=y; ++ RETURN1(x); ++} ++ ++DEFUN_NEW("INIT-PATHNAME",object,fSinit_pathname,SI,7,7,NONE,OO,OO,OO,OO, ++ (object host,object device,object directory,object name,object type,object version,object namestring),"") { ++ ++ object x=alloc_object(t_pathname); ++ ++ x->pn.pn_host=host; ++ x->pn.pn_device=device; ++ x->pn.pn_directory=directory; ++ x->pn.pn_name=name; ++ x->pn.pn_type=type; ++ x->pn.pn_version=version; ++ x->pn.pn_namestring=namestring; ++ ++ RETURN1(x); ++ ++} ++ ++DEFUN_NEW("PATHNAMEP",object,fLpathnamep,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ RETURN1(type_of(x)==t_pathname ? Ct : Cnil); ++} + + void +-gcl_init_pathname(void) +-{ +- Vdefault_pathname_defaults = +- make_special("*DEFAULT-PATHNAME-DEFAULTS*", +- make_pathname(Cnil, Cnil, Cnil, Cnil, Cnil, Cnil)); +- +- sKwild = make_keyword("WILD"); +- sKnewest = make_keyword("NEWEST"); +- +- sKstart = make_keyword("START"); +- sKend = make_keyword("END"); +- sKjunk_allowed = make_keyword("JUNK-ALLOWED"); +- +- sKhost = make_keyword("HOST"); +- sKdevice = make_keyword("DEVICE"); +- sKdirectory = make_keyword("DIRECTORY"); +- sKname = make_keyword("NAME"); +- sKtype = make_keyword("TYPE"); +- sKversion = make_keyword("VERSION"); +- sKdefaults = make_keyword("DEFAULTS"); +- +- sKroot = make_keyword("ROOT"); +- sKcurrent = make_keyword("CURRENT"); +- sKparent = make_keyword("PARENT"); +- sKper = make_keyword("PER"); ++gcl_init_pathname(void) { ++ + } + + void +-gcl_init_pathname_function() +-{ +- make_function("PATHNAME", Lpathname); +- make_function("PARSE-NAMESTRING", Lparse_namestring); +- make_function("MERGE-PATHNAMES", Lmerge_pathnames); +- make_function("MAKE-PATHNAME", Lmake_pathname); +- make_function("PATHNAMEP", Lpathnamep); +- make_function("PATHNAME-HOST", Lpathname_host); +- make_function("PATHNAME-DEVICE", Lpathname_device); +- make_function("PATHNAME-DIRECTORY", Lpathname_directory); +- make_function("PATHNAME-NAME", Lpathname_name); +- make_function("PATHNAME-TYPE", Lpathname_type); +- make_function("PATHNAME-VERSION", Lpathname_version); +- make_function("NAMESTRING", Lnamestring); +- make_function("FILE-NAMESTRING", Lfile_namestring); +- make_function("DIRECTORY-NAMESTRING", Ldirectory_namestring); +- make_function("HOST-NAMESTRING", Lhost_namestring); +- make_function("ENOUGH-NAMESTRING", Lenough_namestring); ++gcl_init_pathname_function(void) { ++ + } +--- gcl-2.6.12.orig/o/predicate.c ++++ gcl-2.6.12/o/predicate.c +@@ -29,6 +29,10 @@ Foundation, 675 Mass Ave, Cambridge, MA + #include + #include "include.h" + ++DEFUN_NEW("PATHNAME-DESIGNATORP",object,fSpathname_designatorp,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ RETURN1(pathname_designatorp(x) ? Ct : Cnil); ++} ++ + DEFUNO_NEW("NULL",object,fLnull,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lnull,(object x0),"") + { +--- gcl-2.6.12.orig/o/print.d ++++ gcl-2.6.12/o/print.d +@@ -1260,6 +1260,7 @@ int level; + write_ch('>'); + break; + ++ case smm_file_synonym: + case smm_synonym: + write_str("#sm.sm_object0, level); +@@ -1381,7 +1382,7 @@ int level; + if (1 || PRINTescape) { + write_ch('#'); + write_ch('p'); +- vs_push(namestring(x)); ++ vs_push(x->pn.pn_namestring==Cnil ? make_simple_string("") : x->pn.pn_namestring); + write_object(vs_head, level); + vs_popp; + } else { +--- gcl-2.6.12.orig/o/read.d ++++ gcl-2.6.12/o/read.d +@@ -1564,38 +1564,6 @@ Ldefault_dispatch_macro() + } + + /* +- #p" ... " returns the pathname with namestring ... . +-*/ +-static void +-Lsharp_p_reader() +-{ +- check_arg(3); +- if (vs_base[2] != Cnil && !READsuppress) +- extra_argument('p'); +- vs_popp; +- vs_popp; +- vs_base[0] = read_object(vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +-} +- +-/* +- #" ... " returns the pathname with namestring ... . +-*/ +-static void +-Lsharp_double_quote_reader() +-{ +- check_arg(3); +- +- if (vs_base[2] != Cnil && !READsuppress) +- extra_argument('"'); +- vs_popp; +- unread_char(vs_base[1], vs_base[0]); +- vs_popp; +- vs_base[0] = read_object(vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +-} +- +-/* + #$ fixnum returns a random-state with the fixnum + as its content. + */ +@@ -2369,9 +2337,6 @@ gcl_init_read() + dtab['<'] = make_cf(Lsharp_less_than_reader); + */ + dtab['|'] = make_cf(Lsharp_vertical_bar_reader); +- dtab['"'] = make_cf(Lsharp_double_quote_reader); +- dtab['p'] = make_cf(Lsharp_p_reader); +- dtab['P'] = make_cf(Lsharp_p_reader); + /* This is specific to this implimentation */ + dtab['$'] = make_cf(Lsharp_dollar_reader); + /* This is specific to this implimentation */ +--- gcl-2.6.12.orig/o/regexp.c ++++ gcl-2.6.12/o/regexp.c +@@ -117,7 +117,7 @@ min_initial_branch_length(regexp *, unsi + #define PLUS 11 /* node Match this (simple) thing 1 or more times. */ + #define OPEN 20 /* no Mark this point in input as start of #n. */ + /* OPEN+1 is number 1, etc. */ +-#define CLOSE 30 /* no Analogous to OPEN. */ ++#define CLOSE (OPEN+NSUBEXP) /* no Analogous to OPEN. */ + + /* + * Opcode notes: +@@ -1083,15 +1083,8 @@ regmatch(char *prog) + break; + case BACK: + break; +- case OPEN+1: +- case OPEN+2: +- case OPEN+3: +- case OPEN+4: +- case OPEN+5: +- case OPEN+6: +- case OPEN+7: +- case OPEN+8: +- case OPEN+9: { ++ case OPEN+1 ... OPEN+NSUBEXP-1: ++ { + register int no; + register char *save; + +@@ -1112,15 +1105,8 @@ regmatch(char *prog) + } + /* NOTREACHED */ + break; +- case CLOSE+1: +- case CLOSE+2: +- case CLOSE+3: +- case CLOSE+4: +- case CLOSE+5: +- case CLOSE+6: +- case CLOSE+7: +- case CLOSE+8: +- case CLOSE+9: { ++ case CLOSE+1 ... CLOSE+NSUBEXP-1: ++ { + register int no; + register char *save; + +@@ -1394,27 +1380,11 @@ char *op; + case END: + p = "END"; + break; +- case OPEN+1: +- case OPEN+2: +- case OPEN+3: +- case OPEN+4: +- case OPEN+5: +- case OPEN+6: +- case OPEN+7: +- case OPEN+8: +- case OPEN+9: ++ case OPEN+1 ... OPEN+NSUBEXP-1: + sprintf(buf+strlen(buf), "OPEN%d", OP(op)-OPEN); + p = NULL; + break; +- case CLOSE+1: +- case CLOSE+2: +- case CLOSE+3: +- case CLOSE+4: +- case CLOSE+5: +- case CLOSE+6: +- case CLOSE+7: +- case CLOSE+8: +- case CLOSE+9: ++ case CLOSE+1 ... CLOSE+NSUBEXP-1: + sprintf(buf+strlen(buf), "CLOSE%d", OP(op)-CLOSE); + p = NULL; + break; +--- gcl-2.6.12.orig/o/regexp.h ++++ gcl-2.6.12/o/regexp.h +@@ -1,7 +1,7 @@ + #ifndef _REGEXP + #define _REGEXP 1 + +-#define NSUBEXP 10 ++#define NSUBEXP 19 + typedef struct regexp { + char *startp[NSUBEXP]; + char *endp[NSUBEXP]; +--- gcl-2.6.12.orig/o/regexpr.c ++++ gcl-2.6.12/o/regexpr.c +@@ -81,6 +81,7 @@ DEFUN_NEW("COMPILE-REGEXP",object,fScomp + res->v.v_elttype=aet_uchar; + res->v.v_adjustable=0; + res->v.v_offset=0; ++ res->v.v_self=NULL; + if (!(res->v.v_self=(void *)regcomp(tmp,&res->v.v_dim))) + FEerror("regcomp failure",0); + res->v.v_fillp=res->v.v_dim; +--- gcl-2.6.12.orig/o/run_process.c ++++ gcl-2.6.12/o/run_process.c +@@ -177,10 +177,12 @@ void run_process ( char *name ) + stream_in->sm.sm_mode = smm_input; + stream_in->sm.sm_fp = ofp; + stream_in->sm.sm_buffer = 0; ++ stream_in->sm.sm_flags=0; + stream_out = (object) alloc_object(t_stream); + stream_out->sm.sm_mode = smm_output; + stream_out->sm.sm_fp = ifp; + stream_out->sm.sm_buffer = 0; ++ stream_out->sm.sm_flags=0; + setup_stream_buffer ( stream_in ); + setup_stream_buffer ( stream_out ); + stream = make_two_way_stream ( stream_in, stream_out ); +@@ -433,6 +435,7 @@ enum smmode smm; + stream->sm.sm_object0 = sLcharacter; + stream->sm.sm_object1 = host_l; + stream->sm.sm_int0 = stream->sm.sm_int1 = 0; ++ stream->sm.sm_flags=0; + vs_push(stream); + setup_stream_buffer(stream); + vs_reset; +@@ -503,6 +506,7 @@ make_socket_pair() + stream_in->sm.sm_int0 = sockets_in[1]; + stream_in->sm.sm_int1 = 0; + stream_in->sm.sm_object0=stream_in->sm.sm_object1=OBJNULL; ++ stream_in->sm.sm_flags = 0; + stream_out = (object) alloc_object(t_stream); + stream_out->sm.sm_mode = smm_output; + stream_out->sm.sm_fp = fp2; +@@ -511,6 +515,7 @@ make_socket_pair() + setup_stream_buffer(stream_out); + stream_out->sm.sm_int0 = sockets_out[1]; + stream_out->sm.sm_int1 = 0; ++ stream_out->sm.sm_flags = 0; + stream_out->sm.sm_object0=stream_out->sm.sm_object1=OBJNULL; + stream = make_two_way_stream(stream_in, stream_out); + return(stream); +--- gcl-2.6.12.orig/o/sfaslcoff.c ++++ gcl-2.6.12/o/sfaslcoff.c +@@ -151,6 +151,16 @@ find_init_address(struct syment *sym,str + + } + ++static ul ++get_sym_value(const char *name) { ++ ++ struct node *answ; ++ ++ return (answ=find_sym_ptable(name)) ? answ->address : ++ ({massert(!emsg("Unrelocated non-local symbol: %s\n",name));0;}); ++ ++} ++ + static void + relocate_symbols(struct syment *sym,struct syment *sye,struct scnhdr *sec1,char *st1) { + +@@ -163,22 +173,10 @@ relocate_symbols(struct syment *sym,stru + + else if (!sym->n_scnum) { + +- char c=0,*s; +- +- if (sym->n.n.n_zeroes) { +- c=sym->n.n_name[8]; +- sym->n.n_name[8]=0; +- s=sym->n.n_name; +- } else +- s=st1+sym->n.n.n_offset; +- +- if ((answ=find_sym_ptable(s))) +- sym->n_value=answ->address; ++ if (sym->n.n.n_zeroes) ++ STOP(sym->n.n_name,sym->n_value=get_sym_value(sym->n.n_name)); + else +- massert(!emsg("Unrelocated non-local symbol: %s\n",s)); +- +- if (c) +- sym->n.n_name[8]=c; ++ sym->n_value=get_sym_value(st1+sym->n.n.n_offset); + + } + +@@ -391,13 +389,11 @@ fasload(object faslfile) { + struct reloc *rel,*rele; + object memory, data; + FILE *fp; +- char filename[MAXPATHLEN],*st1,*ste; ++ char *st1,*ste; + int i; + ul init_address=0; + void *st,*est; + +- coerce_to_filename(faslfile, filename); +- faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); + fp = faslfile->sm.sm_fp; + + massert(st=get_mmap(fp,&est)); +@@ -427,7 +423,6 @@ fasload(object faslfile) { + data = read_fasl_vector(faslfile); + + massert(!un_mmap(st,est)); +- close_stream(faslfile); + + #ifdef CLEAR_CACHE + CLEAR_CACHE; +--- gcl-2.6.12.orig/o/sfaslelf.c ++++ gcl-2.6.12/o/sfaslelf.c +@@ -542,15 +542,13 @@ int + fasload(object faslfile) { + + FILE *fp; +- char filename[256],*sn,*st1,*dst1; ++ char *sn,*st1,*dst1; + ul init_address=0,end,gs=0,*got=&gs,*gote=got+1; + object memory,data; + Shdr *sec1,*sece; + Sym *sym1,*syme,*dsym1,*dsyme; + void *v1,*ve; + +- coerce_to_filename(faslfile, filename); +- faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); + fp = faslfile->sm.sm_fp; + + massert(v1=get_mmap(fp,&ve)); +@@ -573,7 +571,6 @@ fasload(object faslfile) { + data=feof(fp) ? 0 : read_fasl_vector(faslfile); + + massert(!un_mmap(v1,ve)); +- close_stream(faslfile); + + massert(!clear_protect_memory(memory)); + +--- gcl-2.6.12.orig/o/sfaslmacho.c ++++ gcl-2.6.12/o/sfaslmacho.c +@@ -524,7 +524,6 @@ fasload(object faslfile) { + + FILE *fp; + object data; +- char filename[256]; + ul init_address=-1; + object memory; + void *v1,*ve,*p; +@@ -533,8 +532,6 @@ fasload(object faslfile) { + char *st1=NULL,*ste=NULL; + ul gs,*got=&gs,*gote,*io1=NULL,rls,start; + +- coerce_to_filename(faslfile, filename); +- faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); + fp = faslfile->sm.sm_fp; + + massert(v1=get_mmap(fp,&ve)); +@@ -563,7 +560,6 @@ fasload(object faslfile) { + #endif + + massert(!un_mmap(v1,ve)); +- close_stream(faslfile); + + init_address-=(ul)memory->cfd.cfd_start; + call_init(init_address,memory,data,0); +--- gcl-2.6.12.orig/o/sgbc.c ++++ gcl-2.6.12/o/sgbc.c +@@ -717,7 +717,7 @@ sgc_start(void) { + void *p=NULL,*pe; + struct pageinfo *pi; + ufixnum i; +- ++ + old_cb_pointer=cb_pointer; + reset_contblock_freelist(); + +@@ -774,6 +774,8 @@ sgc_start(void) { + 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); ++ SET_WRITABLE(page(v)); ++ SET_WRITABLE(page(sSAwritableA)); + } + + tm_of(t_relocatable)->tm_alt_npage=0; +@@ -787,7 +789,7 @@ sgc_start(void) { + Turn memory protection on for the pages which are writable. + */ + sgc_enabled=1; +- if (memory_protect(1)) ++ if (memory_protect(1)) + sgc_quit(); + if (sSAnotify_gbcA->s.s_dbind != Cnil) + emsg("[SGC on]"); +@@ -897,7 +899,7 @@ sgc_quit(void) { + for (p=pagetochar(page(v)),j=tm->tm_nppage;j>0;--j,p+=tm->tm_size) + ((object) p)->d.s=SGC_NORMAL; + #endif +- ++ + for (i=0;iv.v_fillp &&(v=(void *)contblock_array->v.v_self[i]);i++) + if (v->sgc_flags&SGC_PAGE_FLAG) + bzero(CB_SGCF_START(v),CB_DATA_START(v)-CB_SGCF_START(v)); +@@ -931,7 +933,7 @@ memprotect_handler(int sig, long code, v + #endif + if (faddr >= (void *)core_end || faddr < data_start) { + static void *old_faddr; +- if (old_faddr==faddr) ++ if (old_faddr==faddr) + if (fault_count++ > 300) error("fault count too high"); + old_faddr=faddr; + INSTALL_MPROTECT_HANDLER; +@@ -1017,7 +1019,7 @@ memory_protect(int on) { + + if (writable==WRITABLE_PAGE_P(i) && ism.sm_fp); + + #endif + +-static void +-FFN(siLfaslink)(void) +-{ +- bds_ptr old_bds_top; +- int i; +- object package; +- +- check_arg(2); +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- check_type_string(&vs_base[1]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_base[0]->pn.pn_type = FASL_string; +- vs_base[0] = namestring(vs_base[0]); +- package = symbol_value(sLApackageA); +- old_bds_top = bds_top; +- bds_bind(sLApackageA, package); +- i = faslink(vs_base[0], vs_base[1]); +- bds_unwind(old_bds_top); +- vs_top = vs_base; +- vs_push(make_fixnum(i)); +-} +- + #endif + #endif/* svr4 */ + #endif /* UNIXFASL */ + + void +-gcl_init_unixfasl(void) +-{ +-#ifdef FASLINK +- make_si_function("FASLINK", siLfaslink); +-#endif ++gcl_init_unixfasl(void) { + } +--- gcl-2.6.12.orig/o/unixfsys.c ++++ gcl-2.6.12/o/unixfsys.c +@@ -44,10 +44,6 @@ Foundation, 675 Mass Ave, Cambridge, MA + #define HAVE_RENAME + #endif + +-void Ldirectory(void); +- +- +- + #ifdef NEED_GETWD + #include + +@@ -168,17 +164,41 @@ getwd(char *buffer) { + b_[_c+_d]=0;\ + }) + ++static object ++get_string(object x) { ++ switch(type_of(x)) { ++ case t_symbol: ++ case t_string: ++ return x; ++ case t_pathname: ++ return x->pn.pn_namestring; ++ case t_stream: ++ switch(x->sm.sm_mode) { ++ case smm_input: ++ case smm_output: ++ case smm_probe: ++ case smm_io: ++ return get_string(x->sm.sm_object1); ++ case smm_file_synonym: ++ case smm_synonym: ++ return get_string(x->sm.sm_object0->s.s_dbind); ++ } ++ } ++ return Cnil; ++} ++ ++ + void + coerce_to_filename(object pathname,char *p) { + +- object namestring=coerce_to_namestring(pathname); ++ object namestring=get_string(pathname); + unsigned e=namestring->st.st_fillp; +- char *q=namestring->st.st_self,*qe=q+e;; ++ char *q=namestring->st.st_self,*qe=q+e; + +- if (pathname==Cnil) ++ if (pathname==Cnil||namestring==Cnil) + FEerror ( "NIL argument.", 1, pathname ); + +- if (*q=='~') { ++ if (*q=='~' && e) { + + unsigned m=0; + char *s=++q,*c; +@@ -224,134 +244,6 @@ coerce_to_filename(object pathname,char + + } + +-object +-truename(object pathname) +-{ +- register char *p, *q; +- char filename[MAXPATHLEN]; +- char truefilename[MAXPATHLEN]; +- char current_directory[MAXPATHLEN]; +- char directory[MAXPATHLEN]; +-#ifdef __MINGW32__ +- DWORD current_directory_length = +- GetCurrentDirectory ( MAXPATHLEN, current_directory ); +- if ( MAXPATHLEN < current_directory_length ) { +- FEerror ( "truename got a current directory name larger than MAXPATHLEN", 1, "" ); +- } +- if ( 0 == current_directory_length ) { +- FEerror ( "truename could not determine the current directory.", 1, "" ); +- } +-#else +- massert(current_directory==getcwd(current_directory,sizeof(current_directory))); +-#endif +- +- coerce_to_filename(pathname, filename); +- +-#ifdef S_IFLNK +- { +- +- struct stat filestatus; +- int islinkcount=8; +- +- if (lstat(filename, &filestatus) >= 0) +- +- while (((filestatus.st_mode&S_IFMT) == S_IFLNK) && (--islinkcount>0)) { +- +- char newname[MAXPATHLEN]; +- int newlen; +- +- newlen=readlink(filename,newname,MAXPATHLEN-1); +- if (newlen < 0) +- return((FEerror("Symlink broken at ~S.",1,pathname),Cnil)); +- +- for (p = filename, q = 0; *p != '\0'; p++) +- if (*p == '/') q = p; +- if (q == 0 || *newname == '/') +- q = filename; +- else +- q++; +- +- memcpy(q,newname,newlen); +- q[newlen]=0; +- if (lstat(filename, &filestatus) < 0) +- islinkcount=0; /* It would be ANSI to do the following : +- return(file_error("Symlink broken at ~S.",pathname)); +- but this would break DIRECTORY if a file points to nowhere */ +- } +- } +-#endif +- +- for (p = filename, q = 0; *p != '\0'; p++) +- if (*p == '/') +- q = p; +- if (q == filename) { +- q++; +- p = "/"; +- } else if (q == 0) { +- q = filename; +- p = current_directory; +- } else +-#ifdef __MINGW32__ +- if ( ( q > filename ) && ( q[-1] == ':' ) ) { +- int current = (q++, q[0]); +- q[0]=0; +- if (chdir(filename) < 0) +- FEerror("Cannot get the truename of ~S.", 1, pathname); +- current_directory_length = +- GetCurrentDirectory ( MAXPATHLEN, directory ); +- if ( MAXPATHLEN < current_directory_length ) { +- FEerror ( "truename got a current directory name larger than MAXPATHLEN", 1, "" ); +- } +- if ( 0 == current_directory_length ) { +- FEerror ( "truename could not determine the current directory.", 1, "" ); +- } +- p = directory; +- if ( p[1]==':' && ( p[2]=='\\' || p[2]=='/' ) && p[3]==0 ) p[2]=0; +- q[0]=current; +- } +- else +-#endif +- { +- *q++ = '\0'; +- if (chdir(filename) < 0) +- FEerror("Cannot get the truename of ~S.", 1, pathname); +-#ifdef __MINGW32__ +- current_directory_length = GetCurrentDirectory ( MAXPATHLEN, directory ); +- if ( MAXPATHLEN < current_directory_length ) { +- FEerror ( "truename got a current directory name larger than MAXPATHLEN", 1, "" ); +- } +- if ( 0 == current_directory_length ) { +- FEerror ( "truename could not determine the current directory.", 1, "" ); +- } +- p = directory; +-#else +- p = getcwd(directory,sizeof(directory)); +-#endif +- } +- if (p[0] == '/' && p[1] == '\0') { +- if (strcmp(q, "..") == 0) +- strcpy(truefilename, "/."); +- else +- sprintf(truefilename, "/%s", q); +- } else if (strcmp(q, ".") == 0) +- strcpy(truefilename, p); +- else if (strcmp(q, "..") == 0) { +- for (q = p + strlen(p); *--q != '/';) ; +- if (p == q) +- strcpy(truefilename, "/."); +- else { +- *q = '\0'; +- strcpy(truefilename, p); +- *q = '/'; +- } +- } else +- sprintf(truefilename, "%s/%s", p, q); +- massert(!chdir(current_directory)); +- vs_push(make_simple_string(truefilename)); +- pathname = coerce_to_pathname(vs_head); +- vs_popp; +- return(pathname); +-} + object sSAallow_gzipped_fileA; + + bool +@@ -429,41 +321,6 @@ file_len(FILE *fp) + else return 0; + } + +-LFD(Ltruename)(void) +-{ +- check_arg(1); +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = truename(vs_base[0]); +-} +- +-LFD(Lrename_file)(void) +-{ +- char filename[MAXPATHLEN]; +- char newfilename[MAXPATHLEN]; +- +- check_arg(2); +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- check_type_or_Pathname_string_symbol(&vs_base[1]); +- coerce_to_filename(vs_base[0], filename); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_base[1] = coerce_to_pathname(vs_base[1]); +- vs_base[1] = merge_pathnames(vs_base[1], vs_base[0], Cnil); +- coerce_to_filename(vs_base[1], newfilename); +-#ifdef HAVE_RENAME +- if (rename(filename, newfilename) < 0) +- FEerror("Cannot rename the file ~S to ~S.", +- 2, vs_base[0], vs_base[1]); +-#else +- sprintf(command, "mv %s %s", filename, newfilename); +- msystem(command); +-#endif +- vs_push(vs_base[1]); +- vs_push(truename(vs_base[0])); +- vs_push(truename(vs_base[1])); +- vs_base += 2; +-} +- +- + DEF_ORDINARY("DIRECTORY",sKdirectory,KEYWORD,""); + DEF_ORDINARY("LINK",sKlink,KEYWORD,""); + DEF_ORDINARY("FILE",sKfile,KEYWORD,""); +@@ -500,33 +357,28 @@ int gcl_putc(int i,void *v) {return putc + + + +-DEFUN_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object path),"") { ++DEFUNM_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + +- char filename[4096]; + struct stat ss; +- + +- bzero(filename,sizeof(filename)); +- coerce_to_filename(path,filename); ++ check_type_string(&x); ++ coerce_to_filename(x,FN1); ++ + #ifdef __MINGW32__ + { +- char *p=filename+strlen(filename)-1; +- for (;p>filename && *p=='/';p--) ++ char *p=FN1+strlen(FN1)-1; ++ for (;p>FN1 && *p=='/';p--) + *p=0; + } + #endif +- if (lstat(filename,&ss)) ++ if (lstat(FN1,&ss)) + RETURN1(Cnil); +- else {/* ctime_r insufficiently portable */ +- /* int j; +- ctime_r(&ss.st_ctime,filename); +- j=strlen(filename); +- if (isspace(filename[j-1])) +- filename[j-1]=0;*/ +- RETURN1(list(3,S_ISDIR(ss.st_mode) ? sKdirectory : +- (S_ISLNK(ss.st_mode) ? sKlink : sKfile), +- make_fixnum(ss.st_size),make_fixnum(ss.st_ctime))); +- } ++ else ++ RETURN4(S_ISDIR(ss.st_mode) ? sKdirectory : ++ (S_ISLNK(ss.st_mode) ? sKlink : sKfile), ++ make_fixnum(ss.st_size), ++ make_fixnum(ss.st_ctime), ++ make_fixnum(ss.st_uid)); + } + + DEFUN_NEW("SETENV",object,fSsetenv,SI,2,2,NONE,OO,OO,OO,OO,(object variable,object value),"Set environment VARIABLE to VALUE") +@@ -551,266 +403,6 @@ DEFUN_NEW("SETENV",object,fSsetenv,SI,2, + RETURN1((res == 0 ? Ct : Cnil )); + } + +-DEFUNO_NEW("DELETE-FILE",object,fLdelete_file,LISP +- ,1,1,NONE,OO,OO,OO,OO,void,Ldelete_file,(object path),"") +- +-{ +- char filename[MAXPATHLEN]; +- +- /* 1 args */ +- check_type_or_pathname_string_symbol_stream(&path); +- coerce_to_filename(path, filename); +- if (unlink(filename) < 0 && rmdir(filename) < 0) +- FEerror("Cannot delete the file ~S: ~s.", 2, path, make_simple_string(strerror(errno))); +- path = Ct; +- RETURN1(path); +-} +-#ifdef STATIC_FUNCTION_POINTERS +-object +-fLdelete_file(object path) { +- return FFN(fLdelete_file)(path); +-} +-#endif +- +-LFD(Lprobe_file)(void) +-{ +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- if (file_exists(vs_base[0])) +- vs_base[0] = truename(vs_base[0]); +- else +- vs_base[0] = Cnil; +-} +- +-LFD(Lfile_write_date)(void) +-{ +- char filename[MAXPATHLEN]; +- struct stat filestatus; +- +- check_arg(1); +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- coerce_to_filename(vs_base[0], filename); +- if (stat(filename, &filestatus) < 0 || S_ISDIR(filestatus.st_mode)) +- { vs_base[0] = Cnil; return;} +- vs_base[0] = unix_time_to_universal_time(filestatus.st_mtime); +-} +- +-LFD(Lfile_author)(void) +-{ +-#if !defined(NO_PWD_H) && !defined(STATIC_LINKING) +- char filename[MAXPATHLEN]; +- struct stat filestatus; +- struct passwd *pwent; +-#ifndef __STDC__ +- extern struct passwd *getpwuid(); +-#endif +- +- check_arg(1); +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- coerce_to_filename(vs_base[0], filename); +- if (stat(filename, &filestatus) < 0 || S_ISDIR(filestatus.st_mode)) +- { vs_base[0] = Cnil; return;} +- pwent = getpwuid(filestatus.st_uid); +- vs_base[0] = make_simple_string(pwent->pw_name); +-#else +- vs_base[0] = Cnil; return; +-#endif +- +-} +- +-static void +-FFN(Luser_homedir_pathname)(void) +-{ +- +- char filename[MAXPATHLEN]; +- +- coerce_to_filename(make_simple_string("~/"),filename); +- vs_base[0]=coerce_to_pathname(make_simple_string(filename)); +- vs_top = vs_base+1; +- +-} +- +- +-#ifdef BSD +-LFD(Ldirectory)(void) +-{ +- char filename[MAXPATHLEN]; +- char command[MAXPATHLEN * 2]; +- FILE *fp; +- register int i, c; +- object *top = vs_top; +- char iobuffer[BUFSIZ]; +- extern FILE *popen(const char *, const char *); +- +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- if (vs_base[0]->pn.pn_name==Cnil && vs_base[0]->pn.pn_type==Cnil) { +- coerce_to_filename(vs_base[0], filename); +- strcat(filename, "*"); +- } else if (vs_base[0]->pn.pn_name==Cnil) { +- vs_base[0]->pn.pn_name = sKwild; +- coerce_to_filename(vs_base[0], filename); +- vs_base[0]->pn.pn_name = Cnil; +- } else if (vs_base[0]->pn.pn_type==Cnil) { +- coerce_to_filename(vs_base[0], filename); +- strcat(filename, "*"); +- } else +- coerce_to_filename(vs_base[0], filename); +- sprintf(command, "ls -d %s 2> /dev/null", filename); +- fp = popen(command, "r"); +- setbuf(fp, iobuffer); +- for (;;) { +- for (i = 0; (c = getc(fp)); i++) +- if (c <= 0) +- goto L; +- else if (c == '\n') +- break; +- else +- filename[i] = c; +- filename[i] = '\0'; +- vs_push(make_simple_string(filename)); +- vs_head = truename(vs_head); +- } +-L: +- pclose(fp); +- vs_push(Cnil); +- while (vs_top > top + 1) +- stack_cons(); +- vs_base = top; +-} +-#endif +- +- +-#ifdef ATT +-LFD(Ldirectory)() +-{ +- object name, type; +- char filename[MAXPATHLEN]; +- FILE *fp; +- object *top = vs_top; +- char iobuffer[BUFSIZ]; +- struct direct dir; +- int i; +- +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_push(vs_base[0]->pn.pn_name); +- vs_push(vs_base[0]->pn.pn_type); +- vs_base[0]->pn.pn_name = Cnil; +- vs_base[0]->pn.pn_type = Cnil; +- coerce_to_filename(vs_base[0], filename); +- type = vs_base[0]->pn.pn_type = vs_pop; +- name = vs_base[0]->pn.pn_name = vs_pop; +- i = strlen(filename); +- if (i > 1 && filename[i-1] == '/') +- filename[i-1] = '\0'; +- if (i == 0) +- strcpy(filename, "."); +- fp = fopen(filename, "r"); +- if (fp == NULL) { +- vs_push(make_simple_string(filename)); +- FEerror("Can't open the directory ~S.", 1, vs_head); +- } +- setbuf(fp, iobuffer); +- fread(&dir, sizeof(struct direct), 1, fp); +- fread(&dir, sizeof(struct direct), 1, fp); +- filename[DIRSIZ] = '\0'; +- for (;;) { +- if (fread(&dir, sizeof(struct direct), 1, fp) <=0) +- break; +- if (dir.d_ino == 0) +- continue; +- strncpy(filename, dir.d_name, DIRSIZ); +- vs_push(make_simple_string(filename)); +- vs_head = coerce_to_pathname(vs_head); +- if ((name == Cnil || name == sKwild || +- equal(name, vs_head->pn.pn_name)) && +- (type == Cnil || type == sKwild || +- equal(type, vs_head->pn.pn_type))) { +- vs_head->pn.pn_directory +- = vs_base[0]->pn.pn_directory; +- vs_head = truename(vs_head); +- } else +- vs_pop; +- } +- fclose(fp); +- vs_push(Cnil); +- while (vs_top > top + 1) +- stack_cons(); +- vs_base = top; +-} +-#endif +- +- +-#ifdef E15 +-#include +- +-LFD(Ldirectory)() +-{ +- object name, type; +- char filename[MAXPATHLEN]; +- FILE *fp; +- object *top = vs_top; +- char iobuffer[BUFSIZ]; +- struct direct dir; +- int i; +- +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_push(vs_base[0]->pn.pn_name); +- vs_push(vs_base[0]->pn.pn_type); +- vs_base[0]->pn.pn_name = Cnil; +- vs_base[0]->pn.pn_type = Cnil; +- coerce_to_filename(vs_base[0], filename); +- type = vs_base[0]->pn.pn_type = vs_pop; +- name = vs_base[0]->pn.pn_name = vs_pop; +- i = strlen(filename); +- if (i > 1 && filename[i-1] == '/') +- filename[i-1] = '\0'; +- if (i == 0) +- strcpy(filename, "."); +- fp = fopen(filename, "r"); +- if (fp == NULL) { +- vs_push(make_simple_string(filename)); +- FEerror("Can't open the directory ~S.", 1, vs_head); +- } +- setbuf(fp, iobuffer); +- fread(&dir, sizeof(struct direct), 1, fp); +- fread(&dir, sizeof(struct direct), 1, fp); +- filename[DIRSIZ] = '\0'; +- for (;;) { +- if (fread(&dir, sizeof(struct direct), 1, fp) <=0) +- break; +- if (dir.d_ino == 0) +- continue; +- strncpy(filename, dir.d_name, DIRSIZ); +- vs_push(make_simple_string(filename)); +- vs_head = coerce_to_pathname(vs_head); +- if ((name == Cnil || name == sKwild || +- equal(name, vs_head->pn.pn_name)) && +- (type == Cnil || type == sKwild || +- equal(type, vs_head->pn.pn_type))) { +- vs_head->pn.pn_directory +- = vs_base[0]->pn.pn_directory; +- vs_head = truename(vs_head); +- } else +- vs_pop; +- } +- fclose(fp); +- vs_push(Cnil); +- while (vs_top > top + 1) +- stack_cons(); +- vs_base = top; +-} +-#endif +- + #include + #include + +@@ -840,17 +432,31 @@ DEFUN_NEW("D-TYPE-LIST",object,fSd_type_ + } + #endif + +-DEFUN_NEW("READDIR",object,fSreaddir,SI,2,2,NONE,OI,IO,OO,OO,(fixnum x,fixnum y),"") { ++DEFUN_NEW("READDIR",object,fSreaddir,SI,3,3,NONE,OI,IO,OO,OO,(fixnum x,fixnum y,object s),"") { + struct dirent *e; + object z; ++ long tl; ++ size_t l; + if (!x) RETURN1(Cnil); +- e=readdir((DIR *)x); +- RETURN1(e ? make_simple_string(e->d_name) : Cnil); ++ tl=telldir((DIR *)x); + #ifdef HAVE_D_TYPE + for (;(e=readdir((DIR *)x)) && y!=DT_UNKNOWN && e->d_type!=y;); + #endif + if (!e) RETURN1(Cnil); +- z=make_simple_string(e->d_name); ++ if (s==Cnil) ++ z=make_simple_string(e->d_name); ++ else { ++ check_type_string(&s); ++ l=strlen(e->d_name); ++ if (s->st.st_dim-s->st.st_fillp>=l) { ++ memcpy(s->st.st_self+s->st.st_fillp,e->d_name,l); ++ s->st.st_fillp+=l; ++ z=s; ++ } else { ++ seekdir((DIR *)x,tl); ++ RETURN1(make_fixnum(l)); ++ } ++ } + #ifdef HAVE_D_TYPE + if (y==DT_UNKNOWN) z=MMcons(z,make_fixnum(e->d_type)); + #endif +@@ -882,7 +488,126 @@ DEFUN_NEW("MKDIR",object,fSmkdir,SI,1,1, + + } + ++DEFUN_NEW("RMDIR",object,fSrmdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ check_type_string(&x); ++ ++ coerce_to_filename(x,FN1); ++ ++ RETURN1(rmdir(FN1) ? Cnil : Ct); ++ ++} ++ ++ ++ ++#include ++#include ++#include ++#include ++ ++DEFUN_NEW("READLINKAT",object,fSreadlinkat,SI,2,2,NONE,OI,OO,OO,OO,(fixnum d,object s),"") { ++ char *b1,*b2=NULL; ++ ssize_t l,z1,z2; ++ check_type_string(&s); ++ /* l=s->st.st_hasfillp ? s->st.st_fillp : s->st.st_dim; */ ++ z1=length(s); ++ massert((b1=alloca(z1+1))); ++ memcpy(b1,s->st.st_self,z1); ++ b1[z1]=0; ++ for (l=z2=0;l>=z2;) { ++ memset(b2,0,z2); ++ z2+=z2+10; ++ massert((b2=alloca(z2))); ++ massert((l=readlinkat(d ? dirfd((DIR *)d) : AT_FDCWD,b1,b2,z2))>=0); ++ } ++ b2[l]=0; ++ s=make_simple_string(b2); ++ memset(b1,0,z1); ++ memset(b2,0,z2); ++ RETURN1(s); ++} ++ ++DEFUN_NEW("GETCWD",object,fSgetcwd,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { ++ char *b=NULL; ++ size_t z; ++ object s; ++ ++ for (z=0;!(errno=0) && !getcwd(b,z) && errno==ERANGE;b=memset(b,0,z),z+=z+10,({massert((b=alloca(z)));})); ++ massert((b=getcwd(b,z))); ++ s=make_simple_string(b); ++ memset(b,0,z); ++ RETURN1(s); ++ ++} ++ ++DEFUN_NEW("UID-TO-NAME",object,fSuid_to_name,SI,1,1,NONE,OI,OO,OO,OO,(fixnum uid),"") { ++ struct passwd *pwent,pw; ++ char *b; ++ long r; ++ ++ massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); ++ massert(b=alloca(r)); ++ ++ massert(!getpwuid_r(uid,&pw,b,r,&pwent)); ++ ++ RETURN1(make_simple_string(pwent->pw_name)); ++ ++} ++ ++DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") { ++ ++ struct passwd *pwent,pw; ++ char *b; ++ long r; ++ ++ massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); ++ massert(b=alloca(r)); + ++ if (nm->st.st_fillp==1) ++ ++ if ((pw.pw_dir=getenv("HOME"))) ++ pwent=&pw; ++ else ++ massert(!getpwuid_r(getuid(),&pw,b,r,&pwent)); ++ ++ else { ++ ++ char *name; ++ ++ massert(name=alloca(nm->st.st_fillp)); ++ memcpy(name,nm->st.st_self+1,nm->st.st_fillp-1); ++ name[nm->st.st_fillp-1]=0; ++ ++ massert(!getpwnam_r(name,&pw,b,r,&pwent)); ++ ++ } ++ ++ massert((b=alloca(strlen(pwent->pw_dir)+2))); ++ memcpy(b,pwent->pw_dir,strlen(pwent->pw_dir)); ++ b[strlen(pwent->pw_dir)]='/'; ++ b[strlen(pwent->pw_dir)+1]=0; ++ RETURN1(make_simple_string(b)); ++ ++} ++ ++DEFUN_NEW("RENAME",object,fSrename,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { ++ ++ check_type_string(&x); ++ check_type_string(&y); ++ ++ coerce_to_filename(x,FN1); ++ coerce_to_filename(y,FN2); ++ ++ RETURN1(rename(FN1,FN2) ? Cnil : Ct); ++ ++} ++ ++DEFUN_NEW("UNLINK",object,fSunlink,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ ++ coerce_to_filename(x,FN1); ++ ++ RETURN1(unlink(FN1) ? Cnil : Ct); ++ ++} + + + static void +@@ -900,16 +625,8 @@ FFN(siLchdir)(void) + } + + void +-gcl_init_unixfsys(void) +-{ +- make_function("TRUENAME", Ltruename); +- make_function("RENAME-FILE", Lrename_file); +- make_function("DELETE-FILE", Ldelete_file); +- make_function("PROBE-FILE", Lprobe_file); +- make_function("FILE-WRITE-DATE", Lfile_write_date); +- make_function("FILE-AUTHOR", Lfile_author); +- make_function("USER-HOMEDIR-PATHNAME", Luser_homedir_pathname); +- make_function("DIRECTORY", Ldirectory); ++gcl_init_unixfsys(void) { ++ ++ make_si_function("CHDIR", siLchdir); + +- make_si_function("CHDIR", siLchdir); + } +--- gcl-2.6.12.orig/o/usig.c ++++ gcl-2.6.12/o/usig.c +@@ -148,13 +148,15 @@ DEFUN_NEW("FLD",object,fSfld,SI,1,1,NONE + + #endif + +-DEFUN_NEW("*FIXNUM",fixnum,fSAfixnum,SI,1,1,NONE,II,OO,OO,OO,(fixnum addr),"") { +- RETURN1(*(fixnum *)addr); ++/* For now ignore last three args governing offsets and data modification, just to ++ support fpe sync with master*/ ++DEFUN_NEW("*FIXNUM",object,fSAfixnum,SI,4,4,NONE,OI,OO,OO,OO,(fixnum addr,object x,object y,object z),"") { ++ RETURN1((object)*(fixnum *)addr); + } +-DEFUN_NEW("*FLOAT",object,fSAfloat,SI,1,1,NONE,OI,OO,OO,OO,(fixnum addr),"") { ++DEFUN_NEW("*FLOAT",object,fSAfloat,SI,4,4,NONE,OI,OO,OO,OO,(fixnum addr,object x,object y,object z),"") { + RETURN1(make_shortfloat(*(float *)addr)); + } +-DEFUN_NEW("*DOUBLE",object,fSAdouble,SI,1,1,NONE,OI,OO,OO,OO,(fixnum addr),"") { ++DEFUN_NEW("*DOUBLE",object,fSAdouble,SI,4,4,NONE,OI,OO,OO,OO,(fixnum addr,object x,object y,object z),"") { + RETURN1(make_longfloat(*(double *)addr)); + } + +@@ -264,7 +266,6 @@ sigpipe(void) + FEerror("Broken pipe", 0); + } + +- + void + sigint(void) + { +@@ -272,8 +273,6 @@ sigint(void) + terminal_interrupt(1); + } + +- +- + static void + sigalrm(void) + { +--- gcl-2.6.12.orig/unixport/sys_ansi_gcl.c ++++ gcl-2.6.12/unixport/sys_ansi_gcl.c +@@ -41,7 +41,6 @@ gcl_init_system(object no_init) + #ifdef HAVE_JAPI_H + ar_check_init(gcl_japi,no_init); + #endif +- ar_check_init(gcl_iolib,no_init); + ar_check_init(gcl_listlib,no_init); + ar_check_init(gcl_mislib,no_init); + ar_check_init(gcl_numlib,no_init); +@@ -56,9 +55,23 @@ gcl_init_system(object no_init) + ar_check_init(gcl_defpackage,no_init); + ar_check_init(gcl_make_defpackage,no_init); + ar_check_init(gcl_sharp,no_init); +- ar_check_init(gcl_fpe,no_init); + ++ ar_check_init(gcl_sharp_uv,no_init); ++ ar_check_init(gcl_namestring,no_init); ++ ar_check_init(gcl_logical_pathname_translations,no_init); ++ ar_check_init(gcl_make_pathname,no_init); ++ ar_check_init(gcl_parse_namestring,no_init); ++ ar_check_init(gcl_translate_pathname,no_init); ++ ar_check_init(gcl_directory,no_init); ++ ar_check_init(gcl_merge_pathnames,no_init); ++ ar_check_init(gcl_truename,no_init); ++ ar_check_init(gcl_rename_file,no_init); ++ ar_check_init(gcl_wild_pathname_p,no_init); ++ ar_check_init(gcl_pathname_match_p,no_init); + ++ ar_check_init(gcl_iolib,no_init); ++ ar_check_init(gcl_fpe,no_init); ++ + ar_check_init(gcl_cmpinline,no_init); + ar_check_init(gcl_cmputil,no_init); + +@@ -107,6 +120,7 @@ gcl_init_system(object no_init) + ar_check_init(gcl_index,no_init); + #endif + ++ lsp_init("../pcl/package.lisp"); + ar_check_init(gcl_pcl_pkg,no_init); + ar_check_init(gcl_pcl_walk,no_init); + ar_check_init(gcl_pcl_iterate,no_init); +@@ -142,6 +156,7 @@ gcl_init_system(object no_init) + ar_check_init(gcl_pcl_precom1,no_init); + ar_check_init(gcl_pcl_precom2,no_init); + ++ lsp_init("../clcs/package.lisp"); + ar_check_init(gcl_clcs_precom,no_init); + ar_check_init(gcl_clcs_handler,no_init); + ar_check_init(gcl_clcs_conditions,no_init); +--- gcl-2.6.12.orig/unixport/sys_gcl.c ++++ gcl-2.6.12/unixport/sys_gcl.c +@@ -34,7 +34,6 @@ gcl_init_system(object no_init) { + #ifdef HAVE_JAPI_H + ar_check_init(gcl_japi,no_init); + #endif +- ar_check_init(gcl_iolib,no_init); + ar_check_init(gcl_listlib,no_init); + ar_check_init(gcl_mislib,no_init); + ar_check_init(gcl_numlib,no_init); +@@ -49,9 +48,23 @@ gcl_init_system(object no_init) { + ar_check_init(gcl_defpackage,no_init); + ar_check_init(gcl_make_defpackage,no_init); + ar_check_init(gcl_sharp,no_init); +- ar_check_init(gcl_fpe,no_init); + ++ ar_check_init(gcl_sharp_uv,no_init); ++ ar_check_init(gcl_namestring,no_init); ++ ar_check_init(gcl_logical_pathname_translations,no_init); ++ ar_check_init(gcl_make_pathname,no_init); ++ ar_check_init(gcl_parse_namestring,no_init); ++ ar_check_init(gcl_translate_pathname,no_init); ++ ar_check_init(gcl_directory,no_init); ++ ar_check_init(gcl_merge_pathnames,no_init); ++ ar_check_init(gcl_truename,no_init); ++ ar_check_init(gcl_rename_file,no_init); ++ ar_check_init(gcl_wild_pathname_p,no_init); ++ ar_check_init(gcl_pathname_match_p,no_init); + ++ ar_check_init(gcl_iolib,no_init); ++ ar_check_init(gcl_fpe,no_init); ++ + ar_check_init(gcl_cmpinline,no_init); + ar_check_init(gcl_cmputil,no_init); + +--- gcl-2.6.12.orig/unixport/sys_init.lsp.in ++++ gcl-2.6.12/unixport/sys_init.lsp.in +@@ -9,9 +9,6 @@ + (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) +@@ -20,7 +17,7 @@ + (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))) ++(let* ((x (append (pathname-directory *system-directory*) (list :back))) + (lsp (append x (list "lsp"))) + (cmpnew (append x (list "cmpnew"))) + (h (append x (list "h"))) +@@ -59,6 +56,7 @@ + + (fmakunbound 'init-cmp-anon) + (when (fboundp 'user-init) (user-init)) ++ + (in-package :compiler) + (setq *cc* @LI-CC@ + *ld* @LI-LD@ +@@ -79,7 +77,9 @@ + #-ansi-cl(do-symbols (s :cltl1-compat) (export s :lisp))) + + #+ansi-cl (use-package :pcl :user) +-#+ansi-cl (import 'si::(clines defentry defcfun object void int double quit bye gbc system) :user) ++ ++(import 'si::(clines defentry defcfun object void int double quit bye gbc system ++ *lib-directory* *system-directory*) :user) + + (let* ((i 4096)(j (si::equal-tail-recursion-check i))) + (unless (<= (ash i -1) j) +--- gcl-2.6.12.orig/unixport/sys_pcl_gcl.c ++++ gcl-2.6.12/unixport/sys_pcl_gcl.c +@@ -41,7 +41,6 @@ gcl_init_system(object no_init) + #ifdef HAVE_JAPI_H + ar_check_init(gcl_japi,no_init); + #endif +- ar_check_init(gcl_iolib,no_init); + ar_check_init(gcl_listlib,no_init); + ar_check_init(gcl_mislib,no_init); + ar_check_init(gcl_numlib,no_init); +@@ -56,9 +55,23 @@ gcl_init_system(object no_init) + ar_check_init(gcl_defpackage,no_init); + ar_check_init(gcl_make_defpackage,no_init); + ar_check_init(gcl_sharp,no_init); +- ar_check_init(gcl_fpe,no_init); + ++ ar_check_init(gcl_sharp_uv,no_init); ++ ar_check_init(gcl_namestring,no_init); ++ ar_check_init(gcl_logical_pathname_translations,no_init); ++ ar_check_init(gcl_make_pathname,no_init); ++ ar_check_init(gcl_parse_namestring,no_init); ++ ar_check_init(gcl_translate_pathname,no_init); ++ ar_check_init(gcl_directory,no_init); ++ ar_check_init(gcl_merge_pathnames,no_init); ++ ar_check_init(gcl_truename,no_init); ++ ar_check_init(gcl_rename_file,no_init); ++ ar_check_init(gcl_wild_pathname_p,no_init); ++ ar_check_init(gcl_pathname_match_p,no_init); + ++ ar_check_init(gcl_iolib,no_init); ++ ar_check_init(gcl_fpe,no_init); ++ + ar_check_init(gcl_cmpinline,no_init); + ar_check_init(gcl_cmputil,no_init); + +@@ -107,6 +120,7 @@ gcl_init_system(object no_init) + ar_check_init(gcl_index,no_init); + #endif + ++ lsp_init("../pcl/package.lisp"); + ar_check_init(gcl_pcl_pkg,no_init); + ar_check_init(gcl_pcl_walk,no_init); + ar_check_init(gcl_pcl_iterate,no_init); +--- gcl-2.6.12.orig/unixport/sys_pre_gcl.c ++++ gcl-2.6.12/unixport/sys_pre_gcl.c +@@ -39,7 +39,6 @@ gcl_init_system(object no_init) + #ifdef HAVE_JAPI_H + lsp_init("../lsp/gcl_japi.lsp"); + #endif +- lsp_init("../lsp/gcl_iolib.lsp"); + /* lsp_init("../lsp/gcl_listlib.lsp"); */ + lsp_init("../lsp/gcl_mislib.lsp"); + lsp_init("../lsp/gcl_numlib.lsp"); +@@ -54,6 +53,21 @@ gcl_init_system(object no_init) + lsp_init("../lsp/gcl_defpackage.lsp"); + lsp_init("../lsp/gcl_make_defpackage.lsp"); + lsp_init("../lsp/gcl_sharp.lsp"); ++ ++ lsp_init("../lsp/gcl_sharp_uv.lsp"); ++ lsp_init("../lsp/gcl_logical_pathname_translations.lsp"); ++ lsp_init("../lsp/gcl_make_pathname.lsp"); ++ lsp_init("../lsp/gcl_parse_namestring.lsp"); ++ lsp_init("../lsp/gcl_namestring.lsp"); ++ lsp_init("../lsp/gcl_translate_pathname.lsp"); ++ lsp_init("../lsp/gcl_directory.lsp"); ++ lsp_init("../lsp/gcl_merge_pathnames.lsp"); ++ lsp_init("../lsp/gcl_truename.lsp"); ++ lsp_init("../lsp/gcl_rename_file.lsp"); ++ lsp_init("../lsp/gcl_wild_pathname_p.lsp"); ++ lsp_init("../lsp/gcl_pathname_match_p.lsp"); ++ ++ lsp_init("../lsp/gcl_iolib.lsp"); + lsp_init("../lsp/gcl_fpe.lsp"); + + lsp_init("../cmpnew/gcl_cmpinline.lsp"); +--- gcl-2.6.12.orig/xbin/make-fn ++++ gcl-2.6.12/xbin/make-fn +@@ -6,10 +6,13 @@ TMP=/tmp/tmpd$$ + mkdir ${TMP} + cp $@ ${TMP} + +-for v in $@ ; ++for v in $1 ; + do + echo '(load (format nil "~a~a" si::*system-directory* "../cmpnew/gcl_collectfn"))' \ + '(compiler::emit-fn t)'\ ++ "(compile-file \"${TMP}/$v\" :o-file nil)" ++echo '(load (format nil "~a~a" si::*system-directory* "../cmpnew/gcl_collectfn"))' \ ++ '(compiler::emit-fn t)'\ + "(compile-file \"${TMP}/$v\" :o-file nil)" | ${LISP} + done + diff --git a/patches/pathnames1.11 b/patches/pathnames1.11 new file mode 100644 index 00000000..71bab921 --- /dev/null +++ b/patches/pathnames1.11 @@ -0,0 +1,246 @@ +Description: + 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-45) unstable; urgency=high + . + * pathnames1.11 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-31 + +--- gcl-2.6.12.orig/cmpnew/gcl_lfun_list.lsp ++++ gcl-2.6.12/cmpnew/gcl_lfun_list.lsp +@@ -144,7 +144,7 @@ + (DEFSYSFUN 'SVREF "Lsvref" '(T T) 'T NIL NIL) + (DEFSYSFUN 'APPLY "Lapply" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'DECODE-FLOAT "Ldecode_float" '(T) '(VALUES T T T) NIL NIL) +-(DEFSYSFUN 'SUBST-IF-NOT "Lsubst_if_not" '(T T T *) 'T NIL NIL) ++;(DEFSYSFUN 'SUBST-IF-NOT "Lsubst_if_not" '(T T T *) 'T NIL NIL) + (DEFSYSFUN 'RPLACA "Lrplaca" '(T T) 'T NIL NIL) + (DEFSYSFUN 'SYMBOL-PLIST "Lsymbol_plist" '(T) 'T NIL NIL) + (DEFSYSFUN 'WRITE-STRING "Lwrite_string" '(T *) 'T NIL NIL) +@@ -210,7 +210,7 @@ + (DEFSYSFUN 'NSUBLIS "Lnsublis" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'CHAR-NOT-EQUAL "Lchar_not_equal" '(T *) 'T NIL T) + (DEFSYSFUN 'MACRO-FUNCTION "Lmacro_function" '(T) 'T NIL NIL) +-(DEFSYSFUN 'SUBST-IF "Lsubst_if" '(T T T *) 'T NIL NIL) ++;(DEFSYSFUN 'SUBST-IF "Lsubst_if" '(T T T *) 'T NIL NIL) + (DEFSYSFUN 'COMPLEXP "Lcomplexp" '(T) 'T NIL T) + (DEFSYSFUN 'READ-LINE "Lread_line" '(*) '(VALUES T T) NIL NIL) + (DEFSYSFUN 'MAX "Lmax" '(T *) 'T NIL NIL) +@@ -232,7 +232,7 @@ + (DEFSYSFUN 'FLOAT "Lfloat" '(T *) 'T NIL NIL) + ;(DEFSYSFUN 'FIRST "Lcar" '(T) 'T NIL NIL) + (DEFSYSFUN 'ROUND "Lround" '(T *) '(VALUES T T) NIL NIL) +-(DEFSYSFUN 'SUBST "Lsubst" '(T T T *) 'T NIL NIL) ++;(DEFSYSFUN 'SUBST "Lsubst" '(T T T *) 'T NIL NIL) + (DEFSYSFUN 'UPPER-CASE-P "Lupper_case_p" '(T) 'T NIL T) + (DEFSYSFUN 'ARRAY-ELEMENT-TYPE "Larray_element_type" '(T) 'T NIL NIL) + (DEFSYSFUN 'ADJOIN "Ladjoin" '(T T *) 'T NIL NIL) +--- gcl-2.6.12.orig/lsp/gcl_arraylib.lsp ++++ gcl-2.6.12/lsp/gcl_arraylib.lsp +@@ -262,8 +262,6 @@ + (static (staticp array)) + &aux (fill-pointer (or fill-pointer (when (array-has-fill-pointer-p array) (fill-pointer array))))) + +- (declare (ignore element-type)) +- + (let ((x (if initial-contents-supplied-p + (make-array new-dimensions + :adjustable t +--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp ++++ gcl-2.6.12/lsp/gcl_iolib.lsp +@@ -80,7 +80,7 @@ + 0 l))) + + (defun get-string-input-stream-index (stream &aux (s (c-stream-object0 stream))) +- (+ (fill-pointer s) (multiple-value-bind (a b) (array-displacement s) b))) ++ (+ (fill-pointer s) (multiple-value-bind (a b) (array-displacement s) (declare (ignore a)) b))) + + (defmacro with-input-from-string ((var string &key index (start 0) end) . body) + (declare (optimize (safety 1))) +@@ -457,10 +457,10 @@ + if-exists iesp if-does-not-exist idnesp external-format))) + (when (typep s 'stream) (c-set-stream-object1 s pf) s))) + +-(defun load-pathname-exists (z) +- (or (probe-file z) +- (when *allow-gzipped-file* +- (when (probe-file (string-concatenate (namestring z) ".gz")) ++(defun load-pathname-exists (z &aux (z (link-expand (namestring z)))) ++ (cond ((eq (stat z) :file) z) ++ (*allow-gzipped-file* ++ (when (eq (stat (string-concatenate (namestring z) ".gz")) :file) + z)))) + + (defun load-pathname (p print if-does-not-exist external-format +--- gcl-2.6.12.orig/lsp/gcl_listlib.lsp ++++ gcl-2.6.12/lsp/gcl_listlib.lsp +@@ -180,3 +180,34 @@ + (defmacro nth-value (n expr) + (declare (optimize (safety 1))) + `(nth ,n (multiple-value-list ,expr))) ++ ++(eval-when (compile eval) ++ ++ (defmacro repl-if (tc) `(labels ((l (tr &aux (k (if kf (funcall kf tr) tr))) ++ (cond (,tc n) ++ ((atom tr) tr) ++ ((let* ((ca (car tr))(a (l ca))(cd (cdr tr))(d (l cd))) ++ (if (and (eq a ca) (eq d cd)) tr (cons a d))))))) ++ (declare (ftype (function (t) t) l)) ++ (l tr)))) ++ ++(defun subst (n o tr &key key test test-not ++ &aux (kf (when key (coerce key 'function))) ++ (tf (when test (coerce test 'function))) ++ (ntf (when test-not (coerce test-not 'function)))) ++ (declare (optimize (safety 1))) ++ (check-type key (or null function)) ++ (check-type test (or null function)) ++ (check-type test-not (or null function)) ++ (repl-if (cond (tf (funcall tf o k))(ntf (not (funcall ntf o k)))((eql o k))))) ++ ++(defun subst-if (n p tr &key key &aux (kf (when key (coerce key 'function)))) ++ (declare (optimize (safety 1))) ++ (check-type p function) ++ (check-type key (or null function)) ++ (repl-if (funcall p k))) ++(defun subst-if-not (n p tr &key key &aux (kf (when key (coerce key 'function)))) ++ (declare (optimize (safety 1))) ++ (check-type p function) ++ (check-type key (or null function)) ++ (repl-if (not (funcall p k))))) +--- gcl-2.6.12.orig/lsp/gcl_truename.lsp ++++ gcl-2.6.12/lsp/gcl_truename.lsp +@@ -23,7 +23,8 @@ + (check-type pd pathname-designator) + (when (wild-pathname-p ns) + (error 'file-error :pathname pd :format-control "Pathname is wild")) +- (let* ((ns (ensure-dir-string (link-expand ns)))(ppd (pathname ns))) ++ (let* ((ns (ensure-dir-string (link-expand ns))) ++ (ppd (if (eq (namestring pd) ns) pd (pathname ns)))) + (unless (or (zerop (length ns)) (stat ns)) + (error 'file-error :pathname ns :format-control "Pathname does not exist")) + (let* ((d (pathname-directory ppd)) +--- gcl-2.6.12.orig/o/list.d ++++ gcl-2.6.12/o/list.d +@@ -528,26 +528,26 @@ object x; + vs_check_push(x); + } + +-/* +- Subst(new, tree) pushes +- the result of substituting new in tree +- onto vs. +-*/ +-static void +-subst(new, tree) +-object new, tree; +-{ +- cs_check(new); +- +- if (TEST(tree)) +- vs_check_push(new); +- else if (type_of(tree) == t_cons) { +- subst(new, tree->c.c_car); +- subst(new, tree->c.c_cdr); +- stack_cons(); +- } else +- vs_check_push(tree); +-} ++/* /\* */ ++/* Subst(new, tree) pushes */ ++/* the result of substituting new in tree */ ++/* onto vs. */ ++/* *\/ */ ++/* static void */ ++/* subst(new, tree) */ ++/* object new, tree; */ ++/* { */ ++/* cs_check(new); */ ++ ++/* if (TEST(tree)) */ ++/* vs_check_push(new); */ ++/* else if (type_of(tree) == t_cons) { */ ++/* subst(new, tree->c.c_car); */ ++/* subst(new, tree->c.c_cdr); */ ++/* stack_cons(); */ ++/* } else */ ++/* vs_check_push(tree); */ ++/* } */ + + /* static object */ + /* subst1(object new, object tree) { */ +@@ -1153,25 +1153,25 @@ LFD(Lrplacd)() + vs_popp; + } + +-@(defun subst (new old tree &key test test_not key) +- saveTEST; +-@ +- protectTEST; +- setupTEST(old, test, test_not, key); +- subst(new, tree); +- tree = vs_pop; +- /* if (kf==identity && */ +- /* tf==test_eql && */ +- /* (is_imm_fixnum(item_compared) || */ +- /* ({enum type tp=type_of(item_compared);tp>t_complex || tpt_complex || tp + 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-46) unstable; urgency=high + . + * pathnames1.12 + * Bug fix: "maintainer script(s) do not start on #!", thanks to + treinen@debian.org; (Closes: #843303). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/843303 + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-11-18 + +--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp ++++ gcl-2.6.12/lsp/gcl_iolib.lsp +@@ -457,11 +457,10 @@ + if-exists iesp if-does-not-exist idnesp external-format))) + (when (typep s 'stream) (c-set-stream-object1 s pf) s))) + +-(defun load-pathname-exists (z &aux (z (link-expand (namestring z)))) +- (cond ((eq (stat z) :file) z) +- (*allow-gzipped-file* +- (when (eq (stat (string-concatenate (namestring z) ".gz")) :file) +- z)))) ++(defun load-pathname-exists (z) ++ (or (probe-file z) ++ (when *allow-gzipped-file* ++ (probe-file (string-concatenate (namestring z) ".gz"))))) + + (defun load-pathname (p print if-does-not-exist external-format + &aux (pp (merge-pathnames p)) +--- gcl-2.6.12.orig/lsp/gcl_listlib.lsp ++++ gcl-2.6.12/lsp/gcl_listlib.lsp +@@ -123,8 +123,8 @@ + + (defun smallnthcdr (n x) + (declare (fixnum n)) +- (cond ((atom x) (when x (tp-error x proper-list))) +- ((= n 0) x) ++ (cond ((= n 0) x) ++ ((atom x) (when x (tp-error x proper-list))) + ((smallnthcdr (1- n) (cdr x))))) + + (defun bignthcdr (n i s f) +--- gcl-2.6.12.orig/lsp/gcl_truename.lsp ++++ gcl-2.6.12/lsp/gcl_truename.lsp +@@ -38,5 +38,5 @@ + (check-type pd pathname-designator) + (when (wild-pathname-p pn) + (error 'file-error :pathname pn :format-control "Pathname is wild")) +- (when (eq (stat (namestring pn)) :file) ++ (when (eq (stat (link-expand (namestring pn))) :file) + (truename pn))) diff --git a/patches/pathnames1.13 b/patches/pathnames1.13 new file mode 100644 index 00000000..57073da4 --- /dev/null +++ b/patches/pathnames1.13 @@ -0,0 +1,40 @@ +Description: + 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-46) unstable; urgency=high + . + * pathnames1.12 + * Bug fix: "maintainer script(s) do not start on #!", thanks to + treinen@debian.org; (Closes: #843303). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/843303 + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-11-22 + +--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp ++++ gcl-2.6.12/lsp/gcl_iolib.lsp +@@ -460,7 +460,8 @@ + (defun load-pathname-exists (z) + (or (probe-file z) + (when *allow-gzipped-file* +- (probe-file (string-concatenate (namestring z) ".gz"))))) ++ (when (probe-file (string-concatenate (namestring z) ".gz")) ++ z)))) + + (defun load-pathname (p print if-does-not-exist external-format + &aux (pp (merge-pathnames p)) diff --git a/patches/pathnames1.2 b/patches/pathnames1.2 new file mode 100644 index 00000000..f7bb1114 --- /dev/null +++ b/patches/pathnames1.2 @@ -0,0 +1,1196 @@ +Description: + 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-39) unstable; urgency=medium + . + * pathnames1.1 + * ansi-test clean target +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-12 + +--- gcl-2.6.12.orig/h/notcomp.h ++++ gcl-2.6.12/h/notcomp.h +@@ -296,6 +296,8 @@ gcl_init_cmp_anon(void); + + char FN1[PATH_MAX],FN2[PATH_MAX],FN3[PATH_MAX],FN4[PATH_MAX],FN5[PATH_MAX]; + ++#define coerce_to_filename(a_,b_) coerce_to_filename1(a_,b_,sizeof(b_)) ++ + #include + #define massert(a_) ({errno=0;if (!(a_)||errno) assert_error(#a_,__LINE__,__FILE__,__FUNCTION__);}) + +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -508,7 +508,7 @@ typedef void (*funcvoid)(void); + /* unexlin.c:808:OF */ extern int write_segment (int new, register char *ptr, register char *end); /* (new, ptr, end) int new; register char *ptr; register char *end; */ + /* unixfasl.c:409:OF */ extern void gcl_init_unixfasl (void); /* () */ + /* unixfsys.c:145:OF */ extern char *getwd (char *buffer); /* (buffer) char *buffer; */ +-/* unixfsys.c:209:OF */ extern void coerce_to_filename (object pathname, char *p); /* (pathname, p) object pathname; char *p; */ ++/* unixfsys.c:209:OF */ extern void coerce_to_filename1 (object pathname, char *p,unsigned sz); /* (pathname, p) object pathname; char *p; */ + /* unixfsys.c:329:OF */ extern bool file_exists (object file); /* (file) object file; */ + /* unixfsys.c:359:OF */ extern FILE *backup_fopen (char *filename, char *option); /* (filename, option) char *filename; char *option; */ + /* unixfsys.c:359:OF */ extern FILE *fopen_not_dir (char *filename, char *option); /* (filename, option) char *filename; char *option; */ +--- gcl-2.6.12.orig/lsp/gcl_directory.lsp ++++ gcl-2.6.12/lsp/gcl_directory.lsp +@@ -48,8 +48,12 @@ + (expand-wild-directory (cons :relative (cdr x)) f q e)) :directory));FIXME + ((funcall f z y)))))) + ++(defun chdir (s) ++ (when (chdir1 (namestring (pathname s)));to expand ~/ ++ (setq *current-directory* (current-directory-pathname)))) ++ + (defun directory (p &key &aux (p (translate-logical-pathname p))(d (pathname-directory p)) +- (c (unless (eq (car d) :absolute) (make-frame (concatenate 'string (getcwd) "/")))) ++ (c (unless (eq (car d) :absolute) (make-frame (namestring *current-directory*)))) + (lc (when c (length c))) + (filesp (or (pathname-name p) (pathname-type p))) + (v (compile-regexp (to-regexp p)))(*up-key* :back) r) +--- gcl-2.6.12.orig/lsp/gcl_rename_file.lsp ++++ gcl-2.6.12/lsp/gcl_rename_file.lsp +@@ -35,6 +35,7 @@ + (check-type spec pathname-designator) + (multiple-value-bind + (tp sz tm) (stat (namestring (truename spec))) ++ (declare (ignore tp sz)) + (+ tm (* (+ 17 (* 70 365)) (* 24 60 60))))) + + +@@ -43,5 +44,6 @@ + (check-type spec pathname-designator) + (multiple-value-bind + (tp sz tm uid) (stat (namestring (truename spec))) ++ (declare (ignore tp sz tm)) + (uid-to-name uid))) + +--- gcl-2.6.12.orig/lsp/gcl_top.lsp ++++ gcl-2.6.12/lsp/gcl_top.lsp +@@ -607,8 +607,13 @@ First directory is checked for first nam + (defvar *ld* "ld") + (defvar *objdump* "objdump --source ") + ++(defvar *current-directory* *system-directory*) ++ ++(defun current-directory-pathname nil (pathname (concatenate 'string (getcwd) "/"))) ++ + (defun set-up-top-level (&aux (i (argc)) tem) + (declare (fixnum i)) ++ (setq *current-directory* (current-directory-pathname)) + (setq *tmp-dir* (get-temp-dir) + *cc* (get-path *cc*) + *ld* (get-path *ld*) +--- gcl-2.6.12.orig/lsp/gcl_truename.lsp ++++ gcl-2.6.12/lsp/gcl_truename.lsp +@@ -18,20 +18,18 @@ + (pathname (typep x 'logical-pathname)) + (stream (logical-pathname-designator-p (pathname x))))) + +-;(defvar *current-dir* (pathname (concatenate 'string (getcwd) "/"))) FIXME sync with chdir +- +-(defun truename (pd &aux (ppd (translate-logical-pathname pd))(ns (namestring ppd))) ++(defun truename (pd &aux (ns (namestring (translate-logical-pathname pd)))) + (declare (optimize (safety 1))) + (check-type pd pathname-designator) + (when (wild-pathname-p ns) + (error 'file-error :pathname pd :format-control "Pathname is wild")) +- (let* ((ns (ensure-dir-string (link-expand ns)))) ++ (let* ((ns (ensure-dir-string (link-expand ns)))(ppd (pathname ns))) + (unless (or (zerop (length ns)) (stat ns)) + (error 'file-error :pathname ns :format-control "Pathname does not exist")) + (let* ((d (pathname-directory ppd)) + (d1 (subst :back :up d)) + (ppd (if (eq d d1) ppd (make-pathname :directory d1 :defaults ppd)))) +- (if (eq (car d) :absolute) ppd (merge-pathnames ppd (concatenate 'string (getcwd) "/") nil))))) ++ (if (eq (car d) :absolute) ppd (merge-pathnames ppd *current-directory* nil))))) + + + (defun probe-file (pd &aux (pn (translate-logical-pathname pd))) +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -351,120 +351,86 @@ open_stream(object fn,enum smmode smm, o + vs_mark; + + coerce_to_filename(fn,FN1); +- if (smm == smm_input || smm == smm_probe) { +- if(FN1[0]=='|') +- fp = popen(FN1+1,"r"); +- else +- fp = fopen_not_dir(FN1, "r"); + +- if ((fp == NULL) && +- (sSAallow_gzipped_fileA->s.s_dbind != sLnil)) { +- union lispunion st; +- char buf[256]; +- if (snprintf(buf,sizeof(buf),"%s.gz",FN1)<=0) +- FEerror("Cannot write .gz filename",0); +- st.st.st_self=buf; +- st.st.st_dim=st.st.st_fillp=strlen(buf); +- set_type_of(&st,t_string); +- if (fSstat((object)&st)!=Cnil) { ++ switch(smm) { ++ ++ case smm_input: ++ case smm_probe: ++ ++ if (!(fp=*FN1=='|' ? popen(FN1+1,"r") : fopen_not_dir(FN1,"r")) && sSAallow_gzipped_fileA->s.s_dbind!=Cnil) { ++ ++ struct stat ss; ++ massert(snprintf(FN2,sizeof(FN2),"%s.gz",FN1)>0); ++ ++ if (!stat(FN2,&ss)) { ++ + FILE *pp; + int n; +- if (!(fp=tmpfile())) +- FEerror("Cannot create temporary file",0); +- if (snprintf(buf,sizeof(buf),"zcat %s.gz",FN1)<=0) +- FEerror("Cannot write zcat pipe name",0); +- if (!(pp=popen(buf,"r"))) +- FEerror("Cannot open zcat pipe",0); +- while((n=fread(buf,1,sizeof(buf),pp))) +- if (!fwrite(buf,1,n,fp)) +- FEerror("Cannot write pipe output to temporary file",0); +- if (pclose(pp)<0) +- FEerror("Cannot close zcat pipe",0); +- if (fseek(fp,0,SEEK_SET)) +- FEerror("Cannot rewind temporary file\n",0); ++ ++ massert((fp=tmpfile())); ++ massert(snprintf(FN3,sizeof(FN2),"zcat %s",FN2)>0); ++ massert(pp=popen(FN3,"r")); ++ while ((n=fread(FN4,1,sizeof(FN3),pp))) ++ massert(fwrite(FN4,1,n,fp)==n); ++ massert(pclose(pp)>=0); ++ massert(!fseek(fp,0,SEEK_SET)); ++ + } ++ + } +- if (fp == NULL) { +- if (if_does_not_exist == sKerror) +- cannot_open(fn); +- else if (if_does_not_exist == sKcreate) { +- fp = fopen_not_dir(FN1, "w"); +- if (fp == NULL) +- cannot_create(fn); ++ ++ if (!fp) { ++ ++ if (if_does_not_exist==sKerror) cannot_open(fn); ++ else if (if_does_not_exist==sKcreate) { ++ if (!(fp=fopen_not_dir(FN1,"w"))) cannot_create(fn); + fclose(fp); +- fp = fopen_not_dir(FN1, "r"); +- if (fp == NULL) +- cannot_open(fn); +- } else if (if_does_not_exist == Cnil) +- return(Cnil); +- else +- FEerror("~S is an illegal IF-DOES-NOT-EXIST option.", +- 1, if_does_not_exist); ++ if (!(fp=fopen_not_dir(FN1,"r"))) cannot_open(fn); ++ } else if (if_does_not_exist==Cnil) return(Cnil); ++ else FEerror("~S is an illegal IF-DOES-NOT-EXIST option.",1,if_does_not_exist); ++ + } +- } else if (smm == smm_output || smm == smm_io) { +- if (FN1[0] == '|') +- fp = NULL; +- else +- fp = fopen_not_dir(FN1, "r"); +- if (fp != NULL) { ++ break; ++ ++ case smm_output: ++ case smm_io: ++ ++ if ((fp=*FN1=='|' ? NULL : fopen_not_dir(FN1,"r"))) { ++ + fclose(fp); +- if (if_exists == sKerror) +- FILE_ERROR(fn,"File exists"); +- else if (if_exists == sKrename) { ++ if (if_exists==sKerror) FILE_ERROR(fn,"File exists"); ++ else if (if_exists==sKrename) { + massert(snprintf(FN2,sizeof(FN2),"%s.BAK",FN1)>=0); + massert(!rename(FN1,FN2)); +- if (smm == smm_output) +- fp = fopen(FN1, "w"); +- else +- fp = fopen(FN1, "w+"); +- if (fp == NULL) +- cannot_create(fn); +- } else if (if_exists == sKrename_and_delete || +- if_exists == sKnew_version || +- if_exists == sKsupersede) { +- if (smm == smm_output) +- fp = fopen_not_dir(FN1, "w"); +- else +- fp = fopen_not_dir(FN1, "w+"); +- if (fp == NULL) +- cannot_create(fn); +- } else if (if_exists == sKoverwrite) { +- fp = fopen_not_dir(FN1, "r+"); +- if (fp == NULL) +- cannot_open(fn); +- } else if (if_exists == sKappend) { +- if (smm == smm_output) +- fp = fopen_not_dir(FN1, "a"); +- else +- fp = fopen_not_dir(FN1, "a+"); +- if (fp == NULL) ++ if (!(fp=fopen(FN1,smm==smm_output ? "w" : "w+"))) cannot_create(fn); ++ } else if (if_exists==sKrename_and_delete || ++ if_exists==sKnew_version || ++ if_exists==sKsupersede) { ++ if (!(fp=fopen(FN1,smm==smm_output ? "w" : "w+"))) cannot_create(fn); ++ } else if (if_exists==sKoverwrite) { ++ if (!(fp=fopen_not_dir(FN1,"r+"))) cannot_open(fn); ++ } else if (if_exists==sKappend) { ++ if (!(fp = fopen_not_dir(FN1,smm==smm_output ? "a" : "a+"))) + FEerror("Cannot append to the file ~A.",1,fn); +- } else if (if_exists == Cnil) +- return(Cnil); +- else +- FEerror("~S is an illegal IF-EXISTS option.", +- 1, if_exists); ++ } else if (if_exists == Cnil) return(Cnil); ++ else FEerror("~S is an illegal IF-EXISTS option.",1,if_exists); ++ + } else { ++ + if (if_does_not_exist == sKerror) + FILE_ERROR(fn,"The file does not exist"); + else if (if_does_not_exist == sKcreate) { +- if (smm == smm_output) { +- if(FN1[0]=='|') +- fp = popen(FN1+1,"w"); +- else +- fp = fopen_not_dir(FN1, "w"); +- } else +- fp = fopen_not_dir(FN1, "w+"); +- if (fp == NULL) ++ if (!(fp=smm==smm_output ? (*FN1=='|' ? popen(FN1+1,"w") : fopen_not_dir(FN1, "w")) : fopen_not_dir(FN1, "w+"))) + cannot_create(fn); +- } else if (if_does_not_exist == Cnil) +- return(Cnil); +- else +- FEerror("~S is an illegal IF-DOES-NOT-EXIST option.", +- 1, if_does_not_exist); ++ } else if (if_does_not_exist==Cnil) return(Cnil); ++ else FEerror("~S is an illegal IF-DOES-NOT-EXIST option.",1,if_does_not_exist); + } +- } else ++ break; ++ ++ default: + FEerror("Illegal open mode for ~S.",1,fn); ++ break; ++ } + + vs_push(make_simple_string(FN1)); + x = alloc_object(t_stream); +@@ -600,10 +566,6 @@ close_stream(object strm) { + fclose(strm->sm.sm_fp); + strm->sm.sm_fp = NULL; + strm->sm.sm_fd = -1; +- if (strm->sm.sm_object0 && +- type_of(strm->sm.sm_object0 )==t_cons && +- Mcar(strm->sm.sm_object0)==sSAallow_gzipped_fileA) +- ifuncall1(sLdelete_file,Mcdr(strm->sm.sm_object0)); + break; + + case smm_file_synonym: +@@ -1762,9 +1724,7 @@ LFD(siLoutput_stream_string)() + } + + DEFUN_NEW("FILE-STREAM-P",object,fSfile_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +- RETURN1(type_of(x)==t_stream && +- (x->sm.sm_mode==smm_input || x->sm.sm_mode==smm_output || x->sm.sm_mode==smm_io || x->sm.sm_mode==smm_probe) +- ? Ct : Cnil); ++ RETURN1(type_of(x)==t_stream && file_synonym_stream_p(x) ? Ct : Cnil); + } + + DEFUN_NEW("SYNONYM-STREAM-P",object,fSsynonym_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +--- gcl-2.6.12.orig/o/unixfsys.c ++++ gcl-2.6.12/o/unixfsys.c +@@ -19,8 +19,6 @@ Foundation, 675 Mass Ave, Cambridge, MA + + */ + +-#include +-#include + #include + #include + +@@ -32,140 +30,17 @@ Foundation, 675 Mass Ave, Cambridge, MA + #include + #endif + +-#ifdef __MINGW32__ +-# include ++#ifdef __MINGW32__ ++# include + /* Windows has no symlink, therefore no lstat. Without symlinks lstat + is equivalent to stat anyway. */ + # define S_ISLNK(a) 0 + # define lstat stat +-#endif +- +-#ifdef BSD +-#define HAVE_RENAME + #endif + +-#ifdef NEED_GETWD +-#include +- +- +-#ifndef HAVE_GETCWD +-char dotdot[3*16+2] = "../../../../../../../../../../../../../../../../."; +-#include +-static char *getwd_buf; +-static int getwd_bufp; +- +-static char * +-getwd(buffer) +-char *buffer; +-{ +- getwd_buf = buffer; +- getwd1(0); +- if (getwd_bufp == 0) +- getwd_buf[getwd_bufp++] = '/'; +- getwd_buf[getwd_bufp] = '\0'; +- return(getwd_buf); +-} +- +-getwd1(n) +-int n; +-{ +- struct stat st, dev_st; +- struct direct dir; +- ino_t ino; +- struct mnttab mnt; +- FILE *fp; +- register int i; +- char buf[BUFSIZ]; +- static char dev_name[64]; +- +- if (stat(dotdot+(16-n)*3, &st) < 0) +- FEerror("Can't get the current working directory.", 0); +- ino = st.st_ino; +- if (ino == 2) +- goto ROOT; +- getwd1(n+1); +- fp = fopen(dotdot+(16-n-1)*3, "r"); +- if (fp == NULL) +- FEerror("Can't get the current working directory.", 0); +- setbuf(fp, buf); +- fread(&dir, sizeof(struct direct), 1, fp); +- fread(&dir, sizeof(struct direct), 1, fp); +- for (;;) { +- if (fread(&dir, sizeof(struct direct), 1, fp) <= 0) +- break; +- if (dir.d_ino == ino) +- goto FOUND; +- } +- fclose(fp); +- FEerror("Can't get the current working directory.", 0); +- +-FOUND: +- fclose(fp); +- getwd_buf[getwd_bufp++] = '/'; +- for (i = 0; i < DIRSIZ && dir.d_name[i] != '\0'; i++) +- getwd_buf[getwd_bufp++] = dir.d_name[i]; +- return; +- +-ROOT: +- fp = fopen("/etc/mnttab", "r"); +- if (fp == NULL) +- FEerror("Can't get the current working directory.", 0); +- setbuf(fp, buf); +- for (;;) { +- if (fread(&mnt, sizeof(struct mnttab), 1, fp) <= 0) +- break; +- if (mnt.mt_dev[0] != '/') { +- strcpy(dev_name, "/dev/dsk/"); +- strcat(dev_name, mnt.mt_dev); +- stat(dev_name, &dev_st); +- } else +- stat(mnt.mt_dev, &dev_st); +- if (dev_st.st_rdev == st.st_dev) +- goto DEV_FOUND; +- } +- fclose(fp); +- getwd_bufp = 0; +- return; +- +-DEV_FOUND: +- fclose(fp); +- getwd_bufp = 0; +- for (i = 0; mnt.mt_filsys[i] != '\0'; i++) +- getwd_buf[i] = mnt.mt_filsys[i]; +- /* BUG FIX by Grant J. Munsey */ +- if (i == 1 && *getwd_buf == '/') +- i = 0; /* don't add an empty directory name */ +- /* END OF BUG FIX */ +- getwd_bufp = i; +-} +-#endif /* not HAVE_GETCWD */ +-#endif +- +-#ifndef MAXPATHLEN +-#define MAXPATHLEN 512 +-#endif +- +- +-#ifdef HAVE_GETCWD +-char * +-getwd(char *buffer) { +-#ifndef _WIN32 +- char *getcwd(char *, size_t); +-#endif +- return(getcwd(buffer, MAXPATHLEN)); +-} +-#endif +- +- +-#define pcopy(a_,b_,c_,d_) ({\ +- unsigned _c=c_,_d=d_;\ +- if (_c+_d>=MAXPATHLEN-16) FEerror("Can't expand pathname ~a",1,namestring);\ +- bcopy(a_,b_+_c,_d);\ +- b_[_c+_d]=0;\ +- }) +- + static object + get_string(object x) { ++ + switch(type_of(x)) { + case t_symbol: + case t_string: +@@ -180,182 +55,110 @@ get_string(object x) { + case smm_io: + return get_string(x->sm.sm_object1); + case smm_file_synonym: +- case smm_synonym: + return get_string(x->sm.sm_object0->s.s_dbind); + } + } ++ + return Cnil; +-} + ++} + + void +-coerce_to_filename(object pathname,char *p) { ++coerce_to_filename1(object spec, char *p,unsigned sz) { + +- object namestring=get_string(pathname); +- unsigned e=namestring->st.st_fillp; +- char *q=namestring->st.st_self,*qe=q+e; ++ object namestring=get_string(spec); + +- if (pathname==Cnil||namestring==Cnil) +- FEerror ( "NIL argument.", 1, pathname ); +- +- if (*q=='~' && e) { ++ massert(namestring->st.st_fillpst.st_self,namestring->st.st_fillp); ++ p[namestring->st.st_fillp]=0; + +- unsigned m=0; +- char *s=++q,*c; ++#ifdef FIX_FILENAME ++ FIX_FILENAME(spec,p); ++#endif + +- for (;spw_dir,p,0,m=strlen(pwent->pw_dir)); +- +- } +-#endif ++ massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); ++ massert(rpw_name)); + +- pcopy(q,p,0,e); +- +-#ifdef FIX_FILENAME +- FIX_FILENAME(pathname,p); +-#endif +- + } + +-object sSAallow_gzipped_fileA; ++DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") { + +-bool +-file_exists(object file) +-{ +- char filename[MAXPATHLEN]; +- struct stat filestatus; ++ struct passwd *pwent,pw; ++ long r; + +- coerce_to_filename(file, filename); ++ massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); ++ massert(r filename) && +- ( ( *(p-1) == '/' ) || ( *(p-1) == '\\' ) ) ) { +- *(p-1) = '\0'; +- } +- } +-#endif +- +- if (stat(filename, &filestatus) >= 0 && !S_ISDIR(filestatus.st_mode)) +- { +-#ifdef AIX +- /* if /tmp/foo is not a directory /tmp/foo/ should not exist */ +- if (filename[strlen(filename)-1] == '/' && +- !( filestatus.st_mode & S_IFDIR)) +- return(FALSE); +-#endif +- +- return TRUE; +- } +- else +- if (sSAallow_gzipped_fileA->s.s_dbind != sLnil +- && (strcat(filename,".gz"), +- stat(filename, &filestatus) >= 0 && !S_ISDIR(filestatus.st_mode))) +- +- return TRUE; ++ if (nm->st.st_fillp==1) + +- else +- return(FALSE); +-} ++ if ((pw.pw_dir=getenv("HOME"))) ++ pwent=&pw; ++ else ++ massert(!getpwuid_r(getuid(),&pw,FN1,r,&pwent) && pwent); + +-FILE * +-fopen_not_dir(char *filename,char * option) { ++ else { + +- struct stat ss; ++ massert(nm->st.st_fillpst.st_self+1,nm->st.st_fillp-1); ++ FN2[nm->st.st_fillp-1]=0; + +- if (!stat(filename,&ss) && S_ISDIR(ss.st_mode)) +- return NULL; +- else +- return fopen(filename,option); ++ massert(!getpwnam_r(FN2,&pw,FN1,r,&pwent) && pwent); ++ ++ } ++ ++ massert(strlen(pwent->pw_dir)+2pw_dir,strlen(pwent->pw_dir)); ++ FN3[strlen(pwent->pw_dir)]='/'; ++ FN3[strlen(pwent->pw_dir)+1]=0; ++ RETURN1(make_simple_string(FN3)); + + } + ++#define FILE_EXISTS_P(a_,b_) !stat(a_,&b_) && S_ISREG(b_.st_mode) ++#define DIR_EXISTS_P(a_,b_) !stat(a_,&b_) && S_ISDIR(b_.st_mode) ++ + FILE * +-backup_fopen(char *filename, char *option) +-{ +- char backupfilename[MAXPATHLEN]; +- char command[MAXPATHLEN * 2]; ++fopen_not_dir(char *filename,char *option) { ++ ++ struct stat ss; ++ ++ return DIR_EXISTS_P(filename,ss) ? NULL : fopen(filename,option); + +- strcat(strcpy(backupfilename, filename), ".BAK"); +- sprintf(command, "mv %s %s", filename, backupfilename); +- msystem(command); +- return(fopen(filename, option)); + } + + int +-file_len(FILE *fp) +-{ +- struct stat filestatus; ++file_len(FILE *fp) {/*FIXME dir*/ + +- if (fstat(fileno(fp), &filestatus)==0) +- return(filestatus.st_size); +- else return 0; +-} ++ struct stat filestatus; + +-DEF_ORDINARY("DIRECTORY",sKdirectory,KEYWORD,""); +-DEF_ORDINARY("LINK",sKlink,KEYWORD,""); +-DEF_ORDINARY("FILE",sKfile,KEYWORD,""); ++ return fstat(fileno(fp), &filestatus) ? 0 : filestatus.st_size; + +-/* export these for AXIOM */ +-int gcl_putenv(char *s) {return putenv(s);} +-char *gcl_strncpy(char *d,const char *s,size_t z) {return strncpy(d,s,z);} +-char *gcl_strncpy_chk(size_t z) {char a[10],b[10];return strncpy(a,b,z);}/*compile in __strncpy_chk with FORTIFY_SOURCE*/ +-#ifdef __MINGW32__ +-#define uid_t int +-#endif +-uid_t gcl_geteuid(void) { +-#ifndef __MINGW32__ +- return geteuid(); +-#else +- return 0; +-#endif +-} +-uid_t gcl_getegid(void) { +-#ifndef __MINGW32__ +- return getegid(); +-#else +- return 0; +-#endif + } +-int gcl_dup2(int o,int n) {return dup2(o,n);} +-char *gcl_gets(char *s,int z) {return fgets(s,z,stdin);} +-int gcl_puts(const char *s) {int i=fputs(s,stdout);fflush(stdout);return i;} + ++bool ++file_exists(object x) { + +-int gcl_feof(void *v) {return feof(((FILE *)v));} +-int gcl_getc(void *v) {return getc(((FILE *)v));} +-int gcl_putc(int i,void *v) {return putc(i,((FILE *)v));} ++ struct stat ss; ++ ++ coerce_to_filename(x,FN1); + ++ return FILE_EXISTS_P(FN1,ss) ? TRUE : FALSE; + ++} ++ ++DEF_ORDINARY("DIRECTORY",sKdirectory,KEYWORD,""); ++DEF_ORDINARY("LINK",sKlink,KEYWORD,""); ++DEF_ORDINARY("FILE",sKfile,KEYWORD,""); + + DEFUNM_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + +@@ -381,6 +184,31 @@ DEFUNM_NEW("STAT",object,fSstat,SI,1,1,N + make_fixnum(ss.st_uid)); + } + ++#include ++#include ++#include ++#include ++ ++DEFUN_NEW("READLINKAT",object,fSreadlinkat,SI,2,2,NONE,OI,OO,OO,OO,(fixnum d,object s),"") { ++ ssize_t l,z1; ++ ++ check_type_string(&s); ++ /* l=s->st.st_hasfillp ? s->st.st_fillp : s->st.st_dim; */ ++ z1=length(s); ++ massert(z1st.st_self,z1); ++ FN1[z1]=0; ++ massert((l=readlinkat(d ? dirfd((DIR *)d) : AT_FDCWD,FN1,FN2,sizeof(FN2)))>=0 && l + + DEFUN_NEW("OPENDIR",object,fSopendir,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") { +- DIR *d; +- char filename[MAXPATHLEN]; + check_type_string(&x); +- memcpy(filename,x->st.st_self,x->st.st_fillp); +- filename[x->st.st_fillp]=0; +- d=opendir(filename); +- return (object)d; ++ coerce_to_filename(x,FN1); ++ return (object)opendir(FN1); + } + + #ifdef HAVE_D_TYPE +@@ -430,19 +254,27 @@ DEFUN_NEW("D-TYPE-LIST",object,fSd_type_ + MMcons(make_fixnum(DT_UNKNOWN),make_keyword("UNKNOWN")) + )); + } ++#else ++#define DT_UNKNOWN 0 + #endif + + DEFUN_NEW("READDIR",object,fSreaddir,SI,3,3,NONE,OI,IO,OO,OO,(fixnum x,fixnum y,object s),"") { ++ + struct dirent *e; + object z; + long tl; + size_t l; ++ + if (!x) RETURN1(Cnil); ++ + tl=telldir((DIR *)x); +-#ifdef HAVE_D_TYPE +- for (;(e=readdir((DIR *)x)) && y!=DT_UNKNOWN && e->d_type!=y;); ++ ++#ifndef HAVE_D_TYPE ++ y=DT_UNKNOWN; + #endif ++ for (;(e=readdir((DIR *)x)) && y!=DT_UNKNOWN && e->d_type!=y;); + if (!e) RETURN1(Cnil); ++ + if (s==Cnil) + z=make_simple_string(e->d_name); + else { +@@ -457,10 +289,13 @@ DEFUN_NEW("READDIR",object,fSreaddir,SI, + RETURN1(make_fixnum(l)); + } + } ++ + #ifdef HAVE_D_TYPE + if (y==DT_UNKNOWN) z=MMcons(z,make_fixnum(e->d_type)); + #endif ++ + RETURN1(z); ++ + } + + DEFUN_NEW("CLOSEDIR",object,fSclosedir,SI,1,1,NONE,OI,OO,OO,OO,(fixnum x),"") { +@@ -468,165 +303,174 @@ DEFUN_NEW("CLOSEDIR",object,fSclosedir,S + return Cnil; + } + +-DEFUN_NEW("MKDIR",object,fSmkdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +- +- char filename[MAXPATHLEN]; ++DEFUN_NEW("RENAME",object,fSrename,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { + + check_type_string(&x); ++ check_type_string(&y); + +- memcpy(filename,x->st.st_self,x->st.st_fillp); +- filename[x->st.st_fillp]=0; +- +-#ifdef __MINGW32__ +- if (mkdir(filename) < 0) +-#else +- if (mkdir(filename,01777) < 0) +-#endif +- FEerror("Cannot make the directory ~S.", 1, vs_base[0]); ++ coerce_to_filename(x,FN1); ++ coerce_to_filename(y,FN2); + +- RETURN1(x); ++ RETURN1(rename(FN1,FN2) ? Cnil : Ct); + + } + +-DEFUN_NEW("RMDIR",object,fSrmdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++DEFUN_NEW("UNLINK",object,fSunlink,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ + check_type_string(&x); + + coerce_to_filename(x,FN1); + +- RETURN1(rmdir(FN1) ? Cnil : Ct); ++ RETURN1(unlink(FN1) ? Cnil : Ct); + + } + + ++DEFUN_NEW("CHDIR1",object,fSchdir1,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + +-#include +-#include +-#include +-#include ++ check_type_string(&x); + +-DEFUN_NEW("READLINKAT",object,fSreadlinkat,SI,2,2,NONE,OI,OO,OO,OO,(fixnum d,object s),"") { +- char *b1,*b2=NULL; +- ssize_t l,z1,z2; +- check_type_string(&s); +- /* l=s->st.st_hasfillp ? s->st.st_fillp : s->st.st_dim; */ +- z1=length(s); +- massert((b1=alloca(z1+1))); +- memcpy(b1,s->st.st_self,z1); +- b1[z1]=0; +- for (l=z2=0;l>=z2;) { +- memset(b2,0,z2); +- z2+=z2+10; +- massert((b2=alloca(z2))); +- massert((l=readlinkat(d ? dirfd((DIR *)d) : AT_FDCWD,b1,b2,z2))>=0); +- } +- b2[l]=0; +- s=make_simple_string(b2); +- memset(b1,0,z1); +- memset(b2,0,z2); +- RETURN1(s); +-} ++ coerce_to_filename(x,FN1); + +-DEFUN_NEW("GETCWD",object,fSgetcwd,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { +- char *b=NULL; +- size_t z; +- object s; +- +- for (z=0;!(errno=0) && !getcwd(b,z) && errno==ERANGE;b=memset(b,0,z),z+=z+10,({massert((b=alloca(z)));})); +- massert((b=getcwd(b,z))); +- s=make_simple_string(b); +- memset(b,0,z); +- RETURN1(s); ++ RETURN1(chdir(FN1) ? Cnil : Ct); + + } + +-DEFUN_NEW("UID-TO-NAME",object,fSuid_to_name,SI,1,1,NONE,OI,OO,OO,OO,(fixnum uid),"") { +- struct passwd *pwent,pw; +- char *b; +- long r; ++DEFUN_NEW("MKDIR",object,fSmkdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + +- massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); +- massert(b=alloca(r)); ++ check_type_string(&x); + +- massert(!getpwuid_r(uid,&pw,b,r,&pwent)); ++ coerce_to_filename(x,FN1); + +- RETURN1(make_simple_string(pwent->pw_name)); ++ RETURN1(mkdir(FN1 ++#ifndef __MINGW32__ ++ ,01777 ++#endif ++ ) ? Cnil : Ct); + + } + +-DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") { ++DEFUN_NEW("RMDIR",object,fSrmdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ check_type_string(&x); + +- struct passwd *pwent,pw; +- char *b; +- long r; ++ coerce_to_filename(x,FN1); + +- massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); +- massert(b=alloca(r)); ++ RETURN1(rmdir(FN1) ? Cnil : Ct); + +- if (nm->st.st_fillp==1) ++} + +- if ((pw.pw_dir=getenv("HOME"))) +- pwent=&pw; +- else +- massert(!getpwuid_r(getuid(),&pw,b,r,&pwent)); ++DEFVAR("*LOAD-WITH-FREAD*",sSAload_with_freadA,SI,Cnil,""); + +- else { ++#ifdef _WIN32 + +- char *name; ++void * ++get_mmap(FILE *fp,void **ve) { + +- massert(name=alloca(nm->st.st_fillp)); +- memcpy(name,nm->st.st_self+1,nm->st.st_fillp-1); +- name[nm->st.st_fillp-1]=0; ++ int n; ++ void *st; ++ size_t sz; ++ HANDLE handle; ++ ++ massert((sz=file_len(fp))>0); ++ if (sSAload_with_freadA->s.s_dbind==Cnil) { ++ n=fileno(fp); ++ massert((n=fileno(fp))>2); ++ massert(handle = CreateFileMapping((HANDLE)_get_osfhandle(n), NULL, PAGE_WRITECOPY, 0, 0, NULL)); ++ massert(st=MapViewOfFile(handle,FILE_MAP_COPY,0,0,sz)); ++ CloseHandle(handle); ++ } else { ++ massert(st=malloc(sz)); ++ massert(fread(st,sz,1,fp)==1); ++ } + +- massert(!getpwnam_r(name,&pw,b,r,&pwent)); ++ *ve=st+sz; + +- } ++ return st; ++ ++} + +- massert((b=alloca(strlen(pwent->pw_dir)+2))); +- memcpy(b,pwent->pw_dir,strlen(pwent->pw_dir)); +- b[strlen(pwent->pw_dir)]='/'; +- b[strlen(pwent->pw_dir)+1]=0; +- RETURN1(make_simple_string(b)); ++int ++un_mmap(void *v1,void *ve) { ++ ++ if (sSAload_with_freadA->s.s_dbind==Cnil) ++ return UnmapViewOfFile(v1) ? 0 : -1; ++ else { ++ free(v1); ++ return 0; ++ } + + } + +-DEFUN_NEW("RENAME",object,fSrename,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { + +- check_type_string(&x); +- check_type_string(&y); ++#else + +- coerce_to_filename(x,FN1); +- coerce_to_filename(y,FN2); ++#include + +- RETURN1(rename(FN1,FN2) ? Cnil : Ct); ++void * ++get_mmap(FILE *fp,void **ve) { ++ ++ int n; ++ void *v1; ++ struct stat ss; ++ ++ massert((n=fileno(fp))>2); ++ massert(!fstat(n,&ss)); ++ if (sSAload_with_freadA->s.s_dbind==Cnil) { ++ massert((v1=mmap(0,ss.st_size,PROT_READ|PROT_WRITE,MAP_PRIVATE,n,0))!=(void *)-1); ++ } else { ++ massert(v1=malloc(ss.st_size)); ++ massert(fread(v1,ss.st_size,1,fp)==1); ++ } ++ ++ *ve=v1+ss.st_size; ++ return v1; + + } + +-DEFUN_NEW("UNLINK",object,fSunlink,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + +- coerce_to_filename(x,FN1); ++int ++un_mmap(void *v1,void *ve) { + +- RETURN1(unlink(FN1) ? Cnil : Ct); ++ if (sSAload_with_freadA->s.s_dbind==Cnil) ++ return munmap(v1,ve-v1); ++ else { ++ free(v1); ++ return 0; ++ } + + } + ++#endif + +-static void +-FFN(siLchdir)(void) +-{ +- char filename[MAXPATHLEN]; +- +- check_arg(1); +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- coerce_to_filename(vs_base[0], filename); +- +- if (chdir(filename) < 0) +- FEerror("Can't change the current directory to ~S.", +- 1, vs_base[0]); ++/* export these for AXIOM */ ++int gcl_putenv(char *s) {return putenv(s);} ++char *gcl_strncpy(char *d,const char *s,size_t z) {return strncpy(d,s,z);} ++char *gcl_strncpy_chk(size_t z) {char a[10],b[10];return strncpy(a,b,z);}/*compile in __strncpy_chk with FORTIFY_SOURCE*/ ++#ifdef __MINGW32__ ++#define uid_t int ++#endif ++uid_t gcl_geteuid(void) { ++#ifndef __MINGW32__ ++ return geteuid(); ++#else ++ return 0; ++#endif ++} ++uid_t gcl_getegid(void) { ++#ifndef __MINGW32__ ++ return getegid(); ++#else ++ return 0; ++#endif + } ++int gcl_dup2(int o,int n) {return dup2(o,n);} ++char *gcl_gets(char *s,int z) {return fgets(s,z,stdin);} ++int gcl_puts(const char *s) {int i=fputs(s,stdout);fflush(stdout);return i;} ++ ++int gcl_feof(void *v) {return feof(((FILE *)v));} ++int gcl_getc(void *v) {return getc(((FILE *)v));} ++int gcl_putc(int i,void *v) {return putc(i,((FILE *)v));} + + void + gcl_init_unixfsys(void) { +- +- make_si_function("CHDIR", siLchdir); +- + } +--- gcl-2.6.12.orig/o/unixsys.c ++++ gcl-2.6.12/o/unixsys.c +@@ -235,89 +235,6 @@ DEFUN_NEW("GETPID",object,fSgetpid,SI,0, + } + + +-DEFVAR("*LOAD-WITH-FREAD*",sSAload_with_freadA,SI,Cnil,""); +- +-#ifdef _WIN32 +- +-void * +-get_mmap(FILE *fp,void **ve) { +- +- int n; +- void *st; +- size_t sz; +- HANDLE handle; +- +- massert((sz=file_len(fp))>0); +- if (sSAload_with_freadA->s.s_dbind==Cnil) { +- n=fileno(fp); +- massert((n=fileno(fp))>2); +- massert(handle = CreateFileMapping((HANDLE)_get_osfhandle(n), NULL, PAGE_WRITECOPY, 0, 0, NULL)); +- massert(st=MapViewOfFile(handle,FILE_MAP_COPY,0,0,sz)); +- CloseHandle(handle); +- } else { +- massert(st=malloc(sz)); +- massert(fread(st,sz,1,fp)==1); +- } +- +- *ve=st+sz; +- +- return st; +- +-} +- +-int +-un_mmap(void *v1,void *ve) { +- +- if (sSAload_with_freadA->s.s_dbind==Cnil) +- return UnmapViewOfFile(v1) ? 0 : -1; +- else { +- free(v1); +- return 0; +- } +- +-} +- +- +-#else +- +-#include +- +-void * +-get_mmap(FILE *fp,void **ve) { +- +- int n; +- void *v1; +- struct stat ss; +- +- massert((n=fileno(fp))>2); +- massert(!fstat(n,&ss)); +- if (sSAload_with_freadA->s.s_dbind==Cnil) { +- massert((v1=mmap(0,ss.st_size,PROT_READ|PROT_WRITE,MAP_PRIVATE,n,0))!=(void *)-1); +- } else { +- massert(v1=malloc(ss.st_size)); +- massert(fread(v1,ss.st_size,1,fp)==1); +- } +- +- *ve=v1+ss.st_size; +- return v1; +- +-} +- +- +-int +-un_mmap(void *v1,void *ve) { +- +- if (sSAload_with_freadA->s.s_dbind==Cnil) +- return munmap(v1,ve-v1); +- else { +- free(v1); +- return 0; +- } +- +-} +- +-#endif +- + void + gcl_init_unixsys(void) { + diff --git a/patches/pathnames1.3 b/patches/pathnames1.3 new file mode 100644 index 00000000..311c6277 --- /dev/null +++ b/patches/pathnames1.3 @@ -0,0 +1,48 @@ +Description: + 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-40) unstable; urgency=medium + . + * pathnames1.2 + * Bug fix: "popen arguments not quoted causes trouble and security + issues", thanks to axel (Closes: #802203). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/802203 + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-14 + +--- gcl-2.6.12.orig/o/unixfsys.c ++++ gcl-2.6.12/o/unixfsys.c +@@ -83,7 +83,7 @@ DEFUN_NEW("UID-TO-NAME",object,fSuid_to_ + long r; + + massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); +- massert(r=0); +- massert(rst.st_fillp==1) + diff --git a/patches/pathnames1.4 b/patches/pathnames1.4 new file mode 100644 index 00000000..e52d8916 --- /dev/null +++ b/patches/pathnames1.4 @@ -0,0 +1,36 @@ +Description: + 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-41) unstable; urgency=medium + . + * pathnames1.3, kfreebsd fix +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-14 + +--- gcl-2.6.12.orig/o/unixfsys.c ++++ gcl-2.6.12/o/unixfsys.c +@@ -180,7 +180,7 @@ DEFUNM_NEW("STAT",object,fSstat,SI,1,1,N + RETURN4(S_ISDIR(ss.st_mode) ? sKdirectory : + (S_ISLNK(ss.st_mode) ? sKlink : sKfile), + make_fixnum(ss.st_size), +- make_fixnum(ss.st_ctime), ++ make_fixnum(ss.st_mtime), + make_fixnum(ss.st_uid)); + } + diff --git a/patches/pathnames1.5 b/patches/pathnames1.5 new file mode 100644 index 00000000..66b8ac0d --- /dev/null +++ b/patches/pathnames1.5 @@ -0,0 +1,10494 @@ +Description: + 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-41) unstable; urgency=medium + . + * pathnames1.4, kfreebsd fix +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-26 + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -488,20 +488,6 @@ Cannot compile ~a.~%" + (t (setq dir "."))) + (setq na (namestring + (make-pathname :name name :type (pathname-type(first args))))) +- #+(or dos winnt) +- (format nil "~a -I~a ~a ~a -c -w ~a -o ~a" +- *cc* +- (concatenate 'string si::*system-directory* "../h") +- (if (and (boundp '*c-debug*) *c-debug*) " -g " "") +- (case *speed* +- (3 *opt-three* ) +- (2 *opt-two*) +- (t "")) +- (namestring (make-pathname :type "c" :defaults (first args))) +- (namestring (make-pathname :type "o" :defaults (first args))) +- ) +- +- #-(or dos winnt) + (format nil "~a -I~a ~a ~a -c ~a -o ~a ~a" + *cc* + (concatenate 'string si::*system-directory* "../h") +@@ -527,8 +513,8 @@ Cannot compile ~a.~%" + #+expect-unresolved "-expect_unresolved '*'" + na na na)) + +- #+bsd ""; "-w" +- #-(or aix3 bsd irix3) " 2> /dev/null ") ++ #+(or winnt bsd) ""; "-w" ++ #-(or aix3 bsd winnt irix3) " 2> /dev/null ") + + + ) +@@ -543,30 +529,14 @@ Cannot compile ~a.~%" + (prep-win-path-acc finish (concatenate 'string acc start "~"))) + (concatenate 'string acc s)))) + +-#+winnt +-(defun no-device (c) +- (let* ((c (namestring (truename c))) +- (p (search ":" c))) +- (if p (subseq c (1+ p)) c))) +- +-;; #+winnt +-;; (defun prep-win-path (c o) +-;; (let* ((w si::*wine-detected*) +-;; (c (if w (no-device c) c)) +-;; (o (if w (no-device o) o))) +-;; (prep-win-path-acc (compiler-command c o) ""))) +- + (defun compiler-cc (c-pathname o-pathname) + (safe-system + (format + nil +- (prog1 +- #+irix5 (compiler-command c-pathname o-pathname ) +- #+vax "~a ~@[~*-O ~]-S -I. -w ~a ; as -J -W -o ~A ~A" +- #+(or system-v e15 dgux sgi ) "~a ~@[~*-O ~]-c -I. ~a 2> /dev/null" +- #+winnt (prep-win-path-acc (compiler-command c-pathname o-pathname) "") +- #-winnt (compiler-command c-pathname o-pathname) +- ) ++ #+vax "~a ~@[~*-O ~]-S -I. -w ~a ; as -J -W -o ~A ~A" ++ #+(or system-v e15 dgux sgi ) "~a ~@[~*-O ~]-c -I. ~a 2> /dev/null" ++ #+winnt (prep-win-path-acc (compiler-command c-pathname o-pathname) "") ++ #-(or vax system-v e15 dgux sgi) (compiler-command c-pathname o-pathname) + *cc* + (if (or (= *speed* 2) (= *speed* 3)) t nil) + (namestring c-pathname) +@@ -763,20 +733,9 @@ Cannot compile ~a.~%" + `(let ((,q (si::string-match ,x ,y ,@(when z (list z))))) + (if (= ,q -1) (length ,y) ,q))))) + +-(defun ts (s &optional (r "")) +- (declare (string s) (ignorable r)) +- #+winnt +- (if (not si::*wine-detected*) s +- (let* ((x (sml (fcr #u"[^ \n\t]") s)) +- (y (sml (fcr #u"[ \n\t]") s x)) +- (f (subseq s x y)) +- (l (subseq s y)) +- (k (when (> (length f) 0) (aref f 0))) +- (q (if (eql k #\") (string k) "")) +- (f (if (eql k #\") (subseq f 1 (1- (length f))) f)) +- (f (if (and k (not (eql k #\-))) (namestring (no-device f)) f))) +- (if k (concatenate 'string r q f q (ts l " ")) ""))) +- #-winnt s) ++(defun ts (s) ++ (declare (string s)) ++ s) + + (defun mdelete-file (x) + (delete-file (ts (namestring x)))) +@@ -795,8 +754,7 @@ Cannot compile ~a.~%" + raw)) + (map (merge-pathnames (make-pathname + :name (concatenate 'string (pathname-name raw) "_map")) raw)) +- #+winnt (raw (merge-pathnames (make-pathname :type "exe") raw)) +- ) ++ #+winnt (raw (merge-pathnames (make-pathname :type "exe") raw))) + + (with-open-file (st (namestring map) :direction :output)) + (safe-system +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -624,7 +624,6 @@ use + GNU_LD + LEADING_UNDERSCORE + EXTRA_LOBJS +-PRELINK_CHECK + O2FLAGS + O3FLAGS + NIFLAGS +@@ -678,6 +677,7 @@ EGREP + GREP + MAKEINFO + AWK ++GCL_CC + CPP + OBJEXT + EXEEXT +@@ -686,7 +686,7 @@ CPPFLAGS + LDFLAGS + CFLAGS + CC +-PROCESSOR_FLAGS ++PRELINK_CHECK + host_os + host_vendor + host_cpu +@@ -738,41 +738,38 @@ SHELL' + ac_subst_files='' + ac_user_opts=' + enable_option_checking ++enable_machine + enable_widecons + enable_safecdr + enable_safecdrdbg + enable_prelink +-enable_fastimmfix +-enable_holepage + enable_vssize + enable_bdssize + enable_ihssize + enable_frssize +-enable_machine +-enable_immfix +-enable_notify +-enable_tcltk +-enable_tkconfig +-enable_tclconfig + enable_infodir + enable_emacsdir +-enable_common_binary +-enable_japi +-enable_xdr + enable_xgcl + enable_dlopen + enable_statsysbfd + enable_dynsysbfd + enable_custreloc + enable_debug +-enable_gprof + enable_static + enable_pic +-enable_oldgmp ++enable_gprof + enable_dynsysgmp + with_x +-enable_readline ++enable_xdr ++enable_immfix ++enable_fastimmfix + enable_ansi ++enable_japi ++enable_readline ++enable_tcltk ++enable_tkconfig ++enable_tclconfig ++enable_notify + ' + ac_precious_vars='build_alias + host_alias +@@ -1410,51 +1407,37 @@ Optional Features: + --disable-option-checking ignore unrecognized --enable/--with options + --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) + --enable-FEATURE[=ARG] include FEATURE [ARG=yes] +-use a three word cons with simplified typing +-protect cdr from immfix and speed up type processing +-debug safecdr code +---enable-prelink will insist that the produced images may be prelinked +---enable-fastimmfix=XXXX will reject low immediate fixnums unless 1<&6; } + + } # ac_fn_c_check_member + ++# ac_fn_c_try_link LINENO ++# ----------------------- ++# Try to link conftest.$ac_ext, and return whether this succeeded. ++ac_fn_c_try_link () ++{ ++ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack ++ rm -f conftest.$ac_objext conftest$ac_exeext ++ if { { ac_try="$ac_link" ++case "(($ac_try" in ++ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; ++ *) ac_try_echo=$ac_try;; ++esac ++eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" ++$as_echo "$ac_try_echo"; } >&5 ++ (eval "$ac_link") 2>conftest.err ++ ac_status=$? ++ if test -s conftest.err; then ++ grep -v '^ *+' conftest.err >conftest.er1 ++ cat conftest.er1 >&5 ++ mv -f conftest.er1 conftest.err ++ fi ++ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 ++ test $ac_status = 0; } && { ++ test -z "$ac_c_werror_flag" || ++ test ! -s conftest.err ++ } && test -s conftest$ac_exeext && { ++ test "$cross_compiling" = yes || ++ test -x conftest$ac_exeext ++ }; then : ++ ac_retval=0 ++else ++ $as_echo "$as_me: failed program was:" >&5 ++sed 's/^/| /' conftest.$ac_ext >&5 ++ ++ ac_retval=1 ++fi ++ # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information ++ # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would ++ # interfere with the next link command; also delete a directory that is ++ # left behind by Apple's compiler. We do this before executing the actions. ++ rm -rf conftest.dSYM conftest_ipa8_conftest.oo ++ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno ++ as_fn_set_status $ac_retval ++ ++} # ac_fn_c_try_link ++ + # ac_fn_c_check_func LINENO FUNC VAR + # ---------------------------------- + # Tests whether FUNC exists, setting the cache variable VAR accordingly +@@ -2506,226 +2535,6 @@ ac_config_headers="$ac_config_headers h/ + VERSION=`cat majvers`.`cat minvers` + + +-# some parts of this configure script are taken from the tcl configure.in +- +-# +-# Arguments +-# +- +- +- +- +-# Check whether --enable-widecons was given. +-if test "${enable_widecons+set}" = set; then : +- enableval=$enable_widecons; +-$as_echo "#define WIDE_CONS 1" >>confdefs.h +- +-fi +- +- +- +-# Check whether --enable-safecdr was given. +-if test "${enable_safecdr+set}" = set; then : +- enableval=$enable_safecdr; +-else +- enable_safecdr="no" +-fi +- +-if test "$enable_safecdr" = "yes" ; then +- +-$as_echo "#define USE_SAFE_CDR 1" >>confdefs.h +- +-fi +-# Check whether --enable-safecdrdbg was given. +-if test "${enable_safecdrdbg+set}" = set; then : +- enableval=$enable_safecdrdbg; +-$as_echo "#define DEBUG_SAFE_CDR 1" >>confdefs.h +- +-fi +- +- +-# Check whether --enable-prelink was given. +-if test "${enable_prelink+set}" = set; then : +- enableval=$enable_prelink; PRELINK_CHECK=t +-else +- PRELINK_CHECK= +-fi +- +- +-# Check whether --enable-fastimmfix was given. +-if test "${enable_fastimmfix+set}" = set; then : +- enableval=$enable_fastimmfix; +-else +- enable_fastimmfix=64 +-fi +- +- +- +-# Check whether --enable-holepage was given. +-if test "${enable_holepage+set}" = set; then : +- enableval=$enable_holepage; +-cat >>confdefs.h <<_ACEOF +-#define HOLEPAGE $enable_holepage +-_ACEOF +- +-fi +- +- +-# Check whether --enable-vssize was given. +-if test "${enable_vssize+set}" = set; then : +- enableval=$enable_vssize; +-else +- enable_vssize=262144 +-fi +- +- +-cat >>confdefs.h <<_ACEOF +-#define VSSIZE $enable_vssize +-_ACEOF +- +- +-# Check whether --enable-bdssize was given. +-if test "${enable_bdssize+set}" = set; then : +- enableval=$enable_bdssize; +-else +- enable_bdssize=2048 +-fi +- +- +-cat >>confdefs.h <<_ACEOF +-#define BDSSIZE $enable_bdssize +-_ACEOF +- +- +-# Check whether --enable-ihssize was given. +-if test "${enable_ihssize+set}" = set; then : +- enableval=$enable_ihssize; +-else +- enable_ihssize=4096 +-fi +- +- +-cat >>confdefs.h <<_ACEOF +-#define IHSSIZE $enable_ihssize +-_ACEOF +- +- +-# Check whether --enable-frssize was given. +-if test "${enable_frssize+set}" = set; then : +- enableval=$enable_frssize; +-else +- enable_frssize=4096 +-fi +- +- +-cat >>confdefs.h <<_ACEOF +-#define FRSSIZE $enable_frssize +-_ACEOF +- +- +-# Check whether --enable-machine was given. +-if test "${enable_machine+set}" = set; then : +- enableval=$enable_machine; enable_machine=$enableval +-else +- enable_machine="" +-fi +- +- +-# Check whether --enable-immfix was given. +-if test "${enable_immfix+set}" = set; then : +- enableval=$enable_immfix; +-else +- enable_immfix=yes +-fi +- +- +-#AC_ARG_ENABLE(gmp,[ --enable-gmp=no will disable use of GMP gnu multiprecision arithmetic, (default is =yes)] , +-#[use_gmp=$enableval],[use_gmp="yes"]) +- +-use_gmp="yes" +- +-# Check whether --enable-notify was given. +-if test "${enable_notify+set}" = set; then : +- enableval=$enable_notify; enable_notify=$enableval +-else +- enable_notify="yes" +-fi +- +- +-# Check whether --enable-tcltk was given. +-if test "${enable_tcltk+set}" = set; then : +- enableval=$enable_tcltk; enable_tcltk=$enableval +-else +- enable_tcltk="yes" +-fi +- +- +-# Check whether --enable-tkconfig was given. +-if test "${enable_tkconfig+set}" = set; then : +- enableval=$enable_tkconfig; TK_CONFIG_PREFIX=$enableval +-else +- TK_CONFIG_PREFIX="unknown" +-fi +- +- +- +-# Check whether --enable-tclconfig was given. +-if test "${enable_tclconfig+set}" = set; then : +- enableval=$enable_tclconfig; TCL_CONFIG_PREFIX=$enableval +-else +- TCL_CONFIG_PREFIX="unknown" +-fi +- +- +-# Check whether --enable-infodir was given. +-if test "${enable_infodir+set}" = set; then : +- enableval=$enable_infodir; INFO_DIR=$enableval +-else +- INFO_DIR=$prefix/share/info +-fi +- +-INFO_DIR=`eval echo $INFO_DIR/` +- +-# Check whether --enable-emacsdir was given. +-if test "${enable_emacsdir+set}" = set; then : +- enableval=$enable_emacsdir; EMACS_SITE_LISP=$enableval +-else +- EMACS_SITE_LISP=$prefix/share/emacs/site-lisp +-fi +- +-EMACS_SITE_LISP=`eval echo $EMACS_SITE_LISP/` +- +-# Check whether --enable-common-binary was given. +-if test "${enable_common_binary+set}" = set; then : +- enableval=$enable_common_binary; use_common_binary=$enableval +-else +- use_common_binary="yes" +-fi +- +- +-# Check whether --enable-japi was given. +-if test "${enable_japi+set}" = set; then : +- enableval=$enable_japi; try_japi=$enableval +-else +- try_japi="no" +-fi +- +- +-# Check whether --enable-xdr was given. +-if test "${enable_xdr+set}" = set; then : +- enableval=$enable_xdr; enable_xdr=$enableval +-else +- enable_xdr="yes" +-fi +- +- +-# Check whether --enable-xgcl was given. +-if test "${enable_xgcl+set}" = set; then : +- enableval=$enable_xgcl; enable_xgcl=$enableval +-else +- enable_xgcl="yes" +-fi +- + + # + # Host information +@@ -2856,380 +2665,247 @@ fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: host=$host" >&5 + $as_echo "host=$host" >&6; } + +-PROCESSOR_FLAGS=${PROCESSOR_FLAGS:-""} +- + use=unknown +-TLDFLAGS="" + case $canonical in +- older) +- use=386-bsd;; +- +- sh4*linux*) +- use=sh4-linux;; +- +- *x86_64*linux*) +- use=amd64-linux;; +- +- *x86_64*kfreebsd*) +- use=amd64-kfreebsd;; +- +- *86*linux*) +- use=386-linux;; +- +- *86*kfreebsd*) +- use=386-kfreebsd;; +- +- *86*gnu*) +- use=386-gnu;; +- +-# m6800 not working with gcc-3.2 +- m68k*linux*) +- if test "$use_common_binary" = "yes"; then +- host=m68020-unknown-linux-gnu +- echo "The host is canonicalised to $host" +- fi +- use=m68k-linux;; +- +- alpha*linux*) +- use=alpha-linux;; +- +- mips*linux*) +- use=mips-linux;; +- +- mipsel*linux*) +- use=mipsel-linux;; +- +- sparc*linux*) +- use=sparc-linux;; +- +- aarch64*linux*) +- use=aarch64-linux;; +- +- arm*linux*) +- use=arm-linux;; +- +- s390*linux*) +- use=s390-linux;; +- +- ia64*linux*) +- use=ia64-linux;; +- +- hppa*linux*) +- use=hppa-linux;; +- +- powerpc*linux*) +- use=powerpc-linux;; +- +- powerpc-*-darwin*) +- use=powerpc-macosx;; +- +- *86*darwin*) +- use=386-macosx +- if test "$build_cpu" = "x86_64" ; then +- CFLAGS="-m64 $CFLAGS"; +- LDFLAGS="-m64 -Wl,-headerpad,72 -Wl,-no_pie $LDFLAGS"; +- else +- CFLAGS="-m32 $CFLAGS"; +- LDFLAGS="-m32 -Wl,-headerpad,56 -Wl,-no_pie $LDFLAGS"; ++ sh4*linux*) use=sh4-linux;; ++ *x86_64*linux*) use=amd64-linux;; ++ *x86_64*kfreebsd*) use=amd64-kfreebsd;; ++ *86*linux*) use=386-linux;; ++ *86*kfreebsd*) use=386-kfreebsd;; ++ *86*gnu*) use=386-gnu;; ++ m68k*linux*) use=m68k-linux;; ++ alpha*linux*) use=alpha-linux;; ++ mips*linux*) use=mips-linux;; ++ mipsel*linux*) use=mipsel-linux;; ++ sparc*linux*) use=sparc-linux;; ++ aarch64*linux*) use=aarch64-linux;; ++ arm*linux*) use=arm-linux;; ++ s390*linux*) use=s390-linux;; ++ ia64*linux*) use=ia64-linux;; ++ hppa*linux*) use=hppa-linux;; ++ powerpc*linux*) use=powerpc-linux;; ++ powerpc-*-darwin*) use=powerpc-macosx;; ++ *86*darwin*) use=386-macosx;; ++ i*mingw*|i*msys*) use=mingw;; ++ i*cygwin*) ++ if $CC -v 2>&1 | fgrep ming > /dev/null ; ++ then use=mingw ++ else use=gnuwin95 + fi;; ++ *openbsd*) use=FreeBSD;; ++ sparc-sun-solaris*) use=solaris;; ++ i?86-pc-solaris*) use=solaris-i386;; ++esac + +- alpha-dec-osf) +- use=alpha-osf1;; +- +- mips-dec-ultrix) +- use=dec3100;; +- +- old) +- use=dos-go32;; +- +- *86*-freebsd*) +- use=FreeBSD;; +- +- hp3*-*hpux*) +- use=hp300;; +- +- hp3*-*-*bsd*) +- use=hp300-bsd;; +- +- hppa*-*hpux*) +- use=hp800;; +- +- mips-sgi-irix) +- case $system in +- IRIX5*) +- use=irix5;; +- IRIX6*) +- use=irix6;; +- IRIX3*) +- use=sgi4d;; +- esac ;; +- +- +- m68k-apple-aux*) +- use=mac2;; +- +- old) +- use=mp386;; ++# Check whether --enable-machine was given. ++if test "${enable_machine+set}" = set; then : ++ enableval=$enable_machine; echo enable_machine=$enableval ; use=$enableval ++fi + +- *86-ncr-sysv4) +- use=ncr;; + +- *3-986-*netbsd*) +- use=NetBSD;; ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: use=$use" >&5 ++$as_echo "use=$use" >&6; } + +- old) +- use=NeXT;; ++def_dlopen="no" ++def_statsysbfd="no" ++def_custreloc="yes" ++def_oldgmp="no" ++def_pic="no"; ++def_static="no"; ++def_debug="no"; ++case $use in ++ *kfreebsd) ++ ln -snf linux.defs h/$use.defs;; ++ *gnu) ++ ln -snf linux.defs h/$use.defs;; ++ *linux) ++ ln -snf linux.defs h/$use.defs; ++ case $use in ++ ia64*) ++ def_dlopen="yes" ; def_custreloc="no" ;; ++ hppa*) ++ def_pic="yes" ;; ++ esac;; ++esac + +- old) +- use=NeXT30-m68k;; ++# Check whether --enable-widecons was given. ++if test "${enable_widecons+set}" = set; then : ++ enableval=$enable_widecons; if test "$enableval" = "yes" ; then ++$as_echo "#define WIDE_CONS 1" >>confdefs.h ++ fi ++fi + +- *86-*nextstep*) +- use=NeXT32-i386;; + +- *m68*-*nextstep*) +- use=NeXT32-m68k;; ++# Check whether --enable-safecdr was given. ++if test "${enable_safecdr+set}" = set; then : ++ enableval=$enable_safecdr; if test "$enableval" = "yes" ; then + +- *rs6000-*-aix4*) +- use=rios;; ++$as_echo "#define USE_SAFE_CDR 1" >>confdefs.h + +- *rs6000-*-aix3*) +- use=rios-aix3;; ++ # Check whether --enable-safecdrdbg was given. ++if test "${enable_safecdrdbg+set}" = set; then : ++ enableval=$enable_safecdrdbg; if test "$enableval" = "yes" ; then ++$as_echo "#define DEBUG_SAFE_CDR 1" >>confdefs.h ++ fi ++fi + +- old) +- use=rt_aix;; ++ fi ++fi + +- old) +- use=sgi;; + +- sparc-sun-solaris*) +- use=solaris;; ++# Check whether --enable-prelink was given. ++if test "${enable_prelink+set}" = set; then : ++ enableval=$enable_prelink; if test "$enable_prelink" = "yes" ; then PRELINK_CHECK=t; fi ++fi + +- i?86-pc-solaris*) +- use=solaris-i386;; + +- old) +- use=sun2r3;; + +- old) +- use=sun3;; ++# Check whether --enable-vssize was given. ++if test "${enable_vssize+set}" = set; then : ++ enableval=$enable_vssize; ++cat >>confdefs.h <<_ACEOF ++#define VSSIZE $enableval ++_ACEOF + +- m68*-sunos*) +- use=sun3-os4;; ++fi + +- old) +- use=sun386i;; ++# Check whether --enable-bdssize was given. ++if test "${enable_bdssize+set}" = set; then : ++ enableval=$enable_bdssize; ++cat >>confdefs.h <<_ACEOF ++#define BDSSIZE $enableval ++_ACEOF + +- sparc*sunos*) +- use=sun4;; ++fi + +- *86-sequent-dynix) +- use=symmetry;; ++# Check whether --enable-ihssize was given. ++if test "${enable_ihssize+set}" = set; then : ++ enableval=$enable_ihssize; ++cat >>confdefs.h <<_ACEOF ++#define IHSSIZE $enableval ++_ACEOF + +- u370*aix) +- use=u370_aix;; ++fi + +- old) +- use=vax;; ++# Check whether --enable-frssize was given. ++if test "${enable_frssize+set}" = set; then : ++ enableval=$enable_frssize; ++cat >>confdefs.h <<_ACEOF ++#define FRSSIZE $enableval ++_ACEOF + +- i*mingw*) +- if test "$use_common_binary" = "yes"; then +- host=i386-pc-mingw32 +- PROCESSOR_FLAGS="-march=i386 " +- echo "The host is canonicalised to $host" +- fi +- use=mingw;; ++fi + +- i*cygwin*) +- if $CC -v 2>&1 | fgrep ming > /dev/null ; +- then use=mingw +- else use=gnuwin95 +- fi;; + +- *openbsd*) +- # 'ld -Z' means disable W^X +- TLDFLAGS="$TLDFLAGS -Z" +- use=FreeBSD;; ++# Check whether --enable-infodir was given. ++if test "${enable_infodir+set}" = set; then : ++ enableval=$enable_infodir; INFO_DIR=$enableval ++else ++ INFO_DIR=$prefix/share/info ++fi + +-esac ++INFO_DIR=`eval echo $INFO_DIR/` + ++# Check whether --enable-emacsdir was given. ++if test "${enable_emacsdir+set}" = set; then : ++ enableval=$enable_emacsdir; EMACS_SITE_LISP=$enableval ++else ++ EMACS_SITE_LISP=$prefix/share/emacs/site-lisp ++fi + ++EMACS_SITE_LISP=`eval echo $EMACS_SITE_LISP/` + +-echo enable_machine=$enable_machine +-if test "x$enable_machine" != "x" ; then +- use=$enable_machine ++# Check whether --enable-xgcl was given. ++if test "${enable_xgcl+set}" = set; then : ++ enableval=$enable_xgcl; ++else ++ enable_xgcl=yes + fi + +-def_dlopen="no" +-def_statsysbfd="no" +-def_custreloc="yes" +-#def_statsysbfd="yes" +-#def_custreloc="no" +-def_locbfd="no" +-def_oldgmp="no" +-def_pic="no"; +-def_static="no"; +-def_debug="no"; +-case $use in +- *kfreebsd) +- ln -snf linux.defs h/$use.defs;; +- *gnu) +- ln -snf linux.defs h/$use.defs;; +- *linux) +- ln -snf linux.defs h/$use.defs; +- case $use in +-# def_static -- Function descriptors are currently realized at runtime in a non-reproducible fashion +-# on these architectures -- CM +- powerpc*) +-# if test "$host_cpu" = "powerpc64" ; then def_dlopen="yes" ; def_custreloc="no" ; fi +- ;; +- ia64*) +- def_dlopen="yes" ; def_custreloc="no" ;; +- hppa*) +- def_pic="yes" ;; +-# def_dlopen="yes" ; def_custreloc="no" ; def_pic="yes" ;; +- esac;; +-esac + + # Check whether --enable-dlopen was given. + if test "${enable_dlopen+set}" = set; then : + enableval=$enable_dlopen; + else +- enable_dlopen="$def_dlopen" ++ enable_dlopen=$def_dlopen + fi + + # Check whether --enable-statsysbfd was given. + if test "${enable_statsysbfd+set}" = set; then : + enableval=$enable_statsysbfd; + else +- enable_statsysbfd="$def_statsysbfd" ++ enable_statsysbfd=$def_statsysbfd + fi + + # Check whether --enable-dynsysbfd was given. + if test "${enable_dynsysbfd+set}" = set; then : + enableval=$enable_dynsysbfd; + else +- enable_dynsysbfd="no" ++ enable_dynsysbfd=no + fi + +-#AC_ARG_ENABLE(locbfd, +-# [ --enable-locbfd uses a static bfd library built from this source tree for loading and relocationing object files ] +-# ,,enable_locbfd="$def_locbfd") + # Check whether --enable-custreloc was given. + if test "${enable_custreloc+set}" = set; then : + enableval=$enable_custreloc; + else +- enable_custreloc="$def_custreloc" ++ enable_custreloc=$def_custreloc + fi + ++ + # Check whether --enable-debug was given. + if test "${enable_debug+set}" = set; then : + enableval=$enable_debug; + else +- enable_debug="$def_debug" +-fi +- +-# Check whether --enable-gprof was given. +-if test "${enable_gprof+set}" = set; then : +- enableval=$enable_gprof; +-else +- enable_gprof="no" ++ enable_debug=$def_debug + fi + + # Check whether --enable-static was given. + if test "${enable_static+set}" = set; then : +- enableval=$enable_static; enable_static=$enableval ++ enableval=$enable_static; + else +- enable_static="$def_static" ++ enable_static=$def_static + fi + + # Check whether --enable-pic was given. + if test "${enable_pic+set}" = set; then : + enableval=$enable_pic; + else +- enable_pic="$def_pic" +-fi +- +- +-# Check whether --enable-oldgmp was given. +-if test "${enable_oldgmp+set}" = set; then : +- enableval=$enable_oldgmp; +-else +- enable_oldgmp="$def_oldgmp" ++ enable_pic=$def_pic + fi + + +-# Check whether --enable-dynsysgmp was given. +-if test "${enable_dynsysgmp+set}" = set; then : +- enableval=$enable_dynsysgmp; +-else +- enable_dynsysgmp="yes" +-fi +- +- +-load_opt="0" ++load_opt=0 + if test "$enable_dlopen" = "yes" ; then +- load_opt=1 ++ load_opt=1 + fi + if test "$enable_statsysbfd" = "yes" ; then +- case $load_opt in +- 0) load_opt=1;; +- 1) load_opt=2;; +- esac ++ case $load_opt in ++ 0) load_opt=1;; ++ 1) load_opt=2;; ++ esac + fi + if test "$enable_dynsysbfd" = "yes" ; then +- case $load_opt in +- 0) load_opt=1;; +- 1) load_opt=2;; +- 2) load_opt=3;; +- esac +-fi +-if test "$enable_locbfd" = "yes" ; then +- case $load_opt in +- 0) load_opt=1;; +- 1) load_opt=2;; +- 2) load_opt=3;; +- 3) load_opt=4;; +- esac ++ case $load_opt in ++ 0) load_opt=1;; ++ 1) load_opt=2;; ++ 2) load_opt=3;; ++ esac + fi + if test "$enable_custreloc" = "yes" ; then +- case $load_opt in +- 0) load_opt=1;; +- 1) load_opt=2;; +- 2) load_opt=3;; +- 3) load_opt=4;; +- 4) load_opt=5;; +- esac ++ case $load_opt in ++ 0) load_opt=1;; ++ 1) load_opt=2;; ++ 2) load_opt=3;; ++ 3) load_opt=4;; ++ 4) load_opt=5;; ++ esac + fi + + if test "$load_opt" != "1" ; then +- echo "Exactly one loader option must be chosen: dlopen=$enable_dlopen statsysbfd=$enable_statsysbfd dynsysbfd=$enable_dynsysbfd locbfd=$enable_locbfd custreloc=$enable_custreloc" +- exit 1 ++ echo "Exactly one loader option must be chosen: dlopen=$enable_dlopen statsysbfd=$enable_statsysbfd dynsysbfd=$enable_dynsysbfd custreloc=$enable_custreloc" ++ as_fn_error $? "loader option failure" "$LINENO" 5 + fi + +-TLDFLAGS="" +-if test "$enable_static" = "yes" ; then +- TLDFLAGS="-static -Wl,-zmuldefs $TLDFLAGS"; #FIXME should be in unixport/makefile +- +-$as_echo "#define STATIC_LINKING 1" >>confdefs.h +- +-fi +-case $use in +- *gnuwin*) +- TLDFLAGS="$TLDFLAGS -Wl,--stack,8000000";; +-esac +- +-## finally warn if we did not find a recognized machine.s +-## +-#if test "$use" = "unknown" ; then +-#types=`echo h/*.defs` | sed -e "s:h/::g" -e "s:\.defs:g"` +-#echo got canonical=$canonical, but was not recognized. +-#echo Unable to guess type to use. Try one of +-#exit(1) +-#fi +- +-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: use=$use" >&5 +-$as_echo "use=$use" >&6; } +- + + # + # System programs +@@ -3238,10 +2914,10 @@ $as_echo "use=$use" >&6; } + # We set the default CFLAGS below, and don't want the autoconf default + # CM 20040106 + if test "$CFLAGS" = "" ; then +- CFLAGS=" " ++ CFLAGS=" " + fi + if test "$LDFLAGS" = "" ; then +- LDFLAGS=" " ++ LDFLAGS=" " + fi + + ac_ext=c +@@ -4171,74 +3847,90 @@ ac_link='$CC -o conftest$ac_exeext $CFLA + ac_compiler_gnu=$ac_cv_c_compiler_gnu + + ++GCL_CC=`basename $CC` ++if echo $GCL_CC |grep gcc |grep -q win; then ++ GCL_CC=gcc ++fi + + +-# can only test for numbers -- CM +-# if test "${GCC}" -eq "yes" ; then +-#if [[ "${GCC}" = "yes" ]] ; then +-# Allog for environment variable overrides on compiler selection -- CM +-#GCC=$CC +-#else +-#GCC="" +-#fi +-# subst GCC not only under 386-linux, but where available -- CM +- +-TCFLAGS="-fsigned-char -fno-builtin-malloc -fno-builtin-free" +- +-if test "$GCC" = "yes" ; then +- +- TCFLAGS="$TCFLAGS -Wall" ++add_arg_to_tcflags() { + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for clang" >&5 +-$as_echo_n "checking for clang... " >&6; } ++ local i=1 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFLAG $1" >&5 ++$as_echo_n "checking for CFLAG $1... " >&6; } ++ CFLAGS_ORI=$CFLAGS ++ CFLAGS="$CFLAGS -Werror $1 `echo $1|sed 's,-Wno-,-W,1'`" + + if test "$cross_compiling" = yes; then : +- { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +-as_fn_error $? "cannot run test program while cross compiling +-See \`config.log' for more details" "$LINENO" 5; } ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + ++int ++main () ++{ + +- int main() { +- return +- #ifdef __clang__ +- 0 +- #else +- 1 +- #endif +- ;} ++ ; ++ return 0; ++} + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +-$as_echo "yes" >&6; } +- clang="yes" +- TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign" +- +-$as_echo "#define CLANG 1" >>confdefs.h +- ++ TCFLAGS="$TCFLAGS $1";{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; };i=0 + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } +- #FIXME -Wno-unused-but-set-variable when time +- TMPF=-Wno-unused-but-set-variable +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFLAG $TMPF" >&5 +-$as_echo_n "checking for CFLAG $TMPF... " >&6; } +- CFLAGS_ORI=$CFLAGS +- CFLAGS="$CFLAGS $TMPF" +- if test "$cross_compiling" = yes; then : ++fi ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++fi ++ ++ CFLAGS=$CFLAGS_ORI ++ return $i ++ ++} ++ ++assert_arg_to_tcflags() { ++ if ! add_arg_to_tcflags $1 ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot add $1 to CFLAGS" >&5 ++$as_echo "cannot add $1 to CFLAGS" >&6; }; exit 1 ; fi ++ return 0 ++} ++ ++add_args_to_tcflags() { ++ ++ while test "$#" -ge 1 ; do ++ add_arg_to_tcflags $1 ++ shift ++ done ++} ++ ++add_arg_to_tldflags() { ++ ++ local i=1 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for LDFLAG $1" >&5 ++$as_echo_n "checking for LDFLAG $1... " >&6; } ++ LDFLAGS_ORI=$LDFLAGS ++ LDFLAGS="$LDFLAGS -Werror $1" ++ if test "$cross_compiling" = yes; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-int main() {return 0;} ++ ++int ++main () ++{ ++ ++ ; ++ return 0; ++} + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : +- TCFLAGS="$TCFLAGS $TMPF";{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +-$as_echo "yes" >&6; } ++ TLDFLAGS="$TLDFLAGS $1";{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; };i=0 + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } +@@ -4247,48 +3939,136 @@ rm -f core *.core core.conftest.* gmon.o + conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +- CFLAGS=$CFLAGS_ORI ++ LDFLAGS=$LDFLAGS_ORI ++ return $i ++ ++} ++ ++assert_arg_to_tldflags() { ++ if ! add_arg_to_tldflags $1 ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot add $1 to LDFLAGS" >&5 ++$as_echo "cannot add $1 to LDFLAGS" >&6; }; exit 1 ; fi ++ return 0 ++} ++ ++add_args_to_tldflags() { ++ ++ while test "$#" -ge 1 ; do ++ add_arg_to_tldflags $1 ++ shift ++ done ++} ++ ++remove_arg_from_ldflags() { ++ ++ NEW_LDFLAGS="" ++ for i in $LDFLAGS; do ++ if ! test "$i" = "$1" ; then ++ NEW_LDFLAGS="$NEW_LDFLAGS $i" ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: removing $1 from LDFLAGS" >&5 ++$as_echo "removing $1 from LDFLAGS" >&6; } ++ fi ++ done ++ LDFLAGS=$NEW_LDFLAGS ++ ++ return 0 ++ ++} ++ ++TCFLAGS="" ++add_args_to_tcflags -fsigned-char -pipe \ ++ -fno-builtin-malloc -fno-builtin-free \ ++ -fno-PIE -fno-pie -fno-PIC -fno-pic \ ++ -Wall \ ++ -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign \ ++ -Wno-unused-but-set-variable -Wno-misleading-indentation ++ ++TLDFLAGS="" ++add_args_to_tldflags -Wl,-no_pie -no-pie -Wl,-z,lazy ++ ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for clang" >&5 ++$as_echo_n "checking for clang... " >&6; } ++if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "cannot run test program while cross compiling ++See \`config.log' for more details" "$LINENO" 5; } ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++ ++ #ifdef __clang__ ++ #define RET 0 ++ #else ++ #define RET 1 ++ #endif ++ ++int ++main () ++{ ++ ++ return RET; ++ ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } ++ clang="yes" ++ remove_arg_from_ldflags -pie ++ ++$as_echo "#define CLANG 1" >>confdefs.h ++ ++else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + fi + rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +-fi + +-if test "$GCC" = "yes" ; then +- TCFLAGS="$TCFLAGS -pipe" +- case $use in +- *mingw*) +-# echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." +-# echo " It is otherwise needed for the Unexec stuff to work." +-# if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi +- TCFLAGS="$TCFLAGS -fno-zero-initialized-in-bss -mms-bitfields";; +- *gnuwin*) +-# echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." +-# echo " It is otherwise needed for the Unexec stuff to work." +-# if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi +- TCFLAGS="$TCFLAGS -fno-zero-initialized-in-bss -mms-bitfields";; +- esac +-fi +-#if test -f /proc/sys/kernel/exec-shield ; then +-# exec_stat=`cat /proc/sys/kernel/exec-shield` +-# if test "$exec_stat" != "0" ; then +-# # CFLAGS here to hopefully cover the DBEGIN routine below +-# CFLAGS="$CFLAGS -Wa,--execstack" +-# fi +-#fi ++case $use in ++ *mingw*) ++ assert_arg_to_tcflags -fno-zero-initialized-in-bss ++ assert_arg_to_tcflags -mms-bitfields;; ++ *gnuwin*) ++ assert_arg_to_tcflags -fno-zero-initialized-in-bss ++ assert_arg_to_tcflags -mms-bitfields ++ assert_arg_to_tldflags -Wl,--stack,8000000;; ++ 386-macosx) ++ assert_arg_to_tldflags -Wl,-no_pie ++ if test "$build_cpu" = "x86_64" ; then ++ assert_arg_to_tcflags -m64 ++ assert_arg_to_tldflags -m64 ++ assert_arg_to_tldflags -Wl,-headerpad,72 ++ else ++ assert_arg_to_tcflags -m32 ++ assert_arg_to_tldflags -m32 ++ assert_arg_to_tldflags -Wl,-headerpad,56 ++ fi;; ++ FreeBSD) assert_arg_to_tldflags -Z;; ++esac ++ ++if test "$enable_static" = "yes" ; then ++ assert_arg_to_tldflags -static ++ assert_arg_to_tldflags -Wl,-zmuldefs ++ ++$as_echo "#define STATIC_LINKING 1" >>confdefs.h ++ ++fi + + TO3FLAGS="" + TO2FLAGS="" + +-#TFPFLAG="-fomit-frame-pointer" +-# FIXME -- remove when mingw compiler issues are fixed + case "$use" in +- *mingw*) ++ *mingw*) + TFPFLAG="";; +- m68k*)#FIXME gcc 4.x bug workaround ++ m68k*)#FIXME gcc 4.x bug workaround + TFPFLAG="";; +- *) ++ *) + TFPFLAG="-fomit-frame-pointer";; + esac + +@@ -4335,143 +4115,104 @@ fi + done + + +-# Work around system/gprof mips/hppa hang +-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking working gprof" >&5 ++# Check whether --enable-gprof was given. ++if test "${enable_gprof+set}" = set; then : ++ enableval=$enable_gprof; if test "$enableval" = "yes" ; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking working gprof" >&5 + $as_echo_n "checking working gprof... " >&6; } +-old_enable_gprof=$enable_gprof +-case $use in +- powerpc*) if test "$host_cpu" = "powerpc64le" ; then enable_gprof="no"; fi;; +- sh4*) enable_gprof="no";; +- ia64*) enable_gprof="no";; +-# mips*) enable_gprof="no";; +- hppa*) enable_gprof="no";; +- arm*) enable_gprof="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible +- *gnu) enable_gprof="no";; +-esac +-if test "$enable_gprof" = "$old_enable_gprof" ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5 +-$as_echo "ok" >&6; } +-else +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: disabled" >&5 ++ case $use in ++ powerpc*) if test "$host_cpu" = "powerpc64le" ; then enableval="no"; fi;; ++ sh4*) enableval="no";; ++ ia64*) enableval="no";; ++ hppa*) enableval="no";; ++ arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++ *gnu) enableval="no";; ++ esac ++ if test "$enableval" != "yes" ; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: disabled" >&5 + $as_echo "disabled" >&6; } +-fi +- +-if test "$enable_gprof" = "yes" ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for text start" >&5 ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5 ++$as_echo "ok" >&6; } ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for text start" >&5 + $as_echo_n "checking for text start... " >&6; } +- echo 'int main () {return(0);}' >foo.c +- $CC foo.c -o foo +- GCL_GPROF_START=`nm foo | $AWK '/ *[TD] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc +- rm -f foo.c foo +- if test "$GCL_GPROF_START" != "" ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GCL_GPROF_START" >&5 ++ echo 'int main () {return(0);}' >foo.c ++ $CC foo.c -o foo ++ GCL_GPROF_START=`nm foo | $AWK '/ *[TD] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc ++ rm -f foo.c foo ++ if test "$GCL_GPROF_START" != "" ; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GCL_GPROF_START" >&5 + $as_echo "$GCL_GPROF_START" >&6; } + + cat >>confdefs.h <<_ACEOF + #define GCL_GPROF_START $GCL_GPROF_START + _ACEOF + +- case "$use" in +- arm*) +- #FIXME report and remove this when done +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: Reducing optimization on profiling arm build to workaround gcc bug" >&5 +-$as_echo "Reducing optimization on profiling arm build to workaround gcc bug" >&6; } +- enable_debug=yes;; +- esac +- TCFLAGS="$TCFLAGS -pg"; +- case $use in +- s390*) ;; # relocation truncation bug in gcc +- *) TLIBS="$TLIBS -pg";; +- esac +- TFPFLAG="" ++ assert_arg_to_tcflags -pg ++ case $use in ++ s390*) ;; # relocation truncation bug in gcc ++ *) TLIBS="$TLIBS -pg";; ++ esac ++ TFPFLAG="" + + $as_echo "#define GCL_GPROF 1" >>confdefs.h + +- else +- enable_gprof="no"; +- fi +-fi +- +-if $CC -v 2>&1 | tail -1 | grep "gcc version 4.6.1" >/dev/null ; then +- case "$use" in +- arm*) +- #FIXME report and remove this when done +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: Reducing optimization on arm build to workaround gcc 4.6 bug" >&5 +-$as_echo "Reducing optimization on arm build to workaround gcc 4.6 bug" >&6; } +- enable_debug=yes;; +- esac ++ fi ++ fi ++ fi + fi + + + if test "$enable_debug" = "yes" ; then +- TCFLAGS="$TCFLAGS -g" +- # for subconfigurations +- CFLAGS="$CFLAGS -g" ++ assert_arg_to_tcflags -g ++ # for subconfigurations ++ CFLAGS="$CFLAGS -g" + else +- TO3FLAGS="-O3 $TFPFLAG" +- TO2FLAGS="-O" ++ TO3FLAGS="-O3 $TFPFLAG" ++ TO2FLAGS="-O" + fi + + # gcc on ppc cannot compile our new_init.c with full opts --CM + TONIFLAGS="" + case $use in +- powerpc*macosx) +- TCFLAGS="$TCFLAGS -mlongcall";; +- *linux) ++ powerpc*macosx) assert_arg_to_tcflags -mlongcall;; ++ *linux) + case $use in +-# amd64*) # stack-boundary option does not work +-# TCFLAGS="$TCFLAGS -m64 -mpreferred-stack-boundary=8";; +- alpha*) +- TCFLAGS="$TCFLAGS -mieee" +- if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1 +- ;; +-# m68k*) +-# TCFLAGS="$TCFLAGS -ffloat-store";; +- aarch64*) +- TLIBS="$TLIBS -lgcc_s";; +- hppa*) +- TCFLAGS="$TCFLAGS -mlong-calls " +- TLIBS="$TLIBS -lgcc_s" # workaround hppa __moddi3 local func symbols with default linker flags +- if test "$enable_debug" != "yes" ; then TO3FLAGS="-O2" ; TFPFLAG=""; fi #FIXME needed asof gcc 4.8.1 +-# TCFLAGS="$TCFLAGS -ffunction-sections" +-# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O $TFPFLAG" ; fi +-# if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi +- ;; +- mips*) +- case $canonical in +- mips64*linux*) +- TLIBS="$TLIBS -Wl,-z -Wl,now";; +- esac +-# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 +- ;; +- ia64*) +- if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 +- ;; +- arm*) +- TCFLAGS="$TCFLAGS -mlong-calls -fdollars-in-identifiers -g " +-# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.6.2 +-# if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi +- ;; +- powerpc*) +- TCFLAGS="$TCFLAGS -mlongcall" +- ;; +-# if $CC -v 2>&1 | grep -q "gcc version 3.2" ; then +-# echo Reducing optimization for buggy gcc-3.2 +-# if test "$enable_debug" != "yes" ; then TONIFLAGS="-O $TFPFLAG" ; fi +-# fi; +-# echo Probing for longcall +-# if ! $CC -v 2>&1 | $AWK '/^gcc version / {split($3,A,".");if (A[[1]]+0>3 || (A[[1]]+0>=3 && A[[2]]+0>=3)) exit 1;}'; then +-# echo Enabling longcall on gcc 3.3 or later +-# TCFLAGS="$TCFLAGS -mlongcall" +-# echo Reducing optimization for buggy gcc 3.3 or later +-# if test "$enable_debug" != "yes" ; then TONIFLAGS="-O $TFPFLAG" ; fi +-# fi;; ++ alpha*) ++ assert_arg_to_tcflags -mieee ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1 ++ ;; ++ aarch64*) ++ TLIBS="$TLIBS -lgcc_s";; ++ hppa*) ++ assert_arg_to_tcflags -mlong-calls ++ TLIBS="$TLIBS -lgcc_s" # workaround hppa __moddi3 local func symbols with default linker flags ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O2" ; TFPFLAG=""; fi #FIXME needed asof gcc 4.8.1 ++ ;; ++ mips*) ++ case $canonical in ++ mips64*linux*) ++ assert_arg_to_tldflags -Wl,-z,now;; ++ esac ++ ;; ++ ia64*) ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 ++ ;; ++ arm*) ++ assert_arg_to_tcflags -mlong-calls ++ assert_arg_to_tcflags -fdollars-in-identifiers ++ assert_arg_to_tcflags -g #? ++ ;; ++ powerpc*) ++ assert_arg_to_tcflags -mlongcall ++ ;; + esac;; + esac + if test "$enable_pic" = "yes" ; then +- TCFLAGS="$TCFLAGS -fPIC" ++ assert_arg_to_tcflags -fPIC + fi + ++ + FDEBUG=`echo $CFLAGS | tr ' ' '\012' |grep "^\-g$"|tr '\012' ' '` + #CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-g$"` + FOMITF=`echo $CFLAGS | tr ' ' '\012' |grep "^\-fomit-frame-pointer$"|tr '\012' ' '` +@@ -4488,27 +4229,27 @@ FOOPT0=`echo $CFLAGS | tr ' ' '\012' |gr + CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-O0$"|tr '\012' ' '` + + if test "$FOOPT0" != "" ; then +- TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[123 ],-O0 ,g' | sed 's,\-O$,-O0 ,g'` +- TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[123 ],-O0 ,g' | sed 's,\-O$,-O0 ,g'` ++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[123 ],-O0 ,g' | sed 's,\-O$,-O0 ,g'` ++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[123 ],-O0 ,g' | sed 's,\-O$,-O0 ,g'` + else +-if test "$FOOPT1" != "" ; then +- TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[2-3],-O1,g'` +- TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[2-3],-O1,g'` +-else +-if test "$FOOPT2" != "" ; then +- TO3FLAGS=`echo "$TO3FLAGS" | sed 's,\-O3,-O2,g'` +- TO2FLAGS=`echo "$TO2FLAGS" | sed 's,\-O3,-O2,g'` +-fi +-fi ++ if test "$FOOPT1" != "" ; then ++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[2-3],-O1,g'` ++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[2-3],-O1,g'` ++ else ++ if test "$FOOPT2" != "" ; then ++ TO3FLAGS=`echo "$TO3FLAGS" | sed 's,\-O3,-O2,g'` ++ TO2FLAGS=`echo "$TO2FLAGS" | sed 's,\-O3,-O2,g'` ++ fi ++ fi + fi + + if test "$FDEBUG" != "" ; then +- TO3FLAGS=`echo $TO3FLAGS | sed 's,\-fomit-frame-pointer,,g'` +- TO2FLAGS=`echo $TO2FLAGS | sed 's,\-fomit-frame-pointer,,g'` ++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-fomit-frame-pointer,,g'` ++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-fomit-frame-pointer,,g'` + fi + + if test "$FOMITF" != "" ; then +- TO3FLAGS="$TO3FLAGS $FOMITF" ++ TO3FLAGS="$TO3FLAGS $FOMITF" + fi + + # Step 1: set the variable "system" to hold the name and version number +@@ -4569,8 +4310,8 @@ if test -f /usr/lib/NextStep/software_ve + else + system=`uname -s`-`uname -r` + if test "$?" -ne 0 ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: unknown (can't find uname command)" >&5 +-$as_echo "unknown (can't find uname command)" >&6; } ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: unknown (cannot find uname command)" >&5 ++$as_echo "unknown (cannot find uname command)" >&6; } + system=unknown + else + # Special check for weird MP-RAS system (uname returns weird +@@ -4588,7 +4329,7 @@ $as_echo "$system" >&6; } + fi + + case $use in +- *macosx) ++ *macosx) + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 + $as_echo_n "checking for grep that handles long lines and -e... " >&6; } +@@ -4864,7 +4605,7 @@ fi + done + + ac_fn_c_check_member "$LINENO" "struct _malloc_zone_t" "memalign" "ac_cv_member_struct__malloc_zone_t_memalign" " +- #include ++ #include + + " + if test "x$ac_cv_member_struct__malloc_zone_t_memalign" = xyes; then : +@@ -4877,7 +4618,6 @@ fi + ;; + esac + +- + for ac_header in setjmp.h + do : + ac_fn_c_check_header_mongrel "$LINENO" "setjmp.h" "ac_cv_header_setjmp_h" "$ac_includes_default" +@@ -4887,7 +4627,7 @@ if test "x$ac_cv_header_setjmp_h" = xyes + _ACEOF + { $as_echo "$as_me:${as_lineno-$LINENO}: checking sizeof jmp_buf" >&5 + $as_echo_n "checking sizeof jmp_buf... " >&6; } +- if test "$cross_compiling" = yes; then : ++ if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 + $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + as_fn_error $? "cannot run test program while cross compiling +@@ -4896,19 +4636,24 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + ++ #include ++ #include + +- #include +- #include +- int main() { +- FILE *fp=fopen("conftest1","w"); +- fprintf(fp,"%lu\n",sizeof(jmp_buf)); +- fclose(fp); +- return 0; +- } ++int ++main () ++{ ++ ++ FILE *fp=fopen("conftest1","w"); ++ fprintf(fp,"%lu\n",sizeof(jmp_buf)); ++ fclose(fp); ++ ++ ; ++ return 0; ++} + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + sizeof_jmp_buf=`cat conftest1` +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $sizeof_jmp_buf" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $sizeof_jmp_buf" >&5 + $as_echo "$sizeof_jmp_buf" >&6; } + + cat >>confdefs.h <<_ACEOF +@@ -4929,7 +4674,6 @@ done + + + # sysconf +- + for ac_header in unistd.h + do : + ac_fn_c_check_header_mongrel "$LINENO" "unistd.h" "ac_cv_header_unistd_h" "$ac_includes_default" +@@ -4944,52 +4688,6 @@ if ${ac_cv_lib_c_sysconf+:} false; then + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lc $LIBS" +- +-# ac_fn_c_try_link LINENO +-# ----------------------- +-# Try to link conftest.$ac_ext, and return whether this succeeded. +-ac_fn_c_try_link () +-{ +- as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack +- rm -f conftest.$ac_objext conftest$ac_exeext +- if { { ac_try="$ac_link" +-case "(($ac_try" in +- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; +- *) ac_try_echo=$ac_try;; +-esac +-eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +-$as_echo "$ac_try_echo"; } >&5 +- (eval "$ac_link") 2>conftest.err +- ac_status=$? +- if test -s conftest.err; then +- grep -v '^ *+' conftest.err >conftest.er1 +- cat conftest.er1 >&5 +- mv -f conftest.er1 conftest.err +- fi +- $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 +- test $ac_status = 0; } && { +- test -z "$ac_c_werror_flag" || +- test ! -s conftest.err +- } && test -s conftest$ac_exeext && { +- test "$cross_compiling" = yes || +- test -x conftest$ac_exeext +- }; then : +- ac_retval=0 +-else +- $as_echo "$as_me: failed program was:" >&5 +-sed 's/^/| /' conftest.$ac_ext >&5 +- +- ac_retval=1 +-fi +- # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information +- # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would +- # interfere with the next link command; also delete a directory that is +- # left behind by Apple's compiler. We do this before executing the actions. +- rm -rf conftest.dSYM conftest_ipa8_conftest.oo +- eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno +- as_fn_set_status $ac_retval +- +-} # ac_fn_c_try_link + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +@@ -5022,39 +4720,40 @@ $as_echo "$ac_cv_lib_c_sysconf" >&6; } + if test "x$ac_cv_lib_c_sysconf" = xyes; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: checking _SC_CLK_TCK" >&5 + $as_echo_n "checking _SC_CLK_TCK... " >&6; } +- if test "$cross_compiling" = yes; then : +- hz=0 ++ hz=0 ++ if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "cannot run test program while cross compiling ++See \`config.log' for more details" "$LINENO" 5; } + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include +- #include +- int +- main() { +- FILE *fp=fopen("conftest1","w"); +- fprintf(fp,"%lu\n",sysconf(_SC_CLK_TCK)); +- fclose(fp); +- return 0; +- } +-_ACEOF +-if ac_fn_c_try_run "$LINENO"; then : +- hz=`cat conftest1` + +-cat >>confdefs.h <<_ACEOF +-#define HZ $hz +-_ACEOF ++ #include ++ #include + ++int ++main () ++{ ++ ++ FILE *fp=fopen("conftest1","w"); ++ fprintf(fp,"%lu\n",sysconf(_SC_CLK_TCK)); ++ fclose(fp); ++ ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : + +-else +- hz=0 + fi + rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $hz" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $hz" >&5 + $as_echo "$hz" >&6; } +- + fi + + fi +@@ -5063,20 +4762,16 @@ done + + + +-#MY_SUBDIRS= +- +-# +-# GMP +-# +- + rm -f makedefsafter + +-MP_INCLUDE="" +-if test $use_gmp = yes ; then ++# Check whether --enable-dynsysgmp was given. ++if test "${enable_dynsysgmp+set}" = set; then : ++ enableval=$enable_dynsysgmp; ++fi ++ + +- PATCHED_SYMBOLS="" +- if test "$enable_dynsysgmp" = "yes" ; then +- for ac_header in gmp.h ++if test "$enable_dynsysgmp" != "no" ; then ++ for ac_header in gmp.h + do : + ac_fn_c_check_header_mongrel "$LINENO" "gmp.h" "ac_cv_header_gmp_h" "$ac_includes_default" + if test "x$ac_cv_header_gmp_h" = xyes; then : +@@ -5120,100 +4815,97 @@ fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gmp___gmpz_init" >&5 + $as_echo "$ac_cv_lib_gmp___gmpz_init" >&6; } + if test "x$ac_cv_lib_gmp___gmpz_init" = xyes; then : +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking \"for external gmp version\"" >&5 +-$as_echo_n "checking \"for external gmp version\"... " >&6; } +- if test "$cross_compiling" = yes; then : +- echo "Cannot use dynamic gmp lib" ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for external gmp version" >&5 ++$as_echo_n "checking for external gmp version... " >&6; } ++ if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "cannot run test program while cross compiling ++See \`config.log' for more details" "$LINENO" 5; } + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include +- int main() { +- #if __GNU_MP_VERSION > 3 +- return 0; +- #else +- return -1; +- #endif +- } ++ ++ #include ++ ++int ++main () ++{ ++ ++ #if __GNU_MP_VERSION > 3 ++ return 0; ++ #else ++ return -1; ++ #endif ++ ++ ; ++ return 0; ++} + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : +- # MPFILES=$GMPDIR/mpn/mul_n.o +-# PATCHED_SYMBOLS=__gmpn_toom3_mul_n +- MPFILES= +- PATCHED_SYMBOLS= +-# if test "$use" = "m68k-linux" ; then +-# MPFILES="$MPFILES $GMPDIR/mpn/lshift.o $GMPDIR/mpn/rshift.o" +-# PATCHED_SYMBOLS="$PATCHED_SYMBOLS __gmpn_lshift __gmpn_rshift" +-# fi +- TLIBS="$TLIBS -lgmp" +- echo "#include \"gmp.h\"" >foo.c +- echo "int main() {return 0;}" >>foo.c +- MP_INCLUDE=`cpp foo.c | $AWK '/(\/|\\\\)gmp.h/ {if (!i) print $3;i=1}' | tr -d '"'` +- rm -f foo.c +-else +- echo "Cannot use dynamic gmp lib" ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: good" >&5 ++$as_echo "good" >&6; } ++ TLIBS="$TLIBS -lgmp" ++ echo "#include \"gmp.h\"" >foo.c ++ echo "int main() {return 0;}" >>foo.c ++ MP_INCLUDE=`cpp foo.c | $AWK '/(\/|\\\\)gmp.h/ {if (!i) print $3;i=1}' | tr -d '"'` ++ rm -f foo.c + fi + rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +-else +- echo "Cannot use dynamic gmp lib" + fi + +-else +- echo "Cannot use dynamic gmp lib" + fi + + done + ++ ++ if test "$MP_INCLUDE" = "" ; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: Cannot use dynamic gmp lib" >&5 ++$as_echo "Cannot use dynamic gmp lib" >&6; } ++ fi ++ + fi + +-NEED_LOCAL_GMP='' ++ + if test "$MP_INCLUDE" = "" ; then +- NEED_LOCAL_GMP=1; +-fi +-if test "$PATCHED_SYMBOLS" != "" ; then +- NEED_LOCAL_GMP=1; +-fi + +-if test "$NEED_LOCAL_GMP" != "" ; then ++ GMPDIR=gmp4 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking doing configure in gmp directory" >&5 ++$as_echo_n "checking doing configure in gmp directory... " >&6; } ++ echo ++ echo "#" ++ echo "#" ++ echo "# -------------------" ++ echo "# Subconfigure of GMP" ++ echo "#" ++ echo "#" + +- GMPDIR=gmp4 +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking use_gmp=yes, doing configure in gmp directory" >&5 +-$as_echo_n "checking use_gmp=yes, doing configure in gmp directory... " >&6; } +- echo +- echo "#" +- echo "#" +- echo "# -------------------" +- echo "# Subconfigure of GMP" +- echo "#" +- echo "#" +- +- if test "$use_common_binary" = "yes"; then +- cd $GMPDIR && ./configure --build=$host && cd .. +- else +- cd $GMPDIR && ./configure && cd .. +- fi +- #MY_SUBDIRS="$MY_SUBDIRS $GMPDIR" +- +- echo "#" +- echo "#" +- echo "#" +- echo "# Subconfigure of GMP done" +- echo "# ------------------------" +- echo "#" +- +- if test "$MP_INCLUDE" = "" ; then +- cp $GMPDIR/gmp.h h/gmp.h +- MP_INCLUDE=h/gmp.h +- MPFILES=gmp_all +- fi ++ if test "$use_common_binary" = "yes"; then ++ cd $GMPDIR && ./configure --build=$host && cd .. ++ else ++ cd $GMPDIR && ./configure --host=$host --build=$build && cd .. ++ fi ++ #MY_SUBDIRS="$MY_SUBDIRS $GMPDIR" + ++ echo "#" ++ echo "#" ++ echo "#" ++ echo "# Subconfigure of GMP done" ++ echo "# ------------------------" ++ echo "#" ++ ++ if test "$MP_INCLUDE" = "" ; then ++ cp $GMPDIR/gmp.h h/gmp.h ++ MP_INCLUDE=h/gmp.h ++ MPFILES=gmp_all ++ fi + fi + +-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking \"for leading underscore in object symbols\"" >&5 +-$as_echo_n "checking \"for leading underscore in object symbols\"... " >&6; } ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for leading underscore in object symbols" >&5 ++$as_echo_n "checking for leading underscore in object symbols... " >&6; } + cat>foo.c < + #include +@@ -5221,15 +4913,15 @@ int main() {FILE *f;double d=0.0;getc(f) + EOFF + $CC -c foo.c -o foo.o + if nm foo.o |grep " U " | grep "_cos" >/dev/null || nm foo.o |grep " U " | grep " _getc" >/dev/null ; then +- LEADING_UNDERSCORE=1 ++ LEADING_UNDERSCORE=1 + + $as_echo "#define LEADING_UNDERSCORE 1" >>confdefs.h + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"yes\"" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"yes\"" >&5 + $as_echo "\"yes\"" >&6; } + else +- LEADING_UNDERSCORE="" +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"no\"" >&5 ++ LEADING_UNDERSCORE="" ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"no\"" >&5 + $as_echo "\"no\"" >&6; } + fi + +@@ -5239,16 +4931,16 @@ $as_echo_n "checking \"for GNU ld option + touch map + $CC -o foo -Wl,-Map map foo.o >/dev/null 2>&1 + if test `cat map | wc -l` != "0" ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"yes\"" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"yes\"" >&5 + $as_echo "\"yes\"" >&6; } + + $as_echo "#define HAVE_GNU_LD 1" >>confdefs.h + +- GNU_LD=1 ++ GNU_LD=1 + else +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"no\"" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"no\"" >&5 + $as_echo "\"no\"" >&6; } +- GNU_LD= ++ GNU_LD= + fi + rm -f foo.c foo.o foo map + +@@ -5263,17 +4955,16 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #include "$MP_INCLUDE" ++ #include ++ #include "$MP_INCLUDE" + + int + main () + { + +- FILE *fp=fopen("conftest1","w"); +- fprintf(fp,"%u",sizeof(mp_limb_t)); +- fclose(fp); +- return 0; ++ FILE *fp=fopen("conftest1","w"); ++ fprintf(fp,"%u",sizeof(mp_limb_t)); ++ fclose(fp); + + ; + return 0; +@@ -5307,18 +4998,18 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #include "$MP_INCLUDE" ++ #include ++ #include "$MP_INCLUDE" + + int + main () + { + +- #ifdef _SHORT_LIMB +- return 0; +- #else +- return 1; +- #endif ++ #ifdef _SHORT_LIMB ++ return 0; ++ #else ++ return 1; ++ #endif + + ; + return 0; +@@ -5349,18 +5040,18 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #include "$MP_INCLUDE" ++ #include ++ #include "$MP_INCLUDE" + + int + main () + { + +- #ifdef _LONG_LONG_LIMB +- return 0; +- #else +- return 1; +- #endif ++ #ifdef _LONG_LONG_LIMB ++ return 0; ++ #else ++ return 1; ++ #endif + + ; + return 0; +@@ -5380,17 +5071,17 @@ rm -f core *.core core.conftest.* gmon.o + fi + + +- GMP=1 ++GMP=1 + + $as_echo "#define GMP 1" >>confdefs.h + + + +- echo > makedefsafter +- echo "MPFILES=$MPFILES" >> makedefsafter +- echo "PATCHED_SYMBOLS=$PATCHED_SYMBOLS" >> makedefsafter +- echo >> makedefsafter +-fi ++echo > makedefsafter ++echo "MPFILES=$MPFILES" >> makedefsafter ++echo "PATCHED_SYMBOLS=$PATCHED_SYMBOLS" >> makedefsafter ++echo >> makedefsafter ++ + + + # +@@ -5399,7 +5090,7 @@ fi + + if test "$enable_xgcl" = "yes" ; then + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for X" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for X" >&5 + $as_echo_n "checking for X... " >&6; } + + +@@ -5592,24 +5283,14 @@ else + $as_echo "libraries $x_libraries, headers $x_includes" >&6; } + fi + +-# AC_PATH_XTRA +-# echo $X_CFLAGS +-# echo $X_LIBS +-# echo $X_EXTRA_LIBS +-# echo $X_PRE_LIBS +- +- miss=0 +-# AC_CHECK_LIB(Xmu,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS)#FIXME remove these +-# AC_CHECK_LIB(Xt,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS) +-# AC_CHECK_LIB(Xext,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS) +-# AC_CHECK_LIB(Xaw,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS)#until here +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lX11" >&5 ++ ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lX11" >&5 + $as_echo_n "checking for main in -lX11... " >&6; } + if ${ac_cv_lib_X11_main+:} false; then : + $as_echo_n "(cached) " >&6 + else + ac_check_lib_save_LIBS=$LIBS +-LIBS="-lX11 $X_LIBS $LIBS" ++LIBS="-lX11 $LIBS" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +@@ -5635,22 +5316,14 @@ fi + $as_echo "$ac_cv_lib_X11_main" >&6; } + if test "x$ac_cv_lib_X11_main" = xyes; then : + X_LIBS="$X_LIBS -lX11" ++$as_echo "#define HAVE_XGCL 1" >>confdefs.h ++ + else +- miss=1 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: missing x libraries -- cannot compile xgcl" >&5 ++$as_echo "missing x libraries -- cannot compile xgcl" >&6; } + fi + + +- if test "$miss" = "1" ; then +- X_CFLAGS= +- X_LIBS= +- X_EXTRA_LIBS= +- X_PRE_LIBS= +- echo missing x libraries -- cannot compile xgcl +- else +- +-$as_echo "#define HAVE_XGCL 1" >>confdefs.h +- +- fi + fi + + +@@ -5663,7 +5336,7 @@ fi + + if test "$enable_dlopen" = "yes" ; then + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 + $as_echo_n "checking for dlopen in -ldl... " >&6; } + if ${ac_cv_lib_dl_dlopen+:} false; then : + $as_echo_n "(cached) " >&6 +@@ -5700,25 +5373,27 @@ fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 + $as_echo "$ac_cv_lib_dl_dlopen" >&6; } + if test "x$ac_cv_lib_dl_dlopen" = xyes; then : +- have_dl=1 ++ cat >>confdefs.h <<_ACEOF ++#define HAVE_LIBDL 1 ++_ACEOF ++ ++ LIBS="-ldl $LIBS" ++ + else +- have_dl=0 ++ as_fn_error $? "Cannot find dlopen" "$LINENO" 5 + fi + +- if test "$have_dl" = "0" ; then +- echo "Cannot find dlopen in -dl" +- exit 1 +- fi + +- TLIBS="$TLIBS -ldl -rdynamic" +- TCFLAGS="-fPIC $TCFLAGS" ++ TLIBS="$TLIBS -ldl -rdynamic" ++ assert_arg_to_tcflags -fPIC + + $as_echo "#define USE_DLOPEN 1" >>confdefs.h + ++ + fi + + if test "$enable_statsysbfd" = "yes" || test "$enable_dynsysbfd" = "yes" ; then +- for ac_header in bfd.h ++ for ac_header in bfd.h + do : + ac_fn_c_check_header_mongrel "$LINENO" "bfd.h" "ac_cv_header_bfd_h" "$ac_includes_default" + if test "x$ac_cv_header_bfd_h" = xyes; then : +@@ -5763,18 +5438,28 @@ fi + $as_echo "$ac_cv_lib_bfd_bfd_init" >&6; } + if test "x$ac_cv_lib_bfd_bfd_init" = xyes; then : + # +- # Old binutils appear to need CONST defined to const +- # +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking if need to define CONST for bfd" >&5 +-$as_echo_n "checking if need to define CONST for bfd... " >&6; } +- if test "$cross_compiling" = yes; then : ++ # Old binutils appear to need CONST defined to const ++ # ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking need to define CONST for bfd" >&5 ++$as_echo_n "checking need to define CONST for bfd... " >&6; } ++ if test "$cross_compiling" = yes; then : + as_fn_error $? "cannot use bfd" "$LINENO" 5 + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#define IN_GCC +- #include +- int main() { symbol_info t; return 0;} ++ ++ #define IN_GCC ++ #include ++ ++int ++main () ++{ ++ ++ symbol_info t; ++ ++ ; ++ return 0; ++} + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +@@ -5785,10 +5470,20 @@ else + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#define CONST const +- #define IN_GCC +- #include +- int main() {symbol_info t; return 0;} ++ ++ #define CONST const ++ #define IN_GCC ++ #include ++ ++int ++main () ++{ ++ ++ symbol_info t; ++ ++ ; ++ return 0; ++} + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +@@ -5820,13 +5515,13 @@ done + $as_echo "#define HAVE_LIBBFD 1" >>confdefs.h + + +-# +-# BFD boolean syntax +-# ++ # ++ # BFD boolean syntax ++ # + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for useable bfd_boolean" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for useable bfd_boolean" >&5 + $as_echo_n "checking for useable bfd_boolean... " >&6; } +- if test "$cross_compiling" = yes; then : ++ if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 + $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + as_fn_error $? "cannot run test program while cross compiling +@@ -5835,14 +5530,14 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #define IN_GCC +- #include +- bfd_boolean foo() {return FALSE;} ++ #define IN_GCC ++ #include ++ bfd_boolean foo() {return FALSE;} + + int + main () + { +-return 0; ++ + ; + return 0; + } +@@ -5862,13 +5557,13 @@ rm -f core *.core core.conftest.* gmon.o + fi + + +-# +-# bfd_link_info.output_bfd minimal configure change check +-# +- +- ac_fn_c_check_member "$LINENO" "struct bfd_link_info" "output_bfd" "ac_cv_member_struct_bfd_link_info_output_bfd" " +- #include +- #include ++ # ++ # bfd_link_info.output_bfd minimal configure change check ++ # ++ ++ ac_fn_c_check_member "$LINENO" "struct bfd_link_info" "output_bfd" "ac_cv_member_struct_bfd_link_info_output_bfd" " ++ #include ++ #include + + " + if test "x$ac_cv_member_struct_bfd_link_info_output_bfd" = xyes; then : +@@ -5879,25 +5574,25 @@ fi + + + +-# +-# FIXME: Need to workaround mingw before this point -- CM +-# +- if test "$enable_statsysbfd" = "yes" && ! $CC -v 2>&1 | fgrep ming > /dev/null ; then +- echo 'int main() {bfd_init();bfd_openr("/dev/null",0);return 0;}' >foo.c +- MP=`$CC -Wl,-M -static -o foo foo.c -lbfd -liberty -ldl 2>&1 | grep -v : | tr '()' '\012\012' | $AWK '{print $NF}' | sort | uniq` +- rm -f foo.c foo +- if echo $MP | tr ' ' '\012' | grep libbfd.a >/dev/null; then +- LIBBFD="`echo $MP | tr ' ' '\012' | grep libbfd.a | $AWK '{i=split($1,A,"/");for (j=1;j<=i;j++) if (j>1 && A[j]=="..") {j--;i-=2;for (k=j;k<=i;k++) A[k]=A[k+2];j--;}} END {for (j=1;j<=i;j++) printf("%s%s",A[j],j!=i ? "/" : "")}'`" +- else +- as_fn_error $? "cannot locate external libbfd.a" "$LINENO" 5 +- fi +- if echo $MP | tr ' ' '\012' | grep libiberty.a >/dev/null ; then +- LIBIBERTY="`echo $MP | tr ' ' '\012' | grep libiberty.a | $AWK '{i=split($1,A,"/");for (j=1;j<=i;j++) if (j>1 && A[j]=="..") {j--;i-=2;for (k=j;k<=i;k++) A[k]=A[k+2];j--;}} END {for (j=1;j<=i;j++) printf("%s%s",A[j],j!=i ? "/" : "")}'`" +- else +- as_fn_error $? "cannot locate external libiberty.a" "$LINENO" 5 +- fi +- BUILD_BFD=copy_bfd +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inflate in -lz" >&5 ++ # ++ # FIXME: Need to workaround mingw before this point -- CM ++ # ++ if test "$enable_statsysbfd" = "yes" && ! $CC -v 2>&1 | fgrep ming > /dev/null ; then ++ echo 'int main() {bfd_init();bfd_openr("/dev/null",0);return 0;}' >foo.c ++ MP=`$CC -Wl,-M -static -o foo foo.c -lbfd -liberty -ldl 2>&1 | grep -v : | tr '()' '\012\012' | $AWK '{print $NF}' | sort | uniq` ++ rm -f foo.c foo ++ if echo $MP | tr ' ' '\012' | grep libbfd.a >/dev/null; then ++ LIBBFD="`echo $MP | tr ' ' '\012' | grep libbfd.a | $AWK '{i=split($1,A,\"/\");for (j=1;j<=i;j++) if (j>1 && A[j]==\"..\") {j--;i-=2;for (k=j;k<=i;k++) A[k]=A[k+2];j--;}} END {for (j=1;j<=i;j++) printf(\"%s%s\",A[j],j!=i ? \"/\" : \"\")}'`" ++ else ++ as_fn_error $? "cannot locate external libbfd.a" "$LINENO" 5 ++ fi ++ if echo $MP | tr ' ' '\012' | grep libiberty.a >/dev/null ; then ++ LIBIBERTY="`echo $MP | tr ' ' '\012' | grep libiberty.a | $AWK '{i=split($1,A,\"/\");for (j=1;j<=i;j++) if (j>1 && A[j]==\"..\") {j--;i-=2;for (k=j;k<=i;k++) A[k]=A[k+2];j--;}} END {for (j=1;j<=i;j++) printf(\"%s%s\",A[j],j!=i ? \"/\" : \"\")}'`" ++ else ++ as_fn_error $? "cannot locate external libiberty.a" "$LINENO" 5 ++ fi ++ BUILD_BFD=copy_bfd ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inflate in -lz" >&5 + $as_echo_n "checking for inflate in -lz... " >&6; } + if ${ac_cv_lib_z_inflate+:} false; then : + $as_echo_n "(cached) " >&6 +@@ -5939,7 +5634,7 @@ else + as_fn_error $? "Need zlib for bfd linking" "$LINENO" 5 + fi + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlsym in -ldl" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlsym in -ldl" >&5 + $as_echo_n "checking for dlsym in -ldl... " >&6; } + if ${ac_cv_lib_dl_dlsym+:} false; then : + $as_echo_n "(cached) " >&6 +@@ -5985,76 +5680,22 @@ fi + + + +- else +- TLIBS="$TLIBS -lbfd -liberty -ldl" +- fi ++ else ++ TLIBS="$TLIBS -lbfd -liberty -ldl" ++ fi + fi + +-if test "$enable_locbfd" = "yes" ; then +- +- # check for gettext. It is part of glibc, but others +- # need GNU gettext separately. +-# AC_CHECK_HEADERS(libintl.h, true, +-# AC_MSG_ERROR(libintl.h (gettext) not found)) +-# AC_SEARCH_LIBS(dgettext, intl, true, AC_MSG_ERROR(gettext library not found)) +- +- echo "#" +- echo "#" +- echo "# -------------------------" +- echo "# Subconfigure of LIBINTL" +- echo "#" +- echo "#" +- cd binutils/intl && chmod +x configure && ./configure --disable-nls && cd ../.. +-# MY_SUBDIRS="$MY_SUBDIRS binutils/libiberty " +- echo "#" +- echo "#" +- echo "#" +- echo "# Subconfigure of LIBINTL done" +- echo "# ------------------------------" +- echo "#" +- echo "#" +- echo "#" +- echo "# -------------------------" +- echo "# Subconfigure of LIBIBERTY" +- echo "#" +- echo "#" +- cd binutils/libiberty && chmod +x configure && ./configure --disable-nls && cd ../.. +-# MY_SUBDIRS="$MY_SUBDIRS binutils/libiberty " +- echo "#" +- echo "#" +- echo "#" +- echo "# Subconfigure of LIBIBERTY done" +- echo "# ------------------------------" +- echo "#" +- echo "#" +- echo "#" +- echo "# -------------------" +- echo "# Subconfigure of BFD" +- echo "#" +- echo "#" +- cd binutils/bfd && chmod +x configure && ./configure --with-included-gettext --disable-nls && cd ../.. +-# MY_SUBDIRS="$MY_SUBDIRS binutils/bfd " +- echo "#" +- echo "#" +- echo "#" +- echo "# Subconfigure of BFD done" +- echo "# ------------------------" +- echo "#" +-# TLIBS="$TLIBS `pwd`/binutils/bfd/libbfd.a `pwd`/binutils/libiberty/libiberty.a" +- +-$as_echo "#define HAVE_LIBBFD 1" >>confdefs.h +- +- BUILD_BFD="h/bfd.h h/bfdlink.h h/ansidecl.h h/symcat.h" +- ++# Check whether --enable-xdr was given. ++if test "${enable_xdr+set}" = set; then : ++ enableval=$enable_xdr; + fi + + +-if test "$enable_xdr" = "yes" ; then +- ac_fn_c_check_func "$LINENO" "xdr_double" "ac_cv_func_xdr_double" ++if test "$enable_xdr" != "no" ; then ++ XDR_LIB="" ++ ac_fn_c_check_func "$LINENO" "xdr_double" "ac_cv_func_xdr_double" + if test "x$ac_cv_func_xdr_double" = xyes; then : +- +-$as_echo "#define HAVE_XDR 1" >>confdefs.h +- ++ XDR_LIB=" " + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -ltirpc" >&5 + $as_echo_n "checking for xdr_double in -ltirpc... " >&6; } +@@ -6093,10 +5734,7 @@ fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tirpc_xdr_double" >&5 + $as_echo "$ac_cv_lib_tirpc_xdr_double" >&6; } + if test "x$ac_cv_lib_tirpc_xdr_double" = xyes; then : +- +-$as_echo "#define HAVE_XDR 1" >>confdefs.h +- +- TLIBS="$TLIBS -ltirpc" TCFLAGS="$TCFLAGS -I/usr/include/tirpc" ++ XDR_LIB=tirpc + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -lgssrpc" >&5 + $as_echo_n "checking for xdr_double in -lgssrpc... " >&6; } +@@ -6135,10 +5773,7 @@ fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gssrpc_xdr_double" >&5 + $as_echo "$ac_cv_lib_gssrpc_xdr_double" >&6; } + if test "x$ac_cv_lib_gssrpc_xdr_double" = xyes; then : +- +-$as_echo "#define HAVE_XDR 1" >>confdefs.h +- +- TLIBS="$TLIBS -lgssrpc" TCFLAGS="$TCFLAGS -I/usr/include/gssrpc" ++ XDR_LIB=gssrpc + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -lrpc" >&5 + $as_echo_n "checking for xdr_double in -lrpc... " >&6; } +@@ -6177,10 +5812,7 @@ fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_rpc_xdr_double" >&5 + $as_echo "$ac_cv_lib_rpc_xdr_double" >&6; } + if test "x$ac_cv_lib_rpc_xdr_double" = xyes; then : +- +-$as_echo "#define HAVE_XDR 1" >>confdefs.h +- +- TLIBS="$TLIBS -lrpc" TCFLAGS="$TCFLAGS -I/usr/include/rpc" ++ XDR_LIB=rpc + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -loncrpc" >&5 + $as_echo_n "checking for xdr_double in -loncrpc... " >&6; } +@@ -6219,10 +5851,7 @@ fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_oncrpc_xdr_double" >&5 + $as_echo "$ac_cv_lib_oncrpc_xdr_double" >&6; } + if test "x$ac_cv_lib_oncrpc_xdr_double" = xyes; then : +- +-$as_echo "#define HAVE_XDR 1" >>confdefs.h +- +- TLIBS="$TLIBS -loncrpc" TCFLAGS="$TCFLAGS -I/usr/include/oncrpc" ++ XDR_LIB=oncrpc + fi + + fi +@@ -6233,6 +5862,16 @@ fi + + fi + ++ ++ if test "$XDR_LIB" != ""; then ++ ++$as_echo "#define HAVE_XDR 1" >>confdefs.h ++ ++ if test "$XDR_LIB" != " "; then ++ TLIBS="$TLIBS -l$XDR_LIB" ++ add_arg_to_tcflags -I/usr/include/$XDR_LIB ++ fi ++ fi + fi + + +@@ -6247,18 +5886,24 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #include +- int main() { +- unsigned long u; +- long j; +- if (__builtin_clzl(0)!=sizeof(long)*8) +- return -1; +- for (u=1,j=sizeof(long)*8-1;j>=0;j--,u<<=1) +- if (__builtin_clzl(u)!=j) +- return -1; +- return 0; +- } ++ #include ++ #include ++ ++int ++main () ++{ ++ ++ unsigned long u; ++ long j; ++ if (__builtin_clzl(0)!=sizeof(long)*8) ++ return -1; ++ for (u=1,j=sizeof(long)*8-1;j>=0;j--,u<<=1) ++ if (__builtin_clzl(u)!=j) ++ return -1; ++ ++ ; ++ return 0; ++} + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +@@ -6286,18 +5931,24 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #include +- int main() { +- unsigned long u; +- long j; +- if (__builtin_ctzl(0)!=sizeof(long)*8) +- return -1; +- for (u=1,j=0;j ++ #include ++ ++int ++main () ++{ ++ ++ unsigned long u; ++ long j; ++ if (__builtin_ctzl(0)!=sizeof(long)*8) ++ return -1; ++ for (u=1,j=0;j&5 +@@ -6316,13 +5967,13 @@ fi + + + case $use in +- sh4*) ;; #FIXME, these exceptions needed as of gcc 4.7 +- hppa*) ;; #FIXME +- powerpc*) ;; #FIXME +- alpha*) ;; #FIXME +- ia64*) ;; #FIXME +- *) +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking __builtin___clear_cache" >&5 ++ sh4*) ;; #FIXME, these exceptions needed as of gcc 4.7 ++ hppa*) ;; #FIXME ++ powerpc*) ;; #FIXME ++ alpha*) ;; #FIXME ++ ia64*) ;; #FIXME ++ *) ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking __builtin___clear_cache" >&5 + $as_echo_n "checking __builtin___clear_cache... " >&6; } + if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +@@ -6333,7 +5984,6 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- + int + main () + { +@@ -6349,7 +5999,7 @@ if ac_fn_c_try_run "$LINENO"; then : + + $as_echo "#define HAVE_BUILTIN_CLEAR_CACHE 1" >>confdefs.h + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +@@ -6414,13 +6064,10 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- +- + int + main () + { + +- + /* Are we little or big endian? Adapted from Harbison&Steele. */ + union {long l;char c[sizeof(long)];} u; + u.l = 1; +@@ -6459,8 +6106,6 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- +- + int + main () + { +@@ -6494,8 +6139,8 @@ fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pagewidth" >&5 + $as_echo_n "checking for pagewidth... " >&6; } + case $use in +- mips*) min_pagewidth=14;; +- *) min_pagewidth=12;; ++ mips*) min_pagewidth=14;; ++ *) min_pagewidth=12;; + esac + if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +@@ -6506,23 +6151,21 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- +- #include +- #include +- #ifdef __CYGWIN__ +- #define getpagesize() 4096 +- #endif ++ #include ++ #include ++ #ifdef __CYGWIN__ ++ #define getpagesize() 4096 ++ #endif + + int + main () + { + +- size_t i=getpagesize(),j; +- FILE *fp=fopen("conftest1","w"); +- for (j=0;i>>=1;j++); +- j=j<$min_pagewidth ? $min_pagewidth : j; +- fprintf(fp,"%u",j); +- return 0; ++ size_t i=getpagesize(),j; ++ FILE *fp=fopen("conftest1","w"); ++ for (j=0;i>>=1;j++); ++ j=j<$min_pagewidth ? $min_pagewidth : j; ++ fprintf(fp,"%u",j); + + ; + return 0; +@@ -6557,27 +6200,27 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #define EXTER +- #define INLINE +- #include "$MP_INCLUDE" +- #include "./h/enum.h" +- #define OBJ_ALIGN +- #include "./h/type.h" +- #include "./h/lu.h" +- #include "./h/object.h" ++ #include ++ #define EXTER ++ #define INLINE ++ #include "$MP_INCLUDE" ++ #include "./h/enum.h" ++ #define OBJ_ALIGN ++ #include "./h/type.h" ++ #include "./h/lu.h" ++ #include "./h/object.h" + + int + main () + { + +- unsigned long i; +- FILE *fp=fopen("conftest1","w"); +- for (i=1;i && NOT_OBJECT_ALIGNED(i); i<<=1); +- if (!i) return -1; +- fprintf(fp,"%lu",i); +- fclose(fp); +- return 0; ++ unsigned long i; ++ FILE *fp=fopen("conftest1","w"); ++ for (i=1;i && NOT_OBJECT_ALIGNED(i); i<<=1); ++ if (!i) return -1; ++ fprintf(fp,"%lu",i); ++ fclose(fp); ++ return 0; + + ; + return 0; +@@ -6585,7 +6228,7 @@ main () + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + obj_align=`cat conftest1` +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $obj_align" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $obj_align" >&5 + $as_echo "$obj_align" >&6; } + + cat >>confdefs.h <<_ACEOF +@@ -6615,8 +6258,8 @@ int + main () + { + +- char *v __attribute__ ((aligned ($obj_align))); +- return 0; ++ char *v __attribute__ ((aligned ($obj_align))); ++ + ; + return 0; + } +@@ -6653,8 +6296,8 @@ int + main () + { + +- extern int v() __attribute__ ((noreturn)); +- return 0; ++ extern int v() __attribute__ ((noreturn)); ++ + ; + return 0; + } +@@ -6679,68 +6322,43 @@ _ACEOF + { $as_echo "$as_me:${as_lineno-$LINENO}: checking sizeof struct contblock" >&5 + $as_echo_n "checking sizeof struct contblock... " >&6; } + +-# work around MSYS pwd result incompatibility +-if test "$use" = "mingw" ; then + if test "$cross_compiling" = yes; then : +- echo Cannot find sizeof struct contblock;exit 1 ++ as_fn_error $? "Cannot find sizeof struct contblock" "$LINENO" 5 + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include +- #define EXTER +- #define INLINE +- #include "$MP_INCLUDE" +- #include "h/enum.h" +- #include "h/type.h" +- #include "h/lu.h" +- #include "h/object.h" +- int main(int argc,char **argv,char **envp) { +- FILE *f=fopen("conftest1","w"); +- fprintf(f,"%u",sizeof(struct contblock)); +- fclose(f); +- return 0; +- } +-_ACEOF +-if ac_fn_c_try_run "$LINENO"; then : +- sizeof_contblock=`cat conftest1` +-else +- echo Cannot find sizeof struct contblock;exit 1 +-fi +-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ +- conftest.$ac_objext conftest.beam conftest.$ac_ext +-fi + +-else +-if test "$cross_compiling" = yes; then : +- echo Cannot find sizeof struct contblock;exit 1 +-else +- cat confdefs.h - <<_ACEOF >conftest.$ac_ext +-/* end confdefs.h. */ +-#include +- #define EXTER +- #define INLINE +- #include "$MP_INCLUDE" +- #include "`pwd`/h/enum.h" +- #include "`pwd`/h/type.h" +- #include "`pwd`/h/lu.h" +- #include "`pwd`/h/object.h" +- int main(int argc,char **argv,char **envp) { +- FILE *f=fopen("conftest1","w"); +- fprintf(f,"%u",sizeof(struct contblock)); +- fclose(f); +- return 0; +- } ++ #include ++ #define EXTER ++ #define INLINE ++ #include "$MP_INCLUDE" ++ #include "h/enum.h" ++ #include "h/type.h" ++ #include "h/lu.h" ++ #include "h/object.h" ++ ++int ++main () ++{ ++ ++ FILE *f=fopen("conftest1","w"); ++ fprintf(f,"%u",sizeof(struct contblock)); ++ fclose(f); ++ ++ ; ++ return 0; ++} + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + sizeof_contblock=`cat conftest1` + else +- echo Cannot find sizeof struct contblock;exit 1 ++ as_fn_error $? "Cannot find sizeof struct contblock" "$LINENO" 5 + fi + rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +-fi ++ + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $sizeof_contblock" >&5 + $as_echo "$sizeof_contblock" >&6; } + +@@ -6758,19 +6376,25 @@ $as_echo "no: WARNING you must be able t + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include +- #include +- int main() { ++ ++ #include ++ #include ++ ++int ++main () ++{ ++ + FILE *f; + if (!(f=fopen("conftest1","w"))) +- return -1; +- fprintf(f,"%u",sbrk(0)); +- return 0; +- } ++ return -1; ++ fprintf(f,"%u",sbrk(0)); ++ ++ ; ++ return 0; ++} + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : +- HAVE_SBRK=1 +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ HAVE_SBRK=1;{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no: WARNING you must be able to emulate sbrk: as on mingw or macosx" >&5 +@@ -6782,16 +6406,16 @@ fi + + + if test "$use" = "386-macosx" ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: emulating sbrk for mac" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: emulating sbrk for mac" >&5 + $as_echo "emulating sbrk for mac" >&6; }; +- HAVE_SBRK=0 ++ HAVE_SBRK=0 + fi + + if test "$HAVE_SBRK" = "1" ; then + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ADDR_NO_RANDOMIZE constant" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ADDR_NO_RANDOMIZE constant" >&5 + $as_echo_n "checking for ADDR_NO_RANDOMIZE constant... " >&6; } +- if test "$cross_compiling" = yes; then : ++ if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 + $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + as_fn_error $? "cannot run test program while cross compiling +@@ -6800,18 +6424,16 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- +- #include +- #include ++ #include ++ #include + + int + main () + { + +- FILE *f; +- if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%x",ADDR_NO_RANDOMIZE); +- return 0; ++ FILE *f; ++ if (!(f=fopen("conftest1","w"))) return -1; ++ fprintf(f,"%x",ADDR_NO_RANDOMIZE); + + ; + return 0; +@@ -6819,11 +6441,11 @@ main () + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + ADDR_NO_RANDOMIZE=`cat conftest1` +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes $ADDR_NO_RANDOMIZE" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes $ADDR_NO_RANDOMIZE" >&5 + $as_echo "yes $ADDR_NO_RANDOMIZE" >&6; } + else + ADDR_NO_RANDOMIZE=0 +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no assuming 0x40000" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no assuming 0x40000" >&5 + $as_echo "no assuming 0x40000" >&6; } + + cat >>confdefs.h <<_ACEOF +@@ -6836,9 +6458,9 @@ rm -f core *.core core.conftest.* gmon.o + fi + + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ADDR_COMPAT_LAYOUT constant" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ADDR_COMPAT_LAYOUT constant" >&5 + $as_echo_n "checking for ADDR_COMPAT_LAYOUT constant... " >&6; } +- if test "$cross_compiling" = yes; then : ++ if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 + $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + as_fn_error $? "cannot run test program while cross compiling +@@ -6847,18 +6469,16 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- +- #include +- #include ++ #include ++ #include + + int + main () + { + +- FILE *f; +- if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%x",ADDR_COMPAT_LAYOUT); +- return 0; ++ FILE *f; ++ if (!(f=fopen("conftest1","w"))) return -1; ++ fprintf(f,"%x",ADDR_COMPAT_LAYOUT); + + ; + return 0; +@@ -6866,11 +6486,11 @@ main () + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + ADDR_COMPAT_LAYOUT=`cat conftest1` +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes $ADDR_COMPAT_LAYOUT" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes $ADDR_COMPAT_LAYOUT" >&5 + $as_echo "yes $ADDR_COMPAT_LAYOUT" >&6; } + else + ADDR_COMPAT_LAYOUT=0 +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } + + cat >>confdefs.h <<_ACEOF +@@ -6883,9 +6503,9 @@ rm -f core *.core core.conftest.* gmon.o + fi + + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ADDR_LIMIT_3GB constant" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ADDR_LIMIT_3GB constant" >&5 + $as_echo_n "checking for ADDR_LIMIT_3GB constant... " >&6; } +- if test "$cross_compiling" = yes; then : ++ if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 + $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + as_fn_error $? "cannot run test program while cross compiling +@@ -6894,18 +6514,16 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- +- #include +- #include ++ #include ++ #include + + int + main () + { + +- FILE *f; +- if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%x",ADDR_LIMIT_3GB); +- return 0; ++ FILE *f; ++ if (!(f=fopen("conftest1","w"))) return -1; ++ fprintf(f,"%x",ADDR_LIMIT_3GB); + + ; + return 0; +@@ -6913,11 +6531,11 @@ main () + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + ADDR_LIMIT_3GB=`cat conftest1` +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes $ADDR_LIMIT_3GB" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes $ADDR_LIMIT_3GB" >&5 + $as_echo "yes $ADDR_LIMIT_3GB" >&6; } + else + ADDR_LIMIT_3GB=0 +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } + + cat >>confdefs.h <<_ACEOF +@@ -6930,9 +6548,9 @@ rm -f core *.core core.conftest.* gmon.o + fi + + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for personality(ADDR_NO_RANDOMIZE) support" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for personality(ADDR_NO_RANDOMIZE) support" >&5 + $as_echo_n "checking for personality(ADDR_NO_RANDOMIZE) support... " >&6; } +- if test "$cross_compiling" = yes; then : ++ if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 + $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + as_fn_error $? "cannot run test program while cross compiling +@@ -6941,12 +6559,13 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + ++ #include ++ #include ++ int main(int argc,char *argv[],char *envp[]) { ++ #include "h/unrandomize.h" ++ return 0; ++ } + +- #include +- #include +- int main(int argc,char **argv,char **envp) { +- #include "h/unrandomize.h" +- return 0;} + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +@@ -6963,92 +6582,89 @@ rm -f core *.core core.conftest.* gmon.o + fi + + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking that sbrk is (now) non-random" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking that sbrk is (now) non-random" >&5 + $as_echo_n "checking that sbrk is (now) non-random... " >&6; } +- if test "$cross_compiling" = yes; then : +- SBRK=0 ++ SBRK=0 ++ if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "cannot run test program while cross compiling ++See \`config.log' for more details" "$LINENO" 5; } + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include +- #include ++ ++ #include ++ #include + int main(int argc,char * argv[],char * envp[]) { + FILE *f; + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" + #endif +- if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%u",sbrk(0)); +- return 0;} ++ if (!(f=fopen("conftest1","w"))) ++ return -1; ++ fprintf(f,"%u",sbrk(0)); ++ return 0; ++ } ++ + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + SBRK=`cat conftest1` +-else +- SBRK=0 + fi + rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +- if test "$SBRK" = "0" ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot trap sbrk" >&5 +-$as_echo "cannot trap sbrk" >&6; } +- exit 1 +- fi +- if test "$cross_compiling" = yes; then : +- SBRK1=0 ++ if test "$SBRK" = "0" ; then ++ as_fn_error $? "cannot trap sbrk" "$LINENO" 5 ++ fi ++ ++ SBRK1=0 ++ if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "cannot run test program while cross compiling ++See \`config.log' for more details" "$LINENO" 5; } + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include +- #include ++ ++ #include ++ #include + int main(int argc,char * argv[],char * envp[]) { + FILE *f; + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" + #endif + if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%u",sbrk(0)); +- return 0;} ++ fprintf(f,"%u",sbrk(0)); ++ return 0; ++ } ++ + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + SBRK1=`cat conftest1` +-else +- SBRK1=0 + fi + rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +- if test "$SBRK1" = "0" ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot trap sbrk" >&5 +-$as_echo "cannot trap sbrk" >&6; } +- exit 1 +- fi +- if test "$SBRK" = "$SBRK1" ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ if test "$SBRK1" = "0" ; then ++ as_fn_error $? "cannot trap sbrk" "$LINENO" 5 ++ fi ++ if test "$SBRK" = "$SBRK1" ; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } +- else +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } +- echo "Cannot build with randomized sbrk. Your options:" +- echo " - upgrade to a kernel/libc that knows about personality(ADDR_NO_RANDOMIZE)" +- echo " - recompile your kernel with CONFIG_COMPAT_BRK (if it has that option)" +- echo " - run sysctl kernel.randomize_va_space=0 before using gcl" +- exit 1 +- fi ++ echo "Cannot build with randomized sbrk. Your options:" ++ echo " - upgrade to a kernel/libc that knows about personality(ADDR_NO_RANDOMIZE)" ++ echo " - recompile your kernel with CONFIG_COMPAT_BRK (if it has that option)" ++ echo " - run sysctl kernel.randomize_va_space=0 before using gcl" ++ as_fn_error $? "exiting" "$LINENO" 5 ++ fi + fi +- +- +- +- +- +- +- +- +- +- +- + { $as_echo "$as_me:${as_lineno-$LINENO}: checking CSTACK_ADDRESS" >&5 + $as_echo_n "checking CSTACK_ADDRESS... " >&6; } + if test "$cross_compiling" = yes; then : +@@ -7060,34 +6676,35 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #include +- void * +- foo() { +- int i; +- return (void *)&i; +- } +- +- int main(int argc,char **argv,char **envp) { +- void *v ; +- FILE *fp = fopen("conftest1","w"); +- unsigned long i,j; +- +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- j=1; +- j<<=$PAGEWIDTH; +- j<<=16; +- i=(unsigned long)&v; +- if (foo()>i) i-=j; +- j--; +- i+=j; +- i&=~j; +- fprintf(fp,"0x%lx",i-1); +- fclose(fp); +- return 0; +-} ++ #include ++ #include ++ void * ++ foo() { ++ int i; ++ return (void *)&i; ++ } ++ ++ int ++ main(int argc,char **argv,char **envp) { ++ void *v ; ++ FILE *fp = fopen("conftest1","w"); ++ unsigned long i,j; ++ ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ j=1; ++ j<<=$PAGEWIDTH; ++ j<<=16; ++ i=(unsigned long)&v; ++ if (foo()>i) i-=j; ++ j--; ++ i+=j; ++ i&=~j; ++ fprintf(fp,"0x%lx",i-1); ++ fclose(fp); ++ return 0; ++ } + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + cstack_address=`cat conftest1` +@@ -7117,35 +6734,36 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #include +- void * +- foo() { +- int i; +- return (void *)&i; +- } +- +- int main(int argc,char **argv,char **envp) { +- void *v ; +- FILE *fp = fopen("conftest1","w"); +- unsigned long i,j; +- +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- j=1; +- j<<=$PAGEWIDTH; +- j<<=16; +- i=(unsigned long)&v; +- if (foo()>i) i-=j; +- j--; +- i+=j; +- i&=~j; +- for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); +- fprintf(fp,"%d",j); +- fclose(fp); +- return 0; +-} ++ #include ++ #include ++ void * ++ foo() { ++ int i; ++ return (void *)&i; ++ } ++ ++ int ++ main(int argc,char **argv,char **envp) { ++ void *v ; ++ FILE *fp = fopen("conftest1","w"); ++ unsigned long i,j; ++ ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ j=1; ++ j<<=$PAGEWIDTH; ++ j<<=16; ++ i=(unsigned long)&v; ++ if (foo()>i) i-=j; ++ j--; ++ i+=j; ++ i&=~j; ++ for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); ++ fprintf(fp,"%d",j); ++ fclose(fp); ++ return 0; ++ } + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + cstack_bits=`cat conftest1` +@@ -7175,33 +6793,33 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #include +- int main(int argc,char **argv,char **envp) { +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- return (long)$cstack_address<0 ? 0 : -1; +-} ++ #include ++ #include ++ int ++ main(int argc,char **argv,char **envp) { ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ return (long)$cstack_address<0 ? 0 : -1; ++ } + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } +- neg_cstack_address=1 ++ neg_cstack_address=1 + + $as_echo "#define NEG_CSTACK_ADDRESS 1" >>confdefs.h + + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } +- neg_cstack_address=0 ++ neg_cstack_address=0 + fi + rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + + +- + { $as_echo "$as_me:${as_lineno-$LINENO}: checking finding CSTACK_ALIGNMENT" >&5 + $as_echo_n "checking finding CSTACK_ALIGNMENT... " >&6; } + if test "$cross_compiling" = yes; then : +@@ -7213,23 +6831,23 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #include +- int main(int argc,char **argv,char **envp) { +- void *b,*c; +- FILE *fp = fopen("conftest1","w"); +- long n; +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- b=alloca(sizeof(b)); +- c=alloca(sizeof(c)); +- n=b>c ? b-c : c-b; +- n=n>sizeof(c) ? n : 1; +- fprintf(fp,"%ld",n); +- fclose(fp); +- return 0; +-} ++ #include ++ #include ++ int main(int argc,char **argv,char **envp) { ++ void *b,*c; ++ FILE *fp = fopen("conftest1","w"); ++ long n; ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ b=alloca(sizeof(b)); ++ c=alloca(sizeof(c)); ++ n=b>c ? b-c : c-b; ++ n=n>sizeof(c) ? n : 1; ++ fprintf(fp,"%ld",n); ++ fclose(fp); ++ return 0; ++ } + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + cstack_alignment=`cat conftest1` +@@ -7259,24 +6877,25 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #include +- void * +- foo(void) { +- int i; +- return (void *)&i; +- } +- +- int main(int argc,char **argv,char **envp) { +- char *b; +- FILE *fp = fopen("conftest1","w"); +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- fprintf(fp,"%d",((long) &b) > ((long) foo()) ? -1 : 1); +- fclose(fp); +- return 0; +-} ++ #include ++ #include ++ void * ++ foo(void) { ++ int i; ++ return (void *)&i; ++ } ++ ++ int ++ main(int argc,char **argv,char **envp) { ++ char *b; ++ FILE *fp = fopen("conftest1","w"); ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ fprintf(fp,"%d",((long) &b) > ((long) foo()) ? -1 : 1); ++ fclose(fp); ++ return 0; ++ } + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + cstack_direction=`cat conftest1` +@@ -7295,62 +6914,74 @@ _ACEOF + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $cstack_direction" >&5 + $as_echo "$cstack_direction" >&6; } + ++# Check whether --enable-immfix was given. ++if test "${enable_immfix+set}" = set; then : ++ enableval=$enable_immfix; ++fi ++ ++ ++# Check whether --enable-fastimmfix was given. ++if test "${enable_fastimmfix+set}" = set; then : ++ enableval=$enable_fastimmfix; ++else ++ enable_fastimmfix=64 ++fi + + + + if test "$use" != "386-gnu" ; then #hurd can push .data below C stack, but sbrk(0) remains above, foiling unexec + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking finding default linker script" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking finding default linker script" >&5 + $as_echo_n "checking finding default linker script... " >&6; } +- touch unixport/gcl.script +- echo "int main() {return 0;}" >foo.c +- $CC -Wl,--verbose foo.c -o foo 2>&1 | \ +- $AWK '/\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=/ {i=1-i;next} {if (i) print}' >gcl.script +- rm -rf foo.c foo ++ touch unixport/gcl.script ++ echo "int main() {return 0;}" >foo.c ++ $CC $TLDFLAGS -Wl,--verbose foo.c -o foo 2>&1 | \ ++ $AWK '/\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=/ {i=1-i;next} {if (i) print}' >gcl.script ++ rm -rf foo.c foo + +- if test "`cat gcl.script | wc -l`" != "0" ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: got it" >&5 ++ if test "`cat gcl.script | wc -l`" != "0" ; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: got it" >&5 + $as_echo "got it" >&6; } +- { $as_echo "$as_me:${as_lineno-$LINENO}: trying to adjust text start" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: trying to adjust text start" >&5 + $as_echo "$as_me: trying to adjust text start" >&6;} +- cp gcl.script gcl.script.def ++ cp gcl.script gcl.script.def + +- n=-1; +- k=0; +- lim=`$AWK 'END {printf("%d\n",m*8-2)}' m=$ac_cv_sizeof_long`; +- max=0; +- min=$lim; +- while test $n -lt $lim ; do +- j=`$AWK 'END {for (i=j=0;j<=n;j++) i=i ? i*2 : 1;printf("%x\n",3*i)}' n=$n gcl.script +-# diff -u gcl.script.def gcl.script +- echo "int main() {return 0;}" >foo.c +- if ( $CC -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then +- if test $n -lt $min ; then min=$n; fi; +- if test $n -gt $max; then max=$n; fi; +- elif test $max -gt 0 ; then +- break; +- fi; +- n=`$AWK 'END {print n+1}' n=$n gcl.script ++ # diff -u gcl.script.def gcl.script ++ echo "int main() {return 0;}" >foo.c ++ if ( $CC $TLDFLAGS -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then ++ if test $n -lt $min ; then min=$n; fi; ++ if test $n -gt $max; then max=$n; fi; ++ elif test $max -gt 0 ; then ++ break; ++ fi; ++ n=`$AWK 'END {print n+1}' n=$n &5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: min log text start $min" >&5 + $as_echo "$as_me: min log text start $min" >&6;} +- { $as_echo "$as_me:${as_lineno-$LINENO}: max log text start $max" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: max log text start $max" >&5 + $as_echo "$as_me: max log text start $max" >&6;} + +- if test $neg_cstack_address -eq 1 ; then #FIXME test this +- if test $cstack_bits -lt $max ; then +- max=$cstack_bits; +- { $as_echo "$as_me:${as_lineno-$LINENO}: max log text start reduced to $max considering c stack address" >&5 ++ if test $neg_cstack_address -eq 1 ; then #FIXME test this ++ if test $cstack_bits -lt $max ; then ++ max=$cstack_bits; ++ { $as_echo "$as_me:${as_lineno-$LINENO}: max log text start reduced to $max considering c stack address" >&5 + $as_echo "$as_me: max log text start reduced to $max considering c stack address" >&6;} +- fi +- fi ++ fi ++ fi + +- j=-1; +- low_shft=""; +- if test $min -le $max ; then +- if test $max -ge $enable_fastimmfix && test "$enable_immfix" = "yes" ; then ++ j=-1; ++ low_shft=""; ++ if test $min -le $max ; then ++ if test $max -ge $enable_fastimmfix && test "$enable_immfix" != "no" ; then + j=`$AWK 'END {for (i=j=0;j<=n;j++) i=i ? i*2 : 1;printf("%x\n",3*i)}' n=$max &5 +@@ -7360,9 +6991,9 @@ $as_echo "$as_me: raising log text to $j + { $as_echo "$as_me:${as_lineno-$LINENO}: lowering log text to $j to maximize data area" >&5 + $as_echo "$as_me: lowering log text to $j to maximize data area" >&6;} + fi +- fi ++ fi + +- if test "$low_shft" != "" ; then ++ if test "$low_shft" != "" ; then + + cat >>confdefs.h <<_ACEOF + #define LOW_SHFT $low_shft +@@ -7373,34 +7004,34 @@ cat >>confdefs.h <<_ACEOF + #define OBJNULL (object)0x$j + _ACEOF + +- else ++ else + + cat >>confdefs.h <<_ACEOF + #define OBJNULL NULL + _ACEOF + +- fi ++ fi + +-# echo $j; +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking our linker script" >&5 ++ # echo $j; ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking our linker script" >&5 + $as_echo_n "checking our linker script... " >&6; } +- if test "$j" -ne "-1" ; then ++ if test "$j" -ne "-1" ; then + cat gcl.script.def | $AWK '/SIZEOF_HEADERS/ {gsub("0x[0-9]*","0x" j,$0);} {print}' j=$j >gcl.script + { $as_echo "$as_me:${as_lineno-$LINENO}: result: done" >&5 + $as_echo "done" >&6; } + rm -f gcl.script.def + LDFLAGS="$LDFLAGS -Wl,-T gcl.script " + cp gcl.script unixport +- else +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: none found or not needed" >&5 ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: none found or not needed" >&5 + $as_echo "none found or not needed" >&6; } +- rm -f gcl.script gcl.script.def +- fi +- rm -rf foo.c foo +- else +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 ++ rm -f gcl.script gcl.script.def ++ fi ++ rm -rf foo.c foo ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 + $as_echo "not found" >&6; } +- fi ++ fi + + else + +@@ -7412,19 +7043,6 @@ _ACEOF + + fi + +- +- +- +- +- +- +- +- +- +- +- +- +- + mem_top=0 + mem_range=0 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking mem top" >&5 +@@ -7438,30 +7056,30 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include ++ #include + + int + main () + { + +- void *v; +- unsigned long i,j,k,l,m; +- FILE *fp = fopen("conftest1","w"); +- +- for (i=2,k=1;i;k=i,i<<=1); +- l=$cstack_address; +- l=$cstack_direction==1 ? (l>=1,i|=j); +- if (j<(k>>3)) i=0; +- j=1; +- j<<=$PAGEWIDTH; +- j<<=4; +- j--; +- i+=j; +- i&=~j; +- fprintf(fp,"0x%lx",i); +- fclose(fp); +- return 0; ++ void *v; ++ unsigned long i,j,k,l,m; ++ FILE *fp = fopen("conftest1","w"); ++ ++ for (i=2,k=1;i;k=i,i<<=1); ++ l=$cstack_address; ++ l=$cstack_direction==1 ? (l>=1,i|=j); ++ if (j<(k>>3)) i=0; ++ j=1; ++ j<<=$PAGEWIDTH; ++ j<<=4; ++ j--; ++ i+=j; ++ i&=~j; ++ fprintf(fp,"0x%lx",i); ++ fclose(fp); ++ return 0; + + ; + return 0; +@@ -7478,10 +7096,11 @@ fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $mem_top" >&5 + $as_echo "$mem_top" >&6; } ++ + if test "$mem_top" != "0x0" ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking finding upper mem half range" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking finding upper mem half range" >&5 + $as_echo_n "checking finding upper mem half range... " >&6; } +- if test "$cross_compiling" = yes; then : ++ if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 + $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + as_fn_error $? "cannot run test program while cross compiling +@@ -7490,19 +7109,19 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include ++ #include + + int + main () + { + +- unsigned long j; +- FILE *fp = fopen("conftest1","w"); ++ unsigned long j; ++ FILE *fp = fopen("conftest1","w"); + +- for (j=1;j && !(j& $mem_top);j<<=1); +- fprintf(fp,"0x%lx",j>>1); +- fclose(fp); +- return 0; ++ for (j=1;j && !(j& $mem_top);j<<=1); ++ fprintf(fp,"0x%lx",j>>1); ++ fclose(fp); ++ return 0; + + ; + return 0; +@@ -7517,9 +7136,9 @@ rm -f core *.core core.conftest.* gmon.o + conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $mem_range" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $mem_range" >&5 + $as_echo "$mem_range" >&6; } +- if test "$mem_range" != "0x0" ; then ++ if test "$mem_range" != "0x0" ; then + + cat >>confdefs.h <<_ACEOF + #define MEM_TOP $mem_top +@@ -7530,12 +7149,12 @@ cat >>confdefs.h <<_ACEOF + #define MEM_RANGE $mem_range + _ACEOF + +- fi ++ fi + fi + +-if test "$enable_immfix" = "yes" ; then +- if test "$mem_top" != "0x0" ; then +- if test "$mem_range" != "0x0" ; then ++if test "$enable_immfix" != "no" ; then ++ if test "$mem_top" != "0x0" ; then ++ if test "$mem_range" != "0x0" ; then + + cat >>confdefs.h <<_ACEOF + #define IM_FIX_BASE $mem_top +@@ -7546,24 +7165,10 @@ cat >>confdefs.h <<_ACEOF + #define IM_FIX_LIM $mem_range + _ACEOF + +- fi +- fi ++ fi ++ fi + fi + +- +- +- +-# On systems with execshield, brk is randomized. We need to catch +-# this and restore the traditional behavior here +- +- +- +- +- +- +- +- +- + { $as_echo "$as_me:${as_lineno-$LINENO}: checking sizeof long long int" >&5 + $as_echo_n "checking sizeof long long int... " >&6; } + if test "$cross_compiling" = yes; then : +@@ -7575,14 +7180,14 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include ++ #include + + int + main () + { + +- if (sizeof(long long int) == 2*sizeof(long)) return 0; +- return 1; ++ if (sizeof(long long int) == 2*sizeof(long)) return 0; ++ return 1; + + ; + return 0; +@@ -7604,7 +7209,6 @@ fi + + + +- + for ac_header in dirent.h + do : + ac_fn_c_check_header_mongrel "$LINENO" "dirent.h" "ac_cv_header_dirent_h" "$ac_includes_default" +@@ -7614,21 +7218,21 @@ if test "x$ac_cv_header_dirent_h" = xyes + _ACEOF + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for d_type" >&5 + $as_echo_n "checking for d_type... " >&6; } +- if test "$cross_compiling" = yes; then : ++ if test "$cross_compiling" = yes; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include ++ #include + + int + main () + { + +- struct dirent d; +- return d.d_type=0; ++ struct dirent d; ++ return d.d_type=0; + + ; + return 0; +@@ -7652,32 +7256,18 @@ fi + done + + +-# readline +-# Check whether --enable-readline was given. +-if test "${enable_readline+set}" = set; then : +- enableval=$enable_readline; +-else +- enable_readline="yes" +-fi +- +- + # ansi lisp ++SYSTEM=ansi_gcl ++CLSTANDARD=ANSI + # Check whether --enable-ansi was given. + if test "${enable_ansi+set}" = set; then : +- enableval=$enable_ansi; +-else +- enable_ansi="yes" ++ enableval=$enable_ansi; if test "$enable_ansi" = "no" ; then ++ SYSTEM=gcl ++ CLSTANDARD=CLtL1 ++ fi + fi + + +-if test "$enable_ansi" = "yes" ; then +- SYSTEM=ansi_gcl +- CLSTANDARD=ANSI +-else +- SYSTEM=gcl +- CLSTANDARD=CLtL1 +-fi +- + FLISP="saved_$SYSTEM" + + +@@ -7913,23 +7503,22 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- +- #include ++ #include + + int + main () + { + +- char *s= "2.7182818284590452353602874713526624977572470936999595749669676277240766303535475945713821785251664274274663919320030599218174135966290435729003342952605956307381323286279434907632338298807531952510190115738341879307021540891499348841675092447614606680822648001684774118537423454424371075390777449920695517027618386062613313845830007520449338265602976067371132007093287091274437470472306969772093101416928368190255151086574637721112523897844250569536967707854499699679468644549059879316368892300987931277361782154249992295763514822082698951936680331825288693984964651058209392398294887933203625094431173012381970684161404"; +- int n, m; +- double f; +- char *endptr; +- FILE *fp=fopen("conftest1","w"); ++ char *s= "2.7182818284590452353602874713526624977572470936999595749669676277240766303535475945713821785251664274274663919320030599218174135966290435729003342952605956307381323286279434907632338298807531952510190115738341879307021540891499348841675092447614606680822648001684774118537423454424371075390777449920695517027618386062613313845830007520449338265602976067371132007093287091274437470472306969772093101416928368190255151086574637721112523897844250569536967707854499699679468644549059879316368892300987931277361782154249992295763514822082698951936680331825288693984964651058209392398294887933203625094431173012381970684161404"; ++ int n, m; ++ double f; ++ char *endptr; ++ FILE *fp=fopen("conftest1","w"); + +- n=sscanf(s,"%lf%n",&f,&m); +- fprintf(fp,"%d",m); +- fclose(fp); +- return s[m]; ++ n=sscanf(s,"%lf%n",&f,&m); ++ fprintf(fp,"%d",m); ++ fclose(fp); ++ return s[m]; + + ; + return 0; +@@ -7940,7 +7529,7 @@ if ac_fn_c_try_run "$LINENO"; then : + $as_echo "none" >&6; } + else + buggy_maximum_sscanf_length=`cat conftest1` +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $buggy_maximum_sscanf_length" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $buggy_maximum_sscanf_length" >&5 + $as_echo "$buggy_maximum_sscanf_length" >&6; } + + cat >>confdefs.h <<_ACEOF +@@ -7955,8 +7544,10 @@ fi + + + EXTRA_LOBJS= +-if test "$try_japi" = "yes" ; then +- for ac_header in japi.h ++# Check whether --enable-japi was given. ++if test "${enable_japi+set}" = set; then : ++ enableval=$enable_japi; if test "$enable_japi" = "yes" ; then ++ for ac_header in japi.h + do : + ac_fn_c_check_header_mongrel "$LINENO" "japi.h" "ac_cv_header_japi_h" "$ac_includes_default" + if test "x$ac_cv_header_japi_h" = xyes; then : +@@ -7965,14 +7556,16 @@ if test "x$ac_cv_header_japi_h" = xyes; + _ACEOF + $as_echo "#define HAVE_JAPI_H 1" >>confdefs.h + +- EXTRA_LOBJS="${EXTRA_LOBJS} gcl_japi.o" +- LIBS="${LIBS} -ljapi -lwsock32" ++ EXTRA_LOBJS="${EXTRA_LOBJS} gcl_japi.o" ++ LIBS="${LIBS} -ljapi -lwsock32" + fi + + done + ++ fi + fi + ++ + # Should really find a way to check for prototypes, but this + # basically works for now. CM + # +@@ -8057,15 +7650,15 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #define _GNU_SOURCE +- #include ++ #define _GNU_SOURCE ++ #include + + int + main () + { + +- float f; +- return isnormal(f) || !isnormal(f) ? 0 : 1; ++ float f; ++ return isnormal(f) || !isnormal(f) ? 0 : 1; + + ; + return 0; +@@ -8077,9 +7670,9 @@ $as_echo "#define HAVE_ISNORMAL 1" >>con + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } + else +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for fpclass in ieeefp.h" >&5 +-$as_echo_n "checking for fpclass in ieeefp.h... " >&6; } +- if test "$cross_compiling" = yes; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for fpclass of ieeefp.h" >&5 ++$as_echo_n "checking for fpclass of ieeefp.h... " >&6; } ++ if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 + $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + as_fn_error $? "cannot run test program while cross compiling +@@ -8088,14 +7681,14 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include ++ #include + + int + main () + { + +- float f; +- return fpclass(f)>=FP_NZERO || fpclass(f)=FP_NZERO || fpclass(f)conftest.$ac_ext + /* end confdefs.h. */ + +- #define _GNU_SOURCE +- #include ++ #define _GNU_SOURCE ++ #include + + int + main () + { + +- float f; +- return isfinite(f) || !isfinite(f) ? 0 : 1; ++ float f; ++ return isfinite(f) || !isfinite(f) ? 0 : 1; + + ; + return 0; +@@ -8153,7 +7746,7 @@ $as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for finite()" >&5 + $as_echo_n "checking for finite()... " >&6; } +- if test "$cross_compiling" = yes; then : ++ if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 + $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + as_fn_error $? "cannot run test program while cross compiling +@@ -8162,15 +7755,15 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #include ++ #include ++ #include + + int + main () + { + +- float f; +- return finite(f) || !finite(f) ? 0 : 1; ++ float f; ++ return finite(f) || !finite(f) ? 0 : 1; + + ; + return 0; +@@ -8194,8 +7787,6 @@ rm -f core *.core core.conftest.* gmon.o + fi + + +- +- + #-------------------------------------------------------------------- + # Check for the existence of the -lsocket and -lnsl libraries. + # The order here is important, so that they end up in the right +@@ -8315,10 +7906,19 @@ fi + fi + + +-RL_OBJS="" +-RL_LIB="" +-if test "$enable_readline" = "yes" ; then +- for ac_header in readline/readline.h ++# readline ++# Check whether --enable-readline was given. ++if test "${enable_readline+set}" = set; then : ++ enableval=$enable_readline; ++fi ++ ++ ++if test "$use" = "mingw" ; then ++ enable_readline=no ++fi ++ ++if test "$enable_readline" != "no" ; then ++ for ac_header in readline/readline.h + do : + ac_fn_c_check_header_mongrel "$LINENO" "readline/readline.h" "ac_cv_header_readline_readline_h" "$ac_includes_default" + if test "x$ac_cv_header_readline_readline_h" = xyes; then : +@@ -8365,12 +7965,8 @@ if test "x$ac_cv_lib_readline_rl_initial + + $as_echo "#define HAVE_READLINE 1" >>confdefs.h + +- TLIBS="$TLIBS -lreadline" #some machines don't link this, e.g. Slackware +- RL_OBJS=gcl_readline.o +-# Readline support now initialized automatically when compiled in, this lisp +-# object no longer needed -- 20040102 CM +-# RL_LIB=lsp/gcl_readline.o +- ++ TLIBS="$TLIBS -lreadline" #some machines don't link this, e.g. Slackware ++ RL_OBJS=gcl_readline.o + fi + + fi +@@ -8378,8 +7974,8 @@ fi + done + + +-# These tests discover differences between readline 4.1 and 4.3 +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for rl_completion_matches in -lreadline" >&5 ++ # These tests discover differences between readline 4.1 and 4.3 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for rl_completion_matches in -lreadline" >&5 + $as_echo_n "checking for rl_completion_matches in -lreadline... " >&6; } + if ${ac_cv_lib_readline_rl_completion_matches+:} false; then : + $as_echo_n "(cached) " >&6 +@@ -8429,34 +8025,37 @@ fi + + + ++# sockets ++ + { $as_echo "$as_me:${as_lineno-$LINENO}: checking For network code for nsocket.c" >&5 + $as_echo_n "checking For network code for nsocket.c... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +-#include +-#include +-#include +- +-#include +-#include +-#include +- +-/************* for the sockets ******************/ +-#include /* struct sockaddr, SOCK_STREAM, ... */ +-#ifndef NO_UNAME +-# include /* uname system call. */ +-#endif +-#include /* struct in_addr, struct sockaddr_in */ +-#include /* inet_ntoa() */ +-#include /* gethostbyname() */ ++ #include ++ #include ++ #include ++ ++ #include ++ #include ++ #include ++ ++ /************* for the sockets ******************/ ++ #include /* struct sockaddr, SOCK_STREAM, ... */ ++ #ifndef NO_UNAME ++ # include /* uname system call. */ ++ #endif ++ #include /* struct in_addr, struct sockaddr_in */ ++ #include /* inet_ntoa() */ ++ #include /* gethostbyname() */ + + int + main () + { +- connect(0,(struct sockaddr *)0,0); +- gethostbyname("jil"); +- socket(AF_INET, SOCK_STREAM, 0); ++ ++ connect(0,(struct sockaddr *)0,0); ++ gethostbyname("jil"); ++ socket(AF_INET, SOCK_STREAM, 0); + + ; + return 0; +@@ -8466,7 +8065,7 @@ if ac_fn_c_try_link "$LINENO"; then : + + $as_echo "#define HAVE_NSOCKET 1" >>confdefs.h + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +@@ -8480,16 +8079,18 @@ rm -f core conftest.err conftest.$ac_obj + $as_echo_n "checking check for listen using fcntl... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include +-#include ++ ++ #include ++ #include + + int + main () + { +-FILE *fp=fopen("configure.in","r"); +- int orig; +- orig = fcntl(fileno(fp), F_GETFL); +- if (! (orig & O_NONBLOCK )) return 0; ++ ++ FILE *fp=fopen("configure.in","r"); ++ int orig; ++ orig = fcntl(fileno(fp), F_GETFL); ++ if (! (orig & O_NONBLOCK )) return 0; + + ; + return 0; +@@ -8499,7 +8100,7 @@ if ac_fn_c_try_compile "$LINENO"; then : + + $as_echo "#define LISTEN_USE_FCNTL 1" >>confdefs.h + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +@@ -8508,8 +8109,6 @@ fi + rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + + +- +- + ac_fn_c_check_func "$LINENO" "profil" "ac_cv_func_profil" + if test "x$ac_cv_func_profil" = xyes; then : + +@@ -8531,7 +8130,7 @@ fi + + + if test "$no_setenv" = "1" ; then +-ac_fn_c_check_func "$LINENO" "putenv" "ac_cv_func_putenv" ++ ac_fn_c_check_func "$LINENO" "putenv" "ac_cv_func_putenv" + if test "x$ac_cv_func_putenv" = xyes; then : + + $as_echo "#define HAVE_PUTENV 1" >>confdefs.h +@@ -8551,17 +8150,11 @@ fi + + gcl_ok=no + +- +- +- +- +- +-# if test "x$enable_machine" = "x" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5 + $as_echo_n "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O... " >&6; } + + case $system in +- OSF*) ++ OSF*) + + $as_echo "#define USE_FIONBIO 1" >>confdefs.h + +@@ -8593,8 +8186,9 @@ esac + $as_echo_n "checking check for SV_ONSTACK... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include +-int joe=SV_ONSTACK; ++ ++ #include ++ int joe=SV_ONSTACK; + + int + main () +@@ -8609,7 +8203,7 @@ if ac_fn_c_try_compile "$LINENO"; then : + $as_echo "#define HAVE_SV_ONSTACK 1" >>confdefs.h + + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +@@ -8621,8 +8215,9 @@ rm -f core conftest.err conftest.$ac_obj + $as_echo_n "checking check for SIGSYS... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include +-int joe=SIGSYS; ++ ++ #include ++ int joe=SIGSYS; + + int + main () +@@ -8637,7 +8232,7 @@ if ac_fn_c_try_compile "$LINENO"; then : + $as_echo "#define HAVE_SIGSYS 1" >>confdefs.h + + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +@@ -8650,8 +8245,9 @@ rm -f core conftest.err conftest.$ac_obj + $as_echo_n "checking check for SIGEMT... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include +-int joe=SIGEMT; ++ ++ #include ++ int joe=SIGEMT; + + int + main () +@@ -8666,7 +8262,7 @@ if ac_fn_c_try_compile "$LINENO"; then : + $as_echo "#define HAVE_SIGEMT 1" >>confdefs.h + + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +@@ -8705,7 +8301,7 @@ if test "x$ac_cv_header_dis_asm_h" = xye + #define HAVE_DIS_ASM_H 1 + _ACEOF + MLIBS=$LIBS +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for init_disassemble_info in -lopcodes" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for init_disassemble_info in -lopcodes" >&5 + $as_echo_n "checking for init_disassemble_info in -lopcodes... " >&6; } + if ${ac_cv_lib_opcodes_init_disassemble_info+:} false; then : + $as_echo_n "(cached) " >&6 +@@ -8750,7 +8346,7 @@ _ACEOF + + fi + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 + $as_echo_n "checking for dlopen in -ldl... " >&6; } + if ${ac_cv_lib_dl_dlopen+:} false; then : + $as_echo_n "(cached) " >&6 +@@ -8788,7 +8384,7 @@ fi + $as_echo "$ac_cv_lib_dl_dlopen" >&6; } + if test "x$ac_cv_lib_dl_dlopen" = xyes; then : + #opcodes changes too quickly to link directly +- for ac_func in print_insn_i386 ++ for ac_func in print_insn_i386 + do : + ac_fn_c_check_func "$LINENO" "print_insn_i386" "ac_cv_func_print_insn_i386" + if test "x$ac_cv_func_print_insn_i386" = xyes; then : +@@ -8807,7 +8403,7 @@ done + + + #if test $use = "386-linux" ; then +- for ac_header in asm/sigcontext.h ++for ac_header in asm/sigcontext.h + do : + ac_fn_c_check_header_mongrel "$LINENO" "asm/sigcontext.h" "ac_cv_header_asm_sigcontext_h" "$ac_includes_default" + if test "x$ac_cv_header_asm_sigcontext_h" = xyes; then : +@@ -8819,7 +8415,7 @@ fi + + done + +- for ac_header in asm/signal.h ++for ac_header in asm/signal.h + do : + ac_fn_c_check_header_mongrel "$LINENO" "asm/signal.h" "ac_cv_header_asm_signal_h" "$ac_includes_default" + if test "x$ac_cv_header_asm_signal_h" = xyes; then : +@@ -8831,17 +8427,18 @@ fi + + done + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sigcontext..." >&5 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sigcontext..." >&5 + $as_echo_n "checking for sigcontext...... " >&6; } +- cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include ++ ++ #include + + int + main () + { + +- struct sigcontext foo; ++ struct sigcontext foo; + + ; + return 0; +@@ -8849,38 +8446,31 @@ main () + _ACEOF + if ac_fn_c_try_compile "$LINENO"; then : + +- sigcontext_works=1; +- + $as_echo "#define SIGNAL_H_HAS_SIGCONTEXT 1" >>confdefs.h + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: sigcontext in signal.h" >&5 +-$as_echo "sigcontext in signal.h" >&6; } +- ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: sigcontext of signal.h" >&5 ++$as_echo "sigcontext of signal.h" >&6; } + else +- sigcontext_works=0; +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: sigcontext NOT in signal.h" >&5 +-$as_echo "sigcontext NOT in signal.h" >&6; } +- +-fi +-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +- if test "$sigcontext_works" = 0 ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sigcontext..." >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: sigcontext NOT of signal.h" >&5 ++$as_echo "sigcontext NOT of signal.h" >&6; } ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sigcontext..." >&5 + $as_echo_n "checking for sigcontext...... " >&6; } +- cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include +- #ifdef HAVE_ASM_SIGCONTEXT_H +- #include +- #endif +- #ifdef HAVE_ASM_SIGNAL_H +- #include +- #endif ++ ++ #include ++ #ifdef HAVE_ASM_SIGCONTEXT_H ++ #include ++ #endif ++ #ifdef HAVE_ASM_SIGNAL_H ++ #include ++ #endif + + int + main () + { + +- struct sigcontext foo; ++ struct sigcontext foo; + + ; + return 0; +@@ -8888,39 +8478,17 @@ main () + _ACEOF + if ac_fn_c_try_compile "$LINENO"; then : + +- + $as_echo "#define HAVE_SIGCONTEXT 1" >>confdefs.h + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: sigcontext in asm files" >&5 +-$as_echo "sigcontext in asm files" >&6; } +- ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: sigcontext asm files" >&5 ++$as_echo "sigcontext asm files" >&6; } + else +- +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no sigcontext found" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no sigcontext found" >&5 + $as_echo "no sigcontext found" >&6; } +- + fi + rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +- +- +- fi +-# echo 'foo() {}' > conftest1.c +-# $CC -S conftest1.c +-# use_underscore=0 +-# if fgrep _foo conftest1.s ; then use_underscore=1 ; fi +-# if test $use_underscore = 0 ; then +-# MPI_FILE=mpi-386_no_under.o +-# else +-# MPI_FILE=mpi-386d.o +-# fi +-# AC_SUBST(MPI_FILE) +-# GCC=$CC +-# if test -x /usr/bin/i386-glibc20-linux-gcc ; then +-# GCC=/usr/bin/i386-glibc20-linux-gcc +-# fi +-# AC_SUBST(GCC) +- +-#fi ++fi ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + + # Extract the first word of "emacs", so it can be a program name with args. + set dummy emacs; ac_word=$2 +@@ -8980,11 +8548,11 @@ EOF + { $as_echo "$as_me:${as_lineno-$LINENO}: checking emacs site lisp directory" >&5 + $as_echo_n "checking emacs site lisp directory... " >&6; } + if [ "$EMACS_SITE_LISP" = "unknown" ] ; then +- if [ "$EMACS" != "" ] ; then +- EMACS_SITE_LISP=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` +- else +- EMACS_SITE_LISP="" +- fi ++ if [ "$EMACS" != "" ] ; then ++ EMACS_SITE_LISP=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` ++ else ++ EMACS_SITE_LISP="" ++ fi + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $EMACS_SITE_LISP" >&5 + $as_echo "$EMACS_SITE_LISP" >&6; } +@@ -9005,14 +8573,14 @@ EOF + { $as_echo "$as_me:${as_lineno-$LINENO}: checking emacs default.el" >&5 + $as_echo_n "checking emacs default.el... " >&6; } + if [ "$EMACS" != "" ] ; then +- EMACS_DEFAULT_EL=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` ++ EMACS_DEFAULT_EL=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` + else +- EMACS_DEFAULT_EL="" ++ EMACS_DEFAULT_EL="" + fi + if test -f "${EMACS_DEFAULT_EL}" ; then true;else +- if test -d $EMACS_SITE_LISP ; then +- EMACS_DEFAULT_EL=${EMACS_SITE_LISP}/default.el +- fi ++ if test -d $EMACS_SITE_LISP ; then ++ EMACS_DEFAULT_EL=${EMACS_SITE_LISP}/default.el ++ fi + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $EMACS_DEFAULT_EL" >&5 + $as_echo "$EMACS_DEFAULT_EL" >&6; } +@@ -9046,14 +8614,34 @@ fi + $as_echo "$INFO_DIR" >&6; } + + +-if test "$enable_tcltk" = "yes" ; then ++# Check whether --enable-tcltk was given. ++if test "${enable_tcltk+set}" = set; then : ++ enableval=$enable_tcltk; ++fi ++ ++# Check whether --enable-tkconfig was given. ++if test "${enable_tkconfig+set}" = set; then : ++ enableval=$enable_tkconfig; TK_CONFIG_PREFIX=$enableval ++else ++ TK_CONFIG_PREFIX=unknown ++fi ++ ++# Check whether --enable-tclconfig was given. ++if test "${enable_tclconfig+set}" = set; then : ++ enableval=$enable_tclconfig; TCL_CONFIG_PREFIX=$enableval ++else ++ TCL_CONFIG_PREFIX=unknown ++fi ++ ++ ++if test "$enable_tcltk" != "no" ; then + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tcl/tk" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tcl/tk" >&5 + $as_echo_n "checking for tcl/tk... " >&6; } + +- if test -d "${TCL_CONFIG_PREFIX}" ; then true ; else ++ if test -d "${TCL_CONFIG_PREFIX}" ; then true ; else + +- # Extract the first word of "tclsh", so it can be a program name with args. ++ # Extract the first word of "tclsh", so it can be a program name with args. + set dummy tclsh; ac_word=$2 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 + $as_echo_n "checking for $ac_word... " >&6; } +@@ -9092,76 +8680,76 @@ fi + + + +- if test "${TCLSH}" = "" ; then true ; else ++ if test "${TCLSH}" = "" ; then true ; else + +- rm -f conftest.tcl +- cat >> conftest.tcl <> conftest.tcl <&5 ++ TCL_VERSION_DOT_FREE=`echo ${TCL_VERSION} | tr -d .` ++ if test -f ${TK_CONFIG_PREFIX}/../bin/tcl${TCL_VERSION_DOT_FREE}.dll ; then ++ TCL_LIBS="-L${TK_CONFIG_PREFIX}/../bin -ltk${TCL_VERSION_DOT_FREE} -ltcl${TCL_VERSION_DOT_FREE}" ++ TCL_STUB_LIBS="-L${TK_CONFIG_PREFIX}/lib -ltkstub${TCL_VERSION_DOT_FREE} -ltclstub${TCL_VERSION_DOT_FREE}" ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -llieee" >&5 + $as_echo_n "checking for main in -llieee... " >&6; } + if ${ac_cv_lib_lieee_main+:} false; then : + $as_echo_n "(cached) " >&6 +@@ -9197,14 +8785,11 @@ else + have_ieee=0 + fi + +- if test "$have_ieee" = "0" ; then +- TCL_LIBS=`echo ${TCL_LIBS} | sed -e "s:-lieee::g" ` +- fi +- if test "$have_dl" = "0" ; then +- TCL_LIBS=`echo ${TCL_LIBS} | sed -e "s:-ldl::g"` +- fi +- TCL_STUB_LIBS="" +- fi ++ if test "$have_ieee" = "0" ; then ++ TCL_LIBS=`echo ${TCL_LIBS} | sed -e "s:-lieee::g" ` ++ fi ++ TCL_STUB_LIBS="" ++ fi + + fi + +@@ -9229,16 +8814,18 @@ fi + + + if test -d "${TK_CONFIG_PREFIX}" ; then +-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: using TK_VERSION=${TK_VERSION} in ${TK_CONFIG_PREFIX}" >&5 +-$as_echo "using TK_VERSION=${TK_VERSION} in ${TK_CONFIG_PREFIX}" >&6; } ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: using TK_VERSION=${TK_VERSION} of ${TK_CONFIG_PREFIX}" >&5 ++$as_echo "using TK_VERSION=${TK_VERSION} of ${TK_CONFIG_PREFIX}" >&6; } + else +-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 + $as_echo "not found" >&6; } + fi + +-NOTIFY=$enable_notify +- ++# Check whether --enable-notify was given. ++if test "${enable_notify+set}" = set; then : ++ enableval=$enable_notify; NOTIFY=$enable_notify + ++fi + + + +@@ -9477,42 +9064,17 @@ _ACEOF + fi + + +-# alloca +- +-# dlopen etc +-# idea make it so you do something dlopen(libX.so,RTLD_GLOBAL) +-# then dlload("foo.o") a lisp file can refer to things in libX.so +-# +- +-# what machine this is, and include then a machine specific hdr. +-# and machine specific defs. +- +-# check bzero, +- +-# check getcwd, getwd etc.. +- + ++LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'` $TLDFLAGS" + ++LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $LIBS $TLIBS" + +-# check socket stuff.. +- +-# getrlimit +- +-# fionread or block +- +-# redhat/cygnus released for some reason a buggy version of gcc, +-# which no one else released. Catch that here. +- +-LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'`" +- +-LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $TLDFLAGS $LIBS $TLIBS" +- +-FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS $TCFLAGS $PROCESSOR_FLAGS" ++FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS $TCFLAGS" + + # Work around bug with gcc on ppc -- CM +-NIFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TONIFLAGS $PROCESSOR_FLAGS -I\$(GCLDIR)/o" ++NIFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TONIFLAGS -I\$(GCLDIR)/o" + +-CFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TO3FLAGS $PROCESSOR_FLAGS -I\$(GCLDIR)/o" ++CFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TO3FLAGS -I\$(GCLDIR)/o" + + O3FLAGS=$TO3FLAGS + +@@ -9522,12 +9084,10 @@ O2FLAGS=$TO2FLAGS + + + +- +- + if test -f h/$use.defs ; then + + +- ac_config_files="$ac_config_files makedefc windows/gcl.iss windows/sysdir.bat windows/install.lsp" ++ ac_config_files="$ac_config_files makedefc windows/gcl.iss windows/sysdir.bat windows/install.lsp" + + cat >confcache <<\_ACEOF + # This file is a shell script that caches the results of configure +@@ -10804,13 +10364,13 @@ if test -n "$ac_unrecognized_opts" && te + $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} + fi + +- echo makedefc +- cat makedefc ++ echo makedefc ++ cat makedefc + +- echo add-defs1 $use +- CC=$CC ./add-defs1 $use ++ echo add-defs1 $use ++ CC=$CC ./add-defs1 $use + + else +- echo "Unable to guess machine type" +- echo use configure --enable-machine=XXX, for XXX such that h/XXX.defs exists, ie in h/*.defs ++ echo "Unable to guess machine type" ++ echo use configure --enable-machine=XXX, for XXX such that h/XXX.defs exists, ie in h/*.defs + fi +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -5,107 +5,6 @@ AC_CONFIG_HEADER(h/gclincl.h) + VERSION=`cat majvers`.`cat minvers` + AC_SUBST(VERSION) + +-# some parts of this configure script are taken from the tcl configure.in +- +-# +-# Arguments +-# +- +-dnl help="--enable-maxpage=XXXX will compile in a page table of size XXX (default ${default_maxpage})" +- +-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +-dnl #include +-dnl #include +-dnl ]],[[ +-dnl FILE *fp=fopen("conftest1","w"); +-dnl fprintf(fp,"%u",262144*( SIZEOF_LONG >>2)/(1<<($PAGEWIDTH-12))); +-dnl return 0;]])],[def_maxpage=`cat conftest1`],[def_maxpage=262144]) +- +-dnl AC_ARG_ENABLE(maxpage, +-dnl [ --enable-maxpage=XXXX will compile in a page table of size XXX +-dnl (eg '--enable-maxpage=64*1024' would produce +-dnl 64K pages allowing 256 MB if pages are 4K each)], +-dnl ,enable_maxpage=$def_maxpage) +- +-AC_ARG_ENABLE(widecons,[use a three word cons with simplified typing],[AC_DEFINE([WIDE_CONS],[1],[three word cons])]) +- +- +-AC_ARG_ENABLE(safecdr,[protect cdr from immfix and speed up type processing],,[enable_safecdr="no"]) +-if test "$enable_safecdr" = "yes" ; then +- AC_DEFINE([USE_SAFE_CDR],[1],[protect cdr from immfix and speed up type processing]) +-fi +-AC_ARG_ENABLE(safecdrdbg,[debug safecdr code],[AC_DEFINE([DEBUG_SAFE_CDR],[1],[debug safecdr code])]) +- +-AC_ARG_ENABLE([prelink],[--enable-prelink will insist that the produced images may be prelinked],[PRELINK_CHECK=t],[PRELINK_CHECK=]) +- +-AC_ARG_ENABLE([fastimmfix],[--enable-fastimmfix=XXXX will reject low immediate fixnums unless 1<&1 | fgrep ming > /dev/null ; +- then use=mingw +- else use=gnuwin95 ++ sh4*linux*) use=sh4-linux;; ++ *x86_64*linux*) use=amd64-linux;; ++ *x86_64*kfreebsd*) use=amd64-kfreebsd;; ++ *86*linux*) use=386-linux;; ++ *86*kfreebsd*) use=386-kfreebsd;; ++ *86*gnu*) use=386-gnu;; ++ m68k*linux*) use=m68k-linux;; ++ alpha*linux*) use=alpha-linux;; ++ mips*linux*) use=mips-linux;; ++ mipsel*linux*) use=mipsel-linux;; ++ sparc*linux*) use=sparc-linux;; ++ aarch64*linux*) use=aarch64-linux;; ++ arm*linux*) use=arm-linux;; ++ s390*linux*) use=s390-linux;; ++ ia64*linux*) use=ia64-linux;; ++ hppa*linux*) use=hppa-linux;; ++ powerpc*linux*) use=powerpc-linux;; ++ powerpc-*-darwin*) use=powerpc-macosx;; ++ *86*darwin*) use=386-macosx;; ++ i*mingw*|i*msys*) use=mingw;; ++ i*cygwin*) ++ if $CC -v 2>&1 | fgrep ming > /dev/null ; ++ then use=mingw ++ else use=gnuwin95 + fi;; +- +- *openbsd*) +- # 'ld -Z' means disable W^X +- TLDFLAGS="$TLDFLAGS -Z" +- use=FreeBSD;; +- ++ *openbsd*) use=FreeBSD;; ++ sparc-sun-solaris*) use=solaris;; ++ i?86-pc-solaris*) use=solaris-i386;; + esac + +-AC_SUBST(PROCESSOR_FLAGS) ++AC_ARG_ENABLE([machine],[ --enable-machine=XXXX will force the use of one of the definitions in h/XXXX.defs], ++ [echo enable_machine=$enableval ; use=$enableval]) + +-echo enable_machine=$enable_machine +-if test "x$enable_machine" != "x" ; then +- use=$enable_machine +-fi ++AC_MSG_RESULT([use=$use]) + + def_dlopen="no" + def_statsysbfd="no" + def_custreloc="yes" +-#def_statsysbfd="yes" +-#def_custreloc="no" +-def_locbfd="no" + def_oldgmp="no" + def_pic="no"; + def_static="no"; + def_debug="no"; + case $use in +- *kfreebsd) ++ *kfreebsd) + ln -snf linux.defs h/$use.defs;; +- *gnu) ++ *gnu) + ln -snf linux.defs h/$use.defs;; +- *linux) ++ *linux) + ln -snf linux.defs h/$use.defs; + case $use in +-# def_static -- Function descriptors are currently realized at runtime in a non-reproducible fashion +-# on these architectures -- CM +- powerpc*) +-# if test "$host_cpu" = "powerpc64" ; then def_dlopen="yes" ; def_custreloc="no" ; fi +- ;; +- ia64*) +- def_dlopen="yes" ; def_custreloc="no" ;; +- hppa*) +- def_pic="yes" ;; +-# def_dlopen="yes" ; def_custreloc="no" ; def_pic="yes" ;; ++ ia64*) ++ def_dlopen="yes" ; def_custreloc="no" ;; ++ hppa*) ++ def_pic="yes" ;; + esac;; + esac + +-AC_ARG_ENABLE(dlopen, +- [ --enable-dlopen uses dlopen for loading objects, which can then not be retained in saved images ] +- ,,enable_dlopen="$def_dlopen") +-AC_ARG_ENABLE(statsysbfd, +- [ --enable-statsysbfd uses a static sytem bfd library for loading and relocationing object files ] +- ,,enable_statsysbfd="$def_statsysbfd") +-AC_ARG_ENABLE(dynsysbfd, +- [ --enable-dynsysbfd uses a dynamic shared sytem bfd library for loading and relocationing object files ] +- ,,enable_dynsysbfd="no") +-#AC_ARG_ENABLE(locbfd, +-# [ --enable-locbfd uses a static bfd library built from this source tree for loading and relocationing object files ] +-# ,,enable_locbfd="$def_locbfd") +-AC_ARG_ENABLE(custreloc, +- [ --enable-custreloc uses custom gcl code if available for loading and relocationing object files ] +- ,,enable_custreloc="$def_custreloc") +-AC_ARG_ENABLE(debug, +- [ --enable-debug builds gcl with -g in CFLAGS to enable running under gdb ] +- ,,enable_debug="$def_debug") +-AC_ARG_ENABLE(gprof, +- [ --enable-gprof builds gcl with -pg in CFLAGS to enable profiling with gprof ] +- ,,enable_gprof="no") +-AC_ARG_ENABLE(static,[ --enable-static will link your GCL against static as opposed to shared system libraries ] , +- [enable_static=$enableval],[enable_static="$def_static"]) +-AC_ARG_ENABLE(pic, +- [ --enable-pic builds gcl with -fPIC in CFLAGS ] +- ,,enable_pic="$def_pic") +- +-AC_ARG_ENABLE(oldgmp, +- [ --enable-oldgmp will link against gmp2 instead of gmp3 ] +- ,,enable_oldgmp="$def_oldgmp") +- +-AC_ARG_ENABLE(dynsysgmp, +- [ --enable-dynsysgmp will link against the system libgmp3 overriding certain functions with patched versions from the local source ] +- ,,enable_dynsysgmp="yes") ++AC_ARG_ENABLE([widecons],[ --enable-widecons will use a three word cons with simplified typing], ++ [if test "$enableval" = "yes" ; then AC_DEFINE([WIDE_CONS],[1],[three word cons]) fi]) ++ ++AC_ARG_ENABLE([safecdr],[ --enable-safecdr will protect cdr from immfix and speed up type processing], ++ [if test "$enableval" = "yes" ; then ++ AC_DEFINE([USE_SAFE_CDR],[1],[protect cdr from immfix and speed up type processing]) ++ AC_ARG_ENABLE([safecdrdbg],[ --enable-safecdrdbg will debug safecdr code], ++ [if test "$enableval" = "yes" ; then AC_DEFINE([DEBUG_SAFE_CDR],[1],[debug safecdr code]) fi]) ++ fi]) ++ ++AC_ARG_ENABLE([prelink],[ --enable-prelink will insist that the produced images may be prelinked], ++ [if test "$enable_prelink" = "yes" ; then PRELINK_CHECK=t; fi]) ++AC_SUBST(PRELINK_CHECK) ++ ++AC_ARG_ENABLE([vssize],[ --enable-vssize=XXXX will compile in a value stack of size XXX], ++ [AC_DEFINE_UNQUOTED(VSSIZE,$enableval,[value stack size])]) ++AC_ARG_ENABLE([bdssize],[ --enable-bdssize=XXXX will compile in a binding stack of size XXX], ++ [AC_DEFINE_UNQUOTED(BDSSIZE,$enableval,[binding stack size])]) ++AC_ARG_ENABLE([ihssize],[ --enable-ihssize=XXXX will compile in a invocation history stack of size XXX], ++ [AC_DEFINE_UNQUOTED(IHSSIZE,$enableval,[invocation history stack size])]) ++AC_ARG_ENABLE([frssize],[ --enable-frssize=XXXX will compile in a frame stack of size XXX], ++ [AC_DEFINE_UNQUOTED(FRSSIZE,$enableval,[frame stack size])]) ++ ++AC_ARG_ENABLE([infodir],[ --enable-infodir=XXXX will force the use of a INFO_DIR=XXXXX as place to look for info], ++ [INFO_DIR=$enableval],[INFO_DIR=$prefix/share/info]) ++INFO_DIR=`eval echo $INFO_DIR/` ++ ++AC_ARG_ENABLE([emacsdir],[ --enable-emacsdir=XXXX will manually specify the location for elisp files], ++ [EMACS_SITE_LISP=$enableval],[EMACS_SITE_LISP=$prefix/share/emacs/site-lisp]) ++EMACS_SITE_LISP=`eval echo $EMACS_SITE_LISP/` ++ ++AC_ARG_ENABLE([xgcl],[ --enable-xgcl=yes will compile in support for XGCL],,[enable_xgcl=yes]) + +-load_opt="0" ++AC_ARG_ENABLE([dlopen],[ --enable-dlopen uses dlopen for loading objects, which can then not be retained in saved images], ++ ,[enable_dlopen=$def_dlopen]) ++AC_ARG_ENABLE([statsysbfd],[ --enable-statsysbfd uses a static sytem bfd library for loading and relocationing object files], ++ ,[enable_statsysbfd=$def_statsysbfd]) ++AC_ARG_ENABLE([dynsysbfd],[ --enable-dynsysbfd uses a dynamic shared sytem bfd library for loading and relocationing object files], ++ ,[enable_dynsysbfd=no]) ++AC_ARG_ENABLE([custreloc],[ --enable-custreloc uses custom gcl code if available for loading and relocationing object files], ++ ,[enable_custreloc=$def_custreloc]) ++ ++AC_ARG_ENABLE([debug],[ --enable-debug builds gcl with -g in CFLAGS to enable running under gdb], ++ ,[enable_debug=$def_debug]) ++AC_ARG_ENABLE([static],[ --enable-static will link your GCL against static as opposed to shared system libraries], ++ ,[enable_static=$def_static]) ++AC_ARG_ENABLE([pic],[ --enable-pic builds gcl with -fPIC in CFLAGS],,[enable_pic=$def_pic]) ++ ++load_opt=0 + if test "$enable_dlopen" = "yes" ; then +- load_opt=1 ++ load_opt=1 + fi + if test "$enable_statsysbfd" = "yes" ; then +- case $load_opt in +- 0) load_opt=1;; +- 1) load_opt=2;; +- esac ++ case $load_opt in ++ 0) load_opt=1;; ++ 1) load_opt=2;; ++ esac + fi + if test "$enable_dynsysbfd" = "yes" ; then +- case $load_opt in +- 0) load_opt=1;; +- 1) load_opt=2;; +- 2) load_opt=3;; +- esac +-fi +-if test "$enable_locbfd" = "yes" ; then +- case $load_opt in +- 0) load_opt=1;; +- 1) load_opt=2;; +- 2) load_opt=3;; +- 3) load_opt=4;; +- esac ++ case $load_opt in ++ 0) load_opt=1;; ++ 1) load_opt=2;; ++ 2) load_opt=3;; ++ esac + fi + if test "$enable_custreloc" = "yes" ; then +- case $load_opt in +- 0) load_opt=1;; +- 1) load_opt=2;; +- 2) load_opt=3;; +- 3) load_opt=4;; +- 4) load_opt=5;; +- esac ++ case $load_opt in ++ 0) load_opt=1;; ++ 1) load_opt=2;; ++ 2) load_opt=3;; ++ 3) load_opt=4;; ++ 4) load_opt=5;; ++ esac + fi + + if test "$load_opt" != "1" ; then +- echo "Exactly one loader option must be chosen: dlopen=$enable_dlopen statsysbfd=$enable_statsysbfd dynsysbfd=$enable_dynsysbfd locbfd=$enable_locbfd custreloc=$enable_custreloc" +- exit 1 ++ echo "Exactly one loader option must be chosen: dlopen=$enable_dlopen statsysbfd=$enable_statsysbfd dynsysbfd=$enable_dynsysbfd custreloc=$enable_custreloc" ++ AC_MSG_ERROR([loader option failure]) + fi + +-TLDFLAGS="" +-if test "$enable_static" = "yes" ; then +- TLDFLAGS="-static -Wl,-zmuldefs $TLDFLAGS"; #FIXME should be in unixport/makefile +- AC_DEFINE(STATIC_LINKING,1,[staticly linked images]) +-fi +-case $use in +- *gnuwin*) +- TLDFLAGS="$TLDFLAGS -Wl,--stack,8000000";; +-esac +- +-## finally warn if we did not find a recognized machine.s +-## +-#if test "$use" = "unknown" ; then +-#types=`echo h/*.defs` | sed -e "s:h/::g" -e "s:\.defs:g"` +-#echo got canonical=$canonical, but was not recognized. +-#echo Unable to guess type to use. Try one of +-#exit(1) +-#fi +- +-AC_MSG_RESULT([use=$use]) +- + + # + # System programs +@@ -462,221 +170,250 @@ AC_MSG_RESULT([use=$use]) + # We set the default CFLAGS below, and don't want the autoconf default + # CM 20040106 + if test "$CFLAGS" = "" ; then +- CFLAGS=" " ++ CFLAGS=" " + fi + if test "$LDFLAGS" = "" ; then +- LDFLAGS=" " ++ LDFLAGS=" " + fi + + AC_PROG_CC + AC_PROG_CPP + AC_SUBST(CC) ++GCL_CC=`basename $CC` ++if echo $GCL_CC |grep gcc |grep -q win; then ++ GCL_CC=gcc ++fi ++AC_SUBST(GCL_CC) + ++add_arg_to_tcflags() { ++ ++ local i=1 ++ AC_MSG_CHECKING([for CFLAG $1]) ++ CFLAGS_ORI=$CFLAGS ++ CFLAGS="$CFLAGS -Werror $1 `echo $1|sed 's,-Wno-,-W,1'`" ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM([[]],[[]])], ++ [TCFLAGS="$TCFLAGS $1";AC_MSG_RESULT([yes]);i=0], ++ [AC_MSG_RESULT([no])], ++ [AC_MSG_RESULT([no])]) ++ CFLAGS=$CFLAGS_ORI ++ return $i ++ ++} + +-# can only test for numbers -- CM +-# if test "${GCC}" -eq "yes" ; then +-#if [[ "${GCC}" = "yes" ]] ; then +-# Allog for environment variable overrides on compiler selection -- CM +-#GCC=$CC +-#else +-#GCC="" +-#fi +-# subst GCC not only under 386-linux, but where available -- CM +- +-TCFLAGS="-fsigned-char -fno-builtin-malloc -fno-builtin-free" +- +-if test "$GCC" = "yes" ; then +- +- TCFLAGS="$TCFLAGS -Wall" +- +- AC_MSG_CHECKING([for clang]) +- AC_RUN_IFELSE([ +- AC_LANG_SOURCE([[ +- int main() { +- return +- #ifdef __clang__ +- 0 +- #else +- 1 +- #endif +- ;}]])], +- [AC_MSG_RESULT([yes]) +- clang="yes" +- TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign" +- AC_DEFINE([CLANG],[1],[running clang compiler])], +- [AC_MSG_RESULT([no]) +- #FIXME -Wno-unused-but-set-variable when time +- TMPF=-Wno-unused-but-set-variable +- AC_MSG_CHECKING([for CFLAG $TMPF]) +- CFLAGS_ORI=$CFLAGS +- CFLAGS="$CFLAGS $TMPF" +- AC_TRY_RUN([int main() {return 0;}],TCFLAGS="$TCFLAGS $TMPF";AC_MSG_RESULT(yes),AC_MSG_RESULT(no),AC_MSG_RESULT(no)) +- CFLAGS=$CFLAGS_ORI]) +-fi ++assert_arg_to_tcflags() { ++ if ! add_arg_to_tcflags $1 ; then AC_MSG_RESULT([cannot add $1 to CFLAGS]); exit 1 ; fi ++ return 0 ++} + +-if test "$GCC" = "yes" ; then +- TCFLAGS="$TCFLAGS -pipe" +- case $use in +- *mingw*) +-# echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." +-# echo " It is otherwise needed for the Unexec stuff to work." +-# if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi +- TCFLAGS="$TCFLAGS -fno-zero-initialized-in-bss -mms-bitfields";; +- *gnuwin*) +-# echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." +-# echo " It is otherwise needed for the Unexec stuff to work." +-# if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi +- TCFLAGS="$TCFLAGS -fno-zero-initialized-in-bss -mms-bitfields";; +- esac +-fi +-#if test -f /proc/sys/kernel/exec-shield ; then +-# exec_stat=`cat /proc/sys/kernel/exec-shield` +-# if test "$exec_stat" != "0" ; then +-# # CFLAGS here to hopefully cover the DBEGIN routine below +-# CFLAGS="$CFLAGS -Wa,--execstack" +-# fi +-#fi ++add_args_to_tcflags() { ++ ++ while test "$#" -ge 1 ; do ++ add_arg_to_tcflags $1 ++ shift ++ done ++} ++ ++add_arg_to_tldflags() { ++ ++ local i=1 ++ AC_MSG_CHECKING([for LDFLAG $1]) ++ LDFLAGS_ORI=$LDFLAGS ++ LDFLAGS="$LDFLAGS -Werror $1" ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM([[]],[[]])], ++ [TLDFLAGS="$TLDFLAGS $1";AC_MSG_RESULT([yes]);i=0], ++ [AC_MSG_RESULT([no])], ++ [AC_MSG_RESULT([no])]) ++ LDFLAGS=$LDFLAGS_ORI ++ return $i ++ ++} ++ ++assert_arg_to_tldflags() { ++ if ! add_arg_to_tldflags $1 ; then AC_MSG_RESULT([cannot add $1 to LDFLAGS]); exit 1 ; fi ++ return 0 ++} ++ ++add_args_to_tldflags() { ++ ++ while test "$#" -ge 1 ; do ++ add_arg_to_tldflags $1 ++ shift ++ done ++} ++ ++remove_arg_from_ldflags() { ++ ++ NEW_LDFLAGS="" ++ for i in $LDFLAGS; do ++ if ! test "$i" = "$1" ; then ++ NEW_LDFLAGS="$NEW_LDFLAGS $i" ++ else ++ AC_MSG_RESULT([removing $1 from LDFLAGS]) ++ fi ++ done ++ LDFLAGS=$NEW_LDFLAGS ++ ++ return 0 ++ ++} ++ ++TCFLAGS="" ++add_args_to_tcflags -fsigned-char -pipe \ ++ -fno-builtin-malloc -fno-builtin-free \ ++ -fno-PIE -fno-pie -fno-PIC -fno-pic \ ++ -Wall \ ++ -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign \ ++ -Wno-unused-but-set-variable -Wno-misleading-indentation ++ ++TLDFLAGS="" ++add_args_to_tldflags -Wl,-no_pie -no-pie -Wl,-z,lazy ++ ++AC_MSG_CHECKING([for clang]) ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM([[ ++ #ifdef __clang__ ++ #define RET 0 ++ #else ++ #define RET 1 ++ #endif ++ ]], ++ [[ ++ return RET; ++ ]])], ++ [AC_MSG_RESULT([yes]) ++ clang="yes" ++ remove_arg_from_ldflags -pie ++ AC_DEFINE([CLANG],[1],[running clang compiler])], ++ [AC_MSG_RESULT([no])]) ++ ++case $use in ++ *mingw*) ++ assert_arg_to_tcflags -fno-zero-initialized-in-bss ++ assert_arg_to_tcflags -mms-bitfields;; ++ *gnuwin*) ++ assert_arg_to_tcflags -fno-zero-initialized-in-bss ++ assert_arg_to_tcflags -mms-bitfields ++ assert_arg_to_tldflags -Wl,--stack,8000000;; ++ 386-macosx) ++ assert_arg_to_tldflags -Wl,-no_pie ++ if test "$build_cpu" = "x86_64" ; then ++ assert_arg_to_tcflags -m64 ++ assert_arg_to_tldflags -m64 ++ assert_arg_to_tldflags -Wl,-headerpad,72 ++ else ++ assert_arg_to_tcflags -m32 ++ assert_arg_to_tldflags -m32 ++ assert_arg_to_tldflags -Wl,-headerpad,56 ++ fi;; ++ FreeBSD) assert_arg_to_tldflags -Z;; ++esac ++ ++if test "$enable_static" = "yes" ; then ++ assert_arg_to_tldflags -static ++ assert_arg_to_tldflags -Wl,-zmuldefs ++ AC_DEFINE(STATIC_LINKING,1,[staticly linked images]) ++fi + + TO3FLAGS="" + TO2FLAGS="" + +-#TFPFLAG="-fomit-frame-pointer" +-# FIXME -- remove when mingw compiler issues are fixed + case "$use" in +- *mingw*) ++ *mingw*) + TFPFLAG="";; +- m68k*)#FIXME gcc 4.x bug workaround ++ m68k*)#FIXME gcc 4.x bug workaround + TFPFLAG="";; +- *) ++ *) + TFPFLAG="-fomit-frame-pointer";; + esac + + AC_CHECK_PROGS(AWK,[gawk nawk awk]) + +-# Work around system/gprof mips/hppa hang +-AC_MSG_CHECKING([working gprof]) +-old_enable_gprof=$enable_gprof +-case $use in +- powerpc*) if test "$host_cpu" = "powerpc64le" ; then enable_gprof="no"; fi;; +- sh4*) enable_gprof="no";; +- ia64*) enable_gprof="no";; +-# mips*) enable_gprof="no";; +- hppa*) enable_gprof="no";; +- arm*) enable_gprof="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible +- *gnu) enable_gprof="no";; +-esac +-if test "$enable_gprof" = "$old_enable_gprof" ; then +- AC_MSG_RESULT([ok]) +-else +- AC_MSG_RESULT([disabled]) +-fi +- +-if test "$enable_gprof" = "yes" ; then +- AC_MSG_CHECKING(for text start) +- echo 'int main () {return(0);}' >foo.c +- $CC foo.c -o foo +- GCL_GPROF_START=`nm foo | $AWK '/ *[[TD]] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc +- rm -f foo.c foo +- if test "$GCL_GPROF_START" != "" ; then +- AC_MSG_RESULT($GCL_GPROF_START) +- AC_DEFINE_UNQUOTED(GCL_GPROF_START,$GCL_GPROF_START,[starting address for gprof]) +- case "$use" in +- arm*) +- #FIXME report and remove this when done +- AC_MSG_RESULT(Reducing optimization on profiling arm build to workaround gcc bug) +- enable_debug=yes;; +- esac +- TCFLAGS="$TCFLAGS -pg"; +- case $use in +- s390*) ;; # relocation truncation bug in gcc +- *) TLIBS="$TLIBS -pg";; +- esac +- TFPFLAG="" +- AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) +- else +- enable_gprof="no"; +- fi +-fi +- +-if $CC -v 2>&1 | tail -1 | grep "gcc version 4.6.1" >/dev/null ; then +- case "$use" in +- arm*) +- #FIXME report and remove this when done +- AC_MSG_RESULT(Reducing optimization on arm build to workaround gcc 4.6 bug) +- enable_debug=yes;; +- esac +-fi +- ++AC_ARG_ENABLE([gprof],[ --enable-gprof builds gcl with -pg in CFLAGS to enable profiling with gprof], ++ [if test "$enableval" = "yes" ; then ++ AC_MSG_CHECKING([working gprof]) ++ case $use in ++ powerpc*) if test "$host_cpu" = "powerpc64le" ; then enableval="no"; fi;; ++ sh4*) enableval="no";; ++ ia64*) enableval="no";; ++ hppa*) enableval="no";; ++ arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++ *gnu) enableval="no";; ++ esac ++ if test "$enableval" != "yes" ; then ++ AC_MSG_RESULT([disabled]) ++ else ++ AC_MSG_RESULT([ok]) ++ AC_MSG_CHECKING([for text start]) ++ echo 'int main () {return(0);}' >foo.c ++ $CC foo.c -o foo ++ GCL_GPROF_START=`nm foo | $AWK '/ *[[TD]] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc ++ rm -f foo.c foo ++ if test "$GCL_GPROF_START" != "" ; then ++ AC_MSG_RESULT($GCL_GPROF_START) ++ AC_DEFINE_UNQUOTED(GCL_GPROF_START,$GCL_GPROF_START,[starting address for gprof]) ++ assert_arg_to_tcflags -pg ++ case $use in ++ s390*) ;; # relocation truncation bug in gcc ++ *) TLIBS="$TLIBS -pg";; ++ esac ++ TFPFLAG="" ++ AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) ++ fi ++ fi ++ fi]) + + if test "$enable_debug" = "yes" ; then +- TCFLAGS="$TCFLAGS -g" +- # for subconfigurations +- CFLAGS="$CFLAGS -g" ++ assert_arg_to_tcflags -g ++ # for subconfigurations ++ CFLAGS="$CFLAGS -g" + else +- TO3FLAGS="-O3 $TFPFLAG" +- TO2FLAGS="-O" ++ TO3FLAGS="-O3 $TFPFLAG" ++ TO2FLAGS="-O" + fi + + # gcc on ppc cannot compile our new_init.c with full opts --CM + TONIFLAGS="" + case $use in +- powerpc*macosx) +- TCFLAGS="$TCFLAGS -mlongcall";; +- *linux) ++ powerpc*macosx) assert_arg_to_tcflags -mlongcall;; ++ *linux) + case $use in +-# amd64*) # stack-boundary option does not work +-# TCFLAGS="$TCFLAGS -m64 -mpreferred-stack-boundary=8";; +- alpha*) +- TCFLAGS="$TCFLAGS -mieee" +- if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1 +- ;; +-# m68k*) +-# TCFLAGS="$TCFLAGS -ffloat-store";; +- aarch64*) +- TLIBS="$TLIBS -lgcc_s";; +- hppa*) +- TCFLAGS="$TCFLAGS -mlong-calls " +- TLIBS="$TLIBS -lgcc_s" # workaround hppa __moddi3 local func symbols with default linker flags +- if test "$enable_debug" != "yes" ; then TO3FLAGS="-O2" ; TFPFLAG=""; fi #FIXME needed asof gcc 4.8.1 +-# TCFLAGS="$TCFLAGS -ffunction-sections" +-# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O $TFPFLAG" ; fi +-# if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi +- ;; +- mips*) +- case $canonical in +- mips64*linux*) +- TLIBS="$TLIBS -Wl,-z -Wl,now";; +- esac +-# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 +- ;; +- ia64*) +- if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 +- ;; +- arm*) +- TCFLAGS="$TCFLAGS -mlong-calls -fdollars-in-identifiers -g " +-# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.6.2 +-# if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi +- ;; +- powerpc*) +- TCFLAGS="$TCFLAGS -mlongcall" +- ;; +-# if $CC -v 2>&1 | grep -q "gcc version 3.2" ; then +-# echo Reducing optimization for buggy gcc-3.2 +-# if test "$enable_debug" != "yes" ; then TONIFLAGS="-O $TFPFLAG" ; fi +-# fi; +-# echo Probing for longcall +-# if ! $CC -v 2>&1 | $AWK '/^gcc version / {split($3,A,".");if (A[[1]]+0>3 || (A[[1]]+0>=3 && A[[2]]+0>=3)) exit 1;}'; then +-# echo Enabling longcall on gcc 3.3 or later +-# TCFLAGS="$TCFLAGS -mlongcall" +-# echo Reducing optimization for buggy gcc 3.3 or later +-# if test "$enable_debug" != "yes" ; then TONIFLAGS="-O $TFPFLAG" ; fi +-# fi;; ++ alpha*) ++ assert_arg_to_tcflags -mieee ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1 ++ ;; ++ aarch64*) ++ TLIBS="$TLIBS -lgcc_s";; ++ hppa*) ++ assert_arg_to_tcflags -mlong-calls ++ TLIBS="$TLIBS -lgcc_s" # workaround hppa __moddi3 local func symbols with default linker flags ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O2" ; TFPFLAG=""; fi #FIXME needed asof gcc 4.8.1 ++ ;; ++ mips*) ++ case $canonical in ++ mips64*linux*) ++ assert_arg_to_tldflags -Wl,-z,now;; ++ esac ++ ;; ++ ia64*) ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 ++ ;; ++ arm*) ++ assert_arg_to_tcflags -mlong-calls ++ assert_arg_to_tcflags -fdollars-in-identifiers ++ assert_arg_to_tcflags -g #? ++ ;; ++ powerpc*) ++ assert_arg_to_tcflags -mlongcall ++ ;; + esac;; + esac + if test "$enable_pic" = "yes" ; then +- TCFLAGS="$TCFLAGS -fPIC" ++ assert_arg_to_tcflags -fPIC + fi + ++ + FDEBUG=`echo $CFLAGS | tr ' ' '\012' |grep "^\-g$"|tr '\012' ' '` + #CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-g$"` + FOMITF=`echo $CFLAGS | tr ' ' '\012' |grep "^\-fomit-frame-pointer$"|tr '\012' ' '` +@@ -693,27 +430,27 @@ FOOPT0=`echo $CFLAGS | tr ' ' '\012' |gr + CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-O0$"|tr '\012' ' '` + + if test "$FOOPT0" != "" ; then +- TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[[123 ]],-O0 ,g' | sed 's,\-O$,-O0 ,g'` +- TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[[123 ]],-O0 ,g' | sed 's,\-O$,-O0 ,g'` +-else +-if test "$FOOPT1" != "" ; then +- TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[[2-3]],-O1,g'` +- TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[[2-3]],-O1,g'` ++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[[123 ]],-O0 ,g' | sed 's,\-O$,-O0 ,g'` ++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[[123 ]],-O0 ,g' | sed 's,\-O$,-O0 ,g'` + else +-if test "$FOOPT2" != "" ; then +- TO3FLAGS=`echo "$TO3FLAGS" | sed 's,\-O3,-O2,g'` +- TO2FLAGS=`echo "$TO2FLAGS" | sed 's,\-O3,-O2,g'` +-fi +-fi ++ if test "$FOOPT1" != "" ; then ++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[[2-3]],-O1,g'` ++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[[2-3]],-O1,g'` ++ else ++ if test "$FOOPT2" != "" ; then ++ TO3FLAGS=`echo "$TO3FLAGS" | sed 's,\-O3,-O2,g'` ++ TO2FLAGS=`echo "$TO2FLAGS" | sed 's,\-O3,-O2,g'` ++ fi ++ fi + fi + + if test "$FDEBUG" != "" ; then +- TO3FLAGS=`echo $TO3FLAGS | sed 's,\-fomit-frame-pointer,,g'` +- TO2FLAGS=`echo $TO2FLAGS | sed 's,\-fomit-frame-pointer,,g'` ++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-fomit-frame-pointer,,g'` ++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-fomit-frame-pointer,,g'` + fi + + if test "$FOMITF" != "" ; then +- TO3FLAGS="$TO3FLAGS $FOMITF" ++ TO3FLAGS="$TO3FLAGS $FOMITF" + fi + + # Step 1: set the variable "system" to hold the name and version number +@@ -731,12 +468,12 @@ if test -f /usr/lib/NextStep/software_ve + else + system=`uname -s`-`uname -r` + if test "$?" -ne 0 ; then +- AC_MSG_RESULT([unknown (can't find uname command)]) ++ AC_MSG_RESULT([unknown (cannot find uname command)]) + system=unknown + else + # Special check for weird MP-RAS system (uname returns weird + # results, and the version is kept in special file). +- ++ + if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then + system="MP-RAS-`${AWK} '{print $3}' '/etc/.relid'`" + fi +@@ -748,156 +485,130 @@ else + fi + + case $use in +- *macosx) ++ *macosx) + AC_CHECK_HEADERS(malloc/malloc.h,,[AC_MSG_ERROR([need malloc.h on macosx])]) + AC_CHECK_MEMBER([struct _malloc_zone_t.memalign], +- AC_DEFINE(HAVE_MALLOC_ZONE_MEMALIGN,1,[memalign element present]), [], +- [ +- #include +- ]) ++ AC_DEFINE(HAVE_MALLOC_ZONE_MEMALIGN,1,[memalign element present]), [], ++ [ ++ #include ++ ]) + AC_SUBST(HAVE_MALLOC_ZONE_MEMALIGN) + ;; + esac + +- +-AC_CHECK_HEADERS(setjmp.h, +- AC_MSG_CHECKING([sizeof jmp_buf]) +- AC_RUN_IFELSE([ +- AC_LANG_SOURCE([[ +- #include +- #include +- int main() { +- FILE *fp=fopen("conftest1","w"); +- fprintf(fp,"%lu\n",sizeof(jmp_buf)); +- fclose(fp); +- return 0; +- }]])], +- [sizeof_jmp_buf=`cat conftest1` +- AC_MSG_RESULT($sizeof_jmp_buf) +- AC_DEFINE_UNQUOTED(SIZEOF_JMP_BUF,$sizeof_jmp_buf,[sizeof jmp_buf])], +- [AC_MSG_RESULT(no)])) ++AC_CHECK_HEADERS( ++ [setjmp.h], ++ [AC_MSG_CHECKING([sizeof jmp_buf]) ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #include ++ ]], ++ [[ ++ FILE *fp=fopen("conftest1","w"); ++ fprintf(fp,"%lu\n",sizeof(jmp_buf)); ++ fclose(fp); ++ ]])], ++ [sizeof_jmp_buf=`cat conftest1` ++ AC_MSG_RESULT($sizeof_jmp_buf) ++ AC_DEFINE_UNQUOTED(SIZEOF_JMP_BUF,$sizeof_jmp_buf,[sizeof jmp_buf])], ++ [AC_MSG_RESULT([no])])]) + + # sysconf ++AC_CHECK_HEADERS( ++ [unistd.h], ++ [AC_CHECK_LIB( ++ [c],[sysconf], ++ [AC_MSG_CHECKING([_SC_CLK_TCK]) ++ hz=0 ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #include ++ ]], ++ [[ ++ FILE *fp=fopen("conftest1","w"); ++ fprintf(fp,"%lu\n",sysconf(_SC_CLK_TCK)); ++ fclose(fp); ++ ]], ++ [hz=`cat conftest1` ++ AC_DEFINE_UNQUOTED(HZ,$hz,[time system constant])])]) ++ AC_MSG_RESULT($hz)])]) + +-AC_CHECK_HEADERS(unistd.h, +- AC_CHECK_LIB(c,sysconf, +- AC_MSG_CHECKING(_SC_CLK_TCK) +- AC_TRY_RUN([#include +- #include +- int +- main() { +- FILE *fp=fopen("conftest1","w"); +- fprintf(fp,"%lu\n",sysconf(_SC_CLK_TCK)); +- fclose(fp); +- return 0; +- }], +- hz=`cat conftest1` +- AC_DEFINE_UNQUOTED(HZ,$hz,[time system constant]) +- ,hz=0,hz=0) +- [AC_MSG_RESULT($hz)] +- dnl AC_MSG_CHECKING(_SC_PHYS_PAGES) +- dnl AC_RUN_IFELSE([ +- dnl AC_LANG_SOURCE([[ +- dnl #include +- dnl #include +- dnl int main() { +- dnl FILE *fp=fopen("conftest1","w"); +- dnl fprintf(fp,"%lu\n",sysconf(_SC_PHYS_PAGES)); +- dnl fclose(fp); +- dnl return 0; +- dnl }]])], +- dnl [phys=`cat conftest1` +- dnl AC_MSG_RESULT($phys) +- dnl AC_DEFINE(HAVE_SYSCONF_PHYS_PAGES,$phys,[probe runtime phys pages for gc performance])], +- dnl [AC_MSG_RESULT(no)]) +- )) +- +- +-#MY_SUBDIRS= +- +-# +-# GMP +-# + + rm -f makedefsafter + +-MP_INCLUDE="" +-if test $use_gmp = yes ; then ++AC_ARG_ENABLE([dynsysgmp], ++ [ --enable-dynsysgmp will link against the system libgmp3 overriding certain functions with patched versions from the local source]) + +- PATCHED_SYMBOLS="" +- if test "$enable_dynsysgmp" = "yes" ; then +- AC_CHECK_HEADERS(gmp.h, +- AC_CHECK_LIB(gmp,__gmpz_init, +- AC_MSG_CHECKING("for external gmp version") +- AC_TRY_RUN([#include +- int main() { +- #if __GNU_MP_VERSION > 3 +- return 0; +- #else +- return -1; +- #endif +- }], +-# MPFILES=$GMPDIR/mpn/mul_n.o +-# PATCHED_SYMBOLS=__gmpn_toom3_mul_n +- MPFILES= +- PATCHED_SYMBOLS= +-# if test "$use" = "m68k-linux" ; then +-# MPFILES="$MPFILES $GMPDIR/mpn/lshift.o $GMPDIR/mpn/rshift.o" +-# PATCHED_SYMBOLS="$PATCHED_SYMBOLS __gmpn_lshift __gmpn_rshift" +-# fi +- TLIBS="$TLIBS -lgmp" +- echo "#include \"gmp.h\"" >foo.c +- echo "int main() {return 0;}" >>foo.c +- MP_INCLUDE=`cpp foo.c | $AWK '/(\/|\\\\)gmp.h/ {if (!i) print $3;i=1}' | tr -d '"'` +- rm -f foo.c, +- echo "Cannot use dynamic gmp lib" , echo "Cannot use dynamic gmp lib" ), +- echo "Cannot use dynamic gmp lib" ,), +- echo "Cannot use dynamic gmp lib" ,) +-fi +- +-NEED_LOCAL_GMP='' +-if test "$MP_INCLUDE" = "" ; then +- NEED_LOCAL_GMP=1; +-fi +-if test "$PATCHED_SYMBOLS" != "" ; then +- NEED_LOCAL_GMP=1; ++if test "$enable_dynsysgmp" != "no" ; then ++ AC_CHECK_HEADERS( ++ [gmp.h], ++ [AC_CHECK_LIB( ++ [gmp],[__gmpz_init], ++ [AC_MSG_CHECKING([for external gmp version]) ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ ]], ++ [[ ++ #if __GNU_MP_VERSION > 3 ++ return 0; ++ #else ++ return -1; ++ #endif ++ ]])], ++ [AC_MSG_RESULT([good]) ++ TLIBS="$TLIBS -lgmp" ++ echo "#include \"gmp.h\"" >foo.c ++ echo "int main() {return 0;}" >>foo.c ++ MP_INCLUDE=`cpp foo.c | $AWK '/(\/|\\\\)gmp.h/ {if (!i) print $3;i=1}' | tr -d '"'` ++ rm -f foo.c])])]) ++ ++ if test "$MP_INCLUDE" = "" ; then ++ AC_MSG_RESULT([Cannot use dynamic gmp lib]) ++ fi ++ + fi + +-if test "$NEED_LOCAL_GMP" != "" ; then +- +- GMPDIR=gmp4 +- AC_MSG_CHECKING([use_gmp=yes, doing configure in gmp directory]) +- echo +- echo "#" +- echo "#" +- echo "# -------------------" +- echo "# Subconfigure of GMP" +- echo "#" +- echo "#" +- +- if test "$use_common_binary" = "yes"; then +- cd $GMPDIR && ./configure --build=$host && cd .. +- else +- cd $GMPDIR && ./configure && cd .. +- fi +- #MY_SUBDIRS="$MY_SUBDIRS $GMPDIR" +- +- echo "#" +- echo "#" +- echo "#" +- echo "# Subconfigure of GMP done" +- echo "# ------------------------" +- echo "#" +- +- if test "$MP_INCLUDE" = "" ; then +- cp $GMPDIR/gmp.h h/gmp.h +- MP_INCLUDE=h/gmp.h +- MPFILES=gmp_all +- fi + ++if test "$MP_INCLUDE" = "" ; then ++ ++ GMPDIR=gmp4 ++ AC_MSG_CHECKING([doing configure in gmp directory]) ++ echo ++ echo "#" ++ echo "#" ++ echo "# -------------------" ++ echo "# Subconfigure of GMP" ++ echo "#" ++ echo "#" ++ ++ if test "$use_common_binary" = "yes"; then ++ cd $GMPDIR && ./configure --build=$host && cd .. ++ else ++ cd $GMPDIR && ./configure --host=$host --build=$build && cd .. ++ fi ++ #MY_SUBDIRS="$MY_SUBDIRS $GMPDIR" ++ ++ echo "#" ++ echo "#" ++ echo "#" ++ echo "# Subconfigure of GMP done" ++ echo "# ------------------------" ++ echo "#" ++ ++ if test "$MP_INCLUDE" = "" ; then ++ cp $GMPDIR/gmp.h h/gmp.h ++ MP_INCLUDE=h/gmp.h ++ MPFILES=gmp_all ++ fi + fi + +-AC_MSG_CHECKING("for leading underscore in object symbols") ++AC_MSG_CHECKING([for leading underscore in object symbols]) + cat>foo.c < + #include +@@ -905,12 +616,12 @@ int main() {FILE *f;double d=0.0;getc(f) + EOFF + $CC -c foo.c -o foo.o + if nm foo.o |grep " U " | grep "_cos" >/dev/null || nm foo.o |grep " U " | grep " _getc" >/dev/null ; then +- LEADING_UNDERSCORE=1 +- AC_DEFINE(LEADING_UNDERSCORE,1,[symbol name mangling convention]) +- AC_MSG_RESULT("yes") ++ LEADING_UNDERSCORE=1 ++ AC_DEFINE(LEADING_UNDERSCORE,1,[symbol name mangling convention]) ++ AC_MSG_RESULT("yes") + else +- LEADING_UNDERSCORE="" +- AC_MSG_RESULT("no") ++ LEADING_UNDERSCORE="" ++ AC_MSG_RESULT("no") + fi + + +@@ -918,61 +629,63 @@ AC_MSG_CHECKING("for GNU ld option -Map" + touch map + $CC -o foo [ -Wl,-Map ] map foo.o >/dev/null 2>&1 + if test `cat map | wc -l` != "0" ; then +- AC_MSG_RESULT("yes") +- AC_DEFINE(HAVE_GNU_LD,1,[gnu linker present]) +- GNU_LD=1 ++ AC_MSG_RESULT("yes") ++ AC_DEFINE(HAVE_GNU_LD,1,[gnu linker present]) ++ GNU_LD=1 + else +- AC_MSG_RESULT("no") +- GNU_LD= ++ AC_MSG_RESULT("no") ++ GNU_LD= + fi + rm -f foo.c foo.o foo map + + AC_MSG_CHECKING([for size of gmp limbs]) + AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +- #include +- #include "$MP_INCLUDE" +- ]],[[ +- FILE *fp=fopen("conftest1","w"); +- fprintf(fp,"%u",sizeof(mp_limb_t)); +- fclose(fp); +- return 0; +- ]])],[mpsize=`cat conftest1`],[AC_MSG_ERROR([Cannot determine mpsize])]) ++ #include ++ #include "$MP_INCLUDE" ++ ]], ++ [[ ++ FILE *fp=fopen("conftest1","w"); ++ fprintf(fp,"%u",sizeof(mp_limb_t)); ++ fclose(fp); ++ ]])],[mpsize=`cat conftest1`],[AC_MSG_ERROR([Cannot determine mpsize])]) + AC_DEFINE_UNQUOTED(MP_LIMB_BYTES,$mpsize,[sizeof mp_limb in gmp library]) + AC_MSG_RESULT($mpsize) + + AC_MSG_CHECKING([_SHORT_LIMB]) + AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +- #include +- #include "$MP_INCLUDE" +- ]],[[ +- #ifdef _SHORT_LIMB +- return 0; +- #else +- return 1; +- #endif +- ]])],[AC_DEFINE(__SHORT_LIMB,1,[short gmp3 limbs]) AC_MSG_RESULT(yes)],[AC_MSG_RESULT(no)]) ++ #include ++ #include "$MP_INCLUDE" ++ ]], ++ [[ ++ #ifdef _SHORT_LIMB ++ return 0; ++ #else ++ return 1; ++ #endif ++ ]])],[AC_DEFINE(__SHORT_LIMB,1,[short gmp3 limbs]) AC_MSG_RESULT(yes)],[AC_MSG_RESULT(no)]) + + AC_MSG_CHECKING([_LONG_LONG_LIMB]) + AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +- #include +- #include "$MP_INCLUDE" +- ]],[[ +- #ifdef _LONG_LONG_LIMB +- return 0; +- #else +- return 1; +- #endif +- ]])],[AC_DEFINE(__LONG_LONG_LIMB,1,[long gmp3 limbs]) AC_MSG_RESULT(yes)],[AC_MSG_RESULT(no)]) +- +- GMP=1 +- AC_DEFINE(GMP,1,[using gmp]) +- AC_SUBST(GMP) +- AC_SUBST(GMPDIR) +- echo > makedefsafter +- echo "MPFILES=$MPFILES" >> makedefsafter +- echo "PATCHED_SYMBOLS=$PATCHED_SYMBOLS" >> makedefsafter +- echo >> makedefsafter +-fi ++ #include ++ #include "$MP_INCLUDE" ++ ]], ++ [[ ++ #ifdef _LONG_LONG_LIMB ++ return 0; ++ #else ++ return 1; ++ #endif ++ ]])],[AC_DEFINE(__LONG_LONG_LIMB,1,[long gmp3 limbs]) AC_MSG_RESULT(yes)],[AC_MSG_RESULT(no)]) ++ ++GMP=1 ++AC_DEFINE(GMP,1,[using gmp]) ++AC_SUBST(GMP) ++AC_SUBST(GMPDIR) ++echo > makedefsafter ++echo "MPFILES=$MPFILES" >> makedefsafter ++echo "PATCHED_SYMBOLS=$PATCHED_SYMBOLS" >> makedefsafter ++echo >> makedefsafter ++ + + + # +@@ -980,30 +693,13 @@ fi + # + + if test "$enable_xgcl" = "yes" ; then +- +- AC_PATH_X +-# AC_PATH_XTRA +-# echo $X_CFLAGS +-# echo $X_LIBS +-# echo $X_EXTRA_LIBS +-# echo $X_PRE_LIBS +- +- miss=0 +-# AC_CHECK_LIB(Xmu,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS)#FIXME remove these +-# AC_CHECK_LIB(Xt,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS) +-# AC_CHECK_LIB(Xext,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS) +-# AC_CHECK_LIB(Xaw,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS)#until here +- AC_CHECK_LIB(X11,main,X_LIBS="$X_LIBS -lX11",miss=1,$X_LIBS) +- +- if test "$miss" = "1" ; then +- X_CFLAGS= +- X_LIBS= +- X_EXTRA_LIBS= +- X_PRE_LIBS= +- echo missing x libraries -- cannot compile xgcl +- else +- AC_DEFINE(HAVE_XGCL,1,[using xgcl]) +- fi ++ ++ AC_PATH_X ++ ++ AC_CHECK_LIB(X11,main, ++ [X_LIBS="$X_LIBS -lX11" AC_DEFINE(HAVE_XGCL,1,[using xgcl])], ++ [AC_MSG_RESULT([missing x libraries -- cannot compile xgcl])]) ++ + fi + + +@@ -1015,225 +711,194 @@ AC_SUBST(X_CFLAGS) + # + + if test "$enable_dlopen" = "yes" ; then ++ ++ AC_CHECK_LIB([dl],[dlopen],,AC_MSG_ERROR([Cannot find dlopen])) ++ ++ TLIBS="$TLIBS -ldl -rdynamic" ++ assert_arg_to_tcflags -fPIC ++ AC_DEFINE(USE_DLOPEN,1,[link compiled objects via libdl]) + +- AC_CHECK_LIB(dl,dlopen,have_dl=1,have_dl=0) +- if test "$have_dl" = "0" ; then +- echo "Cannot find dlopen in -dl" +- exit 1 +- fi +-dnl AC_SEARCH_LIBS(dlopen, dl, have_dl=1, AC_ERROR(dlopen not found)) +-dnl LIBS and TLIBS - why not merged from the beginning? +- +- TLIBS="$TLIBS -ldl -rdynamic" +- TCFLAGS="-fPIC $TCFLAGS" +-dnl TLIBS="$TLIBS -rdynamic" +- AC_DEFINE(USE_DLOPEN,1,[link compiled objects via libdl]) + fi + + if test "$enable_statsysbfd" = "yes" || test "$enable_dynsysbfd" = "yes" ; then +- AC_CHECK_HEADERS(bfd.h, +- AC_CHECK_LIB(bfd,bfd_init, +- # +- # Old binutils appear to need CONST defined to const +- # +- AC_MSG_CHECKING(if need to define CONST for bfd) +- AC_TRY_RUN([#define IN_GCC +- #include +- int main() { symbol_info t; return 0;}], +- AC_MSG_RESULT(no), +- AC_TRY_RUN([#define CONST const +- #define IN_GCC +- #include +- int main() {symbol_info t; return 0;}], +- AC_MSG_RESULT(yes) +- AC_DEFINE(NEED_CONST,1,[binutils requires CONST definition]), +- AC_MSG_ERROR([cannot use bfd]), +- AC_MSG_ERROR([cannot use bfd])), +- AC_MSG_ERROR([cannot use bfd])) +- ,,-liberty)) +- +- AC_DEFINE(HAVE_LIBBFD,1,[use libbfd]) +- +-# +-# BFD boolean syntax +-# +- +- AC_MSG_CHECKING(for useable bfd_boolean) +- AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +- #define IN_GCC +- #include +- bfd_boolean foo() {return FALSE;} +- ]],[[return 0;]])], +- [AC_MSG_RESULT(yes) +- AC_DEFINE(HAVE_BFD_BOOLEAN,1,[bfd_boolean defined])], +- [AC_MSG_RESULT(no)]) +- +-# +-# bfd_link_info.output_bfd minimal configure change check +-# +- +- AC_CHECK_MEMBER([struct bfd_link_info.output_bfd], +- AC_DEFINE(HAVE_OUTPUT_BFD,1,[output_bfd element present]), [], +- [ +- #include +- #include +- ]) +- AC_SUBST(HAVE_OUTPUT_BFD) +- +-# +-# FIXME: Need to workaround mingw before this point -- CM +-# +- if test "$enable_statsysbfd" = "yes" && ! $CC -v 2>&1 | fgrep ming > /dev/null ; then +- echo 'int main() {bfd_init();bfd_openr("/dev/null",0);return 0;}' >foo.c +- MP=`$CC [ -Wl,-M ] -static -o foo foo.c -lbfd -liberty -ldl 2>&1 | grep -v : | tr '()' '\012\012' | $AWK '{print $NF}' | sort | uniq` +- rm -f foo.c foo +- if echo $MP | tr ' ' '\012' | grep libbfd.a >/dev/null; then +- LIBBFD="`echo $MP | tr ' ' '\012' | grep libbfd.a | $AWK '{i=split($1,A,"/");for (j=1;j<=i;j++) if (j>1 && A[[j]]=="..") {j--;i-=2;for (k=j;k<=i;k++) A[[k]]=A[[k+2]];j--;}} END {for (j=1;j<=i;j++) printf("%s%s",A[[j]],j!=i ? "/" : "")}'`" +- else +- AC_MSG_ERROR([cannot locate external libbfd.a]) +- fi +- if echo $MP | tr ' ' '\012' | grep libiberty.a >/dev/null ; then +- LIBIBERTY="`echo $MP | tr ' ' '\012' | grep libiberty.a | $AWK '{i=split($1,A,"/");for (j=1;j<=i;j++) if (j>1 && A[[j]]=="..") {j--;i-=2;for (k=j;k<=i;k++) A[[k]]=A[[k+2]];j--;}} END {for (j=1;j<=i;j++) printf("%s%s",A[[j]],j!=i ? "/" : "")}'`" +- else +- AC_MSG_ERROR([cannot locate external libiberty.a]) +- fi +- BUILD_BFD=copy_bfd +- AC_CHECK_LIB(z,inflate, +- [TLIBS="$TLIBS -lz"], +- AC_MSG_ERROR([Need zlib for bfd linking]),[]) +- AC_CHECK_LIB(dl,dlsym, +- [TLIBS="$TLIBS -ldl"], +- AC_MSG_ERROR([Need libdl for bfd linking]),[]) +- AC_SUBST(BUILD_BFD) +- AC_SUBST(LIBBFD) +- AC_SUBST(LIBIBERTY) +- ++ AC_CHECK_HEADERS( ++ [bfd.h], ++ AC_CHECK_LIB( ++ [bfd],[bfd_init], ++ # ++ # Old binutils appear to need CONST defined to const ++ # ++ AC_MSG_CHECKING([need to define CONST for bfd]) ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #define IN_GCC ++ #include ++ ]], ++ [[ ++ symbol_info t; ++ ]])], ++ AC_MSG_RESULT([no]), ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #define CONST const ++ #define IN_GCC ++ #include ++ ]], ++ [[ ++ symbol_info t; ++ ]])], ++ AC_MSG_RESULT([yes]) ++ AC_DEFINE(NEED_CONST,1,[binutils requires CONST definition]), ++ AC_MSG_ERROR([cannot use bfd]), ++ AC_MSG_ERROR([cannot use bfd])), ++ AC_MSG_ERROR([cannot use bfd])) ++ ,,-liberty)) ++ ++ AC_DEFINE(HAVE_LIBBFD,1,[use libbfd]) ++ ++ # ++ # BFD boolean syntax ++ # ++ ++ AC_MSG_CHECKING(for useable bfd_boolean) ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #define IN_GCC ++ #include ++ bfd_boolean foo() {return FALSE;} ++ ]], ++ [[]])], ++ [AC_MSG_RESULT(yes) ++ AC_DEFINE(HAVE_BFD_BOOLEAN,1,[bfd_boolean defined])], ++ [AC_MSG_RESULT(no)]) ++ ++ # ++ # bfd_link_info.output_bfd minimal configure change check ++ # ++ ++ AC_CHECK_MEMBER([struct bfd_link_info.output_bfd], ++ AC_DEFINE(HAVE_OUTPUT_BFD,1,[output_bfd element present]), [], ++ [[ ++ #include ++ #include ++ ]]) ++ AC_SUBST(HAVE_OUTPUT_BFD) ++ ++ # ++ # FIXME: Need to workaround mingw before this point -- CM ++ # ++ if test "$enable_statsysbfd" = "yes" && ! $CC -v 2>&1 | fgrep ming > /dev/null ; then ++ echo 'int main() {bfd_init();bfd_openr("/dev/null",0);return 0;}' >foo.c ++ MP=`$CC [ -Wl,-M ] -static -o foo foo.c -lbfd -liberty -ldl 2>&1 | grep -v : | tr '()' '\012\012' | $AWK '{print $NF}' | sort | uniq` ++ rm -f foo.c foo ++ if echo $MP | tr ' ' '\012' | grep libbfd.a >/dev/null; then ++ LIBBFD="`echo $MP | tr ' ' '\012' | grep libbfd.a | $AWK '{i=split($1,A,\"/\");for (j=1;j<=i;j++) if (j>1 && A[[j]]==\"..\") {j--;i-=2;for (k=j;k<=i;k++) A[[k]]=A[[k+2]];j--;}} END {for (j=1;j<=i;j++) printf(\"%s%s\",A[[j]],j!=i ? \"/\" : \"\")}'`" + else +- TLIBS="$TLIBS -lbfd -liberty -ldl" +- fi +-fi +- +-if test "$enable_locbfd" = "yes" ; then +- +- # check for gettext. It is part of glibc, but others +- # need GNU gettext separately. +-# AC_CHECK_HEADERS(libintl.h, true, +-# AC_MSG_ERROR(libintl.h (gettext) not found)) +-# AC_SEARCH_LIBS(dgettext, intl, true, AC_MSG_ERROR(gettext library not found)) +- +- echo "#" +- echo "#" +- echo "# -------------------------" +- echo "# Subconfigure of LIBINTL" +- echo "#" +- echo "#" +- cd binutils/intl && chmod +x configure && ./configure --disable-nls && cd ../.. +-# MY_SUBDIRS="$MY_SUBDIRS binutils/libiberty " +- echo "#" +- echo "#" +- echo "#" +- echo "# Subconfigure of LIBINTL done" +- echo "# ------------------------------" +- echo "#" +- echo "#" +- echo "#" +- echo "# -------------------------" +- echo "# Subconfigure of LIBIBERTY" +- echo "#" +- echo "#" +- cd binutils/libiberty && chmod +x configure && ./configure --disable-nls && cd ../.. +-# MY_SUBDIRS="$MY_SUBDIRS binutils/libiberty " +- echo "#" +- echo "#" +- echo "#" +- echo "# Subconfigure of LIBIBERTY done" +- echo "# ------------------------------" +- echo "#" +- echo "#" +- echo "#" +- echo "# -------------------" +- echo "# Subconfigure of BFD" +- echo "#" +- echo "#" +- cd binutils/bfd && chmod +x configure && ./configure --with-included-gettext --disable-nls && cd ../.. +-# MY_SUBDIRS="$MY_SUBDIRS binutils/bfd " +- echo "#" +- echo "#" +- echo "#" +- echo "# Subconfigure of BFD done" +- echo "# ------------------------" +- echo "#" +-# TLIBS="$TLIBS `pwd`/binutils/bfd/libbfd.a `pwd`/binutils/libiberty/libiberty.a" +- AC_DEFINE(HAVE_LIBBFD,1,[use libbfd]) +- BUILD_BFD="h/bfd.h h/bfdlink.h h/ansidecl.h h/symcat.h" ++ AC_MSG_ERROR([cannot locate external libbfd.a]) ++ fi ++ if echo $MP | tr ' ' '\012' | grep libiberty.a >/dev/null ; then ++ LIBIBERTY="`echo $MP | tr ' ' '\012' | grep libiberty.a | $AWK '{i=split($1,A,\"/\");for (j=1;j<=i;j++) if (j>1 && A[[j]]==\"..\") {j--;i-=2;for (k=j;k<=i;k++) A[[k]]=A[[k+2]];j--;}} END {for (j=1;j<=i;j++) printf(\"%s%s\",A[[j]],j!=i ? \"/\" : \"\")}'`" ++ else ++ AC_MSG_ERROR([cannot locate external libiberty.a]) ++ fi ++ BUILD_BFD=copy_bfd ++ AC_CHECK_LIB(z,inflate, ++ [TLIBS="$TLIBS -lz"], ++ AC_MSG_ERROR([Need zlib for bfd linking]),[]) ++ AC_CHECK_LIB(dl,dlsym, ++ [TLIBS="$TLIBS -ldl"], ++ AC_MSG_ERROR([Need libdl for bfd linking]),[]) + AC_SUBST(BUILD_BFD) ++ AC_SUBST(LIBBFD) ++ AC_SUBST(LIBIBERTY) ++ ++ else ++ TLIBS="$TLIBS -lbfd -liberty -ldl" ++ fi + fi + ++AC_ARG_ENABLE([xdr],[ --enable-xdr=yes will compile in support for XDR]) + +-if test "$enable_xdr" = "yes" ; then +- AC_CHECK_FUNC(xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]), +- AC_CHECK_LIB(tirpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) +- TLIBS="$TLIBS -ltirpc" TCFLAGS="$TCFLAGS -I/usr/include/tirpc", +- AC_CHECK_LIB(gssrpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) +- TLIBS="$TLIBS -lgssrpc" TCFLAGS="$TCFLAGS -I/usr/include/gssrpc", +- AC_CHECK_LIB(rpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) +- TLIBS="$TLIBS -lrpc" TCFLAGS="$TCFLAGS -I/usr/include/rpc", +- AC_CHECK_LIB(oncrpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) +- TLIBS="$TLIBS -loncrpc" TCFLAGS="$TCFLAGS -I/usr/include/oncrpc"))))) ++if test "$enable_xdr" != "no" ; then ++ XDR_LIB="" ++ AC_CHECK_FUNC([xdr_double],XDR_LIB=" ", ++ [AC_CHECK_LIB([tirpc],[xdr_double],[XDR_LIB=tirpc], ++ [AC_CHECK_LIB([gssrpc],[xdr_double],[XDR_LIB=gssrpc], ++ [AC_CHECK_LIB([rpc],[xdr_double],[XDR_LIB=rpc], ++ [AC_CHECK_LIB([oncrpc],[xdr_double],[XDR_LIB=oncrpc])])])])]) ++ ++ if test "$XDR_LIB" != ""; then ++ AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) ++ if test "$XDR_LIB" != " "; then ++ TLIBS="$TLIBS -l$XDR_LIB" ++ add_arg_to_tcflags -I/usr/include/$XDR_LIB ++ fi ++ fi + fi + + + AC_MSG_CHECKING([__builtin_clzl]) +-AC_RUN_IFELSE([AC_LANG_SOURCE([[ +- #include +- #include +- int main() { +- unsigned long u; +- long j; +- if (__builtin_clzl(0)!=sizeof(long)*8) +- return -1; +- for (u=1,j=sizeof(long)*8-1;j>=0;j--,u<<=1) +- if (__builtin_clzl(u)!=j) +- return -1; +- return 0; +- }]])],[AC_MSG_RESULT([yes]) +- AC_DEFINE(HAVE_CLZL,[1],[clzl instruction])], +- [AC_MSG_RESULT([no])]) ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #include ++ ]], ++ [[ ++ unsigned long u; ++ long j; ++ if (__builtin_clzl(0)!=sizeof(long)*8) ++ return -1; ++ for (u=1,j=sizeof(long)*8-1;j>=0;j--,u<<=1) ++ if (__builtin_clzl(u)!=j) ++ return -1; ++ ]])], ++ [AC_MSG_RESULT([yes]) ++ AC_DEFINE(HAVE_CLZL,[1],[clzl instruction])], ++ [AC_MSG_RESULT([no])]) + + AC_MSG_CHECKING([__builtin_ctzl]) +-AC_RUN_IFELSE([AC_LANG_SOURCE([[ +- #include +- #include +- int main() { +- unsigned long u; +- long j; +- if (__builtin_ctzl(0)!=sizeof(long)*8) +- return -1; +- for (u=1,j=0;j ++ #include ++ ]], ++ [[ ++ unsigned long u; ++ long j; ++ if (__builtin_ctzl(0)!=sizeof(long)*8) ++ return -1; ++ for (u=1,j=0;j +- #include +- #ifdef __CYGWIN__ +- #define getpagesize() 4096 +- #endif +- ]],[[ +- size_t i=getpagesize(),j; +- FILE *fp=fopen("conftest1","w"); +- for (j=0;i>>=1;j++); +- j=j<$min_pagewidth ? $min_pagewidth : j; +- fprintf(fp,"%u",j); +- return 0; +- ]])], +- [PAGEWIDTH=`cat conftest1`], +- [PAGEWIDTH=0]) ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #include ++ #ifdef __CYGWIN__ ++ #define getpagesize() 4096 ++ #endif ++ ]], ++ [[ ++ size_t i=getpagesize(),j; ++ FILE *fp=fopen("conftest1","w"); ++ for (j=0;i>>=1;j++); ++ j=j<$min_pagewidth ? $min_pagewidth : j; ++ fprintf(fp,"%u",j); ++ ]])], ++ [PAGEWIDTH=`cat conftest1`], ++ [PAGEWIDTH=0]) + AC_MSG_RESULT($PAGEWIDTH) + AC_DEFINE_UNQUOTED(PAGEWIDTH,$PAGEWIDTH,[system pagewidth]) + AC_SUBST(PAGEWIDTH) + + AC_MSG_CHECKING([for required object alignment]) +-AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +- #include +- #define EXTER +- #define INLINE +- #include "$MP_INCLUDE" +- #include "./h/enum.h" +- #define OBJ_ALIGN +- #include "./h/type.h" +- #include "./h/lu.h" +- #include "./h/object.h" +- ]],[[ +- unsigned long i; +- FILE *fp=fopen("conftest1","w"); +- for (i=1;i && NOT_OBJECT_ALIGNED(i); i<<=1); +- if (!i) return -1; +- fprintf(fp,"%lu",i); +- fclose(fp); +- return 0; +- ]])], +- [obj_align=`cat conftest1` +- AC_MSG_RESULT($obj_align) +- AC_DEFINE_UNQUOTED(OBJ_ALIGNMENT,$obj_align,[needed object alignment in bytes])], +- [AC_MSG_ERROR([Cannot find object alignent])]) ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #define EXTER ++ #define INLINE ++ #include "$MP_INCLUDE" ++ #include "./h/enum.h" ++ #define OBJ_ALIGN ++ #include "./h/type.h" ++ #include "./h/lu.h" ++ #include "./h/object.h" ++ ]], ++ [[ ++ unsigned long i; ++ FILE *fp=fopen("conftest1","w"); ++ for (i=1;i && NOT_OBJECT_ALIGNED(i); i<<=1); ++ if (!i) return -1; ++ fprintf(fp,"%lu",i); ++ fclose(fp); ++ return 0; ++ ]])], ++ [obj_align=`cat conftest1` ++ AC_MSG_RESULT($obj_align) ++ AC_DEFINE_UNQUOTED(OBJ_ALIGNMENT,$obj_align,[needed object alignment bytes])], ++ [AC_MSG_ERROR([Cannot find object alignent])]) + + AC_MSG_CHECKING([for C extension variable alignment]) +-AC_RUN_IFELSE([AC_LANG_PROGRAM([[]],[[ +- char *v __attribute__ ((aligned ($obj_align))); +- return 0;]])],[obj_align="__attribute__ ((aligned ($obj_align)))"],[AC_MSG_ERROR([Need alignment attributes])]) ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM([[]], ++ [[ ++ char *v __attribute__ ((aligned ($obj_align))); ++ ]])],[obj_align="__attribute__ ((aligned ($obj_align)))"],[AC_MSG_ERROR([Need alignment attributes])]) + AC_MSG_RESULT($obj_align) + AC_DEFINE_UNQUOTED(OBJ_ALIGN,$obj_align,[can use C extension for object alignment]) + + AC_MSG_CHECKING([for C extension noreturn function attribute]) +-AC_RUN_IFELSE([AC_LANG_PROGRAM([[]],[[ +- extern int v() __attribute__ ((noreturn)); +- return 0;]])],[no_return="__attribute__ ((noreturn))"],[no_return=]) ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM([[]], ++ [[ ++ extern int v() __attribute__ ((noreturn)); ++ ]])], ++ [no_return="__attribute__ ((noreturn))"],[no_return=]) + AC_MSG_RESULT($no_return) + AC_DEFINE_UNQUOTED(NO_RETURN,$no_return,[can use C extension for functions that do not return]) + +-AC_MSG_CHECKING(sizeof struct contblock) ++AC_MSG_CHECKING([sizeof struct contblock]) ++ ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #define EXTER ++ #define INLINE ++ #include "$MP_INCLUDE" ++ #include "h/enum.h" ++ #include "h/type.h" ++ #include "h/lu.h" ++ #include "h/object.h" ++ ]], ++ [[ ++ FILE *f=fopen("conftest1","w"); ++ fprintf(f,"%u",sizeof(struct contblock)); ++ fclose(f); ++ ]])], ++ [sizeof_contblock=`cat conftest1`], ++ [AC_MSG_ERROR([Cannot find sizeof struct contblock])], ++ [AC_MSG_ERROR([Cannot find sizeof struct contblock])]) + +-# work around MSYS pwd result incompatibility +-if test "$use" = "mingw" ; then +-AC_TRY_RUN([#include +- #define EXTER +- #define INLINE +- #include "$MP_INCLUDE" +- #include "h/enum.h" +- #include "h/type.h" +- #include "h/lu.h" +- #include "h/object.h" +- int main(int argc,char **argv,char **envp) { +- FILE *f=fopen("conftest1","w"); +- fprintf(f,"%u",sizeof(struct contblock)); +- fclose(f); +- return 0; +- }],sizeof_contblock=`cat conftest1`, +- echo Cannot find sizeof struct contblock;exit 1, +- echo Cannot find sizeof struct contblock;exit 1) +-else +-AC_TRY_RUN([#include +- #define EXTER +- #define INLINE +- #include "$MP_INCLUDE" +- #include "`pwd`/h/enum.h" +- #include "`pwd`/h/type.h" +- #include "`pwd`/h/lu.h" +- #include "`pwd`/h/object.h" +- int main(int argc,char **argv,char **envp) { +- FILE *f=fopen("conftest1","w"); +- fprintf(f,"%u",sizeof(struct contblock)); +- fclose(f); +- return 0; +- }],sizeof_contblock=`cat conftest1`, +- echo Cannot find sizeof struct contblock;exit 1, +- echo Cannot find sizeof struct contblock;exit 1) +-fi + AC_MSG_RESULT($sizeof_contblock) + AC_DEFINE_UNQUOTED(SIZEOF_CONTBLOCK,$sizeof_contblock,[sizeof linked list for contiguous pages]) + + AC_MSG_CHECKING([for sbrk]) + HAVE_SBRK="" +-AC_TRY_RUN([#include +- #include +- int main() { ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #include ++ ]], ++ [[ + FILE *f; + if (!(f=fopen("conftest1","w"))) +- return -1; +- fprintf(f,"%u",sbrk(0)); +- return 0; +- }], +- HAVE_SBRK=1 +- AC_MSG_RESULT(yes), +- AC_MSG_RESULT([no: WARNING you must be able to emulate sbrk: as on mingw or macosx]), +- AC_MSG_RESULT([no: WARNING you must be able to emulate sbrk: as on mingw or macosx])) ++ return -1; ++ fprintf(f,"%u",sbrk(0)); ++ ]])], ++ [HAVE_SBRK=1;AC_MSG_RESULT([yes])], ++ AC_MSG_RESULT([no: WARNING you must be able to emulate sbrk: as on mingw or macosx]), ++ AC_MSG_RESULT([no: WARNING you must be able to emulate sbrk: as on mingw or macosx])) + + if test "$use" = "386-macosx" ; then +- AC_MSG_RESULT(emulating sbrk for mac); +- HAVE_SBRK=0 ++ AC_MSG_RESULT([emulating sbrk for mac]); ++ HAVE_SBRK=0 + fi + + if test "$HAVE_SBRK" = "1" ; then +- +- AC_MSG_CHECKING([for ADDR_NO_RANDOMIZE constant]) +- AC_RUN_IFELSE([ +- AC_LANG_PROGRAM([[ +- #include +- #include +- ]],[[ +- FILE *f; +- if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%x",ADDR_NO_RANDOMIZE); +- return 0; +- ]])], ++ ++ AC_MSG_CHECKING([for ADDR_NO_RANDOMIZE constant]) ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #include ++ ]], ++ [[ ++ FILE *f; ++ if (!(f=fopen("conftest1","w"))) return -1; ++ fprintf(f,"%x",ADDR_NO_RANDOMIZE); ++ ]])], + [ADDR_NO_RANDOMIZE=`cat conftest1` +- AC_MSG_RESULT([yes $ADDR_NO_RANDOMIZE])], ++ AC_MSG_RESULT([yes $ADDR_NO_RANDOMIZE])], + [ADDR_NO_RANDOMIZE=0 +- AC_MSG_RESULT([no assuming 0x40000]) +- AC_DEFINE_UNQUOTED(ADDR_NO_RANDOMIZE,0x40000,[punt guess for no randomize value])]) +- +- AC_MSG_CHECKING([for ADDR_COMPAT_LAYOUT constant]) +- AC_RUN_IFELSE([ +- AC_LANG_PROGRAM([[ +- #include +- #include +- ]],[[ +- FILE *f; +- if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%x",ADDR_COMPAT_LAYOUT); +- return 0; +- ]])], ++ AC_MSG_RESULT([no assuming 0x40000]) ++ AC_DEFINE_UNQUOTED(ADDR_NO_RANDOMIZE,0x40000,[punt guess for no randomize value])]) ++ ++ AC_MSG_CHECKING([for ADDR_COMPAT_LAYOUT constant]) ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #include ++ ]], ++ [[ ++ FILE *f; ++ if (!(f=fopen("conftest1","w"))) return -1; ++ fprintf(f,"%x",ADDR_COMPAT_LAYOUT); ++ ]])], + [ADDR_COMPAT_LAYOUT=`cat conftest1` +- AC_MSG_RESULT([yes $ADDR_COMPAT_LAYOUT])], ++ AC_MSG_RESULT([yes $ADDR_COMPAT_LAYOUT])], + [ADDR_COMPAT_LAYOUT=0 +- AC_MSG_RESULT([no])] ++ AC_MSG_RESULT([no])] + AC_DEFINE_UNQUOTED(ADDR_COMPAT_LAYOUT,0,[constant to reserve upper 3Gb for C stack])) +- +- AC_MSG_CHECKING([for ADDR_LIMIT_3GB constant]) +- AC_RUN_IFELSE([ +- AC_LANG_PROGRAM([[ +- #include +- #include +- ]],[[ +- FILE *f; +- if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%x",ADDR_LIMIT_3GB); +- return 0; +- ]])], ++ ++ AC_MSG_CHECKING([for ADDR_LIMIT_3GB constant]) ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #include ++ ]], ++ [[ ++ FILE *f; ++ if (!(f=fopen("conftest1","w"))) return -1; ++ fprintf(f,"%x",ADDR_LIMIT_3GB); ++ ]])], + [ADDR_LIMIT_3GB=`cat conftest1` +- AC_MSG_RESULT([yes $ADDR_LIMIT_3GB])], ++ AC_MSG_RESULT([yes $ADDR_LIMIT_3GB])], + [ADDR_LIMIT_3GB=0 +- AC_MSG_RESULT([no])] ++ AC_MSG_RESULT([no])] + AC_DEFINE_UNQUOTED(ADDR_LIMIT_3GB,0,[only 3Gb of address space])) +- +- AC_MSG_CHECKING([for personality(ADDR_NO_RANDOMIZE) support]) +- AC_RUN_IFELSE([ +- AC_LANG_SOURCE([[ +- #include +- #include +- int main(int argc,char **argv,char **envp) { +- #include "h/unrandomize.h" +- return 0;}]])], ++ ++ AC_MSG_CHECKING([for personality(ADDR_NO_RANDOMIZE) support]) ++ AC_RUN_IFELSE( ++ [AC_LANG_SOURCE( ++ [[ ++ #include ++ #include ++ int main(int argc,char *argv[],char *envp[]) { ++ #include "h/unrandomize.h" ++ return 0; ++ } ++ ]])], + [AC_MSG_RESULT(yes) +- AC_DEFINE(CAN_UNRANDOMIZE_SBRK,1,[can prevent sbrk from returning random values])], ++ AC_DEFINE(CAN_UNRANDOMIZE_SBRK,1,[can prevent sbrk from returning random values])], + [AC_MSG_RESULT(no)]) + +- AC_MSG_CHECKING([that sbrk is (now) non-random]) +- AC_TRY_RUN([#include +- #include ++ AC_MSG_CHECKING([that sbrk is (now) non-random]) ++ SBRK=0 ++ AC_RUN_IFELSE( ++ [AC_LANG_SOURCE( ++ [[ ++ #include ++ #include + int main(int argc,char * argv[],char * envp[]) { + FILE *f; + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" + #endif +- if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%u",sbrk(0)); +- return 0;}],SBRK=`cat conftest1`,SBRK=0,SBRK=0) +- if test "$SBRK" = "0" ; then +- AC_MSG_RESULT(cannot trap sbrk) +- exit 1 +- fi +- AC_TRY_RUN([#include +- #include ++ if (!(f=fopen("conftest1","w"))) ++ return -1; ++ fprintf(f,"%u",sbrk(0)); ++ return 0; ++ } ++ ]])],[SBRK=`cat conftest1`]) ++ if test "$SBRK" = "0" ; then ++ AC_MSG_ERROR([cannot trap sbrk]) ++ fi ++ ++ SBRK1=0 ++ AC_RUN_IFELSE( ++ [AC_LANG_SOURCE( ++ [[ ++ #include ++ #include + int main(int argc,char * argv[],char * envp[]) { + FILE *f; + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" + #endif + if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%u",sbrk(0)); +- return 0;}],SBRK1=`cat conftest1`,SBRK1=0,SBRK1=0) +- if test "$SBRK1" = "0" ; then +- AC_MSG_RESULT(cannot trap sbrk) +- exit 1 +- fi +- if test "$SBRK" = "$SBRK1" ; then +- AC_MSG_RESULT(yes) +- else +- AC_MSG_RESULT(no) +- echo "Cannot build with randomized sbrk. Your options:" +- echo " - upgrade to a kernel/libc that knows about personality(ADDR_NO_RANDOMIZE)" +- echo " - recompile your kernel with CONFIG_COMPAT_BRK (if it has that option)" +- echo " - run sysctl kernel.randomize_va_space=0 before using gcl" +- exit 1 +- fi ++ fprintf(f,"%u",sbrk(0)); ++ return 0; ++ } ++ ]])],[SBRK1=`cat conftest1`]) ++ if test "$SBRK1" = "0" ; then ++ AC_MSG_ERROR([cannot trap sbrk]) ++ fi ++ if test "$SBRK" = "$SBRK1" ; then ++ AC_MSG_RESULT([yes]) ++ else ++ AC_MSG_RESULT([no]) ++ echo "Cannot build with randomized sbrk. Your options:" ++ echo " - upgrade to a kernel/libc that knows about personality(ADDR_NO_RANDOMIZE)" ++ echo " - recompile your kernel with CONFIG_COMPAT_BRK (if it has that option)" ++ echo " - run sysctl kernel.randomize_va_space=0 before using gcl" ++ AC_MSG_ERROR([exiting]) ++ fi + fi +- +-dnl AC_MSG_CHECKING(DBEGIN) +-dnl AC_RUN_IFELSE([AC_LANG_SOURCE([[ +-dnl #include +-dnl #include +-dnl #include +-dnl void gprof_cleanup() {}; +- +-dnl int main(int argc,char **argv,char **envp) { +- +-dnl void *b; +-dnl FILE *fp; +- +-dnl #ifdef CAN_UNRANDOMIZE_SBRK +-dnl #include "h/unrandomize.h" +-dnl #endif +- +-dnl fp = fopen("conftest1","w"); +- +-dnl #ifdef _WIN32 +-dnl fprintf ( fp,"0x%lx", 0x3000000 ); /* Windows custom allocation from this point up */ +-dnl #else +-dnl #if defined (__APPLE__) && defined (__MACH__) +-dnl fprintf(fp,"0x0"); +-dnl #else +-dnl b = sbrk(0); +-dnl fprintf(fp,"0x%lx",((unsigned long) b) & ~(unsigned long)((1< +-dnl #include +-dnl ]],[[ +-dnl FILE *fp=fopen("conftest1","w"); +-dnl fprintf(fp,"%u",262144*( SIZEOF_LONG >>2)/(1<<($PAGEWIDTH-12))); +-dnl return 0;]])],[def_maxpage=`cat conftest1`],[def_maxpage=262144]) +- +-dnl AC_ARG_ENABLE(maxpage, +-dnl [ --enable-maxpage=XXXX will compile in a page table of size XXX +-dnl (eg '--enable-maxpage=64*1024' would produce +-dnl 64K pages allowing 256 MB if pages are 4K each)], +-dnl ,enable_maxpage=$def_maxpage) +- +- + AC_MSG_CHECKING(CSTACK_ADDRESS) +-AC_RUN_IFELSE([AC_LANG_SOURCE([[ +- #include +- #include +- void * +- foo() { +- int i; +- return (void *)&i; +- } +- +- int main(int argc,char **argv,char **envp) { +- void *v ; +- FILE *fp = fopen("conftest1","w"); +- unsigned long i,j; +- +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- j=1; +- j<<=$PAGEWIDTH; +- j<<=16; +- i=(unsigned long)&v; +- if (foo()>i) i-=j; +- j--; +- i+=j; +- i&=~j; +- fprintf(fp,"0x%lx",i-1); +- fclose(fp); +- return 0; +-}]])],[cstack_address=`cat conftest1`],[cstack_address=0]) ++AC_RUN_IFELSE( ++ [AC_LANG_SOURCE( ++ [[ ++ #include ++ #include ++ void * ++ foo() { ++ int i; ++ return (void *)&i; ++ } ++ ++ int ++ main(int argc,char **argv,char **envp) { ++ void *v ; ++ FILE *fp = fopen("conftest1","w"); ++ unsigned long i,j; ++ ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ j=1; ++ j<<=$PAGEWIDTH; ++ j<<=16; ++ i=(unsigned long)&v; ++ if (foo()>i) i-=j; ++ j--; ++ i+=j; ++ i&=~j; ++ fprintf(fp,"0x%lx",i-1); ++ fclose(fp); ++ return 0; ++ }]])], ++ [cstack_address=`cat conftest1`],[cstack_address=0]) + AC_DEFINE_UNQUOTED(CSTACK_ADDRESS,$cstack_address,[starting C stack address]) + AC_MSG_RESULT($cstack_address) + + AC_MSG_CHECKING([cstack bits]) +-AC_RUN_IFELSE([AC_LANG_SOURCE([[ +- #include +- #include +- void * +- foo() { +- int i; +- return (void *)&i; +- } +- +- int main(int argc,char **argv,char **envp) { +- void *v ; +- FILE *fp = fopen("conftest1","w"); +- unsigned long i,j; +- +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- j=1; +- j<<=$PAGEWIDTH; +- j<<=16; +- i=(unsigned long)&v; +- if (foo()>i) i-=j; +- j--; +- i+=j; +- i&=~j; +- for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); +- fprintf(fp,"%d",j); +- fclose(fp); +- return 0; +-}]])],[cstack_bits=`cat conftest1`],[cstack_bits=0]) ++AC_RUN_IFELSE( ++ [AC_LANG_SOURCE( ++ [[ ++ #include ++ #include ++ void * ++ foo() { ++ int i; ++ return (void *)&i; ++ } ++ ++ int ++ main(int argc,char **argv,char **envp) { ++ void *v ; ++ FILE *fp = fopen("conftest1","w"); ++ unsigned long i,j; ++ ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ j=1; ++ j<<=$PAGEWIDTH; ++ j<<=16; ++ i=(unsigned long)&v; ++ if (foo()>i) i-=j; ++ j--; ++ i+=j; ++ i&=~j; ++ for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); ++ fprintf(fp,"%d",j); ++ fclose(fp); ++ return 0; ++ }]])], ++ [cstack_bits=`cat conftest1`],[cstack_bits=0]) + AC_DEFINE_UNQUOTED(CSTACK_BITS,$cstack_bits,[log starting C stack address]) + AC_MSG_RESULT($cstack_bits) + + AC_MSG_CHECKING(NEG_CSTACK_ADDRESS) +-AC_RUN_IFELSE([AC_LANG_SOURCE([[ +- #include +- #include +- int main(int argc,char **argv,char **envp) { +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- return (long)$cstack_address<0 ? 0 : -1; +-}]])],[AC_MSG_RESULT(yes) +- neg_cstack_address=1 +- AC_DEFINE(NEG_CSTACK_ADDRESS,1,[C stack address is negative])], +- [AC_MSG_RESULT(no) +- neg_cstack_address=0]) +- ++AC_RUN_IFELSE( ++ [AC_LANG_SOURCE( ++ [[ ++ #include ++ #include ++ int ++ main(int argc,char **argv,char **envp) { ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ return (long)$cstack_address<0 ? 0 : -1; ++ }]])], ++ [AC_MSG_RESULT(yes) ++ neg_cstack_address=1 ++ AC_DEFINE(NEG_CSTACK_ADDRESS,1,[C stack address is negative])], ++ [AC_MSG_RESULT(no) ++ neg_cstack_address=0]) + + AC_MSG_CHECKING([finding CSTACK_ALIGNMENT]) +-AC_RUN_IFELSE([AC_LANG_SOURCE([[ +- #include +- #include +- int main(int argc,char **argv,char **envp) { +- void *b,*c; +- FILE *fp = fopen("conftest1","w"); +- long n; +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- b=alloca(sizeof(b)); +- c=alloca(sizeof(c)); +- n=b>c ? b-c : c-b; +- n=n>sizeof(c) ? n : 1; +- fprintf(fp,"%ld",n); +- fclose(fp); +- return 0; +-}]])],[cstack_alignment=`cat conftest1`],[cstack_alignment=0]) ++AC_RUN_IFELSE( ++ [AC_LANG_SOURCE( ++ [[ ++ #include ++ #include ++ int main(int argc,char **argv,char **envp) { ++ void *b,*c; ++ FILE *fp = fopen("conftest1","w"); ++ long n; ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ b=alloca(sizeof(b)); ++ c=alloca(sizeof(c)); ++ n=b>c ? b-c : c-b; ++ n=n>sizeof(c) ? n : 1; ++ fprintf(fp,"%ld",n); ++ fclose(fp); ++ return 0; ++ }]])], ++ [cstack_alignment=`cat conftest1`],[cstack_alignment=0]) + AC_DEFINE_UNQUOTED(CSTACK_ALIGNMENT,$cstack_alignment,[C stack alignment]) + AC_MSG_RESULT($cstack_alignment) + + AC_MSG_CHECKING(CSTACK_DIRECTION) +-AC_RUN_IFELSE([AC_LANG_SOURCE([[ +- #include +- #include +- void * +- foo(void) { +- int i; +- return (void *)&i; +- } +- +- int main(int argc,char **argv,char **envp) { +- char *b; +- FILE *fp = fopen("conftest1","w"); +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- fprintf(fp,"%d",((long) &b) > ((long) foo()) ? -1 : 1); +- fclose(fp); +- return 0; +-}]])],[cstack_direction=`cat conftest1`],[cstack_direction=0]) ++AC_RUN_IFELSE( ++ [AC_LANG_SOURCE( ++ [[ ++ #include ++ #include ++ void * ++ foo(void) { ++ int i; ++ return (void *)&i; ++ } ++ ++ int ++ main(int argc,char **argv,char **envp) { ++ char *b; ++ FILE *fp = fopen("conftest1","w"); ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ fprintf(fp,"%d",((long) &b) > ((long) foo()) ? -1 : 1); ++ fclose(fp); ++ return 0; ++ }]])], ++ [cstack_direction=`cat conftest1`],[cstack_direction=0]) + AC_DEFINE_UNQUOTED(CSTACK_DIRECTION,$cstack_direction,[whether C stack grows up or down]) + AC_MSG_RESULT($cstack_direction) + ++AC_ARG_ENABLE([immfix],[ --enable-immfix will enable an immediate fixnum table above the C stack]) + +-dnl AC_MSG_CHECKING(for shared library/C stack ceiling to heap) +-dnl if test "$use" = "mingw" ; then +-dnl heap_ceiling=2000000000 +-dnl else +-dnl if test "$use" = "solaris-i386" ; then +-dnl heap_ceiling=0x0 +-dnl else +-dnl if test "$enable_static" = "yes" ; then +-dnl heap_ceiling=0x0 +-dnl else +-dnl if ! test -x `which ldd` && ! test -f /proc/self/maps ; then +-dnl heap_ceiling=0x0 +-dnl else +-dnl if test -f /proc/self/maps ; then +-dnl heap_ceiling=0x`/bin/cat /proc/self/maps | grep "/lib.*/ld-" | cut -f1 -d- | head -1` +-dnl else +-dnl if test "`which ldd`" = "" ; then +-dnl heap_ceiling=0x0 +-dnl else +-dnl #echo -e "#include \n int main() {printf(\"foo\");return 0;}" >foo.c +-dnl #$CC foo.c -o foo +-dnl AAWK=`which awk` +-dnl # | grep -v ld-kfreebsd needed on some strange bsd amd64 boxes +-dnl heap_ceiling=`ldd $AAWK | tail -n 1 | $AWK '{print $NF}' | tr -d '()'` +-dnl fi +-dnl fi +-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +-dnl #include +-dnl ]],[[ +-dnl FILE *fp=fopen("conftest1","w"); +-dnl unsigned long h=$heap_ceiling,d=$dbegin,c=$cstack_address; +-dnl h=hd && cfoo.c +-dnl else +-dnl echo "int main() {return !($heap_ceiling && (unsigned long)$dbegin < (unsigned long)$cstack_address);}" >foo.c +-dnl fi +-dnl $CC foo.c -o foo +-dnl if ./foo ; then ++AC_ARG_ENABLE([fastimmfix],[ --enable-fastimmfix=XXXX will reject low immediate fixnums unless 2^XXX can be attained],,[enable_fastimmfix=64]) + +-if test "$use" != "386-gnu" ; then #hurd can push .data below C stack, but sbrk(0) remains above, foiling unexec + +- AC_MSG_CHECKING([finding default linker script]) +- touch unixport/gcl.script +- echo "int main() {return 0;}" >foo.c +- $CC -Wl,--verbose foo.c -o foo 2>&1 | \ +- $AWK '/\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=/ {i=1-i;next} {if (i) print}' >gcl.script +- rm -rf foo.c foo +- +- if test "`cat gcl.script | wc -l`" != "0" ; then +- AC_MSG_RESULT(got it) +- AC_MSG_NOTICE([trying to adjust text start]) +- cp gcl.script gcl.script.def +- +- n=-1; +- k=0; +- lim=`$AWK 'END {printf("%d\n",m*8-2)}' m=$ac_cv_sizeof_long`; +- max=0; +- min=$lim; +- while test $n -lt $lim ; do +- j=`$AWK 'END {for (i=j=0;j<=n;j++) i=i ? i*2 : 1;printf("%x\n",3*i)}' n=$n gcl.script +-# diff -u gcl.script.def gcl.script +- echo "int main() {return 0;}" >foo.c +- if ( $CC -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then +- if test $n -lt $min ; then min=$n; fi; +- if test $n -gt $max; then max=$n; fi; +- elif test $max -gt 0 ; then +- break; +- fi; +- n=`$AWK 'END {print n+1}' n=$n foo.c ++ $CC $TLDFLAGS -Wl,--verbose foo.c -o foo 2>&1 | \ ++ $AWK '/\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=/ {i=1-i;next} {if (i) print}' >gcl.script ++ rm -rf foo.c foo ++ ++ if test "`cat gcl.script | wc -l`" != "0" ; then ++ AC_MSG_RESULT(got it) ++ AC_MSG_NOTICE([trying to adjust text start]) ++ cp gcl.script gcl.script.def ++ ++ n=-1; ++ k=0; ++ lim=`$AWK 'END {printf("%d\n",m*8-2)}' m=$ac_cv_sizeof_long`; ++ max=0; ++ min=$lim; ++ while test $n -lt $lim ; do ++ j=`$AWK 'END {for (i=j=0;j<=n;j++) i=i ? i*2 : 1;printf("%x\n",3*i)}' n=$n gcl.script ++ # diff -u gcl.script.def gcl.script ++ echo "int main() {return 0;}" >foo.c ++ if ( $CC $TLDFLAGS -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then ++ if test $n -lt $min ; then min=$n; fi; ++ if test $n -gt $max; then max=$n; fi; ++ elif test $max -gt 0 ; then ++ break; ++ fi; ++ n=`$AWK 'END {print n+1}' n=$n gcl.script + AC_MSG_RESULT([done]) + rm -f gcl.script.def + LDFLAGS="$LDFLAGS -Wl,-T gcl.script " + cp gcl.script unixport +- else +- AC_MSG_RESULT([none found or not needed]) +- rm -f gcl.script gcl.script.def +- fi +- rm -rf foo.c foo +- else +- AC_MSG_RESULT([not found]) +- fi +- ++ else ++ AC_MSG_RESULT([none found or not needed]) ++ rm -f gcl.script gcl.script.def ++ fi ++ rm -rf foo.c foo ++ else ++ AC_MSG_RESULT([not found]) ++ fi ++ + else +- +- AC_DEFINE_UNQUOTED(OBJNULL,NULL,[lowest address non-object]) +- ++ ++ AC_DEFINE_UNQUOTED(OBJNULL,NULL,[lowest address non-object]) ++ + fi + +- dnl old_LDFLAGS="$LDFLAGS" +- dnl LDFLAGS="$LDFLAGS $TLDFLAGS" +- dnl AC_MSG_CHECKING([revised DBEGIN]) +- dnl AC_RUN_IFELSE([AC_LANG_SOURCE([[ +- dnl #include +- dnl #include +- dnl #include +- +- dnl int main(int argc,char **argv,char **envp) { +- +- dnl void *b; +- dnl FILE *fp; +- +- dnl #ifdef CAN_UNRANDOMIZE_SBRK +- dnl #include "h/unrandomize.h" +- dnl #endif +- dnl fp = fopen("conftest1","w"); +- +- dnl #ifdef _WIN32 +- dnl fprintf ( fp,"0x%lx", 0x1a000000 ); /* Windows custom allocation from this point up */ +- dnl #else +- dnl #if defined (__APPLE__) && defined (__MACH__) +- dnl fprintf(fp,"((unsigned long)get_dbegin())"); +- dnl #else +- dnl b = sbrk(0); +- dnl fprintf(fp,"0x%lx",((unsigned long) b) & ~(unsigned long)0xffffff); +- dnl #endif +- dnl #endif +- dnl fclose(fp); +- dnl return 0;}]])],[dbegin=`cat conftest1`],[dbegin=0]) +- dnl AC_MSG_RESULT($dbegin) +- dnl LDFLAGS="$old_LDFLAGS" +-dnl fi +-dnl dnl AC_DEFINE_UNQUOTED(DBEGIN,$dbegin,[down-rounded beginning address of lisp data]) +-dnl rm -rf foo* +- +-dnl AC_MSG_CHECKING(for maxpage revision) +-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +-dnl #include +-dnl ]],[[ +-dnl char *b; +-dnl unsigned long i,j; +-dnl FILE *fp = fopen("conftest1","w"); +-dnl j=((unsigned long)$enable_maxpage <<$PAGEWIDTH) + $dbegin; +-dnl j=$heap_ceiling && j>$heap_ceiling ? $heap_ceiling : j; +-dnl j-=$dbegin; +-dnl /* for (i=1;i<<1 && i<=j;i<<=1); */ +-dnl /* if (i>j) i>>=1; */ +-dnl i=j; +-dnl fprintf(fp,"%ld",i>>$PAGEWIDTH); +-dnl fclose(fp); +-dnl return 0; +-dnl ]])],[tmp_maxpage=`cat conftest1`],[tmp_maxpage=0]) +-dnl if test "$tmp_maxpage" != "$enable_maxpage" ; then +-dnl enable_maxpage=$tmp_maxpage +-dnl AC_MSG_RESULT($enable_maxpage) +-dnl else +-dnl AC_MSG_RESULT($enable_maxpage is OK) +-dnl fi +-dnl AC_DEFINE_UNQUOTED(MAXPAGE,$enable_maxpage,[maximum number of pages to be allocated]) +- +-dnl AC_MSG_CHECKING(for C stack size floor from heap) +-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +-dnl #include +-dnl ]],[[ +-dnl char *b; +-dnl FILE *fp = fopen("conftest1","w"); +-dnl unsigned long j,k; +- +-dnl j=$cstack_address + $cstack_direction * $enable_cssize; +-dnl k=($dbegin + ((unsigned long)$enable_maxpage << $PAGEWIDTH)); +-dnl j=abs(j-$cstack_address)!=$enable_cssize || (j +-dnl ]],[[ +-dnl char *b; +-dnl FILE *fp = fopen("conftest1","w"); +-dnl unsigned long j,k; +- +-dnl j=$cstack_address + $cstack_direction * $enable_cssize; +-dnl if ($cstack_direction>0) { +-dnl k=$cstack_address + ((-(unsigned long)$cstack_address)>>1); +-dnl j=j<$cstack_address || j > k ? k : j; +-dnl j=$cstack_address < $dbegin && j > $dbegin ? $dbegin : j; +-dnl } +-dnl j-=$cstack_address; +-dnl j*=$cstack_direction; +-dnl fprintf(fp,"%lu",j); +-dnl fclose(fp); +-dnl return 0; +-dnl ]])],[tmp_cssize=`cat conftest1`],[tmp_cssize=0]) +-dnl if test "$tmp_cssize" != "$enable_cssize" ; then +-dnl enable_cssize=$tmp_cssize; +-dnl AC_MSG_RESULT($enable_cssize) +-dnl else +-dnl AC_MSG_RESULT($enable_cssize is OK) +-dnl fi +- +-dnl AC_MSG_CHECKING(for C stack size limit from address wrap) +-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +-dnl #include +-dnl ]],[[ +-dnl char *b; +-dnl FILE *fp = fopen("conftest1","w"); +-dnl unsigned long j,k; +- +-dnl j=-$cstack_address * $cstack_direction; +-dnl j=j>$enable_cssize ? $enable_cssize : j; +-dnl fprintf(fp,"%lu",j); +-dnl fclose(fp); +-dnl return 0; +-dnl ]])],[tmp_cssize=`cat conftest1`],[tmp_cssize=0]) +-dnl if test "$tmp_cssize" != "$enable_cssize" ; then +-dnl enable_cssize=$tmp_cssize; +-dnl AC_MSG_RESULT($enable_cssize) +-dnl else +-dnl AC_MSG_RESULT($enable_cssize is OK) +-dnl fi +-dnl AC_DEFINE_UNQUOTED(CSSIZE,$enable_cssize,[maximum C stack size]) +- +-dnl AC_MSG_CHECKING(for fast NULL_OR_ON_CSTACK macro) +-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +-dnl #include +-dnl ]],[[ +-dnl return ((long)$dbegin>=0 && +-dnl ((long)$dbegin+(long)($enable_maxpage<<$PAGEWIDTH)) >=0 && +-dnl ((long)$cstack_address<0)) ? 0 : 1; +-dnl ]])],[tmp_fnocm=yes],[tmp_fnocm=no]) +-dnl if test "$tmp_fnocm" = "yes" ; then +-dnl AC_MSG_RESULT(yes) +-dnl AC_DEFINE(USE_FAST_NULL_OR_ON_CSTACK_MACRO,1,[whether one instruction heap address check can be used]) +-dnl else +-dnl AC_MSG_RESULT(no) +-dnl fi +- + mem_top=0 + mem_range=0 + AC_MSG_CHECKING(mem top) +-AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +- #include +- ]],[[ +- void *v; +- unsigned long i,j,k,l,m; +- FILE *fp = fopen("conftest1","w"); +- +- for (i=2,k=1;i;k=i,i<<=1); +- l=$cstack_address; +- l=$cstack_direction==1 ? (l>=1,i|=j); +- if (j<(k>>3)) i=0; +- j=1; +- j<<=$PAGEWIDTH; +- j<<=4; +- j--; +- i+=j; +- i&=~j; +- fprintf(fp,"0x%lx",i); +- fclose(fp); +- return 0; +-]])],[mem_top=`cat conftest1`],[mem_top="0x0"]) ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ ]], ++ [[ ++ void *v; ++ unsigned long i,j,k,l,m; ++ FILE *fp = fopen("conftest1","w"); ++ ++ for (i=2,k=1;i;k=i,i<<=1); ++ l=$cstack_address; ++ l=$cstack_direction==1 ? (l>=1,i|=j); ++ if (j<(k>>3)) i=0; ++ j=1; ++ j<<=$PAGEWIDTH; ++ j<<=4; ++ j--; ++ i+=j; ++ i&=~j; ++ fprintf(fp,"0x%lx",i); ++ fclose(fp); ++ return 0; ++ ]])], ++ [mem_top=`cat conftest1`],[mem_top="0x0"]) + AC_MSG_RESULT($mem_top) ++ + if test "$mem_top" != "0x0" ; then +- AC_MSG_CHECKING(finding upper mem half range) +- AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +- #include +- ]],[[ +- unsigned long j; +- FILE *fp = fopen("conftest1","w"); +- +- for (j=1;j && !(j& $mem_top);j<<=1); +- fprintf(fp,"0x%lx",j>>1); +- fclose(fp); +- return 0; +- ]])],[mem_range=`cat conftest1`],[mem_range="0x0"]) +- AC_MSG_RESULT($mem_range) +- if test "$mem_range" != "0x0" ; then ++ AC_MSG_CHECKING(finding upper mem half range) ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ ]], ++ [[ ++ unsigned long j; ++ FILE *fp = fopen("conftest1","w"); ++ ++ for (j=1;j && !(j& $mem_top);j<<=1); ++ fprintf(fp,"0x%lx",j>>1); ++ fclose(fp); ++ return 0; ++ ]])], ++ [mem_range=`cat conftest1`],[mem_range="0x0"]) ++ AC_MSG_RESULT($mem_range) ++ if test "$mem_range" != "0x0" ; then + AC_DEFINE_UNQUOTED(MEM_TOP,$mem_top,[beginning address for immediate fixnum range]) + AC_DEFINE_UNQUOTED(MEM_RANGE,$mem_range,[size of immediate fixnum address space]) +- fi ++ fi + fi + +-if test "$enable_immfix" = "yes" ; then +- if test "$mem_top" != "0x0" ; then +- if test "$mem_range" != "0x0" ; then +- AC_DEFINE_UNQUOTED(IM_FIX_BASE,$mem_top,[beginning address for immediate fixnum range]) +- AC_DEFINE_UNQUOTED(IM_FIX_LIM,$mem_range,[size of immediate fixnum address space]) +- fi +- fi +-fi +- +- +-dnl AC_MSG_CHECKING(for word order) +-dnl AC_TRY_RUN([int main () { +-dnl /* Are we little or big endian? Adapted from Harbison&Steele. */ +-dnl union +-dnl { +-dnl double d; +-dnl int l[sizeof(double)/sizeof(int)]; +-dnl } u; +-dnl u.d = 1.0; +-dnl return u.l[sizeof(double)/sizeof(int)-1] ? 0 : 1; +-dnl }],AC_MSG_RESULT(little) +-dnl AC_DEFINE(LITTLE_END), +-dnl AC_MSG_RESULT(big), +-dnl AC_MSG_RESULT([WARNING: ASSUMING LITTLE ENDIAN FOR CROSS COMPILING !!!] +-dnl AC_DEFINE(LITTLE_END))) +-dnl AC_SUBST(LITTLE_END) +- +- +-# On systems with execshield, brk is randomized. We need to catch +-# this and restore the traditional behavior here +- +-dnl old_LDFLAGS="$LDFLAGS" +-dnl LDFLAGS="$TLDFLAGS" +-dnl AC_MSG_CHECKING("finding DBEGIN") +-dnl AC_TRY_RUN([#include +-dnl #include +- +-dnl void gprof_cleanup() {}; +-dnl int +-dnl main(int argc,char * argv[],char *envp[]) +-dnl { +-dnl char *b,*b1; +-dnl FILE *fp; +- +-dnl #ifdef CAN_UNRANDOMIZE_SBRK +-dnl #include "h/unrandomize.h" +-dnl #endif +-dnl b = (void *) malloc(1000); +-dnl fp = fopen("conftest1","w"); +- +-dnl #ifdef _WIN32 +-dnl fprintf(fp,"_dbegin"); +-dnl #else +-dnl #if defined (__APPLE__) && defined (__MACH__) +-dnl fprintf(fp,"mach_mapstart"); +-dnl #else +-dnl b1=((unsigned long) b) & ~(unsigned long)0xffffff;b=(void *)b1<(void *)&b1 && (void *)b>(void *)&b ? ((unsigned long) b) & ~(unsigned long)((1< +-dnl main() +-dnl { +-dnl char *b ; +-dnl FILE *fp = fopen("conftest1","w"); +-dnl fprintf(fp,"%ld",((long) &b)); +-dnl fclose(fp); +-dnl return 0; +-dnl }],cstack_address=`cat conftest1`,cstack_address=0,cstack_address=0) +-dnl AC_DEFINE_UNQUOTED(CSTACK_ADDRESS,$cstack_address \ +-dnl ) +-dnl AC_MSG_RESULT(got $cstack_address) +- +- ++if test "$enable_immfix" != "no" ; then ++ if test "$mem_top" != "0x0" ; then ++ if test "$mem_range" != "0x0" ; then ++ AC_DEFINE_UNQUOTED(IM_FIX_BASE,$mem_top,[beginning address for immediate fixnum range]) ++ AC_DEFINE_UNQUOTED(IM_FIX_LIM,$mem_range,[size of immediate fixnum address space]) ++ fi ++ fi ++fi + + AC_MSG_CHECKING([sizeof long long int]) +-AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +- #include +- ]],[[ +- if (sizeof(long long int) == 2*sizeof(long)) return 0; +- return 1; +-]])],[AC_DEFINE(HAVE_LONG_LONG,1,[long long is available]) AC_MSG_RESULT(yes)], ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ ]], ++ [[ ++ if (sizeof(long long int) == 2*sizeof(long)) return 0; ++ return 1; ++ ]])], ++ [AC_DEFINE(HAVE_LONG_LONG,1,[long long is available]) AC_MSG_RESULT(yes)], + [AC_MSG_RESULT(no)]) + + AC_SUBST(HAVE_LONG_LONG) + +- +-AC_CHECK_HEADERS(dirent.h, +- AC_MSG_CHECKING([for d_type]) +- AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +- #include +- ]],[[ +- struct dirent d; +- return d.d_type=0; +- ]])], +- [AC_MSG_RESULT([yes]) AC_DEFINE(HAVE_D_TYPE,1,[have struct dirent d_type field])], +- AC_MSG_RESULT([no]),AC_MSG_RESULT([no]))) +- +-# readline +-AC_ARG_ENABLE(readline, +- [--enable-readline enables command line completion via the readline library ],, +- enable_readline="yes") ++AC_CHECK_HEADERS([dirent.h], ++ AC_MSG_CHECKING([for d_type]) ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ ]], ++ [[ ++ struct dirent d; ++ return d.d_type=0; ++ ]])], ++ [AC_MSG_RESULT([yes]) AC_DEFINE(HAVE_D_TYPE,1,[have struct dirent d_type field])], ++ AC_MSG_RESULT([no]),AC_MSG_RESULT([no]))) + + # ansi lisp +-AC_ARG_ENABLE(ansi,[--enable-ansi builds a large gcl aiming for ansi compliance, +- --disable-ansi builds the smaller traditional CLtL1 image],,enable_ansi="yes") +- +-if test "$enable_ansi" = "yes" ; then +- SYSTEM=ansi_gcl +- CLSTANDARD=ANSI +-else +- SYSTEM=gcl +- CLSTANDARD=CLtL1 +-fi ++SYSTEM=ansi_gcl ++CLSTANDARD=ANSI ++AC_ARG_ENABLE([ansi],[ --enable-ansi builds a large gcl aiming for ansi compliance], ++ [if test "$enable_ansi" = "no" ; then ++ SYSTEM=gcl ++ CLSTANDARD=CLtL1 ++ fi]) + + FLISP="saved_$SYSTEM" + AC_SUBST(FLISP) +@@ -2192,51 +1574,44 @@ AC_EGREP_HEADER([gettimeofday], + [sys/time.h], + [AC_MSG_RESULT([present])], + [AC_MSG_RESULT([missing]) +- AC_DEFINE(GETTOD_NOT_DECLARED,1,[No gettimeofday call -- fixme])]) ++ AC_DEFINE(GETTOD_NOT_DECLARED,1,[No gettimeofday call -- fixme])]) + + + AC_CHECK_LIB(m,sin,LIBS="${LIBS} -lm",true) + AC_CHECK_LIB(mingwex,main,LIBS="${LIBS} -lmingwex",true) + + AC_MSG_CHECKING([for buggy maximum sscanf length]) +-AC_RUN_IFELSE([ +- AC_LANG_PROGRAM([[ +- #include +- ]],[[ +- char *s= "2.7182818284590452353602874713526624977572470936999595749669676277240766303535475945713821785251664274274663919320030599218174135966290435729003342952605956307381323286279434907632338298807531952510190115738341879307021540891499348841675092447614606680822648001684774118537423454424371075390777449920695517027618386062613313845830007520449338265602976067371132007093287091274437470472306969772093101416928368190255151086574637721112523897844250569536967707854499699679468644549059879316368892300987931277361782154249992295763514822082698951936680331825288693984964651058209392398294887933203625094431173012381970684161404"; +- int n, m; +- double f; +- char *endptr; +- FILE *fp=fopen("conftest1","w"); +- +- n=sscanf(s,"%lf%n",&f,&m); +- fprintf(fp,"%d",m); +- fclose(fp); +- return s[m]; +- ]])], +- [AC_MSG_RESULT([none])], +- [buggy_maximum_sscanf_length=`cat conftest1` +- AC_MSG_RESULT([$buggy_maximum_sscanf_length]) +- AC_DEFINE_UNQUOTED(BUGGY_MAXIMUM_SSCANF_LENGTH,$buggy_maximum_sscanf_length,[sscanf terminates prematurely (Windows XP)])]) ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ ]], ++ [[ ++ char *s= "2.7182818284590452353602874713526624977572470936999595749669676277240766303535475945713821785251664274274663919320030599218174135966290435729003342952605956307381323286279434907632338298807531952510190115738341879307021540891499348841675092447614606680822648001684774118537423454424371075390777449920695517027618386062613313845830007520449338265602976067371132007093287091274437470472306969772093101416928368190255151086574637721112523897844250569536967707854499699679468644549059879316368892300987931277361782154249992295763514822082698951936680331825288693984964651058209392398294887933203625094431173012381970684161404"; ++ int n, m; ++ double f; ++ char *endptr; ++ FILE *fp=fopen("conftest1","w"); ++ ++ n=sscanf(s,"%lf%n",&f,&m); ++ fprintf(fp,"%d",m); ++ fclose(fp); ++ return s[m]; ++ ]])], ++ [AC_MSG_RESULT([none])], ++ [buggy_maximum_sscanf_length=`cat conftest1` ++ AC_MSG_RESULT([$buggy_maximum_sscanf_length]) ++ AC_DEFINE_UNQUOTED(BUGGY_MAXIMUM_SSCANF_LENGTH,$buggy_maximum_sscanf_length,[sscanf terminates prematurely (Windows XP)])]) + + + EXTRA_LOBJS= +-if test "$try_japi" = "yes" ; then +- AC_CHECK_HEADERS(japi.h,[AC_DEFINE(HAVE_JAPI_H) +- EXTRA_LOBJS="${EXTRA_LOBJS} gcl_japi.o" +- LIBS="${LIBS} -ljapi -lwsock32"] ) +-fi +-dnl if test "$use" = "mingw" ; then +-dnl if test "$try_xdr" = "yes" ; then +-dnl AC_CHECK_HEADERS(rpc/rpc.h,[AC_DEFINE(HAVE_XDR) +-dnl LIBS="${LIBS} -loncrpc"] ) +-dnl fi +-dnl else +-dnl if test "$try_xdr" = "yes" ; then +-dnl AC_CHECK_HEADERS(rpc/rpc.h,[AC_DEFINE(HAVE_XDR) +-dnl LIBS="${LIBS} -lrpc"] ) +-dnl fi +-dnl fi ++AC_ARG_ENABLE([japi],[ --enable-japi=yes will compile in support for the JAPI graphical interface if present on your system], ++ [if test "$enable_japi" = "yes" ; then ++ AC_CHECK_HEADERS([japi.h], ++ [AC_DEFINE(HAVE_JAPI_H) ++ EXTRA_LOBJS="${EXTRA_LOBJS} gcl_japi.o" ++ LIBS="${LIBS} -ljapi -lwsock32"]) ++ fi]) + + # Should really find a way to check for prototypes, but this + # basically works for now. CM +@@ -2260,76 +1635,53 @@ AC_CHECK_HEADERS(float.h,AC_DEFINE(HAVE_ + # test makes sense. CM + # + AC_MSG_CHECKING([for isnormal]) +-AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +- #define _GNU_SOURCE +- #include +- ]],[[ +- float f; +- return isnormal(f) || !isnormal(f) ? 0 : 1; ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #define _GNU_SOURCE ++ #include ++ ]], ++ [[ ++ float f; ++ return isnormal(f) || !isnormal(f) ? 0 : 1; + ]])], +- [AC_DEFINE(HAVE_ISNORMAL,1,[Have isnormal function]) AC_MSG_RESULT(yes)], +- [AC_MSG_CHECKING([for fpclass in ieeefp.h]) +- AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +- #include +- ]],[[ +- float f; +- return fpclass(f)>=FP_NZERO || fpclass(f) ++ ]], ++ [[ ++ float f; ++ return fpclass(f)>=FP_NZERO || fpclass(f) +- ]],[[ +- float f; +- return isfinite(f) || !isfinite(f) ? 0 : 1; +- ]])],[AC_DEFINE(HAVE_ISFINITE,1,[Have isfinite function]) AC_MSG_RESULT(yes)], +- [AC_MSG_CHECKING([for finite()]) +- AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #define _GNU_SOURCE + #include +- #include +- ]],[[ ++ ]], ++ [[ + float f; +- return finite(f) || !finite(f) ? 0 : 1; +- ]])],[AC_DEFINE(HAVE_FINITE,1,[Have finite function]) AC_MSG_RESULT(yes)], +- [AC_MSG_ERROR(no)])]) +- +-dnl AC_MSG_CHECKING([for INFINITY]) +-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +-dnl #define _GNU_SOURCE +-dnl #include +-dnl ]],[[ +-dnl double d=INFINITY; +-dnl return 0; +-dnl ]])],[AC_MSG_RESULT(yes)], +-dnl [AC_MSG_CHECKING([for builtin_inf()]) +-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +-dnl #include +-dnl #include +-dnl ]],[[ +-dnl double d=__builtin_inf(); +-dnl return 0; +-dnl ]])],[AC_DEFINE_UNQUOTED(INFINITY,__builtin_inf(),[Have builtin_inf]) AC_MSG_RESULT(yes)], +-dnl [AC_MSG_ERROR(no)])]) +- +-dnl AC_MSG_CHECKING([for NAN]) +-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +-dnl #define _GNU_SOURCE +-dnl #include +-dnl ]],[[ +-dnl double d=NAN; +-dnl return 0; +-dnl ]])],[AC_MSG_RESULT(yes)], +-dnl [AC_MSG_CHECKING([for builtin_nan()]) +-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +-dnl #include +-dnl #include +-dnl ]],[[ +-dnl double d=__builtin_nan("0x0"); +-dnl return 0; +-dnl ]])],[AC_DEFINE_UNQUOTED(NAN,__builtin_nan("0x0"),[Have builtin_nan]) AC_MSG_RESULT(yes)], +-dnl [AC_MSG_ERROR(no)])]) ++ return isfinite(f) || !isfinite(f) ? 0 : 1; ++ ]])],[AC_DEFINE(HAVE_ISFINITE,1,[Have isfinite function]) AC_MSG_RESULT(yes)], ++ [AC_MSG_CHECKING([for finite()]) ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #include ++ ]], ++ [[ ++ float f; ++ return finite(f) || !finite(f) ? 0 : 1; ++ ]])], ++ [AC_DEFINE(HAVE_FINITE,1,[Have finite function]) AC_MSG_RESULT(yes)], ++ [AC_MSG_ERROR(no)])]) + + #-------------------------------------------------------------------- + # Check for the existence of the -lsocket and -lnsl libraries. +@@ -2363,69 +1715,78 @@ if test "$tcl_checkBoth" = 1; then + fi + AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [TLIBS="$TLIBS -lnsl"])) + +-RL_OBJS="" +-RL_LIB="" +-if test "$enable_readline" = "yes" ; then +- AC_CHECK_HEADERS(readline/readline.h, +- AC_CHECK_LIB(readline,rl_initialize, +- AC_DEFINE(HAVE_READLINE,1,[have readline library]) +- TLIBS="$TLIBS -lreadline" #some machines don't link this, e.g. Slackware +- RL_OBJS=gcl_readline.o +-# Readline support now initialized automatically when compiled in, this lisp +-# object no longer needed -- 20040102 CM +-# RL_LIB=lsp/gcl_readline.o +- )) +- +-# These tests discover differences between readline 4.1 and 4.3 +- AC_CHECK_LIB(readline,rl_completion_matches, +- AC_DEFINE(HAVE_DECL_RL_COMPLETION_MATCHES,1,[have readline completion matches]) +- AC_DEFINE(HAVE_RL_COMPENTRY_FUNC_T,1,[have readline completion matches]),,) ++# readline ++AC_ARG_ENABLE(readline,[ --enable-readline enables command line completion via the readline library ]) ++ ++if test "$use" = "mingw" ; then ++ enable_readline=no ++fi ++ ++if test "$enable_readline" != "no" ; then ++ AC_CHECK_HEADERS([readline/readline.h], ++ AC_CHECK_LIB([readline],[rl_initialize], ++ [AC_DEFINE(HAVE_READLINE,1,[have readline library]) ++ TLIBS="$TLIBS -lreadline" #some machines don't link this, e.g. Slackware ++ RL_OBJS=gcl_readline.o])) ++ ++ # These tests discover differences between readline 4.1 and 4.3 ++ AC_CHECK_LIB([readline],[rl_completion_matches], ++ [AC_DEFINE(HAVE_DECL_RL_COMPLETION_MATCHES,1,[have readline completion matches]) ++ AC_DEFINE(HAVE_RL_COMPENTRY_FUNC_T,1,[have readline completion matches])]) + fi + + AC_SUBST(RL_OBJS) + AC_SUBST(RL_LIB) + +-AC_MSG_CHECKING(For network code for nsocket.c) +-AC_TRY_LINK([ +-#include +-#include +-#include +- +-#include +-#include +-#include +- +-/************* for the sockets ******************/ +-#include /* struct sockaddr, SOCK_STREAM, ... */ +-#ifndef NO_UNAME +-# include /* uname system call. */ +-#endif +-#include /* struct in_addr, struct sockaddr_in */ +-#include /* inet_ntoa() */ +-#include /* gethostbyname() */ +-],[ connect(0,(struct sockaddr *)0,0); +- gethostbyname("jil"); +- socket(AF_INET, SOCK_STREAM, 0); +- ], +-[AC_DEFINE(HAVE_NSOCKET,1,[can use nsocket library]) +- AC_MSG_RESULT(yes)], +-AC_MSG_RESULT(no)) +- +- +-AC_MSG_CHECKING(check for listen using fcntl) +-AC_TRY_COMPILE([#include +-#include +-], +-[FILE *fp=fopen("configure.in","r"); +- int orig; +- orig = fcntl(fileno(fp), F_GETFL); +- if (! (orig & O_NONBLOCK )) return 0; +-], +-[AC_DEFINE(LISTEN_USE_FCNTL,1,[can use fcntl for listen function]) +- AC_MSG_RESULT(yes)], +-AC_MSG_RESULT(no)) +- ++# sockets + ++AC_MSG_CHECKING([For network code for nsocket.c]) ++AC_LINK_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #include ++ #include ++ ++ #include ++ #include ++ #include ++ ++ /************* for the sockets ******************/ ++ #include /* struct sockaddr, SOCK_STREAM, ... */ ++ #ifndef NO_UNAME ++ # include /* uname system call. */ ++ #endif ++ #include /* struct in_addr, struct sockaddr_in */ ++ #include /* inet_ntoa() */ ++ #include /* gethostbyname() */ ++ ]], ++ [[ ++ connect(0,(struct sockaddr *)0,0); ++ gethostbyname("jil"); ++ socket(AF_INET, SOCK_STREAM, 0); ++ ]])], ++ [AC_DEFINE(HAVE_NSOCKET,1,[can use nsocket library]) ++ AC_MSG_RESULT([yes])], ++ [AC_MSG_RESULT([no])]) ++ ++ ++AC_MSG_CHECKING([check for listen using fcntl]) ++AC_COMPILE_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #include ++ ]], ++ [[ ++ FILE *fp=fopen("configure.in","r"); ++ int orig; ++ orig = fcntl(fileno(fp), F_GETFL); ++ if (! (orig & O_NONBLOCK )) return 0; ++ ]])], ++ [AC_DEFINE(LISTEN_USE_FCNTL,1,[can use fcntl for listen function]) ++ AC_MSG_RESULT([yes])], ++ [AC_MSG_RESULT([no])]) + + + AC_CHECK_FUNC(profil, ,[AC_DEFINE(NO_PROFILE,1,[no profil system call])]) +@@ -2433,29 +1794,18 @@ AC_SUBST(NO_PROFILE) + AC_CHECK_FUNC(setenv,[AC_DEFINE(HAVE_SETENV,1,[have setenv call])],no_setenv=1 ) + AC_SUBST(HAVE_SETENV) + if test "$no_setenv" = "1" ; then +-AC_CHECK_FUNC(putenv,[AC_DEFINE(HAVE_PUTENV,1,[have putenv call])],) +-AC_SUBST(HAVE_PUTENV) ++ AC_CHECK_FUNC(putenv,[AC_DEFINE(HAVE_PUTENV,1,[have putenv call])],) ++ AC_SUBST(HAVE_PUTENV) + fi + + AC_CHECK_FUNC(_cleanup, [AC_DEFINE(USE_CLEANUP,1,[have _cleanup function])],) + AC_SUBST(USE_CLEANUP) + gcl_ok=no + +-dnl AC_HEADER_EGREP(LITTLE_ENDIAN, ctype.h, gcl_ok=yes, gcl_ok=noo) +-dnl if test $gcl_ok = yes ; then +-dnl AC_DEFINE(ENDIAN_ALREADY_DEFINED) +-dnl fi +- +-dnl AC_SUBST(ENDIAN_ALREADY_DEFINED) +- +- +- +- +-# if test "x$enable_machine" = "x" ; then + AC_MSG_CHECKING([FIONBIO vs. O_NONBLOCK for nonblocking I/O]) + + case $system in +- OSF*) ++ OSF*) + AC_DEFINE(USE_FIONBIO,1,[use fionbio for non-blocking io]) + AC_MSG_RESULT(FIONBIO) + ;; +@@ -2474,103 +1824,85 @@ esac + + + AC_MSG_CHECKING(check for SV_ONSTACK) +-AC_TRY_COMPILE([#include +-int joe=SV_ONSTACK; +-], +-[], +-[AC_DEFINE(HAVE_SV_ONSTACK,1,[have sv_onstack]) +- AC_SUBST(HAVE_SV_ONSTACK) +- AC_MSG_RESULT(yes)], +-AC_MSG_RESULT(no)) ++AC_COMPILE_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ int joe=SV_ONSTACK; ++ ]], ++ [[]])], ++ [AC_DEFINE(HAVE_SV_ONSTACK,1,[have sv_onstack]) ++ AC_SUBST(HAVE_SV_ONSTACK) ++ AC_MSG_RESULT([yes])], ++ [AC_MSG_RESULT([no])]) + + AC_MSG_CHECKING(check for SIGSYS) +-AC_TRY_COMPILE([#include +-int joe=SIGSYS; +-], +-[], +-[AC_DEFINE(HAVE_SIGSYS,1,[have SIGSYS signal]) +- AC_SUBST(HAVE_SIGSYS) +- AC_MSG_RESULT(yes)], +-AC_MSG_RESULT(no)) ++AC_COMPILE_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ int joe=SIGSYS; ++ ]],[[]])], ++ [AC_DEFINE(HAVE_SIGSYS,1,[have SIGSYS signal]) ++ AC_SUBST(HAVE_SIGSYS) ++ AC_MSG_RESULT([yes])], ++ [AC_MSG_RESULT([no])]) + + + AC_MSG_CHECKING(check for SIGEMT) +-AC_TRY_COMPILE([#include +-int joe=SIGEMT; +-], +-[], +-[AC_DEFINE(HAVE_SIGEMT,1,[have SIGEMT signal]) +- AC_SUBST(HAVE_SIGEMT) +- AC_MSG_RESULT(yes)], +-AC_MSG_RESULT(no)) ++AC_COMPILE_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ int joe=SIGEMT; ++ ]],[[]])], ++ [AC_DEFINE(HAVE_SIGEMT,1,[have SIGEMT signal]) ++ AC_SUBST(HAVE_SIGEMT) ++ AC_MSG_RESULT([yes])], ++ [AC_MSG_RESULT([no])]) + + AC_CHECK_FUNCS(sigaltstack) + AC_CHECK_FUNCS(feenableexcept) + + AC_CHECK_HEADERS(dis-asm.h, +- MLIBS=$LIBS +- AC_CHECK_LIB(opcodes,init_disassemble_info) +- AC_CHECK_LIB(dl,dlopen,#opcodes changes too quickly to link directly +- AC_CHECK_FUNCS(print_insn_i386,LIBS="$MLIBS -ldl"))) ++ MLIBS=$LIBS ++ AC_CHECK_LIB(opcodes,init_disassemble_info) ++ AC_CHECK_LIB(dl,dlopen,#opcodes changes too quickly to link directly ++ AC_CHECK_FUNCS(print_insn_i386,LIBS="$MLIBS -ldl"))) + + #if test $use = "386-linux" ; then +- AC_CHECK_HEADERS(asm/sigcontext.h) +- AC_CHECK_HEADERS(asm/signal.h) +- AC_MSG_CHECKING([for sigcontext...]) +- AC_TRY_COMPILE([#include +- ], +- [ +- struct sigcontext foo; +- ], +- [ +- sigcontext_works=1; +- AC_DEFINE(SIGNAL_H_HAS_SIGCONTEXT,1,[have sigcontext in signal.h]) +- AC_MSG_RESULT(sigcontext in signal.h) +- ], +- +- [sigcontext_works=0; +- AC_MSG_RESULT(sigcontext NOT in signal.h)] +- ) +- if test "$sigcontext_works" = 0 ; then +- AC_MSG_CHECKING([for sigcontext...]) +- AC_TRY_COMPILE([#include +- #ifdef HAVE_ASM_SIGCONTEXT_H +- #include +- #endif +- #ifdef HAVE_ASM_SIGNAL_H +- #include +- #endif +- ], +- [ +- struct sigcontext foo; +- ], +- [ +- AC_DEFINE(HAVE_SIGCONTEXT,1,[have sigcontext]) +- AC_MSG_RESULT(sigcontext in asm files) +- ], +- [ +- AC_MSG_RESULT(no sigcontext found) +- ]) +- +- +- fi +-# echo 'foo() {}' > conftest1.c +-# $CC -S conftest1.c +-# use_underscore=0 +-# if fgrep _foo conftest1.s ; then use_underscore=1 ; fi +-# if test $use_underscore = 0 ; then +-# MPI_FILE=mpi-386_no_under.o +-# else +-# MPI_FILE=mpi-386d.o +-# fi +-# AC_SUBST(MPI_FILE) +-# GCC=$CC +-# if test -x /usr/bin/i386-glibc20-linux-gcc ; then +-# GCC=/usr/bin/i386-glibc20-linux-gcc +-# fi +-# AC_SUBST(GCC) +- +-#fi ++AC_CHECK_HEADERS(asm/sigcontext.h) ++AC_CHECK_HEADERS(asm/signal.h) ++AC_MSG_CHECKING([for sigcontext...]) ++AC_COMPILE_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ ]], ++ [[ ++ struct sigcontext foo; ++ ]])], ++ [AC_DEFINE(SIGNAL_H_HAS_SIGCONTEXT,1,[have sigcontext of signal.h]) ++ AC_MSG_RESULT([sigcontext of signal.h])], ++ [AC_MSG_RESULT([sigcontext NOT of signal.h]) ++ AC_MSG_CHECKING([for sigcontext...]) ++ AC_COMPILE_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #ifdef HAVE_ASM_SIGCONTEXT_H ++ #include ++ #endif ++ #ifdef HAVE_ASM_SIGNAL_H ++ #include ++ #endif ++ ]], ++ [[ ++ struct sigcontext foo; ++ ]])], ++ [AC_DEFINE(HAVE_SIGCONTEXT,1,[have sigcontext]) ++ AC_MSG_RESULT(sigcontext asm files)], ++ [AC_MSG_RESULT([no sigcontext found])])]) + + AC_PATH_PROG(EMACS,emacs) + +@@ -2590,11 +1922,11 @@ EOF + + AC_MSG_CHECKING([emacs site lisp directory]) + if [[ "$EMACS_SITE_LISP" = "unknown" ]] ; then +- if [[ "$EMACS" != "" ]] ; then +- EMACS_SITE_LISP=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` +- else +- EMACS_SITE_LISP="" +- fi ++ if [[ "$EMACS" != "" ]] ; then ++ EMACS_SITE_LISP=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` ++ else ++ EMACS_SITE_LISP="" ++ fi + fi + AC_MSG_RESULT($EMACS_SITE_LISP) + AC_SUBST(EMACS_SITE_LISP) +@@ -2613,14 +1945,14 @@ EOF + + AC_MSG_CHECKING([emacs default.el]) + if [[ "$EMACS" != "" ]] ; then +- EMACS_DEFAULT_EL=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` ++ EMACS_DEFAULT_EL=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` + else +- EMACS_DEFAULT_EL="" ++ EMACS_DEFAULT_EL="" + fi + if test -f "${EMACS_DEFAULT_EL}" ; then true;else +- if test -d $EMACS_SITE_LISP ; then +- EMACS_DEFAULT_EL=${EMACS_SITE_LISP}/default.el +- fi ++ if test -d $EMACS_SITE_LISP ; then ++ EMACS_DEFAULT_EL=${EMACS_SITE_LISP}/default.el ++ fi + fi + AC_MSG_RESULT($EMACS_DEFAULT_EL) + AC_SUBST(EMACS_DEFAULT_EL) +@@ -2651,93 +1983,98 @@ fi + AC_MSG_RESULT($INFO_DIR) + AC_SUBST(INFO_DIR) + +-if test "$enable_tcltk" = "yes" ; then ++AC_ARG_ENABLE([tcltk],[ --enable-tcltk will try to build gcl-tk]) ++AC_ARG_ENABLE([tkconfig], ++ [ --enable-tkconfig=XXXX will force the use of a TK_CONFIG_PREFIX=XXXXX as place to look for tkConfig.sh and tclConfig.sh], ++ [TK_CONFIG_PREFIX=$enableval],[TK_CONFIG_PREFIX=unknown]) ++AC_ARG_ENABLE([tclconfig], ++ [ --enable-tclconfig=XXXX will force the use of a TCL_CONFIG_PREFIX=XXXXX as place to look for tclConfig.sh and tclConfig.sh], ++ [TCL_CONFIG_PREFIX=$enableval],[TCL_CONFIG_PREFIX=unknown]) + +- AC_MSG_CHECKING([for tcl/tk]) ++if test "$enable_tcltk" != "no" ; then + +- if test -d "${TCL_CONFIG_PREFIX}" ; then true ; else ++ AC_MSG_CHECKING([for tcl/tk]) + +- AC_CHECK_PROG(TCLSH,tclsh,tclsh,${TCLSH}) +- +- if test "${TCLSH}" = "" ; then true ; else +- +- rm -f conftest.tcl +- cat >> conftest.tcl <> conftest.tcl <&1 $CC -v | fgrep "gcc version 2.96" > /dev/null +-dnl then +-dnl BROKEN_O4_OPT=1 +-dnl AC_DEFINE(BROKEN_O4_OPT) +-dnl AC_SUBST(BROKEN_O4_OPT) +-dnl echo ODIR_DEBUG=-O >> makedefsafter +-dnl echo >> makedefsafter +-dnl AC_MSG_RESULT([yes .. turning off -O4]) +-dnl else +-dnl AC_MSG_RESULT([no]) +-dnl fi +- +-LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'`" ++LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'` $TLDFLAGS" + AC_SUBST(LDFLAGS) +-LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $TLDFLAGS $LIBS $TLIBS" ++LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $LIBS $TLIBS" + AC_SUBST(LIBS) +-FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS $TCFLAGS $PROCESSOR_FLAGS" ++FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS $TCFLAGS" + AC_SUBST(FINAL_CFLAGS) + # Work around bug with gcc on ppc -- CM +-NIFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TONIFLAGS $PROCESSOR_FLAGS -I\$(GCLDIR)/o" ++NIFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TONIFLAGS -I\$(GCLDIR)/o" + AC_SUBST(NIFLAGS) +-CFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TO3FLAGS $PROCESSOR_FLAGS -I\$(GCLDIR)/o" ++CFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TO3FLAGS -I\$(GCLDIR)/o" + AC_SUBST(CFLAGS) + O3FLAGS=$TO3FLAGS + AC_SUBST(O3FLAGS) + O2FLAGS=$TO2FLAGS + AC_SUBST(O2FLAGS) + +-AC_SUBST(PRELINK_CHECK) +- + AC_SUBST(EXTRA_LOBJS) + AC_SUBST(LEADING_UNDERSCORE) + AC_SUBST(GNU_LD) + if test -f h/$use.defs ; then +- +- AC_SUBST(use) +- AC_OUTPUT(makedefc windows/gcl.iss windows/sysdir.bat windows/install.lsp ) +- echo makedefc +- cat makedefc +- +- echo add-defs1 $use +- CC=$CC ./add-defs1 $use +- ++ ++ AC_SUBST(use) ++ AC_OUTPUT(makedefc windows/gcl.iss windows/sysdir.bat windows/install.lsp ) ++ echo makedefc ++ cat makedefc ++ ++ echo add-defs1 $use ++ CC=$CC ./add-defs1 $use ++ + else +- echo "Unable to guess machine type" +- echo use configure --enable-machine=XXX, for XXX such that h/XXX.defs exists, ie in h/*.defs ++ echo "Unable to guess machine type" ++ echo use configure --enable-machine=XXX, for XXX such that h/XXX.defs exists, ie in h/*.defs + fi +--- gcl-2.6.12.orig/gcl-tk/sheader.h ++++ gcl-2.6.12/gcl-tk/sheader.h +@@ -45,7 +45,7 @@ struct message_header { + + + #define BYTE_S 8 +-#define BYTE_MASK (~(~0 << BYTE_S)) ++#define BYTE_MASK (~(~0UL << BYTE_S)) + + #define GET_3BYTES(p,ans) do{ unsigned char* __p = (unsigned char *) p; \ + ans = BYTE_MASK&(*__p++); \ +--- gcl-2.6.12.orig/h/compprotos.h ++++ gcl-2.6.12/h/compprotos.h +@@ -170,6 +170,7 @@ int gcl_putc(int,void *); + #ifdef CMPINCLUDE + int setjmp(); + int _setjmp(); ++int _setjmp3(); + #endif + void vfun_wrong_number_of_args(object); + void ihs_overflow (void); +@@ -179,4 +180,3 @@ char *gcl_gets(char *,int); + int gcl_puts(const char *); + int endp_error(object); + object Icall_gen_error_handler(object,object,object,object,ufixnum,...); +- +--- gcl-2.6.12.orig/h/funlink.h ++++ gcl-2.6.12/h/funlink.h +@@ -54,7 +54,7 @@ enum F_arg_types + }; + + /* Make a mask for bits i < j, masking j-i bits */ +-#define MASK_RANGE(i,j) ((~(~0 << (j-i)))<< i) ++#define MASK_RANGE(i,j) ((~(~0UL << (j-i)))<< i) + + #define F_PLAIN(x) (((x) & MASK_RANGE( F_START_TYPES_POS,31)) == 0) + #define ARG_LIMIT 63 +--- gcl-2.6.12.orig/h/mingw.defs ++++ gcl-2.6.12/h/mingw.defs +@@ -54,7 +54,7 @@ TCL_LIB_SPEC= + TCL_DL_LIBS= + TCL_LIBS= + +-PWD_CMD=pwd -W ++#PWD_CMD=pwd -W + + # + # End h/mingw.defs +--- gcl-2.6.12.orig/h/mingw.h ++++ gcl-2.6.12/h/mingw.h +@@ -26,21 +26,6 @@ + #define f_nsyms NumberOfSymbols + #define NO_PWD_H + +-#define MAXPATHLEN 512 +- +-/* alter pathToAlter to fit in with the Clibrary of the system. +- and report error using name 'x' if you cant do it. +- The result in pathToAlter should be less +-*/ +-#define FIX_FILENAME(x,pathToAlter) fix_filename(x,pathToAlter) +- +-#define MEMORY_SAVE(self,filename) \ +- do { char buf[MAXPATHLEN]; \ +- strcpy(buf,self); \ +- fix_filename(Cnil,buf); \ +- memory_save(buf,filename); \ +- } while (0) +- + #define signals_pending *signalsPendingPtr + + #undef DBEGIN_TY +--- gcl-2.6.12.orig/h/object.h ++++ gcl-2.6.12/h/object.h +@@ -371,6 +371,9 @@ emsg(const char *s,...) { + va_list args; + ufixnum n=0; + void *v=NULL; ++#ifndef vsnprintf ++ extern int vsnprintf(); ++#endif + va_start(args,s); + n=vsnprintf(v,n,s,args)+1; + va_end(args); +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1777,6 +1777,7 @@ void gcl_init_shared_memory ( void ); + void fix_filename ( object pathname, char *filename1 ); + void alarm ( int n ); + void *sbrk ( ptrdiff_t increment ); ++#define sigset_t int + void sigemptyset( sigset_t *set); + void sigaddset ( sigset_t *set, int n); + int sigismember ( sigset_t *set, int n ); +@@ -1798,19 +1799,12 @@ msystem(const char *); + void + assert_error(const char *,unsigned,const char *,const char *); + +-#ifdef _WIN32 +-void +-detect_wine(void); +- ++#ifdef __MINGW32__ + void + init_shared_memory(void); + +-void * +-alloca(size_t); +- + object + find_init_string(const char *); +- + #endif + + void * +@@ -1964,3 +1958,6 @@ gcl_cleanup(int); + + void + do_gcl_abort(void); ++ ++int ++vsystem(const char *); +--- gcl-2.6.12.orig/h/wincoff.h ++++ gcl-2.6.12/h/wincoff.h +@@ -10,6 +10,7 @@ + in this */ + #undef va_start + ++#include "winsock2.h" + #include "windows.h" + #ifdef __MINGW32__ + #include "minglacks.h" +--- gcl-2.6.12.orig/lsp/gcl_auto_new.lsp ++++ gcl-2.6.12/lsp/gcl_auto_new.lsp +@@ -206,14 +206,8 @@ + ;; So to stop users from invoking this + #+sun + (defun user-homedir-pathname () +- (let* ((tem (si::getenv "HOME")) +- (l (- (length tem) 1))) +- (cond ((null tem) nil) +- (t +- (or (and (>= l 0) +- (eql (aref tem l) #\/)) +- (setq tem (concatenate 'string tem "/"))) +- (pathname tem))))) +- ++ (let* ((tem (si::getenv "HOME"))) ++ (when tem ++ (pathname (coerce-slash-terminated tem))))) + + (AUTOLOAD 'init-readline '|gcl_readline|) +--- gcl-2.6.12.orig/lsp/gcl_directory.lsp ++++ gcl-2.6.12/lsp/gcl_directory.lsp +@@ -34,9 +34,9 @@ + (defun make-frame (s &aux (l (length s))) + (replace (make-array l :element-type 'character :adjustable t :fill-pointer l) s)) + +-(defun expand-wild-directory (l f zz &optional (yy (make-frame zz))) ++(defun expand-wild-directory (d l f zz &optional (yy (make-frame zz))) + (let* ((x (member-if 'wild-dir-element-p l)) +- (s (namestring (make-pathname :directory (ldiff l x)))) ++ (s (namestring (make-pathname :device d :directory (ldiff l x)))) + (z (vector-push-string zz s)) + (l (length yy)) + (y (link-expand (vector-push-string yy s) l)) +@@ -45,19 +45,15 @@ + (cond ((eq (car x) :wild-inferiors) (recurse-dir z y f)) + (x (walk-dir z y (lambda (q e l) + (declare (ignore l)) +- (expand-wild-directory (cons :relative (cdr x)) f q e)) :directory));FIXME ++ (expand-wild-directory d (cons :relative (cdr x)) f q e)) :directory));FIXME + ((funcall f z y)))))) + +-(defun chdir (s) +- (when (chdir1 (namestring (pathname s)));to expand ~/ +- (setq *current-directory* (current-directory-pathname)))) +- + (defun directory (p &key &aux (p (translate-logical-pathname p))(d (pathname-directory p)) + (c (unless (eq (car d) :absolute) (make-frame (namestring *current-directory*)))) + (lc (when c (length c))) + (filesp (or (pathname-name p) (pathname-type p))) + (v (compile-regexp (to-regexp p)))(*up-key* :back) r) +- (expand-wild-directory d ++ (expand-wild-directory (pathname-device p) d + (lambda (dir exp &aux (pexp (pathname (if c (vector-push-string c exp 0 lc) exp)))) + (if filesp + (walk-dir dir exp +@@ -67,5 +63,15 @@ + (push (merge-pathnames (parse-namestring dir nil *default-pathname-defaults* :start pos) pexp nil) r))) + :file) + (when (pathname-match-p dir v) (push pexp r)))) +- (make-frame (if c "./" ""))) ++ (make-frame "")) + r) ++ ++(defun chdir (s) ++ (when (chdir1 (namestring (pathname s)));to expand ~/ ++ (setq *current-directory* (current-directory-pathname)))) ++ ++(defun which (s) ++ (let ((r (with-open-file (s (apply 'string-concatenate "|" #-winnt "which " ++ #+winnt "for %i in (" s #+winnt ".exe) do @echo.%~$PATH:i" nil)) ++ (read-line s nil 'eof)))) ++ (if (eq r 'eof) s (string-downcase r)))) +--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp ++++ gcl-2.6.12/lsp/gcl_iolib.lsp +@@ -451,7 +451,7 @@ + (let* ((*load-pathname* pp)(*load-truename* epp)) + (with-open-file + (s epp :external-format external-format) +- (if (member (peek-char nil s nil 'eof) '#.(mapcar 'code-char (list 127 #xfe #xff #x4c))) ++ (if (member (peek-char nil s nil 'eof) '#.(mapcar 'code-char (list 127 #xcf #xce #x4c))) + (load-fasl s print) + (let ((*standard-input* s)) (load-stream s print))))) + (when if-does-not-exist +--- gcl-2.6.12.orig/lsp/gcl_make_pathname.lsp ++++ gcl-2.6.12/lsp/gcl_make_pathname.lsp +@@ -4,29 +4,58 @@ + ;; (declare (optimize (safety 1))) + ;; (when (typep x 'pathname) t)) + ++ ++(eval-when (compile eval) ++ (defun add-dir-sep (s &optional (i 0) (bp 0) (l (length s))) ++ (when (< i l) ++ (let ((x (aref s i))) ++ (append ++ (if (eql x #\/) ++ (if (zerop bp) (list #\[ x #\\ #\]) (list x #\\)) ++ (list x)) ++ (add-dir-sep s (1+ i) (case x (#\[ (1+ bp))(#\] (1- bp))(otherwise bp)) l))))) ++ ++ (defun ads (s) #+winnt (coerce (add-dir-sep s) 'string) #-winnt s)) ++ ++(defconstant +dirsep+ (compile-regexp #.(ads "/"))) ++ ++(defconstant +glob-to-regexp-alist+ (list (cons #v"{[^}]*}" (lambda (x) (msub '((#\| . #\,)(#\( . #\{)(#\) . #\})) x))) ++ (cons #v"\\[[^\\]*\\]" ++ (lambda (x) ++ (string-concatenate "(" (substitute #\^ #\! (subseq x 0 2)) (subseq x 2) ")"))) ++ (cons #v"\\*" (lambda (x) #.(ads "([^/.]*)"))) ++ (cons #v"\\?" (lambda (x) #.(ads "([^/.])"))) ++ (cons #v"\\." (lambda (x) "\\.")))) ++ ++(defconstant +physical-pathname-defaults+ '(("" "" "") ++ #+winnt("" "([A-Za-z]:)?" ":") #-winnt("" "()" "") ++ ("" #.(ads "(/?([^/]+/)*)") "" "" #.(ads "([^/]+/)") "/") ++ ("" #.(ads "([^/.]*)") "") ++ ("." #.(ads "(\\.[^/]*)?") "") ++ ("" "" ""))) ++ ++(defconstant +logical-pathname-defaults+ '(("" "([-0-9A-Z]+:)?" ":") ++ ("" "" "") ++ ("" "(;?((\\*?([-0-9A-Z]+\\*?)+|\\*|\\*\\*);)*)" "" "" "((\\*?([-0-9A-Z]+\\*?)+|\\*);)" ";") ++ ("" "(\\*?([-0-9A-Z]+\\*?)+|\\*)?" "") ++ ("." "(\\.(\\*?([-0-9A-Z]+\\*?)+|\\*))?" "") ++ ("." "(\\.([1-9][0-9]*|newest|NEWEST|\\*))?" ""))) ++ + (defun msub (a x) (if a (msub (cdr a) (substitute (caar a) (cdar a) x)) x)) + +-(defvar *glob-to-regexp-alist* (list (cons #v"{[^}]*}" (lambda (x) (msub '((#\| . #\,)(#\( . #\{)(#\) . #\})) x))) +- (cons #v"\\[[^\\]*\\]" (lambda (x) +- (concatenate 'string "(" +- (substitute #\^ #\! (subseq x 0 2)) +- (subseq x 2) ")"))) +- (cons #v"\\*" (lambda (x) "([^/.]*)")) +- (cons #v"\\?" (lambda (x) "([^/.])")) +- (cons #v"\\." (lambda (x) "\\.")))) + + (defun mglist (x &optional (b 0)) + (let* ((y (mapcan (lambda (z &aux (w (string-match (car z) x b))) + (unless (eql w -1) + (list (list w (match-end 0) z)))) +- *glob-to-regexp-alist*)) ++ +glob-to-regexp-alist+)) + (z (when y (reduce (lambda (y x) (if (< (car x) (car y)) x y)) y)))) + (when z + (cons z (mglist x (cadr z)))))) + + (defun mgsub (x &optional (l (mglist x)) (b 0) &aux (w (pop l))) + (if w +- (concatenate 'string ++ (string-concatenate + (subseq x b (car w)) + (funcall (cdaddr w) (subseq x (car w) (cadr w))) + (mgsub x l (cadr w))) +@@ -49,21 +78,10 @@ + ; ) + ) + +-(defconstant +physical-pathname-defaults+ '(("" "" "") +- ("" "" "") +- ("" "(/?([^/]+/)*)" "" "" "([^/]+/)" "/") +- ("" "([^/.]*)" "") +- ("." "(\\.[^/]*)?" "") +- ("" "" ""))) +-(defconstant +logical-pathname-defaults+ '(("" "([-0-9A-Z]+:)?" ":") +- ("" "" "") +- ("" "(;?((\\*?([-0-9A-Z]+\\*?)+|\\*|\\*\\*);)*)" "" "" "((\\*?([-0-9A-Z]+\\*?)+|\\*);)" ";") +- ("" "(\\*?([-0-9A-Z]+\\*?)+|\\*)?" "") +- ("." "(\\.(\\*?([-0-9A-Z]+\\*?)+|\\*))?" "") +- ("." "(\\.([1-9][0-9]*|newest|NEWEST|\\*))?" ""))) ++ + + (defun to-regexp-or-namestring (x rp lp) +- (apply 'concatenate 'string ++ (apply 'string-concatenate + (mapcan (lambda (x y) (elsub x y rp lp)) + x (if lp +logical-pathname-defaults+ +physical-pathname-defaults+)))) + +@@ -101,14 +119,14 @@ + (eval-when (compile eval) + (defun strsym (p &rest r) + (declare (:dynamic-extent r)) +- (intern (apply 'concatenate 'string (mapcar 'string-upcase r)) p))) ++ (intern (apply 'string-concatenate (mapcar 'string-upcase r)) p))) + + #.`(defun make-pathname (&key (host nil hostp) (device nil devicep) (directory nil directoryp) + (name nil namep) (type nil typep) (version nil versionp) + defaults (case :local) namestring &aux defaulted (def (when defaults (pathname defaults)))) + (declare (optimize (safety 1))) + (check-type host (or (member nil :unspecific) string)) +- (check-type device (member nil :unspecific)) ++ (check-type device (or (member nil :unspecific) string)) + (check-type directory (or (member nil :unspecific :wild) string list)) + (check-type name (or string (member nil :unspecific :wild))) + (check-type type (or string (member nil :unspecific :wild))) +@@ -116,7 +134,8 @@ + (check-type defaults (or null pathname-designator)) + (check-type case (member :common :local)) + ,(flet ((def? (k) `(let* (,@(when (eq k 'host) `((def (or def *default-pathname-defaults*)))) +- (nk (if ,(strsym :si k "P") ,k (progn (setq defaulted t) (when def (,(strsym :si "C-PATHNAME-" k) def))))) ++ (nk (if ,(strsym :si k "P") ,k (when def (,(strsym :si "C-PATHNAME-" k) def)))) ++ (nk (progn (unless (eq ,k nk) (setq defaulted t)) nk)) + (nk (if (eq case :local) nk (progn (setq defaulted t) (toggle-case nk))))) + nk))) + `(let* ((h ,(def? 'host)) +--- gcl-2.6.12.orig/lsp/gcl_parse_namestring.lsp ++++ gcl-2.6.12/lsp/gcl_parse_namestring.lsp +@@ -14,6 +14,7 @@ + (defun dir-conj (x) (if (eq x :relative) :absolute :relative)) + + (defvar *up-key* :up) ++(defvar *canonicalized* nil) + + (defun mfr (x b i) (subseq x b i)); (make-array (- i b) :element-type 'character :displaced-to x :displaced-index-offset b) + +@@ -30,15 +31,15 @@ + (z (if w (cdr w) z))) + (if (eq z :up) *up-key* z))) + +-(defun dir-parse (x sep sepfirst &optional (b 0)) ++(defun dir-parse (x &optional lp (b 0)) + (when (stringp x) +- (let ((i (search sep x :start2 b)));string-match spoils outer match results +- (when i +- (let* ((y (dir-parse x sep sepfirst (1+ i))) ++ (let ((i (string-match (if lp #v";" +dirsep+) x b))) ++ (unless (minusp i) ++ (let* ((y (dir-parse x lp (1+ i))) + (z (element x b i :directory)) +- (y (if z (cons z y) y))) ++ (y (if z (cons z y) (progn (when (> i b) (setq *canonicalized* t)) y)))) + (if (zerop b) +- (cons (if (zerop i) sepfirst (dir-conj sepfirst)) y) ++ (cons (if (if lp (plusp i) (zerop i)) :absolute :relative) y) + y)))))) + + (defun match-component (x i k &optional (boff 0) (eoff 0)) +@@ -52,40 +53,37 @@ + + (defconstant +generic-logical-pathname-regexp+ (compile-regexp (to-regexp-or-namestring (make-list (length +logical-pathname-defaults+)) t t))) + +-(defun expand-home-dir (dir) +- (cond ((and (eq (car dir) :relative) (stringp (cadr dir)) (eql #\~ (aref (cadr dir) 0))) +- (append (dir-parse (home-namestring (cadr dir)) "/" :absolute) (cddr dir))) +- (dir))) +- + (defun logical-pathname-parse (x &optional host def (b 0) (e (length x))) +- (when (and (eql b (string-match +generic-logical-pathname-regexp+ x b e)) (eql (match-end 0) e)) +- (let ((mhost (match-component x 1 :host 0 -1))) +- (when (and host mhost) +- (unless (string-equal host mhost) ++ (when *pathname-logical* ;;accelerator ++ (when (and (eql b (string-match +generic-logical-pathname-regexp+ x b e)) (eql (match-end 0) e)) ++ (let ((mhost (match-component x 1 :host 0 -1))) ++ (when (and host mhost) ++ (unless (string-equal host mhost) + (error 'error :format-control "Host part of ~s does not match ~s" :format-arguments (list x host)))) +- (let ((host (or host mhost (pathname-host def)))) +- (when (logical-pathname-host-p host) +- (let* ((dir (dir-parse (match-component x 2 :none) ";" :relative)) +- (edir (expand-home-dir dir))) +- (make-pathname :host host +- :device :unspecific +- :directory edir +- :name (match-component x 6 :name) +- :type (match-component x 8 :type 1) +- :version (version-parse (match-component x 11 :version 1)) +- :namestring (when (and mhost (eql b 0) (eql e (length x)) (eq dir edir)) x)))))))) +- ++ (let ((host (or host mhost (pathname-host def)))) ++ (when (logical-pathname-host-p host) ++ (make-pathname :host host ++ :device :unspecific ++ :name (match-component x 6 :name) ++ :type (match-component x 8 :type 1) ++ :version (version-parse (match-component x 11 :version 1)) ++ :directory (dir-parse (match-component x 2 :none) t);must be last ++ :namestring (when (and mhost (eql b 0) (eql e (length x))) x)))))))) ++ + (defconstant +generic-physical-pathname-regexp+ (compile-regexp (to-regexp-or-namestring (make-list (length +physical-pathname-defaults+)) t nil))) + +-(defun pathname-parse (x b e) +- (when (and (eql b (string-match +generic-physical-pathname-regexp+ x b e)) (eql (match-end 0) e)) +- (let* ((dir (dir-parse (match-component x 1 :none) "/" :absolute)) +- (edir (expand-home-dir dir))) +- (make-pathname :directory edir +- :name (match-component x 3 :name) +- :type (match-component x 4 :type 1) +- :namestring (when (and (eql b 0) (eql e (length x)) (eq dir edir)) x))))) ++(defun expand-home-dir (dir) ++ (if (and (eq (car dir) :relative) (stringp (cadr dir)) (eql #\~ (aref (cadr dir) 0))) ++ (prog1 (append (dir-parse (home-namestring (cadr dir))) (cddr dir)) (setq *canonicalized* t)) ++ dir)) + ++(defun pathname-parse (x b e &aux (*canonicalized* nil)) ++ (when (and (eql b (string-match +generic-physical-pathname-regexp+ x b e)) (eql (match-end 0) e)) ++ (make-pathname :device (match-component x 1 :none 0 -1) ++ :name (match-component x 4 :name) ++ :type (match-component x 5 :type 1) ++ :directory (expand-home-dir (dir-parse (match-component x 2 :none)));must be last ++ :namestring (unless *canonicalized* (when (and (eql b 0) (eql e (length x))) x))))) + + (defun path-stream-name (x) + (check-type x pathname-designator) +--- gcl-2.6.12.orig/lsp/gcl_top.lsp ++++ gcl-2.6.12/lsp/gcl_top.lsp +@@ -581,27 +581,20 @@ First directory is checked for first nam + + (defvar *tmp-dir*) + +-(defun wine-tmp-redirect () +- (let* ((s (find-symbol "*WINE-DETECTED*" (find-package "SYSTEM")))) +- (when (and s (symbol-value s)) +- (list *system-directory*)))) +- + (defun ensure-dir-string (str) + (if (eq (stat str) :directory) + (coerce-slash-terminated str) + str)) + + (defun get-temp-dir () +- (dolist (x `(,@(wine-tmp-redirect) ,@(mapcar 'si::getenv '("TMPDIR" "TMP" "TEMP")) "/tmp" "")) ++ (dolist (x `(,@(mapcar 'si::getenv '("TMPDIR" "TMP" "TEMP")) "/tmp" "")) + (when x + (let ((x (coerce-slash-terminated x))) + (when (eq (stat x) :directory) + (return-from get-temp-dir x)))))) + +-(defun get-path (s &aux (m (string-match "([^/ ]*)( |$)" s))(b (match-beginning 1))(e (match-end 1)) +- (r (with-open-file (s (concatenate 'string "|which " (subseq s b e))) (read s nil 'eof)))) +- (if (eq r 'eof) s (concatenate 'string (string-downcase r) (subseq s e)))) +- ++(defun get-path (s &aux (m (string-match "([^ ]*)( |$)" s))(b (match-beginning 1))(e (match-end 1))) ++ (string-concatenate (which (pathname-name (subseq s b e))) (subseq s e))) + + (defvar *cc* "cc") + (defvar *ld* "ld") +@@ -609,7 +602,7 @@ First directory is checked for first nam + + (defvar *current-directory* *system-directory*) + +-(defun current-directory-pathname nil (pathname (concatenate 'string (getcwd) "/"))) ++(defun current-directory-pathname nil (pathname (coerce-slash-terminated (getcwd)))) + + (defun set-up-top-level (&aux (i (argc)) tem) + (declare (fixnum i)) +@@ -627,9 +620,7 @@ First directory is checked for first nam + (when dir + (setq *lib-directory* (coerce-slash-terminated dir))))) + (unless (and *load-path* (equal tem *lib-directory*)) +- (setq *load-path* (cons (string-concatenate *lib-directory* "lsp/") *load-path*)) +- (setq *load-path* (cons (string-concatenate *lib-directory* "gcl-tk/") *load-path*)) +- (setq *load-path* (cons (string-concatenate *lib-directory* "xgcl-2/") *load-path*))) ++ (mapc (lambda (x) (push (string-concatenate *lib-directory* x) *load-path*)) '("lsp/" "gcl-tk/" "xgcl-2/"))) + (unless (boundp '*system-directory*) + (setq *system-directory* (namestring (truename (make-pathname :name nil :type nil :defaults (argv 0)))))))) + +--- gcl-2.6.12.orig/lsp/gcl_truename.lsp ++++ gcl-2.6.12/lsp/gcl_truename.lsp +@@ -4,11 +4,11 @@ + (labels ((frame (b e) (make-array (- n b) :element-type 'character + :displaced-to str :displaced-index-offset b :fill-pointer (- e b))) + (set-fr (fr e &aux (fr (or fr (frame 0 b)))) (setf (fill-pointer fr) e) fr)) +- (let* ((i (string-match #v"/" str b)) ++ (let* ((i (string-match +dirsep+ str b)) + (fr (set-fr fr (if (eql i -1) n i))) + (l (when (eq (stat fr) :link) (readlinkat 0 fr)))) + (cond (l (let ((b (if (eql #\/ (aref l 0)) 0 b))) +- (link-expand (concatenate 'string (set-fr fr b) l (frame (if (eql i -1) n i) n)) b))) ++ (link-expand (string-concatenate (set-fr fr b) l (frame (if (eql i -1) n i) n)) b))) + ((eql i -1) str) + ((link-expand str (1+ i) n fr)))))) + +--- gcl-2.6.12.orig/makedefc.in ++++ gcl-2.6.12/makedefc.in +@@ -45,6 +45,7 @@ PRELINK_CHECK=@PRELINK_CHECK@ + + NOTIFY=@NOTIFY@ + CC=@CC@ ++GCL_CC=@GCL_CC@ + CFLAGS=@CFLAGS@ + LDFLAGS=@LDFLAGS@ + FINAL_CFLAGS=@FINAL_CFLAGS@ +--- gcl-2.6.12.orig/o/bind.c ++++ gcl-2.6.12/o/bind.c +@@ -23,6 +23,8 @@ Foundation, 675 Mass Ave, Cambridge, MA + bind.c + */ + ++#include ++ + #include "include.h" + + static void +--- gcl-2.6.12.orig/o/fasdump.c ++++ gcl-2.6.12/o/fasdump.c +@@ -149,7 +149,7 @@ enum dump_type { + + /* given SHORT extract top code (say 4 bits) and bottom byte */ + #define TOP(i) (i >> SIZE_BYTE) +-#define BOTTOM(i) (i & ~(~0 << SIZE_BYTE)) ++#define BOTTOM(i) (i & ~(~0UL << SIZE_BYTE)) + + #define FASD_VERSION 2 + +@@ -328,7 +328,7 @@ getd(str) + + + #define D_TYPE_OF(byt) \ +- ((enum dump_type )((unsigned int) byt & ~(~0 << SIZE_D_CODE))) ++ ((enum dump_type )((unsigned int) byt & ~(~0UL << SIZE_D_CODE))) + + /* this field may be the top of a short for length, or part of an extended + code */ +@@ -379,7 +379,7 @@ getd(str) + + + +-#define MASK ~(~0 << 8) ++#define MASK ~(~0UL << 8) + #define WRITE_BYTEI(x,i) putc((((x) >> (i*SIZE_BYTE)) & MASK),fas_stream) + + #define PUTFIX(v_) Join(PUT,SIZEOF_LONG)(v_) +@@ -398,7 +398,7 @@ getd(str) + WRITE_BYTEI(var,7);} while(0) + + #define PUT4(varx ) \ +- do{int var= varx ; \ ++ do{unsigned long var= varx ; \ + DPRINTF("{4byte:varx= %d}", var); \ + WRITE_BYTEI(var,0); \ + WRITE_BYTEI(var,1); \ +@@ -406,14 +406,14 @@ getd(str) + WRITE_BYTEI(var,3);} while(0) + + #define PUT2(var ) \ +- do{int v=var; \ ++ do{unsigned long v=var; \ + DPRINTF("{2byte:var= %d}", v); \ + WRITE_BYTEI(v,0); \ + WRITE_BYTEI(v,1); \ + } while(0) + + #define PUT3(var ) \ +- do{int v=var; \ ++ do{unsigned long v=var; \ + DPRINTF("{3byte:var= %d}", v); \ + WRITE_BYTEI(v,0); \ + WRITE_BYTEI(v,1); \ +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -89,8 +89,8 @@ Foundation, 675 Mass Ave, Cambridge, MA + # include + # include + #else +-# include + # include ++# include + #endif + #include + +@@ -400,7 +400,8 @@ open_stream(object fn,enum smmode smm, o + fclose(fp); + if (if_exists==sKerror) FILE_ERROR(fn,"File exists"); + else if (if_exists==sKrename) { +- massert(snprintf(FN2,sizeof(FN2),"%s.BAK",FN1)>=0); ++ massert(snprintf(FN2,sizeof(FN2),"%-*.*s~",(int)strlen(FN1)-1,(int)strlen(FN1)-1,FN1)>=0); ++ massert(!unlink(FN2));/*MinGW*/ + massert(!rename(FN1,FN2)); + if (!(fp=fopen(FN1,smm==smm_output ? "w" : "w+"))) cannot_create(fn); + } else if (if_exists==sKrename_and_delete || +--- gcl-2.6.12.orig/o/funlink.c ++++ gcl-2.6.12/o/funlink.c +@@ -322,10 +322,11 @@ call_proc(object sym, void **link, int a + + } else if (type_of(fun)==t_afun) { + +- ufixnum at=F_TYPES(fun->sfn.sfn_argd)>>F_TYPE_WIDTH; +- ufixnum ma=F_MIN_ARGS(fun->sfn.sfn_argd); +- ufixnum xa=F_MAX_ARGS(fun->sfn.sfn_argd); +- ufixnum rt=F_RESULT_TYPE(fun->sfn.sfn_argd); ++ ufixnum ad=fun->sfn.sfn_argd; ++ ufixnum at=F_TYPES(ad)>>F_TYPE_WIDTH; ++ ufixnum ma=F_MIN_ARGS(ad); ++ ufixnum xa=F_MAX_ARGS(ad); ++ ufixnum rt=F_RESULT_TYPE(ad); + + nargs=SFUN_NARGS(argd); + if (nargs xa || ((argd>>8)&0x3)!=rt || (argd>>12)!=at) +--- gcl-2.6.12.orig/o/hash.d ++++ gcl-2.6.12/o/hash.d +@@ -48,7 +48,7 @@ typedef unsigned char uchar; + + static ufixnum rtb[256]; + +-#define MASK(n) (~(~0L << (n))) ++#define MASK(n) (~(~0UL << (n))) + + static ufixnum + ufixhash(ufixnum g) { +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -148,7 +148,7 @@ mbrk(void *v) { + + #if defined(__CYGWIN__)||defined(__MINGW32__) + +-#include ++#include + + static ufixnum + get_phys_pages_no_malloc(char n) { +@@ -470,12 +470,6 @@ main(int argc, char **argv, char **envp) + kcl_self = argv[0]; + #endif + +-#ifdef __MINGW32__ +- { +- char *s=kcl_self; +- for (;*s;s++) if (*s=='\\') *s='/'; +- } +-#endif + *argv=kcl_self; + + #ifdef CAN_UNRANDOMIZE_SBRK +@@ -537,10 +531,6 @@ main(int argc, char **argv, char **envp) + + } + +-#ifdef _WIN32 +- detect_wine(); +-#endif +- + sSAlisp_maxpagesA->s.s_dbind = make_fixnum(real_maxpage); + + ihs_push(Cnil); +--- gcl-2.6.12.orig/o/mingfile.c ++++ gcl-2.6.12/o/mingfile.c +@@ -1,57 +1,6 @@ + #include "include.h" +-#include "windows.h" + #include "winsock2.h" +- +-extern object truename(object); +-extern object make_pathname(); +-void Ldirectory ( void ) +-{ +- char filename[MAXPATHLEN]; +- object *top=vs_top; +- object path; +- check_arg(1); +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- path = vs_base[0] = coerce_to_pathname(vs_base[0]); +- +- if (vs_base[0]->pn.pn_name==Cnil && vs_base[0]->pn.pn_type==Cnil) { +- coerce_to_filename(vs_base[0], filename); +- strcat(filename, "*.*"); +- } else if (vs_base[0]->pn.pn_name==Cnil) { +- vs_base[0]->pn.pn_name = sKwild; +- coerce_to_filename(vs_base[0], filename); +- vs_base[0]->pn.pn_name = Cnil; +- } else if (vs_base[0]->pn.pn_type==Cnil) { +- coerce_to_filename(vs_base[0], filename); +- strcat(filename, ".*"); +- } else +- coerce_to_filename(vs_base[0], filename); +- { WIN32_FIND_DATA data; +- HANDLE dirHandle = FindFirstFile(filename,&data); +- +- if (dirHandle== INVALID_HANDLE_VALUE) { +- vs_base[0]=Cnil; return; +- } else { +- do { +- if (strcmp(data.cFileName,"..") != 0 && strcmp(data.cFileName,".") != 0 ) { +- object name = make_simple_string(data.cFileName); +- object new = coerce_to_pathname(name); +- vs_push(make_pathname(path->pn.pn_host, +- path->pn.pn_device, +- path->pn.pn_directory, +- new->pn.pn_name, +- new->pn.pn_type, +- new->pn.pn_version)); +- } +- } while (FindNextFile(dirHandle,&data)); +- FindClose(dirHandle); +- } +- vs_push(Cnil); +- while (vs_top > top + 1) +- stack_cons(); +- vs_base = top; +- +- } +-} ++#include "windows.h" + + int + mingwlisten(FILE *fp) { +--- gcl-2.6.12.orig/o/mingwin.c ++++ gcl-2.6.12/o/mingwin.c +@@ -2,6 +2,7 @@ + + + ++#include "winsock2.h" + #include "windows.h" + #include "errno.h" + #include "signal.h" +@@ -923,20 +924,6 @@ sigprocmask (int how , const sigset_t *s + return 0; + } + +-void +-fix_filename(object pathname, char *filename1) { +- +- char *filename=filename1,*p=filename; +- extern char *getwd(); +- +- while (*p) { +- if (*p=='\\') *p='/'; +- p++; +- } +- +-} +- +- + char *GCLExeName ( void ) + { + static char module_name_buf[128]; +@@ -948,3 +935,35 @@ char *GCLExeName ( void ) + } + return ( (char *) rv ); + } ++ ++int ++vsystem(const char *command) { ++ ++ STARTUPINFO s={0}; ++ PROCESS_INFORMATION p={0}; ++ long unsigned int e; ++ char *cmd=NULL,*r; ++ ++ if (!strpbrk(command,"\"'$<>")) { ++ ++ cmd=FN1; ++ massert((r=strpbrk(command," \n\t"))-command=0); ++ command=FN1; ++ ++ } ++ ++ massert(CreateProcess(cmd,(void *)command,NULL,NULL,FALSE,NORMAL_PRIORITY_CLASS|CREATE_NO_WINDOW,NULL,NULL,&s,&p)); ++ massert(!WaitForSingleObject(p.hProcess,INFINITE)); ++ massert(GetExitCodeProcess(p.hProcess,&e)); ++ massert(CloseHandle(p.hProcess)); ++ massert(CloseHandle(p.hThread)); ++ ++ return e; ++ ++} +--- gcl-2.6.12.orig/o/sfaslcoff.c ++++ gcl-2.6.12/o/sfaslcoff.c +@@ -47,7 +47,16 @@ struct scnhdr { + #define ALLOC_SEC(sec) (sec->s_flags&(SEC_CODE|SEC_DATA|SEC_BSS)) + #define LOAD_SEC(sec) (sec->s_flags&(SEC_CODE|SEC_DATA)) + +-#define STOP(s_,op_) ({char *_s=s_,_c=_s[8];_s[8]=0;op_;_s[8]=_c;}) ++#define NM(sym_,tab_,nm_,op_) \ ++ ({char _c=0,*nm_; \ ++ if ((sym_)->n.n.n_zeroes) \ ++ {(nm_)=(sym_)->n.n_name;_c=(nm_)[8];(nm_)[8]=0;} \ ++ else \ ++ (nm_)=(tab_)+(sym_)->n.n.n_offset; \ ++ op_; \ ++ if (_c) (nm_)[8]=_c; \ ++ }) ++ + + struct reloc { + union { +@@ -164,7 +173,7 @@ get_sym_value(const char *name) { + static void + relocate_symbols(struct syment *sym,struct syment *sye,struct scnhdr *sec1,char *st1) { + +- struct node *answ; ++ long value; + + for (;symn_scnum) { + +- if (sym->n.n.n_zeroes) +- STOP(sym->n.n_name,sym->n_value=get_sym_value(sym->n.n_name)); +- else +- sym->n_value=get_sym_value(st1+sym->n.n.n_offset); ++ NM(sym,st1,s,value=get_sym_value(s)); ++ ++ sym->n_value=value; + + } + +@@ -256,10 +264,7 @@ load_self_symbols() { + + ns++; + +- if (sym->n.n.n_zeroes) +- STOP(sym->n.n_name,sl+=strlen(sym->n.n_name)+1); +- else +- sl+=strlen(st1+sym->n.n.n_offset)+1; ++ NM(sym,st1,s,sl+=strlen(s)+1); + + sym+=sym->n_numaux; + +@@ -274,10 +279,7 @@ load_self_symbols() { + if (sym->n_sclass!=2 || sym->n_scnum<1) + continue; + +- if (sym->n.n.n_zeroes) +- STOP(sym->n.n_name,strcpy(st,sym->n.n_name)); +- else +- strcpy(st,st1+sym->n.n.n_offset); ++ NM(sym,st1,s,strcpy(st,s)); + + sec=sec1+sym->n_scnum-1; + jj=sym->n_value+sec->s_vaddr+h->h_ibase; +@@ -343,7 +345,7 @@ find_init_string(const char *s) { + struct syment *sy1,*sym,*sye; + char *st1,*ste; + void *st,*est; +- object o; ++ object o=OBJNULL; + + massert(f=fopen(s,"r")); + massert(st=get_mmap(f,&est)); +@@ -358,13 +360,9 @@ find_init_string(const char *s) { + + for (sym=sy1;symn.n.n_zeroes ? sym->n.n_name : st1+sym->n.n.n_offset; +- +- if (!strncmp(s,"_init_",6)) { +- if (sym->n.n.n_zeroes) +- STOP((char *)s,o=make_simple_string(s)); +- else +- o=make_simple_string(s); ++ NM(sym,st1,s,if (!strncmp(s,"_init_",6)) o=make_simple_string(s)); ++ ++ if (o!=OBJNULL) { + massert(!un_mmap(st,&est)); + massert(!fclose(f)); + return o; +--- gcl-2.6.12.orig/o/sockets.c ++++ gcl-2.6.12/o/sockets.c +@@ -33,8 +33,8 @@ Foundation, 675 Mass Ave, Cambridge, MA + # include + # include + #else +-# include + # include ++# include + #endif + + #ifdef __STDC__ +--- gcl-2.6.12.orig/o/unexnt.c ++++ gcl-2.6.12/o/unexnt.c +@@ -780,7 +780,7 @@ map_in_heap (char *filename) + } + + size = get_committed_heap_size (); +- file_base = MapViewOfFileEx (file_mapping, FILE_MAP_COPY, 0, ++ file_base = MapViewOfFileEx (file_mapping, FILE_MAP_COPY|FILE_MAP_EXECUTE, 0, + heap_index_in_executable, size, + get_heap_start ()); + if (file_base != 0) +@@ -794,7 +794,7 @@ map_in_heap (char *filename) + CloseHandle (file_mapping); + + if (VirtualAlloc (get_heap_start (), get_committed_heap_size (), +- MEM_RESERVE | MEM_COMMIT, PAGE_READWRITE) == NULL) ++ MEM_RESERVE | MEM_COMMIT, PAGE_EXECUTE_READWRITE) == NULL) + { + i = GetLastError (); + do_gcl_abort(); +@@ -1057,7 +1057,7 @@ sbrk (ptrdiff_t increment) + + /* Commit more of our heap. */ + if (VirtualAlloc (data_region_end, size, MEM_COMMIT, +- PAGE_READWRITE) == NULL) ++ PAGE_EXECUTE_READWRITE) == NULL) + return NULL; + data_region_end += size; + +--- gcl-2.6.12.orig/o/unixfsys.c ++++ gcl-2.6.12/o/unixfsys.c +@@ -21,6 +21,7 @@ Foundation, 675 Mass Ave, Cambridge, MA + + #include + #include ++#include + + #define IN_UNIXFSYS + #include "include.h" +@@ -72,39 +73,43 @@ coerce_to_filename1(object spec, char *p + memcpy(p,namestring->st.st_self,namestring->st.st_fillp); + p[namestring->st.st_fillp]=0; + +-#ifdef FIX_FILENAME +- FIX_FILENAME(spec,p); +-#endif +- + } + ++#ifndef __MINGW32__ ++static char GETPW_BUF[4096]; ++#endif ++ + DEFUN_NEW("UID-TO-NAME",object,fSuid_to_name,SI,1,1,NONE,OI,OO,OO,OO,(fixnum uid),"") { ++#ifndef __MINGW32__ + struct passwd *pwent,pw; + long r; + + massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); +- massert(r<=sizeof(FN1));/*FIXME maybe once at image startup*/ ++ massert(r<=sizeof(GETPW_BUF));/*FIXME maybe once at image startup*/ + +- massert(!getpwuid_r(uid,&pw,FN1,r,&pwent)); ++ massert(!getpwuid_r(uid,&pw,GETPW_BUF,r,&pwent)); + + RETURN1(make_simple_string(pwent->pw_name)); +- ++#else ++ RETURN1(Cnil); ++#endif + } + + DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") { + ++#ifndef __MINGW32__ + struct passwd *pwent,pw; + long r; + + massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); +- massert(r<=sizeof(FN1));/*FIXME maybe once at image startup*/ ++ massert(r<=sizeof(GETPW_BUF));/*FIXME maybe once at image startup*/ + + if (nm->st.st_fillp==1) + + if ((pw.pw_dir=getenv("HOME"))) + pwent=&pw; + else +- massert(!getpwuid_r(getuid(),&pw,FN1,r,&pwent) && pwent); ++ massert(!getpwuid_r(getuid(),&pw,GETPW_BUF,r,&pwent) && pwent); + + else { + +@@ -112,15 +117,19 @@ DEFUN_NEW("HOME-NAMESTRING",object,fShom + memcpy(FN2,nm->st.st_self+1,nm->st.st_fillp-1); + FN2[nm->st.st_fillp-1]=0; + +- massert(!getpwnam_r(FN2,&pw,FN1,r,&pwent) && pwent); ++ massert(!getpwnam_r(FN2,&pw,GETPW_BUF,r,&pwent) && pwent); + + } + +- massert(strlen(pwent->pw_dir)+2pw_dir,strlen(pwent->pw_dir)); +- FN3[strlen(pwent->pw_dir)]='/'; +- FN3[strlen(pwent->pw_dir)+1]=0; ++ massert((r=strlen(pwent->pw_dir))+2pw_dir,r); ++ FN3[r]='/'; ++ FN3[r+1]=0; + RETURN1(make_simple_string(FN3)); ++#else ++ massert(snprintf(FN1,sizeof(FN1)-1,"%s%s",getenv("SystemDrive"),getenv("HOMEPATH"))>=0); ++ RETURN1(make_simple_string(FN1)); ++#endif + + } + +@@ -160,28 +169,61 @@ DEF_ORDINARY("DIRECTORY",sKdirectory,KEY + DEF_ORDINARY("LINK",sKlink,KEYWORD,""); + DEF_ORDINARY("FILE",sKfile,KEYWORD,""); + ++object ++file_stream(object x) { ++ if (type_of(x)==t_stream) ++ switch(x->sm.sm_mode) { ++ case smm_input: ++ case smm_output: ++ case smm_io: ++ case smm_probe: ++ return x; ++ case smm_synonym: ++ return file_stream(x->sm.sm_object0->s.s_dbind); ++ default: ++ break; ++ } ++ return Cnil; ++} ++ ++ + DEFUNM_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + + struct stat ss; + +- check_type_string(&x); +- coerce_to_filename(x,FN1); ++ if (type_of(x)==t_string) { ++ ++ coerce_to_filename(x,FN1); + + #ifdef __MINGW32__ +- { +- char *p=FN1+strlen(FN1)-1; +- for (;p>FN1 && *p=='/';p--) +- *p=0; +- } ++ {char *p=FN1+strlen(FN1)-1;for (;p>FN1 && *p=='/';p--) *p=0;} + #endif +- if (lstat(FN1,&ss)) ++ if (lstat(FN1,&ss)) ++ RETURN1(Cnil); ++ } else if ((x=file_stream(x))!=Cnil&&x->sm.sm_fp) { ++ if (fstat(fileno(x->sm.sm_fp),&ss)) ++ RETURN1(Cnil); ++ } else + RETURN1(Cnil); +- else +- RETURN4(S_ISDIR(ss.st_mode) ? sKdirectory : +- (S_ISLNK(ss.st_mode) ? sKlink : sKfile), +- make_fixnum(ss.st_size), +- make_fixnum(ss.st_mtime), +- make_fixnum(ss.st_uid)); ++ ++ RETURN4(S_ISDIR(ss.st_mode) ? sKdirectory : ++ (S_ISLNK(ss.st_mode) ? sKlink : sKfile), ++ make_fixnum(ss.st_size), ++ make_fixnum(ss.st_mtime), ++ make_fixnum(ss.st_uid)); ++ ++} ++ ++DEFUN_NEW("FTELL",object,fSftell,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") { ++ ++ RETURN1((x=file_stream(x))!=Cnil&&x->sm.sm_fp ? (object)ftell(x->sm.sm_fp) : (object)0); ++ ++} ++ ++DEFUN_NEW("FSEEK",object,fSfseek,SI,2,2,NONE,OO,IO,OO,OO,(object x,fixnum pos),"") { ++ ++ RETURN1((x=file_stream(x))!=Cnil&&x->sm.sm_fp&&!fseek(x->sm.sm_fp,pos,SEEK_SET) ? Ct : Cnil); ++ + } + + #include +@@ -198,7 +240,11 @@ DEFUN_NEW("READLINKAT",object,fSreadlink + massert(z1st.st_self,z1); + FN1[z1]=0; ++#ifndef __MINGW32__ + massert((l=readlinkat(d ? dirfd((DIR *)d) : AT_FDCWD,FN1,FN2,sizeof(FN2)))>=0 && ld_type ++#else ++#define get_d_type(e,s) \ ++ ({struct stat ss;\ ++ massert(snprintf(FN1,sizeof(FN1),"%-*.*s%s",s->st.st_fillp,s->st.st_fillp,s->st.st_self,e->d_name)>=0);\ ++ lstat(FN1,&ss);S_ISDIR(ss.st_mode) ? DT_DIR : DT_REG;}) ++#endif + + if (!x) RETURN1(Cnil); + + tl=telldir((DIR *)x); + +-#ifndef HAVE_D_TYPE +- y=DT_UNKNOWN; +-#endif +- for (;(e=readdir((DIR *)x)) && y!=DT_UNKNOWN && e->d_type!=y;); ++ for (;(e=readdir((DIR *)x)) && y!=DT_UNKNOWN && y!=(d_type=get_d_type(e,s));); + if (!e) RETURN1(Cnil); + + if (s==Cnil) +@@ -290,9 +354,7 @@ DEFUN_NEW("READDIR",object,fSreaddir,SI, + } + } + +-#ifdef HAVE_D_TYPE +- if (y==DT_UNKNOWN) z=MMcons(z,make_fixnum(e->d_type)); +-#endif ++ if (y==DT_UNKNOWN) z=MMcons(z,make_fixnum(d_type)); + + RETURN1(z); + +--- gcl-2.6.12.orig/o/unixsys.c ++++ gcl-2.6.12/o/unixsys.c +@@ -24,10 +24,14 @@ Foundation, 675 Mass Ave, Cambridge, MA + #include + #include + #include ++#ifndef __MINGW32__ + #include ++#endif + + #include "include.h" + ++#ifndef __MINGW32__ ++ + int + vsystem(const char *command) { + +@@ -43,12 +47,13 @@ vsystem(const char *command) { + + else { + +- z=alloca(n); +- memcpy(z,command,n); ++ massert(ns.s_dbind=Cnil; +- +- if (stat(s,&ss)) +- return; +- +- massert(f=fopen(s,"r")); +- massert(fscanf(f,"%s",b)==1); +- massert(fscanf(f,"%s",b)==1); +- massert(!fclose(f)); +- +- if (strncmp("wineserver",b,9)) +- return; +- +- massert(o=sSAsystem_directoryA->s.s_dbind); +- massert(o!=Cnil); +- mpid=getpid(); +- +- massert(snprintf(b,sizeof(b),"%-.*smsys /tmp/ out%0d tmp%0d log%0d", +- o->st.st_fillp,o->st.st_self,mpid,mpid,mpid)>0); +- massert(!psystem(b)); +- +- sSAwine_detectedA->s.s_dbind=Ct; +- +- massert(!atexit(close_msys)); +- +-} +-#endif +- + int + msystem(const char *s) { + +- int r; +- +-#ifdef _WIN32 +- +- if (sSAwine_detectedA->s.s_dbind==Ct) { +- +- char b[4096],b1[4096],c; +- FILE *fp; +- +- massert(snprintf(b,sizeof(b),"/tmp/out%0d",mpid)>0); +- massert(snprintf(b1,sizeof(b1),"%s1",b)>0); +- +- massert(fp=fopen(b1,"w")); +- massert(fprintf(fp,"%s",s)>=0); +- massert(!fclose(fp)); +- +- massert(MoveFileEx(b1,b,MOVEFILE_REPLACE_EXISTING)); +- +- if (!*s) +- return 0; +- +- for (;;Sleep(100)) { +- +- massert(fp=fopen(b,"r")); +- massert((c=fgetc(fp))!=EOF); +- if (c!=s[0]) { +- massert(ungetc(c,fp)!=EOF); +- break; +- } +- massert(!fclose(fp)); +- +- } +- +- massert(fscanf(fp,"%d",&r)==1); +- massert(!fclose(fp)); +- +- } else +- +-#endif +- +- r=psystem(s); +- +- return r; ++ return psystem(s); + + } + +--- gcl-2.6.12.orig/unixport/makefile ++++ gcl-2.6.12/unixport/makefile +@@ -77,8 +77,8 @@ sys_init.lsp: sys_init.lsp.in + -e "s#@LI-MINVERS@#`cat ../minvers | cut -f1 -d.`#1" \ + -e "s#@LI-MAJVERS@#`cat ../majvers`#1" \ + -e "s#@LI-RELEASE@#`cat ../release`#1" \ +- -e "s#@LI-CC@#\"$(CC) -c $(FINAL_CFLAGS)\"#1" \ +- -e "s#@LI-LD@#\"$(CC) $(LD_FLAGS) -o \"#1" \ ++ -e "s#@LI-CC@#\"$(GCL_CC) -c $(FINAL_CFLAGS)\"#1" \ ++ -e "s#@LI-LD@#\"$(GCL_CC) $(LD_FLAGS) -o \"#1" \ + -e "s#@LI-LD-LIBS@#\" $(LD_LIBS_PRE) -l$* $(LD_LIBS_POST)\"#1" \ + -e "s#@LI-OPT-THREE@#\"$(O3FLAGS)\"#1" \ + -e "s#@LI-OPT-TWO@#\"$(O2FLAGS)\"#1" \ +@@ -92,7 +92,7 @@ saved_%:raw_% $(RSYM) sys_init.lsp raw_% + + 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_) ++ j=$$(ar t lib$*.a |grep ^gcl_);[ "$$j" = "" ] || ar x lib$*.a $$j #accelerator + $(PORTDIR)/raw_$*$(EXE) $(PORTDIR)/ -libdir $(GCLDIR)/ < foo + # check that saved image can be prelinked + [ "$(PRELINK_CHECK)" = "" ] || \ +--- gcl-2.6.12.orig/unixport/sys.c ++++ gcl-2.6.12/unixport/sys.c +@@ -15,16 +15,6 @@ ar_init_fn(void (fn)(void),const char *s + if (stat(s,&ss)) { + assert(snprintf(b,sizeof(b),"ar x %-.*slib%sgcl.a %s",sysd->st.st_fillp,sysd->st.st_self,FLAVOR,s)>0); + assert(!msystem(b)); +-#ifdef _WIN32 +- if (sSAwine_detectedA->s.s_dbind!=Cnil) { +- char *n; +- unsigned l; +- l=strlen(s)+6; +- n=alloca(l); +- snprintf(n,l,"/tmp/%s",s); +- s=(void *)n; +- } +-#endif + } + gcl_init_or_load1(fn,s); + assert(!unlink(s)); diff --git a/patches/pathnames1.6 b/patches/pathnames1.6 new file mode 100644 index 00000000..a5aab6c5 --- /dev/null +++ b/patches/pathnames1.6 @@ -0,0 +1,42 @@ +Description: + 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-42) unstable; urgency=medium + . + * pathnames1.6 + * Bug fix: "FTBFS with bindnow and PIE enabled", thanks to Balint Reczey + (Closes: #837481). + * Bug fix: "FTBFS with compilers that default to -fPIE (patch + attached)", thanks to Adam Conrad (Closes: #822820). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/822820 +Bug-Debian: https://bugs.debian.org/837481 + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-26 + +--- gcl-2.6.12.orig/o/makefile ++++ gcl-2.6.12/o/makefile +@@ -34,7 +34,7 @@ boot.o: boot.c $(DECL) boot.h + $(CC) -c $(CFLAGS) $(DEFS) -fPIC $*.c $(AUX_INFO) + + prelink.o: prelink.c $(DECL) +- $(CC) -fPIE -c $(filter-out -pg,$(CFLAGS)) $(DEFS) $*.c $(AUX_INFO) ++ $(CC) -c $(filter-out -pg,$(CFLAGS)) -fPIE $(DEFS) $*.c $(AUX_INFO) + + %.o: %.c $(DECL) + $(CC) -c $(CFLAGS) $(DEFS) $*.c $(AUX_INFO) diff --git a/patches/pathnames1.7 b/patches/pathnames1.7 new file mode 100644 index 00000000..64d424ab --- /dev/null +++ b/patches/pathnames1.7 @@ -0,0 +1,601 @@ +Description: + 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-42) unstable; urgency=medium + . + * pathnames1.6 + * Bug fix: "FTBFS with bindnow and PIE enabled", thanks to Balint Reczey + (Closes: #837481). + * Bug fix: "FTBFS with compilers that default to -fPIE (patch + attached)", thanks to Adam Conrad (Closes: #822820). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/822820 +Bug-Debian: https://bugs.debian.org/837481 + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-27 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -3853,9 +3853,8 @@ if echo $GCL_CC |grep gcc |grep -q win; + fi + + +-add_arg_to_tcflags() { ++add_arg_to_cflags() { + +- local i=1 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFLAG $1" >&5 + $as_echo_n "checking for CFLAG $1... " >&6; } + CFLAGS_ORI=$CFLAGS +@@ -3877,8 +3876,8 @@ main () + } + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : +- TCFLAGS="$TCFLAGS $1";{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +-$as_echo "yes" >&6; };i=0 ++ CFLAGS="$CFLAGS_ORI $1";{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; };return 0 + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } +@@ -3888,27 +3887,26 @@ rm -f core *.core core.conftest.* gmon.o + fi + + CFLAGS=$CFLAGS_ORI +- return $i ++ return 1 + + } + +-assert_arg_to_tcflags() { +- if ! add_arg_to_tcflags $1 ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot add $1 to CFLAGS" >&5 ++assert_arg_to_cflags() { ++ if ! add_arg_to_cflags $1 ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot add $1 to CFLAGS" >&5 + $as_echo "cannot add $1 to CFLAGS" >&6; }; exit 1 ; fi + return 0 + } + +-add_args_to_tcflags() { ++add_args_to_cflags() { + + while test "$#" -ge 1 ; do +- add_arg_to_tcflags $1 ++ add_arg_to_cflags $1 + shift + done + } + +-add_arg_to_tldflags() { ++add_arg_to_ldflags() { + +- local i=1 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for LDFLAG $1" >&5 + $as_echo_n "checking for LDFLAG $1... " >&6; } + LDFLAGS_ORI=$LDFLAGS +@@ -3929,8 +3927,8 @@ main () + } + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : +- TLDFLAGS="$TLDFLAGS $1";{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +-$as_echo "yes" >&6; };i=0 ++ LDFLAGS="$LDFLAGS_ORI $1";{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; };return 0 + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } +@@ -3940,20 +3938,20 @@ rm -f core *.core core.conftest.* gmon.o + fi + + LDFLAGS=$LDFLAGS_ORI +- return $i ++ return 1 + + } + +-assert_arg_to_tldflags() { +- if ! add_arg_to_tldflags $1 ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot add $1 to LDFLAGS" >&5 ++assert_arg_to_ldflags() { ++ if ! add_arg_to_ldflags $1 ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot add $1 to LDFLAGS" >&5 + $as_echo "cannot add $1 to LDFLAGS" >&6; }; exit 1 ; fi + return 0 + } + +-add_args_to_tldflags() { ++add_args_to_ldflags() { + + while test "$#" -ge 1 ; do +- add_arg_to_tldflags $1 ++ add_arg_to_ldflags $1 + shift + done + } +@@ -3975,16 +3973,14 @@ $as_echo "removing $1 from LDFLAGS" >&6; + + } + +-TCFLAGS="" +-add_args_to_tcflags -fsigned-char -pipe \ ++add_args_to_cflags -fsigned-char -pipe \ + -fno-builtin-malloc -fno-builtin-free \ + -fno-PIE -fno-pie -fno-PIC -fno-pic \ + -Wall \ + -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign \ + -Wno-unused-but-set-variable -Wno-misleading-indentation + +-TLDFLAGS="" +-add_args_to_tldflags -Wl,-no_pie -no-pie -Wl,-z,lazy ++add_args_to_ldflags -Wl,-no_pie -no-pie -Wl,-z,lazy + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for clang" >&5 + $as_echo_n "checking for clang... " >&6; } +@@ -4032,29 +4028,29 @@ fi + + case $use in + *mingw*) +- assert_arg_to_tcflags -fno-zero-initialized-in-bss +- assert_arg_to_tcflags -mms-bitfields;; ++ assert_arg_to_cflags -fno-zero-initialized-in-bss ++ assert_arg_to_cflags -mms-bitfields;; + *gnuwin*) +- assert_arg_to_tcflags -fno-zero-initialized-in-bss +- assert_arg_to_tcflags -mms-bitfields +- assert_arg_to_tldflags -Wl,--stack,8000000;; ++ assert_arg_to_cflags -fno-zero-initialized-in-bss ++ assert_arg_to_cflags -mms-bitfields ++ assert_arg_to_ldflags -Wl,--stack,8000000;; + 386-macosx) +- assert_arg_to_tldflags -Wl,-no_pie ++ assert_arg_to_ldflags -Wl,-no_pie + if test "$build_cpu" = "x86_64" ; then +- assert_arg_to_tcflags -m64 +- assert_arg_to_tldflags -m64 +- assert_arg_to_tldflags -Wl,-headerpad,72 ++ assert_arg_to_cflags -m64 ++ assert_arg_to_ldflags -m64 ++ assert_arg_to_ldflags -Wl,-headerpad,72 + else +- assert_arg_to_tcflags -m32 +- assert_arg_to_tldflags -m32 +- assert_arg_to_tldflags -Wl,-headerpad,56 ++ assert_arg_to_cflags -m32 ++ assert_arg_to_ldflags -m32 ++ assert_arg_to_ldflags -Wl,-headerpad,56 + fi;; +- FreeBSD) assert_arg_to_tldflags -Z;; ++ FreeBSD) assert_arg_to_ldflags -Z;; + esac + + if test "$enable_static" = "yes" ; then +- assert_arg_to_tldflags -static +- assert_arg_to_tldflags -Wl,-zmuldefs ++ assert_arg_to_ldflags -static ++ assert_arg_to_ldflags -Wl,-zmuldefs + + $as_echo "#define STATIC_LINKING 1" >>confdefs.h + +@@ -4148,7 +4144,7 @@ cat >>confdefs.h <<_ACEOF + #define GCL_GPROF_START $GCL_GPROF_START + _ACEOF + +- assert_arg_to_tcflags -pg ++ assert_arg_to_cflags -pg + case $use in + s390*) ;; # relocation truncation bug in gcc + *) TLIBS="$TLIBS -pg";; +@@ -4164,7 +4160,7 @@ fi + + + if test "$enable_debug" = "yes" ; then +- assert_arg_to_tcflags -g ++ assert_arg_to_cflags -g + # for subconfigurations + CFLAGS="$CFLAGS -g" + else +@@ -4175,41 +4171,41 @@ fi + # gcc on ppc cannot compile our new_init.c with full opts --CM + TONIFLAGS="" + case $use in +- powerpc*macosx) assert_arg_to_tcflags -mlongcall;; ++ powerpc*macosx) assert_arg_to_cflags -mlongcall;; + *linux) + case $use in + alpha*) +- assert_arg_to_tcflags -mieee ++ assert_arg_to_cflags -mieee + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1 + ;; + aarch64*) + TLIBS="$TLIBS -lgcc_s";; + hppa*) +- assert_arg_to_tcflags -mlong-calls ++ assert_arg_to_cflags -mlong-calls + TLIBS="$TLIBS -lgcc_s" # workaround hppa __moddi3 local func symbols with default linker flags + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O2" ; TFPFLAG=""; fi #FIXME needed asof gcc 4.8.1 + ;; + mips*) + case $canonical in + mips64*linux*) +- assert_arg_to_tldflags -Wl,-z,now;; ++ assert_arg_to_ldflags -Wl,-z,now;; + esac + ;; + ia64*) + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 + ;; + arm*) +- assert_arg_to_tcflags -mlong-calls +- assert_arg_to_tcflags -fdollars-in-identifiers +- assert_arg_to_tcflags -g #? ++ assert_arg_to_cflags -mlong-calls ++ assert_arg_to_cflags -fdollars-in-identifiers ++ assert_arg_to_cflags -g #? + ;; + powerpc*) +- assert_arg_to_tcflags -mlongcall ++ assert_arg_to_cflags -mlongcall + ;; + esac;; + esac + if test "$enable_pic" = "yes" ; then +- assert_arg_to_tcflags -fPIC ++ assert_arg_to_cflags -fPIC + fi + + +@@ -5385,7 +5381,7 @@ fi + + + TLIBS="$TLIBS -ldl -rdynamic" +- assert_arg_to_tcflags -fPIC ++ assert_arg_to_cflags -fPIC + + $as_echo "#define USE_DLOPEN 1" >>confdefs.h + +@@ -5869,7 +5865,7 @@ $as_echo "#define HAVE_XDR 1" >>confdefs + + if test "$XDR_LIB" != " "; then + TLIBS="$TLIBS -l$XDR_LIB" +- add_arg_to_tcflags -I/usr/include/$XDR_LIB ++ add_arg_to_cflags -I/usr/include/$XDR_LIB + fi + fi + fi +@@ -6935,7 +6931,7 @@ if test "$use" != "386-gnu" ; then #hurd + $as_echo_n "checking finding default linker script... " >&6; } + touch unixport/gcl.script + echo "int main() {return 0;}" >foo.c +- $CC $TLDFLAGS -Wl,--verbose foo.c -o foo 2>&1 | \ ++ $CC $LDFLAGS -Wl,--verbose foo.c -o foo 2>&1 | \ + $AWK '/\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=/ {i=1-i;next} {if (i) print}' >gcl.script + rm -rf foo.c foo + +@@ -6956,7 +6952,7 @@ $as_echo "$as_me: trying to adjust text + cat gcl.script.def | $AWK '/SIZEOF_HEADERS/ {gsub("0x[0-9]*","0x" j,$0);} {print}' j=$j >gcl.script + # diff -u gcl.script.def gcl.script + echo "int main() {return 0;}" >foo.c +- if ( $CC $TLDFLAGS -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then ++ if ( $CC $LDFLAGS -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then + if test $n -lt $min ; then min=$n; fi; + if test $n -gt $max; then max=$n; fi; + elif test $max -gt 0 ; then +@@ -7020,7 +7016,7 @@ $as_echo_n "checking our linker script.. + { $as_echo "$as_me:${as_lineno-$LINENO}: result: done" >&5 + $as_echo "done" >&6; } + rm -f gcl.script.def +- LDFLAGS="$LDFLAGS -Wl,-T gcl.script " ++ assert_arg_to_ldflags -Wl,-T,gcl.script + cp gcl.script unixport + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none found or not needed" >&5 +@@ -9065,16 +9061,16 @@ fi + + + +-LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'` $TLDFLAGS" ++LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'`" + + LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $LIBS $TLIBS" + +-FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS $TCFLAGS" ++FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS" + + # Work around bug with gcc on ppc -- CM +-NIFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TONIFLAGS -I\$(GCLDIR)/o" ++NIFLAGS="$CFLAGS $CPPFLAGS $TONIFLAGS -I\$(GCLDIR)/o" + +-CFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TO3FLAGS -I\$(GCLDIR)/o" ++CFLAGS="$CFLAGS $CPPFLAGS $TO3FLAGS -I\$(GCLDIR)/o" + + O3FLAGS=$TO3FLAGS + +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -185,60 +185,58 @@ if echo $GCL_CC |grep gcc |grep -q win; + fi + AC_SUBST(GCL_CC) + +-add_arg_to_tcflags() { ++add_arg_to_cflags() { + +- local i=1 + AC_MSG_CHECKING([for CFLAG $1]) + CFLAGS_ORI=$CFLAGS + CFLAGS="$CFLAGS -Werror $1 `echo $1|sed 's,-Wno-,-W,1'`" + AC_RUN_IFELSE( + [AC_LANG_PROGRAM([[]],[[]])], +- [TCFLAGS="$TCFLAGS $1";AC_MSG_RESULT([yes]);i=0], ++ [CFLAGS="$CFLAGS_ORI $1";AC_MSG_RESULT([yes]);return 0], + [AC_MSG_RESULT([no])], + [AC_MSG_RESULT([no])]) + CFLAGS=$CFLAGS_ORI +- return $i ++ return 1 + + } + +-assert_arg_to_tcflags() { +- if ! add_arg_to_tcflags $1 ; then AC_MSG_RESULT([cannot add $1 to CFLAGS]); exit 1 ; fi ++assert_arg_to_cflags() { ++ if ! add_arg_to_cflags $1 ; then AC_MSG_RESULT([cannot add $1 to CFLAGS]); exit 1 ; fi + return 0 + } + +-add_args_to_tcflags() { ++add_args_to_cflags() { + + while test "$#" -ge 1 ; do +- add_arg_to_tcflags $1 ++ add_arg_to_cflags $1 + shift + done + } + +-add_arg_to_tldflags() { ++add_arg_to_ldflags() { + +- local i=1 + AC_MSG_CHECKING([for LDFLAG $1]) + LDFLAGS_ORI=$LDFLAGS + LDFLAGS="$LDFLAGS -Werror $1" + AC_RUN_IFELSE( + [AC_LANG_PROGRAM([[]],[[]])], +- [TLDFLAGS="$TLDFLAGS $1";AC_MSG_RESULT([yes]);i=0], ++ [LDFLAGS="$LDFLAGS_ORI $1";AC_MSG_RESULT([yes]);return 0], + [AC_MSG_RESULT([no])], + [AC_MSG_RESULT([no])]) + LDFLAGS=$LDFLAGS_ORI +- return $i ++ return 1 + + } + +-assert_arg_to_tldflags() { +- if ! add_arg_to_tldflags $1 ; then AC_MSG_RESULT([cannot add $1 to LDFLAGS]); exit 1 ; fi ++assert_arg_to_ldflags() { ++ if ! add_arg_to_ldflags $1 ; then AC_MSG_RESULT([cannot add $1 to LDFLAGS]); exit 1 ; fi + return 0 + } + +-add_args_to_tldflags() { ++add_args_to_ldflags() { + + while test "$#" -ge 1 ; do +- add_arg_to_tldflags $1 ++ add_arg_to_ldflags $1 + shift + done + } +@@ -259,16 +257,14 @@ remove_arg_from_ldflags() { + + } + +-TCFLAGS="" +-add_args_to_tcflags -fsigned-char -pipe \ ++add_args_to_cflags -fsigned-char -pipe \ + -fno-builtin-malloc -fno-builtin-free \ + -fno-PIE -fno-pie -fno-PIC -fno-pic \ + -Wall \ + -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign \ + -Wno-unused-but-set-variable -Wno-misleading-indentation + +-TLDFLAGS="" +-add_args_to_tldflags -Wl,-no_pie -no-pie -Wl,-z,lazy ++add_args_to_ldflags -Wl,-no_pie -no-pie -Wl,-z,lazy + + AC_MSG_CHECKING([for clang]) + AC_RUN_IFELSE( +@@ -290,29 +286,29 @@ AC_RUN_IFELSE( + + case $use in + *mingw*) +- assert_arg_to_tcflags -fno-zero-initialized-in-bss +- assert_arg_to_tcflags -mms-bitfields;; ++ assert_arg_to_cflags -fno-zero-initialized-in-bss ++ assert_arg_to_cflags -mms-bitfields;; + *gnuwin*) +- assert_arg_to_tcflags -fno-zero-initialized-in-bss +- assert_arg_to_tcflags -mms-bitfields +- assert_arg_to_tldflags -Wl,--stack,8000000;; ++ assert_arg_to_cflags -fno-zero-initialized-in-bss ++ assert_arg_to_cflags -mms-bitfields ++ assert_arg_to_ldflags -Wl,--stack,8000000;; + 386-macosx) +- assert_arg_to_tldflags -Wl,-no_pie ++ assert_arg_to_ldflags -Wl,-no_pie + if test "$build_cpu" = "x86_64" ; then +- assert_arg_to_tcflags -m64 +- assert_arg_to_tldflags -m64 +- assert_arg_to_tldflags -Wl,-headerpad,72 ++ assert_arg_to_cflags -m64 ++ assert_arg_to_ldflags -m64 ++ assert_arg_to_ldflags -Wl,-headerpad,72 + else +- assert_arg_to_tcflags -m32 +- assert_arg_to_tldflags -m32 +- assert_arg_to_tldflags -Wl,-headerpad,56 ++ assert_arg_to_cflags -m32 ++ assert_arg_to_ldflags -m32 ++ assert_arg_to_ldflags -Wl,-headerpad,56 + fi;; +- FreeBSD) assert_arg_to_tldflags -Z;; ++ FreeBSD) assert_arg_to_ldflags -Z;; + esac + + if test "$enable_static" = "yes" ; then +- assert_arg_to_tldflags -static +- assert_arg_to_tldflags -Wl,-zmuldefs ++ assert_arg_to_ldflags -static ++ assert_arg_to_ldflags -Wl,-zmuldefs + AC_DEFINE(STATIC_LINKING,1,[staticly linked images]) + fi + +@@ -353,7 +349,7 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof + if test "$GCL_GPROF_START" != "" ; then + AC_MSG_RESULT($GCL_GPROF_START) + AC_DEFINE_UNQUOTED(GCL_GPROF_START,$GCL_GPROF_START,[starting address for gprof]) +- assert_arg_to_tcflags -pg ++ assert_arg_to_cflags -pg + case $use in + s390*) ;; # relocation truncation bug in gcc + *) TLIBS="$TLIBS -pg";; +@@ -365,7 +361,7 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof + fi]) + + if test "$enable_debug" = "yes" ; then +- assert_arg_to_tcflags -g ++ assert_arg_to_cflags -g + # for subconfigurations + CFLAGS="$CFLAGS -g" + else +@@ -376,41 +372,41 @@ fi + # gcc on ppc cannot compile our new_init.c with full opts --CM + TONIFLAGS="" + case $use in +- powerpc*macosx) assert_arg_to_tcflags -mlongcall;; ++ powerpc*macosx) assert_arg_to_cflags -mlongcall;; + *linux) + case $use in + alpha*) +- assert_arg_to_tcflags -mieee ++ assert_arg_to_cflags -mieee + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1 + ;; + aarch64*) + TLIBS="$TLIBS -lgcc_s";; + hppa*) +- assert_arg_to_tcflags -mlong-calls ++ assert_arg_to_cflags -mlong-calls + TLIBS="$TLIBS -lgcc_s" # workaround hppa __moddi3 local func symbols with default linker flags + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O2" ; TFPFLAG=""; fi #FIXME needed asof gcc 4.8.1 + ;; + mips*) + case $canonical in + mips64*linux*) +- assert_arg_to_tldflags -Wl,-z,now;; ++ assert_arg_to_ldflags -Wl,-z,now;; + esac + ;; + ia64*) + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 + ;; + arm*) +- assert_arg_to_tcflags -mlong-calls +- assert_arg_to_tcflags -fdollars-in-identifiers +- assert_arg_to_tcflags -g #? ++ assert_arg_to_cflags -mlong-calls ++ assert_arg_to_cflags -fdollars-in-identifiers ++ assert_arg_to_cflags -g #? + ;; + powerpc*) +- assert_arg_to_tcflags -mlongcall ++ assert_arg_to_cflags -mlongcall + ;; + esac;; + esac + if test "$enable_pic" = "yes" ; then +- assert_arg_to_tcflags -fPIC ++ assert_arg_to_cflags -fPIC + fi + + +@@ -715,7 +711,7 @@ if test "$enable_dlopen" = "yes" ; then + AC_CHECK_LIB([dl],[dlopen],,AC_MSG_ERROR([Cannot find dlopen])) + + TLIBS="$TLIBS -ldl -rdynamic" +- assert_arg_to_tcflags -fPIC ++ assert_arg_to_cflags -fPIC + AC_DEFINE(USE_DLOPEN,1,[link compiled objects via libdl]) + + fi +@@ -834,7 +830,7 @@ if test "$enable_xdr" != "no" ; then + AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) + if test "$XDR_LIB" != " "; then + TLIBS="$TLIBS -l$XDR_LIB" +- add_arg_to_tcflags -I/usr/include/$XDR_LIB ++ add_arg_to_cflags -I/usr/include/$XDR_LIB + fi + fi + fi +@@ -1345,7 +1341,7 @@ if test "$use" != "386-gnu" ; then #hurd + AC_MSG_CHECKING([finding default linker script]) + touch unixport/gcl.script + echo "int main() {return 0;}" >foo.c +- $CC $TLDFLAGS -Wl,--verbose foo.c -o foo 2>&1 | \ ++ $CC $LDFLAGS -Wl,--verbose foo.c -o foo 2>&1 | \ + $AWK '/\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=/ {i=1-i;next} {if (i) print}' >gcl.script + rm -rf foo.c foo + +@@ -1364,7 +1360,7 @@ if test "$use" != "386-gnu" ; then #hurd + cat gcl.script.def | $AWK '/SIZEOF_HEADERS/ {gsub("0x[[0-9]]*","0x" j,$0);} {print}' j=$j >gcl.script + # diff -u gcl.script.def gcl.script + echo "int main() {return 0;}" >foo.c +- if ( $CC $TLDFLAGS -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then ++ if ( $CC $LDFLAGS -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then + if test $n -lt $min ; then min=$n; fi; + if test $n -gt $max; then max=$n; fi; + elif test $max -gt 0 ; then +@@ -1409,7 +1405,7 @@ if test "$use" != "386-gnu" ; then #hurd + cat gcl.script.def | $AWK '/SIZEOF_HEADERS/ {gsub("0x[[0-9]]*","0x" j,$0);} {print}' j=$j >gcl.script + AC_MSG_RESULT([done]) + rm -f gcl.script.def +- LDFLAGS="$LDFLAGS -Wl,-T gcl.script " ++ assert_arg_to_ldflags -Wl,-T,gcl.script + cp gcl.script unixport + else + AC_MSG_RESULT([none found or not needed]) +@@ -2116,16 +2112,16 @@ AC_CHECK_HEADERS(alloca.h) + AC_FUNC_ALLOCA + + +-LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'` $TLDFLAGS" ++LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'`" + AC_SUBST(LDFLAGS) + LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $LIBS $TLIBS" + AC_SUBST(LIBS) +-FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS $TCFLAGS" ++FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS" + AC_SUBST(FINAL_CFLAGS) + # Work around bug with gcc on ppc -- CM +-NIFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TONIFLAGS -I\$(GCLDIR)/o" ++NIFLAGS="$CFLAGS $CPPFLAGS $TONIFLAGS -I\$(GCLDIR)/o" + AC_SUBST(NIFLAGS) +-CFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TO3FLAGS -I\$(GCLDIR)/o" ++CFLAGS="$CFLAGS $CPPFLAGS $TO3FLAGS -I\$(GCLDIR)/o" + AC_SUBST(CFLAGS) + O3FLAGS=$TO3FLAGS + AC_SUBST(O3FLAGS) diff --git a/patches/pathnames1.9 b/patches/pathnames1.9 new file mode 100644 index 00000000..71ee3bd1 --- /dev/null +++ b/patches/pathnames1.9 @@ -0,0 +1,5609 @@ +Description: + 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-43) unstable; urgency=medium + . + * pathnames1.7 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-28 + +--- gcl-2.6.12.orig/ansi-tests/ansi-aux.lsp ++++ gcl-2.6.12/ansi-tests/ansi-aux.lsp +@@ -1635,3 +1635,6 @@ the condition to go uncaught if it canno + + (defmacro expand-in-current-env (macro-form &environment env) + (macroexpand macro-form env)) ++ ++(defun typep* (element type) ++ (not (not (typep element type)))) +--- gcl-2.6.12.orig/clcs/sys-proclaim.lisp ++++ gcl-2.6.12/clcs/sys-proclaim.lisp +@@ -2,30 +2,14 @@ + (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::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::T COMMON-LISP::T +- COMMON-LISP::T) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) + 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::MAKE-CONDITION)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -36,11 +20,27 @@ + 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::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ CONDITIONS::IS-CONDITION CONDITIONS::DEFAULT-REPORT ++ CONDITIONS::IS-WARNING CONDITIONS::CONDITIONP)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) + COMMON-LISP::*) +- COMMON-LISP::MAKE-CONDITION)) +\ No newline at end of file ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PACKAGE-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CASE-FAILURE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ABORT-FAILURE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (FILE-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-VARIABLE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ARITHMETIC-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (END-OF-FILE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (STREAM-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CELL-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (SIMPLE-CONDITION T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-SLOT T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNDEFINED-FUNCTION T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-CONDITION T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PRINT-NOT-READABLE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (TYPE-ERROR T))|)) +\ No newline at end of file +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -430,7 +430,7 @@ Cannot compile ~a.~%" + (si::copy-stream st *standard-output*)) + (with-open-file (st hn) + (si::copy-stream st *standard-output*)) +- (when (eql (aref *objdump* 0) #\/);program found at startup in path ++ (when *objdump* + (safe-system (si::string-concatenate *objdump* (namestring on)))) + (mdelete-file cn) + (mdelete-file dn) +--- gcl-2.6.12.orig/cmpnew/gcl_lfun_list.lsp ++++ gcl-2.6.12/cmpnew/gcl_lfun_list.lsp +@@ -43,7 +43,6 @@ + (DEFSYSFUN 'RASSOC "Lrassoc" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'PPRINT "Lpprint" '(T *) 'T NIL NIL) + (DEFSYSFUN 'NSUBST-IF-NOT "Lnsubst_if_not" '(T T T *) 'T NIL NIL) +-(DEFSYSFUN 'FILE-POSITION "Lfile_position" '(T *) 'T NIL NIL) + (DEFSYSFUN 'STRING< "Lstring_l" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'REVERSE "Lreverse" '(T) 'T NIL NIL) + (DEFSYSFUN 'STREAMP "Lstreamp" '(T) 'T NIL T) +@@ -67,7 +66,6 @@ + (DEFSYSFUN 'CONS "Lcons" '(T T) 'T NIL NIL) + (DEFSYSFUN 'LIST "Llist" '(*) 'T NIL NIL) + (DEFSYSFUN 'USE-PACKAGE "Luse_package" '(T *) 'T NIL NIL) +-(DEFSYSFUN 'FILE-LENGTH "Lfile_length" '(T) 'T NIL NIL) + (DEFSYSFUN 'MAKE-SYMBOL "Lmake_symbol" '(T) 'T NIL NIL) + (DEFSYSFUN 'STRING-RIGHT-TRIM "Lstring_right_trim" '(T T) 'STRING NIL + NIL) +--- gcl-2.6.12.orig/cmpnew/sys-proclaim.lisp ++++ gcl-2.6.12/cmpnew/sys-proclaim.lisp +@@ -2,376 +2,394 @@ + (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::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::T) ++ COMPILER::MLIN)) + (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::VECTOR COMMON-LISP::CHARACTER ++ COMMON-LISP::*) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::T) ++ COMPILER::DASH-TO-UNDERSCORE-INT)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::*) +- COMPILER::T3DEFUN-AUX)) ++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++ COMMON-LISP::*)) ++ COMMON-LISP::T) ++ COMPILER::TS COMPILER::DASH-TO-UNDERSCORE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) +- COMPILER::F-TYPE)) ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++ COMPILER::C1NIL COMPILER::WT-DATA-FILE ++ COMPILER::CLOSE-INLINE-BLOCKS COMPILER::WT-NEXT-VAR-ARG ++ COMPILER::RESET-TOP COMPILER::VS-PUSH COMPILER::BABOON ++ COMPILER::GAZONK-NAME COMPILER::PRINT-COMPILER-INFO ++ COMPILER::ADD-LOAD-TIME-SHARP-COMMA COMPILER::INIT-ENV ++ COMPILER::PRINT-CURRENT-FORM COMPILER::WT-C-PUSH COMPILER::C1T ++ COMPILER::WT-FIRST-VAR-ARG COMPILER::CCB-VS-PUSH ++ COMPILER::INC-INLINE-BLOCKS COMPILER::WT-CVARS ++ COMPILER::WT-FASD-DATA-FILE COMPILER::WFS-ERROR ++ COMPILER::WT-DATA-END COMPILER::TAIL-RECURSION-POSSIBLE ++ COMPILER::CVS-PUSH COMPILER::WT-DATA-BEGIN)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::STRING) COMMON-LISP::T) +- COMPILER::DASH-TO-UNDERSCORE)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++ COMPILER::ANALYZE-REGS1 COMPILER::ANALYZE-REGS ++ COMPILER::PROCLAIMED-ARGD)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) + 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)) ++ COMPILER::CHECK-FNAME-ARGS COMPILER::COERCE-LOC ++ COMPILER::TYPE>= COMPILER::C2BIND-LOC ++ COMPILER::RESULT-TYPE-FROM-ARGS COMPILER::ADD-DEBUG-INFO ++ COMPILER::MAKE-USER-INIT COMPILER::CO1EQL COMPILER::C2ASSOC!2 ++ COMPILER::WT-VAR COMPILER::CFAST-WRITE COMPILER::C2STACK-LET ++ COMPILER::C2DM-BIND-INIT COMPILER::IS-REP-REFERRED ++ COMPILER::CO1CONS COMPILER::SHIFT<< ++ COMPILER::C2MULTIPLE-VALUE-SETQ COMPILER::C2CALL-LOCAL ++ COMPILER::CO1SCHAR COMPILER::C1CONSTANT-VALUE ++ COMPILER::WT-CHARACTER-VALUE COMPILER::CONVERT-CASE-TO-SWITCH ++ COMPILER::C2MULTIPLE-VALUE-CALL COMPILER::C2EXPR-TOP ++ COMPILER::CO1READ-BYTE COMPILER::PRIN1-CMP ++ COMPILER::STRUCT-TYPE-OPT COMPILER::C1DECL-BODY ++ COMPILER::COERCE-LOC-STRUCTURE-REF ++ COMPILER::CO1STRUCTURE-PREDICATE COMPILER::WT-MAKE-DCLOSURE ++ COMPILER::ARGS-INFO-CHANGED-VARS ++ COMPILER::C2LIST-NTH-IMMEDIATE COMPILER::CO1LDB ++ COMPILER::CO1WRITE-BYTE COMPILER::C1PROGN* ++ COMPILER::CO1CONSTANT-FOLD COMPILER::SET-JUMP-TRUE ++ COMPILER::C1SETQ1 COMPILER::CO1READ-CHAR COMPILER::C2BIND-INIT ++ COMPILER::CO1TYPEP COMPILER::WT-FIXNUM-VALUE ++ COMPILER::MULTIPLE-VALUE-CHECK COMPILER::SHIFT>> ++ COMPILER::CO1SUBLIS COMPILER::DO-MACRO-EXPANSION ++ COMPILER::C2UNWIND-PROTECT COMPILER::C2CALL-LAMBDA ++ COMPILER::C2MEMBER!2 COMPILER::GET-INLINE-LOC ++ COMPILER::C1LAMBDA-FUN COMPILER::JUMPS-TO-P COMPILER::C1EXPR* ++ COMPILER::C2SETQ COMPILER::C2APPLY COMPILER::UNWIND-BDS ++ COMPILER::SET-BDS-BIND COMPILER::NEED-TO-PROTECT ++ COMPILER::C1FMLA COMPILER::TYPE-AND COMPILER::CMPFIX-ARGS ++ COMPILER::MAYBE-EVAL COMPILER::C2BLOCK-CLB COMPILER::SET-DBIND ++ COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY ++ COMPILER::WT-LONG-FLOAT-VALUE COMPILER::C2DM-BIND-VL ++ COMPILER::WT-SHORT-FLOAT-VALUE COMPILER::T3SHARP-COMMA ++ COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES COMPILER::C2CATCH ++ COMPILER::C2EXPR-TOP* COMPILER::SET-JUMP-FALSE ++ COMPILER::CO1VECTOR-PUSH COMPILER::WT-V*-MACROS ++ COMPILER::ARGS-INFO-REFERRED-VARS COMPILER::SET-VS ++ COMPILER::WT-REQUIREDS COMPILER::C2RETURN-CCB ++ COMPILER::C2THROW COMPILER::CHECK-END ++ COMPILER::PUSH-CHANGED-VARS COMPILER::C2BLOCK-CCB ++ SYSTEM::ADD-DEBUG COMPILER::C2PSETQ COMPILER::C1ARGS ++ COMPILER::COMPILER-CC COMPILER::INLINE-PROC ++ COMPILER::CO1WRITE-CHAR COMPILER::COMPILER-DEF-HOOK ++ COMPILER::CAN-BE-REPLACED COMPILER::C2MULTIPLE-VALUE-PROG1 ++ COMPILER::C2DM-BIND-LOC COMPILER::ADD-INFO ++ COMPILER::CO1SPECIAL-FIX-DECL COMPILER::C2LAMBDA-EXPR-WITH-KEY ++ COMPILER::FAST-READ COMPILER::C2RETURN-CLB ++ COMPILER::PROCLAIM-VAR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) + 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)) ++ COMPILER::COMPILE-FILE1)) + (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)) ++ COMPILER::MAKE-INLINE-STRING COMPILER::GET-INLINE-INFO ++ COMPILER::C1STRUCTURE-REF1 COMPILER::CJF COMPILER::SET-VAR ++ COMPILER::CHECK-FORM-TYPE COMPILER::AND-FORM-TYPE ++ COMPILER::SUBLIS1-INLINE COMPILER::T3DEFCFUN ++ COMPILER::WT-INLINE-INTEGER COMPILER::C-FUNCTION-NAME ++ COMPILER::FIX-DOWN-ARGS COMPILER::ASSIGN-DOWN-VARS ++ COMPILER::WT-INLINE-FIXNUM COMPILER::C2GO COMPILER::CJT ++ COMPILER::TOO-FEW-ARGS COMPILER::C2PRINC COMPILER::C2CASE ++ COMPILER::C2LET* COMPILER::BOOLE3 COMPILER::COMPILER-PASS2 ++ COMPILER::C1DM COMPILER::CHECK-VDECL COMPILER::C2LET ++ COMPILER::MYSUB COMPILER::CAN-BE-REPLACED* ++ COMPILER::ADD-FUNCTION-PROCLAMATION COMPILER::WT-IF-PROCLAIMED ++ COMPILER::C1MAP-FUNCTIONS COMPILER::ADD-FAST-LINK ++ COMPILER::WT-INLINE-LONG-FLOAT COMPILER::TOO-MANY-ARGS ++ COMPILER::C2MULTIPLE-VALUE-BIND COMPILER::C2PROGV ++ COMPILER::WT-INLINE-CHARACTER ++ COMPILER::ADD-FUNCTION-DECLARATION COMPILER::CMP-EXPAND-MACRO ++ COMPILER::C2MAPCAR COMPILER::INLINE-TYPE-MATCHES ++ COMPILER::C2FUNCALL-SFUN COMPILER::WT-MAKE-CCLOSURE ++ COMPILER::C2MAPCAN COMPILER::C2TAGBODY ++ COMPILER::WT-INLINE-COND COMPILER::C2MAPC ++ COMPILER::WT-INLINE-SHORT-FLOAT)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL COMPILER::LINK +- COMPILER::INLINE-ARGS)) ++ COMPILER::T3LOCAL-FUN COMPILER::T3LOCAL-DCFUN)) + (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) +- 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)) ++ COMPILER::T3DEFMACRO COMPILER::T3DEFENTRY COMPILER::T2DEFENTRY ++ COMPILER::DEFSYSFUN COMPILER::T2DEFMACRO)) + (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) +- COMPILER::DEFSYSFUN COMPILER::T2DEFMACRO COMPILER::T2DEFENTRY +- COMPILER::T3DEFMACRO COMPILER::T3DEFENTRY)) ++ COMPILER::T3DEFUN COMPILER::T3DEFUN-LOCAL-ENTRY ++ COMPILER::C2STRUCTURE-SET COMPILER::T2DEFUN ++ COMPILER::C1APPLY-OPTIMIZE)) + (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) +- COMPILER::T2DEFUN COMPILER::C1APPLY-OPTIMIZE COMPILER::T3DEFUN +- COMPILER::C2STRUCTURE-SET COMPILER::T3DEFUN-LOCAL-ENTRY)) ++ COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL ++ COMPILER::INLINE-ARGS COMPILER::LINK)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) ++ COMMON-LISP::T) + COMMON-LISP::T) +- COMPILER::WT-SIMPLE-CALL COMPILER::GET-OUTPUT-PATHNAME)) ++ COMPILER::T3INIT-FUN COMPILER::C2STRUCTURE-REF ++ COMPILER::WT-GLOBAL-ENTRY COMPILER::T3DEFUN-NORMAL ++ COMPILER::T3DEFUN-VARARG COMPILER::C1MAKE-VAR ++ COMPILER::C2SWITCH COMPILER::MY-CALL COMPILER::C2CALL-GLOBAL ++ COMPILER::C2CALL-UNKNOWN-GLOBAL)) + (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::*) + COMMON-LISP::T) +- COMPILER::T3LOCAL-FUN COMPILER::T3LOCAL-DCFUN)) ++ COMPILER::GET-OUTPUT-PATHNAME COMPILER::WT-SIMPLE-CALL)) ++(COMMON-LISP::MAPC ++ (COMMON-LISP::LAMBDA (COMPILER::X) ++ (COMMON-LISP::SETF ++ (COMMON-LISP::GET COMPILER::X 'COMPILER::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::*) COMMON-LISP::T) ++ COMPILER::MAKE-VAR COMPILER::COMPILER-COMMAND ++ COMPILER::LIST*-INLINE COMMON-LISP::COMPILE-FILE ++ COMPILER::CS-PUSH COMPILER::MAKE-INFO COMPILER::FCALLN-INLINE ++ COMPILER::C2FSET COMPILER::MAKE-TAG COMPILER::WT-CLINK ++ COMPILER::LIST-INLINE COMPILER::MAKE-FUN COMPILER::MAKE-BLK)) + (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)) ++ COMPILER::T1EVAL-WHEN COMPILER::T1EXPR ++ COMPILER::WT-CHARACTER-LOC COMPILER::SET-LOC ++ COMPILER::CMP-TOPLEVEL-EVAL COMPILER::C2PROGN ++ COMPILER::WT-TO-STRING COMPILER::MEXPAND-DEFTYPE ++ COMPILER::WT-SHORT-FLOAT-LOC COMPILER::CMP-EVAL ++ COMPILER::WT-LOC COMPILER::C2AND COMPILER::C2EXPR ++ COMPILER::WT-LONG-FLOAT-LOC COMPILER::C2OR ++ COMPILER::WT-FIXNUM-LOC)) + (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::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ COMPILER::LTVP-EVAL COMPILER::FSET-FN-NAME COMPILER::C1MAPCON ++ COMPILER::FUNCTION-ARG-TYPES COMPILER::C1SHARP-COMMA ++ COMPILER::SAVE-AVMA COMPILER::C2TAGBODY-CCB COMPILER::VAR-LOC ++ COMPILER::WT-DOWN COMPILER::C1SETQ COMPILER::TAG-REF-CCB ++ COMPILER::T1DEFINE-STRUCTURE COMPILER::SAVE-FUNOB ++ COMPILER::C1VAR COMPILER::VV-STR COMPILER::C1RPLACA ++ COMPILER::INFO-SP-CHANGE COMPILER::BLK-REF-CCB ++ COMPILER::T1ORDINARY COMPILER::FIXNUM-LOC-P ++ COMPILER::FUN-REF-CCB COMPILER::C2GET COMPILER::FUN-NAME ++ COMPILER::FUN-P COMPILER::SCH-GLOBAL COMPILER::C1LET ++ COMPILER::C2TAGBODY-CLB COMPILER::C1UNWIND-PROTECT ++ COMPILER::SET-RETURN COMPILER::WT-VAR-DECL ++ COMPILER::VAR-REGISTER COMPILER::C1DEFINE-STRUCTURE ++ COMPILER::LTVP COMPILER::INLINE-POSSIBLE COMPILER::CHECK-VREF ++ COMPILER::TAG-NAME COMPILER::C2DM-RESERVE-VL ++ COMPILER::VAR-TYPE COMPILER::WT-LIST COMPILER::C1LET* ++ COMPILER::VARARG-P COMPILER::C1LOAD-TIME-VALUE ++ COMPILER::C2FUNCALL-AUX COMPILER::INFO-TYPE COMPILER::C1GET ++ COMPILER::C1NTHCDR-CONDITION COMPILER::C1AND ++ COMPILER::C1MULTIPLE-VALUE-CALL COMPILER::C1RPLACA-NTHCDR ++ COMPILER::INFO-VOLATILE COMPILER::INLINE-TYPE ++ COMPILER::LONG-FLOAT-LOC-P COMPILER::INFO-CHANGED-ARRAY ++ SYSTEM::UNDEF-COMPILER-MACRO COMPILER::DECL-BODY-SAFETY ++ COMPILER::TAG-VAR COMPILER::CHARACTER-LOC-P COMPILER::C2BIND ++ COMPILER::C1DECLARE COMPILER::CONS-TO-LISTA ++ COMPILER::C1MULTIPLE-VALUE-SETQ COMPILER::NAME-SD1 ++ COMPILER::BLK-NAME COMPILER::PARSE-CVSPECS COMPILER::C1MAPL ++ COMPILER::AET-C-TYPE COMPILER::C2VAR COMPILER::COPY-INFO ++ COMPILER::C1PSETQ COMPILER::C1VREF COMPILER::FUN-REF ++ COMPILER::WT-H1 COMPILER::T1DEFCFUN COMPILER::T1PROGN ++ COMPILER::C1EVAL-WHEN COMPILER::FLAGS-POS COMPILER::WT-VS ++ COMPILER::C2VAR-KIND COMPILER::C1LENGTH ++ COMPILER::C1MULTIPLE-VALUE-BIND COMPILER::C2LOCATION ++ COMPILER::C2DM-RESERVE-V COMPILER::C2FUNCTION ++ COMPILER::WT-SWITCH-CASE COMPILER::C2TAGBODY-LOCAL ++ COMPILER::CONSTANT-FOLD-P COMPILER::NEED-TO-SET-VS-POINTERS ++ COMPILER::C1MAPCAN COMPILER::WT-FUNCALL-C COMPILER::WT-CCB-VS ++ COMPILER::C1RETURN-FROM COMPILER::GET-INCLUDED ++ COMPILER::C1BLOCK COMPILER::ADD-CONSTANT COMPILER::WT-VS-BASE ++ COMPILER::C1NTH-CONDITION COMPILER::FUN-LEVEL ++ COMPILER::UNWIND-NO-EXIT COMMON-LISP::PROCLAIM ++ COMPILER::C1PRINC COMPILER::C2EXPR* COMPILER::RESULT-TYPE ++ COMPILER::TAG-REF COMPILER::C1FUNCALL COMPILER::C1PROGN ++ COMPILER::MAXARGS COMPILER::UNDEFINED-VARIABLE COMPILER::C1THE ++ COMPILER::CMP-MACROEXPAND COMPILER::C1MAPCAR ++ COMPILER::DEFAULT-INIT COMPILER::C1STRUCTURE-SET ++ COMPILER::WT-SYMBOL-FUNCTION COMPILER::T1DEFUN ++ COMPILER::WT-DATA1 COMPILER::PUSH-DATA-INCF COMPILER::C1IF ++ COMPILER::C1NTHCDR COMPILER::ADD-SYMBOL ++ COMPILER::C1MULTIPLE-VALUE-PROG1 COMPILER::BLK-REF ++ COMPILER::WT-FUNCTION-LINK COMPILER::INFO-P COMPILER::C1FSET ++ COMPILER::C1PROGV COMPILER::C1ASSOC COMPILER::VAR-REF ++ COMPILER::ARGS-CAUSE-SIDE-EFFECT COMPILER::MDELETE-FILE ++ COMPILER::CMP-MACRO-FUNCTION COMPILER::C2DOWNWARD-FUNCTION ++ COMPILER::C2GO-LOCAL COMPILER::T1DEFLA COMPILER::VAR-REF-CCB ++ COMPILER::C1FLET COMPILER::C1LIST-NTH ++ COMPILER::ADD-LOOP-REGISTERS COMPILER::INFO-REFERRED-ARRAY ++ COMPILER::BLK-VALUE-TO-GO COMPILER::WT-VS* ++ COMPILER::NAME-TO-SD COMPILER::C1RPLACD ++ COMPILER::WT-DATA-PACKAGE-OPERATION COMPILER::C1SWITCH ++ COMPILER::C1CATCH COMPILER::WT-CAR COMPILER::C1MACROLET ++ COMPILER::OBJECT-TYPE COMPILER::C1MAPC COMPILER::T1CLINES ++ COMPILER::C1COMPILER-LET COMPILER::CMP-MACROEXPAND-1 ++ COMPILER::C1TAGBODY COMPILER::C1MAPLIST COMPILER::PUSH-ARGS ++ COMPILER::T3ORDINARY COMPILER::C1MEMBER COMPILER::T1MACROLET ++ COMPILER::WT-CDR COMPILER::C1BOOLE3 COMPILER::PROCLAMATION ++ COMPILER::GET-LOCAL-RETURN-TYPE COMPILER::C1LOCAL-FUN ++ COMPILER::VAR-KIND COMPILER::WT1 COMPILER::TAG-SWITCH ++ COMPILER::C1OR COMPILER::C1STRUCTURE-REF ++ COMPILER::THE-PARAMETER COMPILER::VAR-REP-LOC ++ COMPILER::DECLARATION-TYPE COMPILER::TAG-P COMPILER::C2GETHASH ++ COMPILER::C1EXPR COMPILER::REPLACE-CONSTANT COMPILER::C1ECASE ++ COMPILER::FUN-CFUN COMPILER::SET-TOP COMPILER::TAG-LABEL ++ COMPILER::C1DM-BAD-KEY COMPILER::C1THROW COMPILER::C2GO-CCB ++ COMPILER::REP-TYPE COMPILER::C2VALUES ++ COMPILER::SHORT-FLOAT-LOC-P COMPILER::FUNCTION-RETURN-TYPE ++ COMPILER::ADD-OBJECT COMPILER::CTOP-WRITE COMPILER::C1MEMQ ++ COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::C1TERPRI ++ COMPILER::T1DEFMACRO COMPILER::T3CLINES COMPILER::ADD-REG1 ++ COMPILER::C1NTH COMPILER::C1ASH COMPILER::C1FMLA-CONSTANT ++ COMPILER::C2GO-CLB COMPILER::WT-CADR ++ COMPILER::C1BOOLE-CONDITION COMPILER::CLINK COMPILER::VAR-NAME ++ COMPILER::PUSH-ARGS-LISPCALL COMPILER::GET-ARG-TYPES ++ COMPILER::BLK-VAR COMPILER::C1APPLY COMPILER::CHECK-DOWNWARD ++ COMPILER::C1QUOTE COMPILER::TAG-REF-CLB ++ COMPILER::GET-LOCAL-ARG-TYPES COMPILER::REGISTER ++ COMPILER::BLK-P COMPILER::FUN-INFO COMPILER::C2RPLACD ++ COMPILER::ADD-OBJECT2 COMPILER::C2TAGBODY-BODY ++ COMPILER::T1DEFENTRY COMPILER::C1FUNCTION ++ COMPILER::C1DOWNWARD-FUNCTION COMPILER::SAFE-SYSTEM ++ COMPILER::C1GO COMPILER::BLK-EXIT COMPILER::VERIFY-DATA-VECTOR ++ COMPILER::C2RPLACA COMPILER::T2DECLARE COMPILER::MACRO-DEF-P ++ COMPILER::C1LABELS COMPILER::C1GETHASH COMPILER::FIX-OPT ++ COMPILER::SCH-LOCAL-FUN COMPILER::C1FUNOB ++ COMPILER::SET-PUSH-CATCH-FRAME COMPILER::GET-RETURN-TYPE ++ COMPILER::SET-UP-VAR-CVS COMPILER::TAG-UNWIND-EXIT ++ COMPILER::VAR-P COMPILER::C1ADD-GLOBALS COMPILER::TYPE-FILTER ++ COMPILER::WT-VV COMPILER::C1ASH-CONDITION COMPILER::VOLATILE ++ COMPILER::INLINE-BOOLE3-STRING COMPILER::C1LOCAL-CLOSURE ++ COMPILER::WRITE-BLOCK-OPEN COMPILER::ADD-ADDRESS ++ COMPILER::RESET-INFO-TYPE COMPILER::C1VALUES ++ COMPILER::BLK-REF-CLB COMPILER::C1STACK-LET)) ++(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::VECTOR COMMON-LISP::T)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) + COMMON-LISP::T) +- COMPILER::COPY-ARRAY)) ++ COMPILER::MEMOIZED-HASH-EQUAL)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ COMPILER::WT-INLINE-LOC COMPILER::NCONC-FILES ++ COMPILER::COMPILER-BUILD COMPILER::C2BLOCK-LOCAL ++ COMPILER::C2DECL-BODY COMPILER::C1SYMBOL-FUN COMPILER::C2BLOCK ++ COMPILER::C1BODY COMPILER::C2RETURN-LOCAL)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) + 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)) ++ COMPILER::C1LAMBDA-EXPR COMPILER::CMPWARN COMPILER::ADD-INIT ++ COMPILER::UNWIND-EXIT COMPILER::CMPNOTE COMPILER::CMPERR ++ COMPILER::C1CASE COMPILER::WT-COMMENT COMPILER::INIT-NAME ++ COMPILER::FAST-LINK-PROCLAIMED-TYPE-P COMPILER::WT-INTEGER-LOC ++ COMPILER::WT-CVAR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM) COMMON-LISP::T) +- COMPILER::MLIN)) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ COMPILER::C2IF COMPILER::WT-INLINE COMPILER::C2COMPILER-LET ++ COMPILER::C2FLET COMPILER::C2LABELS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) + COMMON-LISP::*) +- COMPILER::COMPILE-FILE1)) ++ COMPILER::C2RETURN-FROM COMPILER::C2APPLY-OPTIMIZE ++ COMPILER::C2DM COMPILER::C1DM-V COMPILER::C1DM-VL)) + (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::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) ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*))) + COMMON-LISP::T) +- COMPILER::MEMOIZED-HASH-EQUAL)) ++ COMPILER::COPY-ARRAY)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T ++ (COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*)) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ COMMON-LISP::T) + COMMON-LISP::FIXNUM) +- COMPILER::PROCLAIMED-ARGD COMPILER::ANALYZE-REGS1 +- COMPILER::ANALYZE-REGS)) ++ COMPILER::BSEARCHLEQ)) + (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 ++ (COMMON-LISP::T ++ (COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*)) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++ COMPILER::PUSH-ARRAY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++ COMPILER::F-TYPE)) +\ No newline at end of file +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -3980,7 +3980,7 @@ add_args_to_cflags -fsigned-char -pipe \ + -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign \ + -Wno-unused-but-set-variable -Wno-misleading-indentation + +-add_args_to_ldflags -Wl,-no_pie -no-pie -Wl,-z,lazy ++add_args_to_ldflags -no-pie -Wl,-z,lazy + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for clang" >&5 + $as_echo_n "checking for clang... " >&6; } +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -264,7 +264,7 @@ add_args_to_cflags -fsigned-char -pipe \ + -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign \ + -Wno-unused-but-set-variable -Wno-misleading-indentation + +-add_args_to_ldflags -Wl,-no_pie -no-pie -Wl,-z,lazy ++add_args_to_ldflags -no-pie -Wl,-z,lazy + + AC_MSG_CHECKING([for clang]) + AC_RUN_IFELSE( +--- gcl-2.6.12.orig/gcl-tk/socketsl.lisp ++++ gcl-2.6.12/gcl-tk/socketsl.lisp +@@ -12,10 +12,6 @@ + (defentry our-write (int object int ) (int "our_write_object")) + (defentry print-to-string1 (object object object) (object print_to_string1)) + +-(clines "#define reset_string_input_stream1(strm,string,start,end) reset_string_input_stream(strm,string,fix(start),fix(end))") +-(defentry reset-string-input-stream (object object object object) (object "reset_string_input_stream1")) +- +- + ;(clines "#define symbol_value_any(x) ((x)->s.s_dbind)") + ;(defentry symbol-value-any (object) (object symbol_value_any)) + +--- gcl-2.6.12.orig/gcl-tk/tkl.lisp ++++ gcl-2.6.12/gcl-tk/tkl.lisp +@@ -293,6 +293,9 @@ + (let () + (send-tcl-cmd *tk-connection* tk-command nil)))) + ++(defun fsubseq (s &optional (b 0) (e (length s))) ++ (make-array (- e b) :element-type (array-element-type s) :displaced-to s :displaced-index-offset b :fill-pointer (- e b))) ++ + (defun send-tcl-cmd (c str send-and-wait ) + ;(notice-text-variables) + (or send-and-wait (setq send-and-wait *send-and-wait*)) +@@ -308,7 +311,7 @@ + + (cond (send-and-wait + (if *debugging* +- (store-circle *requests* (subseq str #.(length *header*)) ++ (store-circle *requests* (fsubseq str #.(length *header*)) + msg-id)) + (store-circle *replies* nil msg-id) + (execute-tcl-cmd c str)) +@@ -932,7 +935,7 @@ + #.(+ 1 (length *header*)) + 3)) + (values +- (subseq str #.(+ 4 (length *header*))) ++ (fsubseq str #.(+ 4 (length *header*))) + (eql (aref str #.(+ 1 (length *header*))) #\0) + reply-from + (get-circle *requests* reply-from))) +@@ -1082,7 +1085,7 @@ + (store-circle *replies* + (cons success + (if (eql (length tk-command) #.(+ 4 (length *header*))) "" +- (subseq tk-command #.(+ 4 (length *header*))))) ++ (fsubseq tk-command #.(+ 4 (length *header*))))) + from-id)) + (#.(pos m_call *mtypes*) + ;; Can play a game of if read-and-act called with request-id: +@@ -1114,7 +1117,7 @@ + (var (aref *text-variable-locations* lisp-var-id)) + (type (get var 'linked-variable-type)) + val) +- (setq val (coerce-result (subseq tk-command #.(+ 3 (length *header*))) type)) ++ (setq val (coerce-result (fsubseq tk-command #.(+ 3 (length *header*))) type)) + (setf (aref *text-variable-locations* (the fixnum + ( + lisp-var-id 1))) + val) +@@ -1130,7 +1133,9 @@ + (let* ((s (car *string-streams*)) + (*string-streams* (cdr *string-streams*))) + (or s (setq s (make-string-input-stream ""))) +- (si::reset-string-input-stream s string start (length string)) ++ (assert (array-has-fill-pointer-p string)) ++ (setf (fill-pointer string) start) ++ (si::c-set-stream-object0 s string) + (read s nil nil))) + + +@@ -1196,7 +1201,7 @@ + (cond (skipping nil) + ((eql brace-level 0) + (if (> i beg) +- (setq ans (cons (subseq x beg i) ans))) ++ (setq ans (cons (fsubseq x beg i) ans))) + + (setq beg (+ i 1)) + ))) +@@ -1207,12 +1212,12 @@ + (setq beg (+ i 1)))) + (incf brace-level)) + (#\} (cond ((eql brace-level 1) +- (setq ans (cons (subseq x beg i) ans)) ++ (setq ans (cons (fsubseq x beg i) ans)) + (setq skipping t))) + (incf brace-level -1))))) + finally + (unless skipping +- (setq ans (cons (subseq x beg i) ans))) ++ (setq ans (cons (fsubseq x beg i) ans))) + (return (nreverse ans)) + )) + +@@ -1394,7 +1399,7 @@ + (cond (start (pp v no_leading_space) (setq start nil)) + (t (pp v normal))) + (setf x (cdr x))) +- (subseq tk-command #.(length *header*)))) ++ (fsubseq tk-command #.(length *header*)))) + + + +@@ -1409,7 +1414,6 @@ + (setq gcltksrv + (cond (host "gcltksrv") + ((si::getenv "GCL_TK_SERVER")) +- ((probe-file (tk-conc si::*lib-directory* "/gcl-tk/gcltksrv"))) + ((probe-file (tk-conc si::*lib-directory* "gcl-tk/gcltksrv"))) + (t (error "Must setenv GCL_TK_SERVER "))))) + (let ((pid (if host -1 (si::getpid))) +@@ -1427,9 +1431,9 @@ + args + ))) + (print command) +- (cond ((not host) (system command)) ++ (cond ((not host) (si::system command)) + (can-rsh +- (system (tk-conc "rsh " host " " command ++ (si::system (tk-conc "rsh " host " " command + " < /dev/null &"))) + (t (format t "Waiting for you to invoke GCL_TK_SERVER, + on ~a as in: ~s~%" host command ))) +--- gcl-2.6.12.orig/h/compprotos.h ++++ gcl-2.6.12/h/compprotos.h +@@ -180,3 +180,4 @@ char *gcl_gets(char *,int); + int gcl_puts(const char *); + int endp_error(object); + object Icall_gen_error_handler(object,object,object,object,ufixnum,...); ++object file_stream(object); +--- gcl-2.6.12.orig/h/lu.h ++++ gcl-2.6.12/h/lu.h +@@ -271,15 +271,14 @@ struct structure { + + struct stream { + FIRSTWORD; +- void *sm_fp; +- object sm_object0; +- object sm_object1; +- int sm_int0; +- int sm_int1; +- char *sm_buffer; +- char sm_mode; +- unsigned char sm_flags; +- short sm_fd; ++ void *sm_fp; ++ object sm_object0; ++ object sm_object1; ++ char *sm_buffer; ++ ufixnum sm_mode:4; ++ ufixnum sm_flags:6; ++ ufixnum sm_fd:6; ++ ufixnum sm_int:LM(16); + }; + + struct random { +--- gcl-2.6.12.orig/h/object.h ++++ gcl-2.6.12/h/object.h +@@ -166,18 +166,18 @@ enum aelttype { /* array element type + /* for any stream that takes writec_char, directly (not two_way or echo) + ie. smm_output,smm_io, smm_string_output, smm_socket + */ +-#define STREAM_FILE_COLUMN(str) ((str)->sm.sm_int1) ++#define STREAM_FILE_COLUMN(str) ((str)->sm.sm_int) + + /* for smm_echo */ +-#define ECHO_STREAM_N_UNREAD(strm) ((strm)->sm.sm_int0) ++#define ECHO_STREAM_N_UNREAD(strm) ((strm)->sm.sm_int) + + /* file fd for socket */ + #define SOCKET_STREAM_FD(strm) ((strm)->sm.sm_fd) + #define SOCKET_STREAM_BUFFER(strm) ((strm)->sm.sm_object1) + + /* for smm_string_input */ +-#define STRING_INPUT_STREAM_NEXT(strm) ((strm)->sm.sm_int0) +-#define STRING_INPUT_STREAM_END(strm) ((strm)->sm.sm_int1) ++#define STRING_INPUT_STREAM_NEXT(strm) ((strm)->sm.sm_object0->st.st_fillp) ++#define STRING_INPUT_STREAM_END(strm) ((strm)->sm.sm_object0->st.st_dim) + + /* for smm_two_way and smm_echo */ + #define STREAM_OUTPUT_STREAM(strm) ((strm)->sm.sm_object1) +--- gcl-2.6.12.orig/h/type.h ++++ gcl-2.6.12/h/type.h +@@ -41,7 +41,6 @@ enum smmode { /* stream mode */ + smm_output, /* output */ + smm_io, /* input-output */ + smm_probe, /* probe */ +- smm_file_synonym, /* synonym stream to file_stream */ + smm_synonym, /* synonym */ + smm_broadcast, /* broadcast */ + smm_concatenated, /* concatenated */ +@@ -152,5 +151,4 @@ enum smmode { /* stream mode */ + #define pathname_string_symbol_streamp(a_) ({enum type _tp=type_of(a_); _tp==t_pathname || _tp == t_string\ + || _tp == t_symbol || _tp==t_stream;}) + +-#define pathname_designatorp(a_) ({object _a=(a_);enum type _tp=type_of(a_);\ +- _tp==t_pathname||_tp==t_string||(_tp==t_stream && _a->sm.sm_mode>=smm_input && _a->sm.sm_mode<=smm_file_synonym);}) ++#define pathname_designatorp(a_) ({object _a=(a_);enum type _tp=type_of(a_);_tp==t_pathname||_tp==t_string||file_stream(_a)!=Cnil;}) +--- gcl-2.6.12.orig/lsp/gcl_directory.lsp ++++ gcl-2.6.12/lsp/gcl_directory.lsp +@@ -74,4 +74,12 @@ + (let ((r (with-open-file (s (apply 'string-concatenate "|" #-winnt "which " + #+winnt "for %i in (" s #+winnt ".exe) do @echo.%~$PATH:i" nil)) + (read-line s nil 'eof)))) +- (if (eq r 'eof) s (string-downcase r)))) ++ (unless (eq r 'eof) ++ (string-downcase r)))) ++ ++(defun get-path (s &aux ++ (e (unless (minusp (string-match #v"([^\n\t\r ]+)([\n\t\r ]|$)" s))(match-end 1))) ++ (w (when e (which (pathname-name (subseq s (match-beginning 1) e)))))) ++ (when w ++ (string-concatenate w (subseq s e)))) ++ +--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp ++++ gcl-2.6.12/lsp/gcl_iolib.lsp +@@ -69,7 +69,20 @@ + (progn ,@b) + (close ,var))))) + +-(defmacro with-input-from-string ((var string &key index start end) . body) ++(defun make-string-input-stream (string &optional (start 0) end) ++ (declare (optimize (safety 1))) ++ (check-type string string) ++ (check-type start seqind) ++ (check-type end (or null seqind)) ++ (let ((l (- (or end (length string)) start))) ++ (make-string-input-stream-int ++ (make-array l :element-type (array-element-type string) :displaced-to string :displaced-index-offset start :fill-pointer 0) ++ 0 l))) ++ ++(defun get-string-input-stream-index (stream &aux (s (c-stream-object0 stream))) ++ (+ (fill-pointer s) (multiple-value-bind (a b) (array-displacement s) b))) ++ ++(defmacro with-input-from-string ((var string &key index (start 0) end) . body) + (declare (optimize (safety 1))) + (multiple-value-bind (ds b) (find-declarations body) + `(let ((,var (make-string-input-stream ,string ,start ,end))) +@@ -77,7 +90,8 @@ + (unwind-protect + (multiple-value-prog1 + (progn ,@b) +- ,@(when index `((setf ,index (get-string-input-stream-index ,var))))) ++ ,@(when index ++ `((setf ,index (get-string-input-stream-index ,var))))) + (close ,var))))) + + (defmacro with-output-to-string ((var &optional string &key element-type) . body) +@@ -406,7 +420,7 @@ + + + (defun write-sequence (seq strm &rest r &key (start 0) end +- &aux (l (listp seq))(cp (eq (stream-element-type strm) 'character))) ++ &aux (cp (eq (stream-element-type strm) 'character))) + (declare (optimize (safety 1))(dynamic-extent r)) + (check-type seq sequence) + (check-type strm stream) +@@ -443,9 +457,15 @@ + if-exists iesp if-does-not-exist idnesp external-format))) + (when (typep s 'stream) (c-set-stream-object1 s pf) s))) + ++(defun load-pathname-exists (z) ++ (or (probe-file z) ++ (when *allow-gzipped-file* ++ (when (probe-file (string-concatenate (namestring z) ".gz")) ++ z)))) ++ + (defun load-pathname (p print if-does-not-exist external-format + &aux (pp (merge-pathnames p)) +- (epp (reduce (lambda (y x) (or y (probe-file (translate-pathname x "" p)))) ++ (epp (reduce (lambda (y x) (or y (load-pathname-exists (translate-pathname x "" p)))) + '(#P".o" #P".lsp" #P".lisp" #P"") :initial-value nil)));FIXME newest? + (if epp + (let* ((*load-pathname* pp)(*load-truename* epp)) +@@ -484,3 +504,36 @@ + (d pd (cdr pd))) + (values ps created))) + ++(defun file-length (x) ++ (declare (optimize (safety 1))) ++ (check-type x (or broadcast-stream file-stream)) ++ (if (typep x 'broadcast-stream) ++ (let ((s (broadcast-stream-streams x))) (if s (file-length (car (last s))) 0)) ++ (multiple-value-bind (tp sz) (stat x) ++ (declare (ignore tp)) ++ (/ sz (get-byte-stream-nchars x))))) ++ ++(defun file-position (x &optional (pos :start pos-p)) ++ (declare (optimize (safety 1))) ++ (check-type x (or broadcast-stream file-stream string-stream)) ++ (check-type pos (or (member :start :end) (integer 0))) ++ (typecase x ++ (broadcast-stream ++ (let ((s (car (last (broadcast-stream-streams x))))) ++ (if s (if pos-p (file-position s pos) (file-position s)) 0))) ++ (string-stream ++ (let* ((st (c-stream-object0 x))(l (length st))(d (array-dimension st 0)) ++ (p (case pos (:start 0) (:end l) (otherwise pos)))) ++ (if pos-p (when (<= p d) (setf (fill-pointer st) p)) l))) ++ (otherwise ++ (let ((n (get-byte-stream-nchars x)) ++ (p (case pos (:start 0) (:end (file-length x)) (otherwise pos)))) ++ (if pos-p (when (fseek x (* p n)) p) (/ (ftell x) n)))))) ++ ++(defun file-string-length (strm obj) ++ (let* ((pos (file-position strm)) ++ (w (write obj :stream strm :escape nil :readably nil)) ++ (pos1 (file-position strm)));(break) ++ (declare (ignore w)) ++ (file-position strm pos) ++ (- pos1 pos))) +--- gcl-2.6.12.orig/lsp/gcl_namestring.lsp ++++ gcl-2.6.12/lsp/gcl_namestring.lsp +@@ -27,7 +27,7 @@ + (declare (optimize (safety 1))) + (check-type x pathname-designator) + (check-type def pathname-designator) +- ,(labels ((new? (k &aux (f (intern (concatenate 'string "PATHNAME-" (string k)) :si))) ++ ,(labels ((new? (k &aux (f (intern (string-concatenate "PATHNAME-" (string k)) :si))) + `(let ((k (,f px))) (unless (equal k (,f pdef)) k)))) + `(namestring (make-pathname + ,@(mapcan (lambda (x) (list x (new? x))) +pathname-keys+))))) +--- gcl-2.6.12.orig/lsp/gcl_predlib.lsp ++++ gcl-2.6.12/lsp/gcl_predlib.lsp +@@ -125,6 +125,8 @@ + (character . characterp) + (package . packagep) + (stream . streamp) ++ (string-input-stream . string-input-stream-p) ++ (string-output-stream . string-output-stream-p) + (file-stream . file-stream-p) + (synonym-stream . synonym-stream-p) + (broadcast-stream . broadcast-stream-p) +--- gcl-2.6.12.orig/lsp/gcl_restart.lsp ++++ gcl-2.6.12/lsp/gcl_restart.lsp +@@ -73,7 +73,7 @@ + &aux rr (report (if (stringp report) `(lambda (s) (write-string ,report s)) report))) + (macrolet ((do-setf (x) + `(when ,x +- (setf (getf rr ,(intern (concatenate 'string (symbol-name x) "-FUNCTION") :keyword)) ++ (setf (getf rr ,(intern (string-concatenate (symbol-name x) "-FUNCTION") :keyword)) + (list 'function ,x))))) + (do-setf report) + (do-setf interactive) +--- gcl-2.6.12.orig/lsp/gcl_serror.lsp ++++ gcl-2.6.12/lsp/gcl_serror.lsp +@@ -2,11 +2,11 @@ + (in-package :si) + + (macrolet +- ((make-conditionp (condition &aux (n (intern (concatenate 'string (string condition) "P")))) ++ ((make-conditionp (condition &aux (n (intern (string-concatenate (string condition) "P")))) + `(defun ,n (x &aux (z (si-find-class ',condition))) + (when z + (funcall (setf (symbol-function ',n) (lambda (x) (typep x z))) x)))) +- (make-condition-classp (class &aux (n (intern (concatenate 'string (string class) "-CLASS-P")))) ++ (make-condition-classp (class &aux (n (intern (string-concatenate (string class) "-CLASS-P")))) + `(defun ,n (x &aux (s (si-find-class 'standard-class)) (z (si-find-class ',class))) + (when (and s z) + (funcall (setf (symbol-function ',n) +@@ -124,9 +124,9 @@ + + (defun process-error (datum args &optional (default-type 'simple-error)) + (let ((internal (cond ((simple-condition-class-p datum) +- (find-symbol (concatenate 'string "INTERNAL-" (string datum)) :conditions)) ++ (find-symbol (string-concatenate "INTERNAL-" (string datum)) :conditions)) + ((condition-class-p datum) +- (find-symbol (concatenate 'string "INTERNAL-SIMPLE-" (string datum)) :conditions))))) ++ (find-symbol (string-concatenate "INTERNAL-SIMPLE-" (string datum)) :conditions))))) + (coerce-to-condition (or internal datum) (if internal (list* :function-name *sig-fn-name* args) args) default-type 'process-error))) + + (defun universal-error-handler (n cp fn cs es &rest args &aux (*sig-fn-name* fn)) +--- gcl-2.6.12.orig/lsp/gcl_top.lsp ++++ gcl-2.6.12/lsp/gcl_top.lsp +@@ -593,12 +593,11 @@ First directory is checked for first nam + (when (eq (stat x) :directory) + (return-from get-temp-dir x)))))) + +-(defun get-path (s &aux (m (string-match "([^ ]*)( |$)" s))(b (match-beginning 1))(e (match-end 1))) +- (string-concatenate (which (pathname-name (subseq s b e))) (subseq s e))) ++ + + (defvar *cc* "cc") + (defvar *ld* "ld") +-(defvar *objdump* "objdump --source ") ++(defvar *objdump* nil) + + (defvar *current-directory* *system-directory*) + +@@ -608,9 +607,9 @@ First directory is checked for first nam + (declare (fixnum i)) + (setq *current-directory* (current-directory-pathname)) + (setq *tmp-dir* (get-temp-dir) +- *cc* (get-path *cc*) +- *ld* (get-path *ld*) +- *objdump* (get-path *objdump*)) ++ *cc* (or (get-path *cc*) *cc*) ++ *ld* (or (get-path *ld*) *ld*) ++ *objdump* (get-path "objdump --source ")) + (dotimes (j i) (push (argv j) tem)) + (setq *command-args* (nreverse tem)) + (setq tem *lib-directory*) +--- gcl-2.6.12.orig/lsp/gcl_translate_pathname.lsp ++++ gcl-2.6.12/lsp/gcl_translate_pathname.lsp +@@ -32,7 +32,7 @@ + (defun do-repl (x y) + (labels ((r (x l &optional (b 0) &aux (f (string-match #v"\\*" x b))) + (if (eql f -1) (if (eql b 0) x (subseq x b)) +- (concatenate 'string (subseq x b f) (or (car l) "") (r x (cdr l) (1+ f)))))) ++ (string-concatenate (subseq x b f) (or (car l) "") (r x (cdr l) (1+ f)))))) + (r y x))) + + (defun dir-p (x) (when (consp x) (member (car x) '(:absolute :relative)))) +--- gcl-2.6.12.orig/lsp/sys-proclaim.lisp ++++ gcl-2.6.12/lsp/sys-proclaim.lisp +@@ -4,229 +4,269 @@ + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER +- COMMON-LISP::*) +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807)) +- COMMON-LISP::FIXNUM) +- SYSTEM::ATOI)) ++ COMMON-LISP::*)) ++ COMMON-LISP::T) ++ SYSTEM::RESET-SYS-PATHS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- (COMMON-LISP::OR COMMON-LISP::NULL +- COMMON-LISP::HASH-TABLE)) +- SYSTEM::CONTEXT-HASH)) ++ (COMMON-LISP::VECTOR COMMON-LISP::T)) ++ SYSTEM::CONTEXT-VEC)) + (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::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::T) ++ SYSTEM::PUSH-CONTEXT SYSTEM::GET-CONTEXT)) + (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 +- SLOOP::FIND-IN-ORDERED-LIST SYSTEM::PARSE-BODY +- COMMON-LISP::STABLE-SORT COMMON-LISP::SORT)) ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++ SLOOP::PARSE-LOOP-DO ANSI-LOOP::LOOP-WHEN-IT-VARIABLE ++ SYSTEM::GET-INDEX-NODE SLOOP::LOOP-PEEK ++ ANSI-LOOP::LOOP-POP-SOURCE SYSTEM::STEP-READ-LINE ++ SYSTEM::SET-UP-TOP-LEVEL SLOOP::LOOP-POP SYSTEM::SET-ENV ++ SYSTEM::DBL COMMON-LISP::TYPE-ERROR SYSTEM::INSPECT-INDENT ++ SLOOP::PARSE-LOOP-COLLECT SYSTEM::CLEANUP ++ SYSTEM::DEFAULT-SYSTEM-BANNER ++ SYSTEM::CURRENT-DIRECTORY-PATHNAME ANSI-LOOP::LOOP-DO-WITH ++ SYSTEM::INIT-BREAK-POINTS SYSTEM::TEST-ERROR ++ SYSTEM::GET-SIG-FN-NAME SLOOP::PARSE-ONE-WHEN-CLAUSE ++ ANSI-LOOP::LOOP-DO-DO SYSTEM::READ-EVALUATED-FORM ++ SYSTEM::INSPECT-INDENT-1 ANSI-LOOP::LOOP-DO-NAMED ++ SLOOP::PARSE-LOOP-FOR SYSTEM::ALL-TRACE-DECLARATIONS ++ ANSI-LOOP::LOOP-GET-FORM ANSI-LOOP::LOOP-BIND-BLOCK ++ SLOOP::PARSE-LOOP-WHEN SYSTEM::TOP-LEVEL ++ SYSTEM::DM-TOO-FEW-ARGUMENTS SYSTEM::KCL-TOP-RESTARTS ++ SYSTEM::DEFAULT-INFO-HOTLIST SYSTEM::SHOW-RESTARTS ++ SYSTEM::DM-TOO-MANY-ARGUMENTS SYSTEM::SETUP-LINEINFO ++ SYSTEM::GET-TEMP-DIR ANSI-LOOP::LOOP-ITERATION-DRIVER ++ SLOOP::PARSE-LOOP1 SLOOP::LOOP-UN-POP ++ ANSI-LOOP::LOOP-DO-FINALLY SYSTEM::INSPECT-READ-LINE ++ ANSI-LOOP::LOOP-CONTEXT SYSTEM::SET-CURRENT ++ ANSI-LOOP::LOOP-DO-REPEAT SYSTEM::ILLEGAL-BOA ++ COMMON-LISP::LISP-IMPLEMENTATION-VERSION ++ ANSI-LOOP::LOOP-DO-RETURN ANSI-LOOP::LOOP-DO-INITIALLY ++ ANSI-LOOP::LOOP-GET-PROGN)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::*) +- SYSTEM::SHARP-+-READER SYSTEM::SHARP---READER +- SYSTEM::SHARP-S-READER ANSI-LOOP::LOOP-GET-COLLECTION-INFO +- SYSTEM::VERIFY-KEYWORDS SYSTEM::LIST-MERGE-SORT +- SYSTEM::RESTART-PRINT SYSTEM::READ-INSPECT-COMMAND)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ COMMON-LISP::HASH-TABLE) ++ SYSTEM::CONTEXT-SPICE)) + (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::FUNCTION (COMMON-LISP::T) ++ (COMMON-LISP::OR COMMON-LISP::NULL ++ COMMON-LISP::HASH-TABLE)) ++ SYSTEM::CONTEXT-HASH)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) +- COMMON-LISP::*) +- SYSTEM::EXPAND-WILD-DIRECTORY SYSTEM::MASET)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++ ANSI-LOOP::DUPLICATABLE-CODE-P SYSTEM::RELATIVE-LINE ++ SYSTEM::LENEL SYSTEM::GET-NODE-INDEX SYSTEM::FASLINK ++ SYSTEM::THE-END)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T) +- COMMON-LISP::*) +- SYSTEM::MME3)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ SLOOP::IN-PACKAGE-SLOOP-MAP SLOOP::DESETQ1 ++ COMMON-LISP::LOGANDC2 ANSI-LOOP::MAKE-LOOP-MINIMAX ++ COMMON-LISP::WRITE-BYTE SYSTEM::MATCH-DIMENSIONS ++ SLOOP::IN-CAREFULLY-SLOOP-FOR SLOOP::SUM-SLOOP-COLLECT ++ SYSTEM::DOT-DIR-P SLOOP::IN-FRINGE-SLOOP-MAP ++ SLOOP::COLLATE-SLOOP-COLLECT ANSI-LOOP::LOOP-TMEMBER ++ FPE::READ-OPERANDS SYSTEM::IN-INTERVAL-P SYSTEM::SUBSTRINGP ++ FPE::PAREN-READER ANSI-LOOP::HIDE-VARIABLE-REFERENCES ++ SYSTEM::QUOTATION-READER SYSTEM::ALL-MATCHES SYSTEM::GET-MATCH ++ SYSTEM::ADD-FILE ANSI-LOOP::LOOP-DO-ALWAYS SLOOP::THE-TYPE ++ SYSTEM::?PUSH SYSTEM::INCREMENT-CURSOR ++ SYSTEM::CHECK-SEQ-START-END SLOOP::MAKE-VALUE ++ SLOOP::THEREIS-SLOOP-COLLECT ANSI-LOOP::LOOP-DO-WHILE ++ COMMON-LISP::COERCE ANSI-LOOP::LOOP-TEQUAL ++ ANSI-LOOP::LOOP-DECLARE-VARIABLE COMMON-LISP::LOGNAND ++ COMMON-LISP::LOGORC1 SYSTEM::BREAK-STEP-NEXT ++ SLOOP::LOGXOR-SLOOP-COLLECT COMMON-LISP::LOGNOR ++ COMPILER::COMPILER-DEF-HOOK ANSI-LOOP::LOOP-TASSOC ++ SYSTEM::GET-LINE-OF-FORM SLOOP::MAXIMIZE-SLOOP-COLLECT ++ ANSI-LOOP::LOOP-DO-IF SYSTEM::SETF-EXPAND SYSTEM::DM-V ++ SYSTEM::ITERATE-OVER-BKPTS COMMON-LISP::NTHCDR ++ SYSTEM::CONDITION-PASS SYSTEM::DISPLAY-COMPILED-ENV ++ COMMON-LISP::LDB-TEST ANSI-LOOP::LOOP-MAYBE-BIND-FORM ++ SYSTEM::SUPER-GO SYSTEM::SETF-LOGICAL-PATHNAME-TRANSLATIONS ++ FPE::RF SYSTEM::SUB-INTERVAL-P SYSTEM::LEFT-PARENTHESIS-READER ++ COMMON-LISP::FILE-STRING-LENGTH SYSTEM::OBJLT SYSTEM::MSUB ++ SYSTEM::COERCE-TO-STRING SYSTEM::SAFE-EVAL ++ SYSTEM::SET-PATH-STREAM-NAME SYSTEM::SET-BACK ++ ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION COMMON-LISP::LOGTEST ++ SYSTEM::*BREAK-POINTS* SLOOP::=-SLOOP-FOR ++ SLOOP::MINIMIZE-SLOOP-COLLECT SYSTEM::KEYWORD-SUPPLIED-P ++ SLOOP::COUNT-SLOOP-COLLECT FPE::%-READER COMMON-LISP::LOGORC2 ++ SYSTEM::SEQUENCE-CURSOR SYSTEM::LOOKUP-KEYWORD ++ COMMON-LISP::BYTE SYSTEM::PARSE-SLOT-DESCRIPTION ++ COMMON-LISP::LOGANDC1 SYSTEM::DM-NTH-CDR FPE::0-READER ++ SLOOP::L-EQUAL SYSTEM::LIST-DELQ SYSTEM::DM-NTH ++ COMMON-LISP::LDB SYSTEM::SETF-HELPER ++ SLOOP::NEVER-SLOOP-COLLECT SLOOP::PARSE-LOOP-MAP ++ COMMON-LISP::NTH SYSTEM::BREAK-STEP-INTO ++ SYSTEM::GET-INFO-CHOICES SLOOP::IN-TABLE-SLOOP-MAP ++ SYSTEM::GET-NODES COMMON-LISP::VECTOR-PUSH ++ COMMON-LISP::PATHNAME-MATCH-P SYSTEM::DBL-UP ++ ANSI-LOOP::LOOP-LOOKUP-KEYWORD FPE::READ-INSTRUCTION ++ SLOOP::ALWAYS-SLOOP-COLLECT SYSTEM::SET-DIR SYSTEM::INFO-AUX ++ SYSTEM::DISPLAY-ENV COMMON-LISP::DOCUMENTATION ++ SYSTEM::OVERWRITE-SLOT-DESCRIPTIONS)) + (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::FUNCTION (COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::*) +- SYSTEM::PUSH-OPTIONAL-BINDING)) +-(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::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807) +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807) +- COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::T) +- SYSTEM::QUICK-SORT)) ++ COMMON-LISP::APROPOS ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE ++ COMMON-LISP::FFLOOR SYSTEM::PRINT-DOC SYSTEM::INFO ++ SYSTEM::PARSE-BODY-HEADER COMMON-LISP::INVOKE-RESTART ++ SYSTEM::BREAK-FUNCTION SYSTEM::SHOW-INFO COMMON-LISP::FROUND ++ COMMON-LISP::GET-SETF-EXPANSION COMMON-LISP::PARSE-NAMESTRING ++ SYSTEM::APROPOS-DOC COMMON-LISP::ENSURE-DIRECTORIES-EXIST ++ COMMON-LISP::USE-VALUE COMMON-LISP::READ-FROM-STRING ++ COMMON-LISP::FTRUNCATE COMMON-LISP::STORE-VALUE ++ SYSTEM::STEPPER SYSTEM::GET-SETF-METHOD-MULTIPLE-VALUE ++ COMMON-LISP::APROPOS-LIST COMMON-LISP::FCEILING ++ COMMON-LISP::WRITE-TO-STRING ++ COMMON-LISP::DECODE-UNIVERSAL-TIME)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807) +- COMMON-LISP::T COMMON-LISP::T) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- SYSTEM::BIGNTHCDR)) ++ SYSTEM::SETF-EXPAND-1 SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS ++ SYSTEM::WARN-VERSION ANSI-LOOP::LOOP-TRANSLATE ++ ANSI-LOOP::LOOP-FOR-IN ANSI-LOOP::PRINT-LOOP-UNIVERSE ++ ANSI-LOOP::LOOP-STANDARD-EXPANSION ++ ANSI-LOOP::LOOP-ANSI-FOR-EQUALS SYSTEM::DM-VL ++ SYSTEM::SHARP-A-READER COMMON-LISP::DEPOSIT-FIELD ++ SYSTEM::RESTART-CASE-EXPRESSION-CONDITION ++ SYSTEM::APPLY-DISPLAY-FUN ANSI-LOOP::HIDE-VARIABLE-REFERENCE ++ SYSTEM::FLOATING-POINT-ERROR SYSTEM::GET-SLOT-POS ++ ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE ++ SYSTEM::MAKE-BREAK-POINT SYSTEM::SHARP-V-READER ++ SYSTEM::TO-REGEXP-OR-NAMESTRING ANSI-LOOP::LOOP-FOR-ON ++ SYSTEM::SHARP-U-READER ANSI-LOOP::LOOP-SUM-COLLECTION ++ SYSTEM::SHARP-P-READER SYSTEM::MAKE-T-TYPE ++ ANSI-LOOP::LOOP-FOR-ACROSS SYSTEM::MFR SYSTEM::RECURSE-DIR ++ SYSTEM::PATHNAME-PARSE ANSI-LOOP::LOOP-FOR-BEING ++ COMMON-LISP::DPB SYSTEM::SHARP-DQ-READER ++ SYSTEM::CHECK-TRACE-ARGS SYSTEM::DEFMACRO* ++ SYSTEM::CHECK-S-DATA FPE::REF)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- COMMON-LISP::EVERY COMMON-LISP::SET-DIFFERENCE +- SYSTEM::VECTOR-PUSH-STRING SYSTEM::PROCESS-ERROR +- COMMON-LISP::POSITION-IF-NOT COMMON-LISP::FIND-IF +- SLOOP::LOOP-ADD-BINDING COMMON-LISP::BIT-ORC1 +- COMMON-LISP::READ-SEQUENCE SYSTEM::INTERNAL-COUNT-IF +- COMMON-LISP::COUNT COMMON-LISP::MISMATCH +- COMMON-LISP::ADJUST-ARRAY COMMON-LISP::INTERSECTION +- COMMON-LISP::UNION COMMON-LISP::DELETE-IF-NOT +- COMMON-LISP::NINTERSECTION COMMON-LISP::BIT-ANDC1 +- COMMON-LISP::REMOVE-IF-NOT COMMON-LISP::TYPEP +- COMMON-LISP::NUNION COMMON-LISP::WRITE-SEQUENCE +- COMMON-LISP::VECTOR-PUSH-EXTEND COMMON-LISP::REMOVE +- COMMON-LISP::BIT-IOR SLOOP::PARSE-LOOP-MACRO +- COMMON-LISP::SEARCH COMMON-LISP::SUBSETP +- COMMON-LISP::SET-EXCLUSIVE-OR SYSTEM::WREADDIR +- COMMON-LISP::POSITION-IF COMMON-LISP::DELETE +- COMMON-LISP::BIT-EQV COMMON-LISP::BIT-ANDC2 +- COMMON-LISP::BIT-AND COMMON-LISP::NSET-EXCLUSIVE-OR +- SLOOP::IN-ARRAY-SLOOP-FOR ANSI-LOOP::LOOP-CHECK-DATA-TYPE +- COMMON-LISP::POSITION COMMON-LISP::MAKE-SEQUENCE +- COMMON-LISP::NOTEVERY COMMON-LISP::MAP-INTO +- COMMON-LISP::REPLACE COMMON-LISP::NSET-DIFFERENCE ++ SYSTEM::FIND-IHS COMMON-LISP::NSET-DIFFERENCE ++ COMMON-LISP::BIT-NAND SYSTEM::BREAK-CALL ++ COMMON-LISP::COUNT-IF-NOT COMMON-LISP::DELETE ++ SYSTEM::INTERNAL-COUNT COMMON-LISP::BIT-ORC1 ++ COMMON-LISP::DELETE-IF COMMON-LISP::BIT-ANDC1 ++ SYSTEM::VECTOR-PUSH-STRING COMMON-LISP::MISMATCH ++ COMMON-LISP::NOTEVERY SYSTEM::PROCESS-ERROR COMMON-LISP::TYPEP ++ COMMON-LISP::BIT-IOR COMMON-LISP::BIT-EQV ++ COMMON-LISP::COUNT-IF COMMON-LISP::REMOVE-IF ++ COMMON-LISP::EVERY COMMON-LISP::POSITION-IF-NOT ++ COMMON-LISP::ADJUST-ARRAY COMMON-LISP::VECTOR-PUSH-EXTEND ++ SYSTEM::INTERNAL-COUNT-IF-NOT COMMON-LISP::COUNT ++ COMMON-LISP::DELETE-IF-NOT COMMON-LISP::NINTERSECTION + COMMON-LISP::FIND-IF-NOT COMMON-LISP::BIT-ORC2 +- COMMON-LISP::DELETE-IF COMMON-LISP::CERROR +- COMMON-LISP::BIT-XOR COMMON-LISP::FIND COMMON-LISP::FILL +- SYSTEM::INTERNAL-COUNT-IF-NOT COMMON-LISP::REMOVE-IF +- COMMON-LISP::BIT-NAND COMMON-LISP::BIT-NOR COMMON-LISP::SOME +- COMMON-LISP::COUNT-IF SYSTEM::BREAK-CALL +- COMMON-LISP::COUNT-IF-NOT SYSTEM::FIND-IHS COMMON-LISP::NOTANY +- SYSTEM::INTERNAL-COUNT)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::T) +- SYSTEM::PATHNAME-PARSE ANSI-LOOP::LOOP-TRANSLATE +- SYSTEM::CHECK-S-DATA SYSTEM::MFR FPE::REF +- ANSI-LOOP::LOOP-STANDARD-EXPANSION ANSI-LOOP::LOOP-FOR-ON +- ANSI-LOOP::LOOP-SUM-COLLECTION SYSTEM::SHARP-DQ-READER +- COMMON-LISP::DPB SYSTEM::CHECK-TRACE-ARGS +- SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS SYSTEM::RECURSE-DIR +- SYSTEM::SHARP-U-READER SYSTEM::FLOATING-POINT-ERROR +- ANSI-LOOP::LOOP-FOR-IN ANSI-LOOP::HIDE-VARIABLE-REFERENCE +- SYSTEM::GET-SLOT-POS SYSTEM::APPLY-DISPLAY-FUN +- SYSTEM::RESTART-CASE-EXPRESSION-CONDITION +- SYSTEM::MAKE-BREAK-POINT SYSTEM::TO-REGEXP-OR-NAMESTRING +- COMMON-LISP::DEPOSIT-FIELD SYSTEM::SHARP-V-READER +- SYSTEM::MAKE-T-TYPE ANSI-LOOP::LOOP-FOR-ACROSS +- ANSI-LOOP::LOOP-ANSI-FOR-EQUALS ANSI-LOOP::PRINT-LOOP-UNIVERSE +- ANSI-LOOP::LOOP-FOR-BEING SYSTEM::SHARP-P-READER SYSTEM::DM-VL +- SYSTEM::SHARP-A-READER ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE +- SYSTEM::DEFMACRO* SYSTEM::SETF-EXPAND-1 SYSTEM::WARN-VERSION)) ++ COMMON-LISP::SUBSETP COMMON-LISP::SOME SYSTEM::WREADDIR ++ COMMON-LISP::SET-DIFFERENCE COMMON-LISP::UNION ++ COMMON-LISP::BIT-XOR SLOOP::PARSE-LOOP-MACRO ++ COMMON-LISP::REPLACE COMMON-LISP::REMOVE ++ SLOOP::LOOP-ADD-BINDING COMMON-LISP::BIT-ANDC2 ++ COMMON-LISP::READ-SEQUENCE COMMON-LISP::CERROR ++ COMMON-LISP::INTERSECTION COMMON-LISP::POSITION-IF ++ ANSI-LOOP::LOOP-CHECK-DATA-TYPE SYSTEM::INTERNAL-COUNT-IF ++ COMMON-LISP::NUNION COMMON-LISP::WRITE-SEQUENCE ++ COMMON-LISP::MAP-INTO COMMON-LISP::MAKE-SEQUENCE ++ COMMON-LISP::SET-EXCLUSIVE-OR SLOOP::IN-ARRAY-SLOOP-FOR ++ COMMON-LISP::FIND-IF COMMON-LISP::SEARCH COMMON-LISP::FILL ++ COMMON-LISP::FIND COMMON-LISP::NOTANY ++ COMMON-LISP::NSET-EXCLUSIVE-OR COMMON-LISP::BIT-NOR ++ COMMON-LISP::REMOVE-IF-NOT COMMON-LISP::POSITION ++ COMMON-LISP::BIT-AND)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) ++ COMMON-LISP::T) + COMMON-LISP::T) +- SYSTEM::MME2 COMMON-LISP::NSUBSTITUTE SYSTEM::MATCH-COMPONENT +- SYSTEM::COMPLETE-PROP SYSTEM::WALK-DIR +- COMMON-LISP::TRANSLATE-PATHNAME ANSI-LOOP::ADD-LOOP-PATH +- SYSTEM::DIR-PARSE ANSI-LOOP::LOOP-MAKE-VARIABLE +- COMMON-LISP::SUBSTITUTE-IF COMMON-LISP::NSUBSTITUTE-IF +- SYSTEM::PUSH-LET-BINDING COMMON-LISP::SUBSTITUTE +- ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH COMMON-LISP::MAP +- COMMON-LISP::SUBSTITUTE-IF-NOT COMMON-LISP::NSUBSTITUTE-IF-NOT +- ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH +- SLOOP::LOOP-DECLARE-BINDING +- ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH +- SYSTEM::CHECK-TYPE-SYMBOL)) ++ SYSTEM::FIND-LINE-IN-FUN ANSI-LOOP::LOOP-FOR-ARITHMETIC ++ SYSTEM::EXPAND-RANGE SYSTEM::MAYBE-BREAK SYSTEM::MINMAX ++ SLOOP::FIRST-USE-SLOOP-FOR SLOOP::FIRST-SLOOP-FOR ++ SYSTEM::SETF-STRUCTURE-ACCESS SYSTEM::DO-BREAK-LEVEL ++ SYSTEM::CALL-TEST SYSTEM::ELEMENT SYSTEM::LOAD-PATHNAME ++ SYSTEM::COERCE-TO-CONDITION SYSTEM::ELSUB)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807)) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- SYSTEM::SHARP-EQ-READER SYSTEM::SHARP-SHARP-READER)) ++ SLOOP::DEF-LOOP-INTERNAL COMMON-LISP::MERGE ++ SYSTEM::PRINT-STACK-FRAME)) + (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) +- SYSTEM::ELSUB SLOOP::FIRST-USE-SLOOP-FOR +- SLOOP::FIRST-SLOOP-FOR SYSTEM::SETF-STRUCTURE-ACCESS +- SYSTEM::FIND-LINE-IN-FUN SYSTEM::COERCE-TO-CONDITION +- ANSI-LOOP::LOOP-FOR-ARITHMETIC SYSTEM::MAYBE-BREAK +- SYSTEM::ELEMENT SYSTEM::DO-BREAK-LEVEL SYSTEM::CALL-TEST)) ++ 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::*) + COMMON-LISP::T) +- ANSI-LOOP::LOOP-SEQUENCER)) ++ ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH ++ SYSTEM::COMPLETE-PROP SYSTEM::CHECK-TYPE-SYMBOL ++ COMMON-LISP::NSUBSTITUTE ++ ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH COMMON-LISP::SUBSTITUTE ++ COMMON-LISP::TRANSLATE-PATHNAME COMMON-LISP::NSUBSTITUTE-IF ++ COMMON-LISP::MAP SLOOP::LOOP-DECLARE-BINDING SYSTEM::WALK-DIR ++ SYSTEM::MATCH-COMPONENT ANSI-LOOP::LOOP-MAKE-VARIABLE ++ ANSI-LOOP::ADD-LOOP-PATH COMMON-LISP::SUBSTITUTE-IF ++ COMMON-LISP::NSUBSTITUTE-IF-NOT SYSTEM::MME2 ++ ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH ++ COMMON-LISP::SUBSTITUTE-IF-NOT SYSTEM::PUSH-LET-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::T COMMON-LISP::T ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) + COMMON-LISP::T) +- SYSTEM::MAKE-CONSTRUCTOR SYSTEM::MAKE-PREDICATE)) ++ 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::T COMMON-LISP::T) + COMMON-LISP::T) +- SYSTEM::PUSH-SUB-LIST-BINDING SYSTEM::DO-ARG-COUNT-ERROR)) ++ SYSTEM::DO-ARG-COUNT-ERROR SYSTEM::PUSH-SUB-LIST-BINDING)) + (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 COMMON-LISP::T) + COMMON-LISP::T) +- SLOOP::DEF-LOOP-INTERNAL COMMON-LISP::MERGE +- SYSTEM::PRINT-STACK-FRAME)) ++ SYSTEM::MAKE-CONSTRUCTOR SYSTEM::MAKE-PREDICATE)) + (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::T COMMON-LISP::T ++ COMMON-LISP::T) + COMMON-LISP::T) +- COMMON-LISP::ENCODE-UNIVERSAL-TIME)) ++ ANSI-LOOP::LOOP-SEQUENCER)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -234,43 +274,50 @@ + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) + SYSTEM::UNIVERSAL-ERROR-HANDLER)) ++(COMMON-LISP::MAPC ++ (COMMON-LISP::LAMBDA (COMPILER::X) ++ (COMMON-LISP::SETF ++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) ++ COMMON-LISP::T)) ++ '(SYSTEM::SI-FIND-CLASS SYSTEM::WARNINGP SYSTEM::SI-CLASS-OF ++ SYSTEM::CONDITION-CLASS-P SYSTEM::UNTRACE-ONE ++ SYSTEM::MAKE-ACCESS-FUNCTION SYSTEM::SIMPLE-CONDITION-CLASS-P ++ SYSTEM::CONDITIONP SYSTEM::AUTOLOAD ++ SYSTEM::SI-CLASS-PRECEDENCE-LIST SYSTEM::SI-CLASSP ++ FPE::BREAK-ON-FLOATING-POINT-EXCEPTIONS SYSTEM::TRACE-ONE ++ SYSTEM::AUTOLOAD-MACRO SYSTEM::DEFINE-STRUCTURE ++ SYSTEM::SI-CLASS-NAME)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::T) +- COMMON-LISP::MERGE-PATHNAMES +- COMMON-LISP::TRANSLATE-LOGICAL-PATHNAME ANSI-LOOP::LOOP-ERROR +- COMMON-LISP::WILD-PATHNAME-P SLOOP::LOOP-ADD-TEMPS +- SYSTEM::FILE-SEARCH SYSTEM::INFO-SEARCH +- COMMON-LISP::PATHNAME-VERSION COMMON-LISP::WARN SYSTEM::MGSUB +- COMMON-LISP::ARRAY-ROW-MAJOR-INDEX +- COMMON-LISP::REMOVE-DUPLICATES COMMON-LISP::PATHNAME-NAME +- COMMON-LISP::BIT COMMON-LISP::FIND-RESTART SYSTEM::TO-REGEXP +- SYSTEM::PROCESS-SOME-ARGS COMMON-LISP::ERROR +- COMMON-LISP::REQUIRE COMMON-LISP::OPEN +- COMMON-LISP::UPGRADED-ARRAY-ELEMENT-TYPE SLOOP::ADD-FROM-DATA +- SYSTEM::BREAK-LEVEL SYSTEM::LIST-MATCHES +- COMMON-LISP::DELETE-DUPLICATES ANSI-LOOP::LOOP-WARN +- COMMON-LISP::PATHNAME-DEVICE COMMON-LISP::LOAD +- COMMON-LISP::PATHNAME-HOST COMMON-LISP::SBIT SYSTEM::NLOAD +- COMMON-LISP::BIT-NOT COMMON-LISP::ENOUGH-NAMESTRING +- COMMON-LISP::SIGNAL COMMON-LISP::ARRAY-IN-BOUNDS-P +- COMMON-LISP::PATHNAME-TYPE SYSTEM::FILE-TO-STRING +- SYSTEM::LOGICAL-PATHNAME-PARSE SYSTEM::NTH-STACK-FRAME +- ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES SYSTEM::MGLIST +- COMMON-LISP::DIRECTORY SYSTEM::BAD-SEQ-LIMIT +- COMMON-LISP::PATHNAME-DIRECTORY COMMON-LISP::READ-BYTE +- SYSTEM::LINK-EXPAND COMMON-LISP::CONCATENATE +- COMMON-LISP::MAKE-ARRAY)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++ SYSTEM::INSTREAM-NAME ANSI-LOOP::LOOP-LIST-STEP ++ COMMON-LISP::PRIN1-TO-STRING ANSI-LOOP::NAMED-VARIABLE ++ SYSTEM::WAITING SYSTEM::FIND-DECLARATIONS COMMON-LISP::INSPECT ++ SYSTEM::END-WAITING SYSTEM::BREAK-GO SYSTEM::INFO-SUBFILE ++ COMMON-LISP::INVOKE-RESTART-INTERACTIVELY ++ ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES SYSTEM::INSPECT-OBJECT ++ SYSTEM::BREAK-LEVEL-INVOKE-RESTART SYSTEM::EXPAND-RANGES ++ SYSTEM::GET-&ENVIRONMENT COMMON-LISP::DESCRIBE ++ COMMON-LISP::PRINC-TO-STRING)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::*) +- SYSTEM::NEWLINE SYSTEM::LIST-TOGGLE-CASE +- COMMON-LISP::RENAME-FILE ANSI-LOOP::ESTIMATE-CODE-SIZE +- SYSTEM::SOURCE-PORTION SYSTEM::RESTART-REPORT SYSTEM::DO-REPL +- SYSTEM::FIND-DOC ANSI-LOOP::ESTIMATE-CODE-SIZE-1 +- SYSTEM::NEW-SEMI-COLON-READER)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++ COMMON-LISP::ABORT ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE ++ SYSTEM::MAKE-S-DATA ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL ++ ANSI-LOOP::MAKE-LOOP-PATH SYSTEM::CURRENT-STEP-FUN SYSTEM::LOC ++ SYSTEM::DBL-READ SYSTEM::MAKE-RESTART ++ SYSTEM::TRANSFORM-KEYWORDS COMMON-LISP::Y-OR-N-P ++ SYSTEM::NEXT-MATCH COMMON-LISP::COMPUTE-RESTARTS ++ SLOOP::PARSE-LOOP-WITH COMMON-LISP::VECTOR SYSTEM::STEP-NEXT ++ ANSI-LOOP::MAKE-LOOP-COLLECTOR ++ COMMON-LISP::USER-HOMEDIR-PATHNAME SLOOP::PARSE-LOOP-DECLARE ++ COMMON-LISP::YES-OR-NO-P SYSTEM::STEP-INTO ++ SYSTEM::MAKE-CONTEXT SYSTEM::BREAK-LOCALS ++ SYSTEM::DESCRIBE-ENVIRONMENT COMMON-LISP::DRIBBLE ++ ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL SYSTEM::MAYBE-CLEAR-INPUT ++ COMMON-LISP::BREAK ANSI-LOOP::LOOP-GENTEMP ++ ANSI-LOOP::MAKE-LOOP-UNIVERSE SYSTEM::MAKE-INSTREAM ++ COMMON-LISP::MAKE-PATHNAME)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -280,74 +327,6 @@ + FPE::FE-ENABLE SYSTEM::DBL-WHAT-FRAME)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::*) +- SYSTEM::INFO SYSTEM::GET-SETF-METHOD-MULTIPLE-VALUE +- COMMON-LISP::FTRUNCATE COMMON-LISP::USE-VALUE +- COMMON-LISP::INVOKE-RESTART COMMON-LISP::WRITE-TO-STRING +- COMMON-LISP::FCEILING COMMON-LISP::FROUND +- COMMON-LISP::READ-FROM-STRING COMMON-LISP::FFLOOR +- SYSTEM::PARSE-BODY-HEADER SYSTEM::BREAK-FUNCTION +- SYSTEM::APROPOS-DOC COMMON-LISP::APROPOS +- COMMON-LISP::APROPOS-LIST +- ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE +- COMMON-LISP::GET-SETF-EXPANSION SYSTEM::PRINT-DOC +- COMMON-LISP::PARSE-NAMESTRING +- COMMON-LISP::ENSURE-DIRECTORIES-EXIST +- COMMON-LISP::DECODE-UNIVERSAL-TIME SYSTEM::SHOW-INFO +- COMMON-LISP::STORE-VALUE SYSTEM::STEPPER)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::T) +- COMMON-LISP::VECTOR-PUSH SYSTEM::DM-NTH COMMON-LISP::LOGORC1 +- SLOOP::L-EQUAL SLOOP::NEVER-SLOOP-COLLECT +- COMMON-LISP::LDB-TEST COMMON-LISP::LDB COMMON-LISP::LOGORC2 +- SLOOP::COUNT-SLOOP-COLLECT SLOOP::MAXIMIZE-SLOOP-COLLECT +- SYSTEM::ALL-MATCHES ANSI-LOOP::LOOP-TMEMBER SLOOP::THE-TYPE +- SYSTEM::?PUSH SYSTEM::INCREMENT-CURSOR SYSTEM::SET-DIR +- SYSTEM::DM-NTH-CDR SYSTEM::IN-INTERVAL-P SLOOP::MAKE-VALUE +- SYSTEM::DBL-UP COMMON-LISP::COERCE SYSTEM::MATCH-DIMENSIONS +- COMMON-LISP::LOGNAND SLOOP::=-SLOOP-FOR +- SYSTEM::KEYWORD-SUPPLIED-P SYSTEM::OVERWRITE-SLOT-DESCRIPTIONS +- SYSTEM::LEFT-PARENTHESIS-READER +- ANSI-LOOP::LOOP-MAYBE-BIND-FORM SYSTEM::COERCE-TO-STRING +- SYSTEM::ADD-FILE SLOOP::PARSE-LOOP-MAP COMMON-LISP::LOGNOR +- SYSTEM::MSUB SYSTEM::SET-BACK SYSTEM::SUPER-GO +- SYSTEM::SUBSTRINGP ANSI-LOOP::LOOP-TEQUAL +- ANSI-LOOP::LOOP-DO-WHILE SYSTEM::GET-LINE-OF-FORM +- FPE::READ-INSTRUCTION SYSTEM::SUB-INTERVAL-P +- SYSTEM::CHECK-SEQ-START-END SYSTEM::*BREAK-POINTS* +- ANSI-LOOP::MAKE-LOOP-MINIMAX SLOOP::IN-PACKAGE-SLOOP-MAP +- SYSTEM::DM-V SYSTEM::INFO-AUX +- ANSI-LOOP::HIDE-VARIABLE-REFERENCES +- SLOOP::COLLATE-SLOOP-COLLECT COMMON-LISP::PATHNAME-MATCH-P +- SYSTEM::SET-PATH-STREAM-NAME SLOOP::SUM-SLOOP-COLLECT +- ANSI-LOOP::LOOP-LOOKUP-KEYWORD +- ANSI-LOOP::LOOP-DECLARE-VARIABLE SYSTEM::BREAK-STEP-NEXT +- FPE::RF SLOOP::IN-TABLE-SLOOP-MAP SYSTEM::OBJLT +- FPE::READ-OPERANDS SYSTEM::BREAK-STEP-INTO COMMON-LISP::BYTE +- SYSTEM::SEQUENCE-CURSOR SYSTEM::LIST-DELQ +- SYSTEM::SETF-LOGICAL-PATHNAME-TRANSLATIONS +- SYSTEM::CONDITION-PASS SYSTEM::SETF-HELPER FPE::0-READER +- SYSTEM::DISPLAY-COMPILED-ENV COMMON-LISP::NTH +- COMPILER::COMPILER-DEF-HOOK SYSTEM::DOT-DIR-P +- COMMON-LISP::LOGTEST SYSTEM::QUOTATION-READER +- SYSTEM::ITERATE-OVER-BKPTS COMMON-LISP::LOGANDC1 +- SLOOP::ALWAYS-SLOOP-COLLECT SLOOP::DESETQ1 +- SYSTEM::GET-INFO-CHOICES COMMON-LISP::WRITE-BYTE +- ANSI-LOOP::LOOP-DO-IF ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION +- ANSI-LOOP::LOOP-TASSOC SLOOP::IN-CAREFULLY-SLOOP-FOR +- COMMON-LISP::DOCUMENTATION FPE::PAREN-READER SYSTEM::GET-NODES +- SYSTEM::PARSE-SLOT-DESCRIPTION SLOOP::IN-FRINGE-SLOOP-MAP +- SYSTEM::SAFE-EVAL SYSTEM::DISPLAY-ENV FPE::%-READER +- SLOOP::THEREIS-SLOOP-COLLECT SYSTEM::LOOKUP-KEYWORD +- COMMON-LISP::LOGANDC2 COMMON-LISP::NTHCDR +- SLOOP::MINIMIZE-SLOOP-COLLECT SYSTEM::GET-MATCH +- SYSTEM::SETF-EXPAND SLOOP::LOGXOR-SLOOP-COLLECT +- ANSI-LOOP::LOOP-DO-ALWAYS)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + ((COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807) +@@ -357,263 +336,300 @@ + SYSTEM::ROUND-UP)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +- COMMON-LISP::Y-OR-N-P COMMON-LISP::YES-OR-NO-P +- COMMON-LISP::DRIBBLE COMMON-LISP::VECTOR SYSTEM::NEXT-MATCH +- SYSTEM::MAKE-S-DATA SYSTEM::LOC SYSTEM::BREAK-LOCALS +- SLOOP::PARSE-LOOP-WITH COMMON-LISP::USER-HOMEDIR-PATHNAME +- SYSTEM::STEP-INTO SYSTEM::MAYBE-CLEAR-INPUT +- ANSI-LOOP::MAKE-LOOP-PATH SYSTEM::STEP-NEXT +- ANSI-LOOP::LOOP-GENTEMP COMMON-LISP::COMPUTE-RESTARTS +- SYSTEM::CURRENT-STEP-FUN SYSTEM::MAKE-INSTREAM +- ANSI-LOOP::MAKE-LOOP-COLLECTOR SYSTEM::MAKE-RESTART +- SYSTEM::DESCRIBE-ENVIRONMENT SYSTEM::TRANSFORM-KEYWORDS +- COMMON-LISP::ABORT ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE +- ANSI-LOOP::MAKE-LOOP-UNIVERSE SLOOP::PARSE-LOOP-DECLARE +- COMMON-LISP::BREAK ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL +- SYSTEM::MAKE-CONTEXT SYSTEM::DBL-READ +- COMMON-LISP::MAKE-PATHNAME +- ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) +- ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES SYSTEM::BREAK-GO +- COMMON-LISP::FILE-AUTHOR SYSTEM::ENSURE-DIR-STRING +- SYSTEM::INFO-SUBFILE COMMON-LISP::DESCRIBE SYSTEM::END-WAITING +- COMMON-LISP::PRIN1-TO-STRING SYSTEM::FIND-DECLARATIONS +- COMMON-LISP::INSPECT ANSI-LOOP::NAMED-VARIABLE +- SYSTEM::GET-&ENVIRONMENT SYSTEM::INSPECT-OBJECT +- COMMON-LISP::PRINC-TO-STRING ANSI-LOOP::LOOP-LIST-STEP +- SYSTEM::INSTREAM-NAME SYSTEM::BREAK-LEVEL-INVOKE-RESTART +- SYSTEM::WAITING COMMON-LISP::INVOKE-RESTART-INTERACTIVELY)) ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++ COMMON-LISP::*) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::FIXNUM) ++ SYSTEM::ATOI)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +- SYSTEM::IHS-NOT-INTERPRETED-ENV COMMON-LISP::NINTH +- SYSTEM::FIND-KCL-TOP-RESTART COMMON-LISP::TRUENAME +- SYSTEM::DIRECTORY-LIST-CHECK SYSTEM::REAL-ASINH +- SYSTEM::SHOW-ENVIRONMENT SYSTEM::PRINT-FRS +- SYSTEM::REWRITE-RESTART-CASE-CLAUSE +- COMMON-LISP::TWO-WAY-STREAM-OUTPUT-STREAM +- ANSI-LOOP::LOOP-COLLECTOR-DATA SLOOP::POINTER-FOR-COLLECT +- SYSTEM::MLP SYSTEM::WILD-PATH-ELEMENT-P SYSTEM::LNP +- ANSI-LOOP::LOOP-MINIMAX-OPERATIONS SYSTEM::FRS-KIND +- SYSTEM::BKPT-FILE COMMON-LISP::FIFTH +- ANSI-LOOP::LOOP-COLLECTOR-P ANSI-LOOP::LOOP-UNIVERSE-ANSI +- ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS SYSTEM::IDESCRIBE +- ANSI-LOOP::LOOP-CONSTANTP +- ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS COMMON-LISP::PROBE-FILE +- ANSI-LOOP::LOOP-UNIVERSE-P COMMON-LISP::SINH SYSTEM::RESTART-P +- SYSTEM::S-DATA-DOCUMENTATION ++ SYSTEM::REGEXP-CONV SYSTEM::DIR-CONJ SYSTEM::DIR-P ++ ANSI-LOOP::LOOP-LIST-COLLECTION COMMON-LISP::COSH ++ SYSTEM::GET-BYTE-STREAM-NCHARS SYSTEM::INSPECT-CONS ++ SYSTEM::KNOWN-TYPE-P SYSTEM::LNP COMMON-LISP::SEVENTH ++ SYSTEM::BKPT-FUNCTION SYSTEM::WILD-DIR-ELEMENT-P ++ COMMON-LISP::COMPILER-MACRO-FUNCTION ++ ANSI-LOOP::LOOP-HACK-ITERATION + COMMON-LISP::ECHO-STREAM-OUTPUT-STREAM +- SYSTEM::FIND-DOCUMENTATION SYSTEM::INFO-GET-FILE +- SLOOP::PARSE-NO-BODY COMMON-LISP::FILE-NAMESTRING +- COMMON-LISP::COMPILER-MACRO-FUNCTION SYSTEM::PROCESS-ARGS +- ANSI-LOOP::LOOP-COLLECTOR-DTYPE COMMON-LISP::PHASE +- SYSTEM::MAKE-FRAME SYSTEM::INSTREAM-STREAM +- ANSI-LOOP::LOOP-COLLECTOR-HISTORY SYSTEM::FIX-LOAD-PATH +- SYSTEM::COMPUTING-ARGS-P +- ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE COMMON-LISP::TENTH +- ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE SYSTEM::WILD-NAMESTRING-P +- SYSTEM::BEST-ARRAY-ELEMENT-TYPE SYSTEM::DM-BAD-KEY +- SYSTEM::TERMINAL-INTERRUPT SYSTEM::REGEXP-CONV +- COMMON-LISP::FILE-WRITE-DATE SLOOP::PARSE-LOOP +- ANSI-LOOP::LOOP-CONSTRUCT-RETURN SYSTEM::DWIM ++ SYSTEM::DIRECTORY-LIST-CHECK COMMON-LISP::FILE-WRITE-DATE ++ SYSTEM::NORMALIZE-TYPE COMMON-LISP::EIGHTH SYSTEM::TOGGLE-CASE ++ SYSTEM::SHOW-ENVIRONMENT ++ COMMON-LISP::TWO-WAY-STREAM-INPUT-STREAM SYSTEM::GET-PATH ++ COMMON-LISP::ASINH SYSTEM::FIND-KCL-TOP-RESTART ++ SYSTEM::RESTART-P SYSTEM::EVAL-FEATURE SYSTEM::ALOAD ++ COMMON-LISP::PHASE SLOOP::SUBSTITUTE-SLOOP-BODY ++ COMMON-LISP::ASIN SYSTEM::NODES-FROM-INDEX ++ SYSTEM::MAKE-DEFPACKAGE-FORM ANSI-LOOP::LOOP-COLLECTOR-DTYPE ++ SYSTEM::LOGICAL-PATHNAMEP SYSTEM::INSPECT-VECTOR + ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS +- SLOOP::RETURN-SLOOP-MACRO SLOOP::AVERAGING-SLOOP-MACRO +- SYSTEM::S-DATA-NAME SYSTEM::CHECK-TRACE-SPEC +- SYSTEM::RESTRICT-STREAM-ELEMENT-TYPE SLOOP::TRANSLATE-NAME +- SYSTEM::ADD-TO-HOTLIST SYSTEM::S-DATA-CONC-NAME +- ANSI-LOOP::LOOP-MINIMAX-TYPE SYSTEM::PRINT-IHS +- SYSTEM::DBL-RPL-LOOP SYSTEM::CANONICALIZE-PATHNAME-DIRECTORY +- SYSTEM::INSPECT-CONS SYSTEM::INSTREAM-STREAM-NAME +- SYSTEM::S-DATA-P SYSTEM::EVAL-FEATURE +- COMMON-LISP::ARRAY-DIMENSIONS SYSTEM::IHS-VISIBLE +- ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE +- SYSTEM::CHECK-DECLARATIONS COMMON-LISP::TANH +- ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS +- COMMON-LISP::COMPILE-FILE-PATHNAME SYSTEM::INSPECT-PACKAGE +- SLOOP::LOOP-LET-BINDINGS COMMON-LISP::CIS SYSTEM::SETUP-INFO +- SYSTEM::NORMALIZE-TYPE ANSI-LOOP::LOOP-PSEUDO-BODY +- SYSTEM::PATH-STREAM-NAME SYSTEM::INFO-GET-TAGS FPE::ST-LOOKUP +- SYSTEM::BREAK-BACKWARD-SEARCH-STACK +- ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE SYSTEM::SIMPLE-ARRAY-P +- SYSTEM::S-DATA-TYPE COMMON-LISP::CONCATENATED-STREAM-STREAMS +- SYSTEM::INSPECT-CHARACTER ANSI-LOOP::DESTRUCTURING-SIZE +- SYSTEM::GET-BYTE-STREAM-NCHARS ANSI-LOOP::LOOP-PATH-P +- COMMON-LISP::FIRST COMMON-LISP::SECOND +- COMMON-LISP::TWO-WAY-STREAM-INPUT-STREAM +- SYSTEM::MAKE-DEFPACKAGE-FORM SYSTEM::INSPECT-SYMBOL +- SYSTEM::INSPECT-VECTOR +- COMMON-LISP::LOAD-LOGICAL-PATHNAME-TRANSLATIONS +- SYSTEM::RESTART-INTERACTIVE-FUNCTION SYSTEM::INSPECT-STRING +- SYSTEM::DIR-P ANSI-LOOP::LOOP-COLLECTOR-CLASS +- SYSTEM::S-DATA-CONSTRUCTORS SYSTEM::NODES-FROM-INDEX +- SYSTEM::VERSION-PARSE SYSTEM::BKPT-FILE-LINE COMMON-LISP::ABS +- SYSTEM::IHS-FNAME ANSI-LOOP::LOOP-MAKE-PSETQ +- SYSTEM::LEAP-YEAR-P ANSI-LOOP::LOOP-EMIT-FINAL-VALUE +- SYSTEM::GET-PATH SYSTEM::ALOAD SYSTEM::DM-KEY-NOT-ALLOWED +- SYSTEM::MAKE-KCL-TOP-RESTART SYSTEM::S-DATA-SLOT-DESCRIPTIONS +- COMMON-LISP::VECTOR-POP ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS +- ANSI-LOOP::LOOP-PATH-USER-DATA SYSTEM::S-DATA-SLOT-POSITION +- COMMON-LISP::BROADCAST-STREAM-STREAMS +- SYSTEM::LOGICAL-PATHNAMEP SYSTEM::BREAK-FORWARD-SEARCH-STACK +- SLOOP::SLOOP-SLOOP-MACRO COMMON-LISP::SIGNUM +- SYSTEM::RESET-TRACE-DECLARATIONS SYSTEM::CONTEXT-P +- SYSTEM::S-DATA-FROZEN SYSTEM::NUMBER-OF-DAYS-FROM-1900 +- SYSTEM::S-DATA-STATICP ANSI-LOOP::LOOP-PATH-FUNCTION +- SYSTEM::KNOWN-TYPE-P COMMON-LISP::PROVIDE SYSTEM::PNL1 +- ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD +- SYSTEM::COERCE-SLASH-TERMINATED COMMON-LISP::LOGICAL-PATHNAME +- SYSTEM::DIR-CONJ SYSTEM::BKPT-FORM +- SYSTEM::LOGICAL-PATHNAME-HOST-P SYSTEM::INSPECT-STRUCTURE +- ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED +- COMMON-LISP::FIND-ALL-SYMBOLS ++ SYSTEM::RESTART-REPORT-FUNCTION SYSTEM::IHS-VISIBLE ++ SLOOP::LOOP-COLLECT-KEYWORD-P ANSI-LOOP::LOOP-TYPED-INIT ++ COMMON-LISP::VECTOR-POP SYSTEM::UNIQUE-ID + ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS +- ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED ++ SYSTEM::SIMPLE-ARRAY-P COMMON-LISP::ACOS SYSTEM::DBL-EVAL ++ SYSTEM::INSPECT-STRING SYSTEM::MLP ++ SYSTEM::INSTREAM-STREAM-NAME SYSTEM::WILD-NAMESTRING-P ++ ANSI-LOOP::LOOP-PATH-FUNCTION ++ SYSTEM::GET-STRING-INPUT-STREAM-INDEX ++ ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE SYSTEM::SEQTYPE ++ ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS ++ SYSTEM::BEST-ARRAY-ELEMENT-TYPE ++ ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA SYSTEM::S-DATA-FROZEN ++ SYSTEM::S-DATA-DOCUMENTATION SYSTEM::DWIM COMMON-LISP::SIGNUM ++ SYSTEM::FIND-DOCUMENTATION ANSI-LOOP::LOOP-COLLECTOR-HISTORY ++ ANSI-LOOP::LOOP-MAKE-PSETQ FPE::GREF SYSTEM::S-DATA-OFFSET ++ SYSTEM::WILD-PATH-ELEMENT-P SYSTEM::INSTREAM-P ++ COMMON-LISP::DIRECTORY-NAMESTRING SYSTEM::INSPECT-ARRAY ++ COMMON-LISP::ARRAY-DIMENSIONS ++ ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS ANSI-LOOP::LOOP-MINIMAX-P ++ SLOOP::RETURN-SLOOP-MACRO SYSTEM::WALK-THROUGH ++ SYSTEM::NEXT-STACK-FRAME SYSTEM::S-DATA-NAME COMMON-LISP::TANH ++ SYSTEM::BREAK-BACKWARD-SEARCH-STACK COMMON-LISP::TENTH ++ SYSTEM::INFO-NODE-FROM-POSITION FPE::ST-LOOKUP ++ COMMON-LISP::RESTART-NAME SYSTEM::S-DATA-TYPE ++ SYSTEM::BKPT-FILE-LINE COMMON-LISP::FIND-ALL-SYMBOLS ++ COMMON-LISP::FIFTH SLOOP::LOOP-LET-BINDINGS ++ COMMON-LISP::ECHO-STREAM-INPUT-STREAM ++ ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED ++ COMMON-LISP::PROBE-FILE SYSTEM::MAKE-FRAME ++ SYSTEM::IHS-NOT-INTERPRETED-ENV SYSTEM::SEARCH-STACK ++ COMMON-LISP::COMPILE-FILE-PATHNAME ++ SYSTEM::PRINT-SYMBOL-APROPOS COMMON-LISP::LOGNOT ++ SYSTEM::INFO-GET-TAGS SYSTEM::SHORT-NAME ++ ANSI-LOOP::LOOP-MINIMAX-TYPE COMMON-LISP::SIXTH ++ COMMON-LISP::SECOND ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS ++ COMMON-LISP::TWO-WAY-STREAM-OUTPUT-STREAM ++ SYSTEM::S-DATA-INCLUDES SYSTEM::RESTART-INTERACTIVE-FUNCTION ++ SLOOP::TRANSLATE-NAME SYSTEM::PATCH-SHARP COMMON-LISP::ABS ++ ANSI-LOOP::LOOP-CONSTANTP SYSTEM::LEAP-YEAR-P ++ ANSI-LOOP::LOOP-UNIVERSE-ANSI ANSI-LOOP::LOOP-EMIT-BODY ++ COMMON-LISP::HOST-NAMESTRING COMMON-LISP::FIRST ++ SYSTEM::INSERT-BREAK-POINT ++ COMMON-LISP::LOAD-LOGICAL-PATHNAME-TRANSLATIONS ++ COMMON-LISP::DELETE-FILE ANSI-LOOP::LOOP-PSEUDO-BODY ++ SYSTEM::GET-NEXT-VISIBLE-FUN SYSTEM::S-DATA-HAS-HOLES ++ ANSI-LOOP::LOOP-COLLECTOR-NAME COMMON-LISP::FOURTH ++ SYSTEM::BKPT-FILE SYSTEM::CANONICALIZE-PATHNAME-DIRECTORY ++ SYSTEM::INSTREAM-STREAM SYSTEM::PNL1 SYSTEM::IHS-FNAME ++ SYSTEM::S-DATA-SLOT-POSITION SLOOP::PARSE-LOOP ++ SYSTEM::CHECK-TRACE-SPEC SYSTEM::S-DATA-CONSTRUCTORS ++ SYSTEM::S-DATA-STATICP SYSTEM::CONTEXT-P + COMMON-LISP::LOGICAL-PATHNAME-TRANSLATIONS +- SYSTEM::TRACE-ONE-PREPROCESS COMMON-LISP::CONSTANTLY +- COMMON-LISP::ACOS SYSTEM::S-DATA-OFFSET COMMON-LISP::ASINH +- SYSTEM::SHORT-NAME SYSTEM::S-DATA-INCLUDED SYSTEM::DBL-EVAL +- SYSTEM::BKPT-FUNCTION SYSTEM::INSPECT-NUMBER +- SYSTEM::GET-INSTREAM SYSTEM::SHOW-BREAK-POINT FPE::LOOKUP +- SYSTEM::NEXT-STACK-FRAME SYSTEM::INSPECT-ARRAY +- SYSTEM::S-DATA-RAW ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA +- SYSTEM::RESTART-REPORT-FUNCTION SYSTEM::TOGGLE-CASE +- SYSTEM::NODE-OFFSET SYSTEM::INSTREAM-P +- ANSI-LOOP::LOOP-PATH-NAMES SYSTEM::FREEZE-DEFSTRUCT +- COMMON-LISP::SEVENTH SYSTEM::SEARCH-STACK COMMON-LISP::SIXTH +- ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS FPE::GREF +- FPE::XMM-LOOKUP COMMON-LISP::HOST-NAMESTRING +- ANSI-LOOP::LOOP-TYPED-INIT ++ SYSTEM::INFO-GET-FILE COMMON-LISP::COMPLEMENT ++ SYSTEM::INSPECT-NUMBER SYSTEM::RESET-TRACE-DECLARATIONS ++ ANSI-LOOP::LOOP-PATH-P SLOOP::REPEAT-SLOOP-MACRO SYSTEM::DO-F ++ SYSTEM::INSPECT-PACKAGE SYSTEM::PATH-STREAM-NAME ++ SYSTEM::GET-INSTREAM COMMON-LISP::BYTE-SIZE ++ SYSTEM::RESTART-FUNCTION FPE::LOOKUP SYSTEM::S-DATA-CONC-NAME ++ COMMON-LISP::PROVIDE SYSTEM::S-DATA-NAMED SYSTEM::PRINT-FRS ++ ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE SYSTEM::NODE-OFFSET ++ ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE SYSTEM::PRINT-IHS ++ ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS COMMON-LISP::TRUENAME ++ SYSTEM::BREAK-FORWARD-SEARCH-STACK ++ COMMON-LISP::CONCATENATED-STREAM-STREAMS SYSTEM::VERSION-PARSE ++ SYSTEM::INSPECT-CHARACTER SYSTEM::LOGICAL-PATHNAME-HOST-P ++ SYSTEM::DM-BAD-KEY SYSTEM::EXPAND-HOME-DIR ++ ANSI-LOOP::LOOP-PATH-USER-DATA ++ ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS SYSTEM::INSPECT-SYMBOL ++ COMMON-LISP::INVOKE-DEBUGGER + SYSTEM::LOGICAL-PATHNAME-DESIGNATOR-P +- ANSI-LOOP::LOOP-DO-THEREIS COMMON-LISP::EIGHTH +- SYSTEM::UNIQUE-ID COMMON-LISP::THIRD +- COMMON-LISP::BYTE-POSITION COMMON-LISP::SYNONYM-STREAM-SYMBOL +- SYSTEM::PATCH-SHARP SYSTEM::PRINT-SYMBOL-APROPOS +- COMMON-LISP::LOGNOT SLOOP::REPEAT-SLOOP-MACRO +- COMMON-LISP::FOURTH SLOOP::SUBSTITUTE-SLOOP-BODY +- COMMON-LISP::ATANH SLOOP::LOOP-COLLECT-KEYWORD-P +- SYSTEM::SEQTYPE SYSTEM::RE-QUOTE-STRING COMMON-LISP::ISQRT +- SYSTEM::DO-F SYSTEM::S-DATA-HAS-HOLES +- ANSI-LOOP::LOOP-HACK-ITERATION ANSI-LOOP::LOOP-COLLECTOR-NAME +- COMMON-LISP::RESTART-NAME COMMON-LISP::DIRECTORY-NAMESTRING +- ANSI-LOOP::LOOP-EMIT-BODY COMMON-LISP::ACOSH +- SYSTEM::RESTART-FUNCTION SYSTEM::INFO-NODE-FROM-POSITION +- COMMON-LISP::ASIN ANSI-LOOP::LOOP-LIST-COLLECTION +- SYSTEM::S-DATA-INCLUDES SYSTEM::GET-NEXT-VISIBLE-FUN +- COMMON-LISP::BYTE-SIZE COMMON-LISP::PATHNAME +- ANSI-LOOP::LOOP-MINIMAX-P SLOOP::PARSE-LOOP-INITIALLY +- COMMON-LISP::COSH SYSTEM::EXPAND-HOME-DIR +- COMMON-LISP::ECHO-STREAM-INPUT-STREAM +- SYSTEM::INSERT-BREAK-POINT SYSTEM::RESTART-TEST-FUNCTION +- SYSTEM::S-DATA-PRINT-FUNCTION SYSTEM::WILD-DIR-ELEMENT-P +- SYSTEM::S-DATA-NAMED COMMON-LISP::INVOKE-DEBUGGER +- COMMON-LISP::NAMESTRING ANSI-LOOP::LOOP-MAKE-DESETQ +- COMMON-LISP::COMPLEMENT SYSTEM::WALK-THROUGH +- COMMON-LISP::RATIONAL ANSI-LOOP::LOOP-MAXMIN-COLLECTION +- COMMON-LISP::DELETE-FILE ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS)) ++ COMMON-LISP::BYTE-POSITION COMMON-LISP::ISQRT COMMON-LISP::CIS ++ ANSI-LOOP::LOOP-COLLECTOR-CLASS ++ COMMON-LISP::SYNONYM-STREAM-SYMBOL ANSI-LOOP::LOOP-PATH-NAMES ++ SYSTEM::RE-QUOTE-STRING SYSTEM::INSPECT-STRUCTURE ++ COMMON-LISP::RATIONAL FPE::XMM-LOOKUP ++ SYSTEM::REWRITE-RESTART-CASE-CLAUSE ++ SYSTEM::S-DATA-PRINT-FUNCTION ++ SYSTEM::RESTRICT-STREAM-ELEMENT-TYPE SLOOP::SLOOP-SLOOP-MACRO ++ COMMON-LISP::NAMESTRING SYSTEM::ENSURE-DIR-STRING ++ COMMON-LISP::CONSTANTLY SLOOP::PARSE-LOOP-INITIALLY ++ SYSTEM::S-DATA-RAW SYSTEM::ADD-TO-HOTLIST SYSTEM::FRS-KIND ++ ANSI-LOOP::LOOP-MAXMIN-COLLECTION ++ ANSI-LOOP::LOOP-COLLECTOR-DATA SYSTEM::PROCESS-ARGS ++ SYSTEM::COERCE-SLASH-TERMINATED SYSTEM::MAKE-KCL-TOP-RESTART ++ COMMON-LISP::ATANH ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD ++ COMMON-LISP::SINH ANSI-LOOP::LOOP-UNIVERSE-P ++ ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED ++ SYSTEM::S-DATA-INCLUDED COMMON-LISP::STREAM-EXTERNAL-FORMAT ++ SYSTEM::COMPUTING-ARGS-P SYSTEM::REAL-ASINH ++ ANSI-LOOP::LOOP-CONSTRUCT-RETURN ++ SYSTEM::S-DATA-SLOT-DESCRIPTIONS SYSTEM::FIX-LOAD-PATH ++ SYSTEM::CHECK-DECLARATIONS ++ ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS ++ SLOOP::POINTER-FOR-COLLECT COMMON-LISP::LOGICAL-PATHNAME ++ SYSTEM::CHDIR SYSTEM::IDESCRIBE ++ ANSI-LOOP::LOOP-MINIMAX-OPERATIONS COMMON-LISP::ACOSH ++ COMMON-LISP::NINTH ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE ++ ANSI-LOOP::LOOP-COLLECTOR-P SYSTEM::S-DATA-P SYSTEM::BKPT-FORM ++ COMMON-LISP::FILE-NAMESTRING SYSTEM::TERMINAL-INTERRUPT ++ SYSTEM::SETUP-INFO SLOOP::PARSE-NO-BODY ++ SYSTEM::DM-KEY-NOT-ALLOWED ANSI-LOOP::LOOP-EMIT-FINAL-VALUE ++ SYSTEM::FREEZE-DEFSTRUCT SYSTEM::DBL-RPL-LOOP ++ SYSTEM::TRACE-ONE-PREPROCESS ++ COMMON-LISP::BROADCAST-STREAM-STREAMS COMMON-LISP::THIRD ++ SLOOP::AVERAGING-SLOOP-MACRO SYSTEM::SHOW-BREAK-POINT ++ COMMON-LISP::PATHNAME ANSI-LOOP::LOOP-DO-THEREIS ++ COMMON-LISP::FILE-AUTHOR ANSI-LOOP::LOOP-MAKE-DESETQ ++ SYSTEM::NC SYSTEM::NUMBER-OF-DAYS-FROM-1900 ++ SYSTEM::RESTART-TEST-FUNCTION SYSTEM::WHICH ++ ANSI-LOOP::DESTRUCTURING-SIZE COMMON-LISP::FILE-LENGTH)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) +- SYSTEM::BREAK-QUIT SYSTEM::BREAK-BDS SYSTEM::DBL-BACKTRACE +- SYSTEM::BREAK-LOCAL SYSTEM::INFO-ERROR +- SYSTEM::SHOW-BREAK-VARIABLES SYSTEM::BREAK-VS +- COMMON-LISP::CONTINUE COMMON-LISP::MUFFLE-WARNING +- SYSTEM::IHS-BACKTRACE ANSI-LOOP::LOOP-OPTIONAL-TYPE +- SYSTEM::BREAK-PREVIOUS SYSTEM::BREAK-NEXT)) ++ SYSTEM::BREAK-VS ANSI-LOOP::LOOP-OPTIONAL-TYPE ++ SYSTEM::BREAK-BDS SYSTEM::IHS-BACKTRACE SYSTEM::INFO-ERROR ++ SYSTEM::BREAK-LOCAL SYSTEM::SHOW-BREAK-VARIABLES ++ COMMON-LISP::MUFFLE-WARNING SYSTEM::BREAK-PREVIOUS ++ SYSTEM::BREAK-QUIT SYSTEM::DBL-BACKTRACE COMMON-LISP::CONTINUE ++ SYSTEM::BREAK-NEXT)) ++(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::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- ((COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807) +- COMMON-LISP::T) ++ (COMMON-LISP::T ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- SYSTEM::SMALLNTHCDR)) ++ SYSTEM::QUICK-SORT)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- COMMON-LISP::HASH-TABLE) +- SYSTEM::CONTEXT-SPICE)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ 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::FIXNUM) +- SYSTEM::S-DATA-SIZE FPE::REG-LOOKUP SYSTEM::INSTREAM-LINE +- SYSTEM::S-DATA-LENGTH SYSTEM::THE-START)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ COMMON-LISP::FIND-RESTART COMMON-LISP::PATHNAME-HOST ++ SYSTEM::LINK-EXPAND COMMON-LISP::CONCATENATE COMMON-LISP::WARN ++ COMMON-LISP::FILE-POSITION ANSI-LOOP::LOOP-WARN ++ COMMON-LISP::PATHNAME-DIRECTORY COMMON-LISP::SBIT ++ COMMON-LISP::BIT ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES ++ COMMON-LISP::PATHNAME-TYPE COMMON-LISP::MAKE-ARRAY ++ ANSI-LOOP::LOOP-ERROR COMMON-LISP::DIRECTORY SYSTEM::DIR-PARSE ++ COMMON-LISP::TRANSLATE-LOGICAL-PATHNAME ++ SYSTEM::NTH-STACK-FRAME COMMON-LISP::REQUIRE COMMON-LISP::LOAD ++ SYSTEM::MGLIST COMMON-LISP::DELETE-DUPLICATES ++ COMMON-LISP::PATHNAME-VERSION COMMON-LISP::ENOUGH-NAMESTRING ++ SYSTEM::BAD-SEQ-LIMIT COMMON-LISP::REMOVE-DUPLICATES ++ COMMON-LISP::PATHNAME-NAME ++ COMMON-LISP::MAKE-STRING-INPUT-STREAM SLOOP::LOOP-ADD-TEMPS ++ SYSTEM::NLOAD SYSTEM::LIST-MATCHES ++ COMMON-LISP::ARRAY-ROW-MAJOR-INDEX ++ COMMON-LISP::ARRAY-IN-BOUNDS-P SYSTEM::BREAK-LEVEL ++ SYSTEM::PROCESS-SOME-ARGS SYSTEM::TO-REGEXP ++ COMMON-LISP::UPGRADED-ARRAY-ELEMENT-TYPE COMMON-LISP::OPEN ++ SYSTEM::FILE-SEARCH COMMON-LISP::READ-BYTE ++ SYSTEM::FILE-TO-STRING SLOOP::ADD-FROM-DATA COMMON-LISP::ERROR ++ COMMON-LISP::SIGNAL SYSTEM::MGSUB COMMON-LISP::WILD-PATHNAME-P ++ COMMON-LISP::PATHNAME-DEVICE SYSTEM::LOGICAL-PATHNAME-PARSE ++ COMMON-LISP::MERGE-PATHNAMES SYSTEM::INFO-SEARCH ++ COMMON-LISP::BIT-NOT)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) +- SYSTEM::MATCH-BEGINNING SYSTEM::MATCH-END)) +-(COMMON-LISP::MAPC +- (COMMON-LISP::LAMBDA (COMPILER::X) +- (COMMON-LISP::SETF +- (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) +- COMMON-LISP::T)) +- '(SYSTEM::CONDITION-CLASS-P SYSTEM::WARNINGP SYSTEM::SI-CLASS-OF +- SYSTEM::SI-FIND-CLASS SYSTEM::DEFINE-STRUCTURE +- FPE::BREAK-ON-FLOATING-POINT-EXCEPTIONS +- SYSTEM::SIMPLE-CONDITION-CLASS-P SYSTEM::AUTOLOAD +- SYSTEM::SI-CLASS-PRECEDENCE-LIST SYSTEM::SI-CLASS-NAME +- SYSTEM::TRACE-ONE SYSTEM::MAKE-ACCESS-FUNCTION +- SYSTEM::UNTRACE-ONE SYSTEM::SI-CLASSP SYSTEM::CONDITIONP +- SYSTEM::AUTOLOAD-MACRO)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ ANSI-LOOP::ESTIMATE-CODE-SIZE-1 SYSTEM::DO-REPL ++ SYSTEM::SOURCE-PORTION SYSTEM::RESTART-REPORT ++ SYSTEM::NEW-SEMI-COLON-READER SYSTEM::FIND-DOC ++ ANSI-LOOP::ESTIMATE-CODE-SIZE SYSTEM::NEWLINE ++ COMMON-LISP::RENAME-FILE SYSTEM::LIST-TOGGLE-CASE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- ((COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807)) +- COMMON-LISP::T) +- SYSTEM::GET-CONTEXT SYSTEM::PUSH-CONTEXT)) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ COMMON-LISP::REDUCE COMMON-LISP::STABLE-SORT ++ SYSTEM::PARSE-BODY SLOOP::FIND-IN-ORDERED-LIST ++ COMMON-LISP::SUBTYPEP COMMON-LISP::SORT)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::FIXNUM) +- SYSTEM::RELATIVE-LINE SYSTEM::LENEL SYSTEM::THE-END +- ANSI-LOOP::DUPLICATABLE-CODE-P SYSTEM::FASLINK +- SYSTEM::GET-NODE-INDEX)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ SYSTEM::LIST-MERGE-SORT ANSI-LOOP::LOOP-GET-COLLECTION-INFO ++ SYSTEM::SHARP---READER SYSTEM::SHARP-S-READER ++ SYSTEM::VERIFY-KEYWORDS SYSTEM::RESTART-PRINT ++ SYSTEM::SHARP-+-READER SYSTEM::READ-INSPECT-COMMAND)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +- SLOOP::PARSE-ONE-WHEN-CLAUSE ANSI-LOOP::LOOP-DO-FINALLY +- SLOOP::LOOP-PEEK ANSI-LOOP::LOOP-DO-INITIALLY SLOOP::LOOP-POP +- ANSI-LOOP::LOOP-GET-PROGN SYSTEM::KCL-TOP-RESTARTS +- SYSTEM::INSPECT-READ-LINE SLOOP::PARSE-LOOP-WHEN +- ANSI-LOOP::LOOP-GET-FORM SYSTEM::DEFAULT-SYSTEM-BANNER +- SYSTEM::SET-UP-TOP-LEVEL SYSTEM::GET-INDEX-NODE +- ANSI-LOOP::LOOP-DO-DO ANSI-LOOP::LOOP-WHEN-IT-VARIABLE +- SYSTEM::SETUP-LINEINFO COMMON-LISP::TYPE-ERROR +- SYSTEM::READ-EVALUATED-FORM SYSTEM::INSPECT-INDENT-1 +- SLOOP::LOOP-UN-POP SLOOP::PARSE-LOOP-DO +- ANSI-LOOP::LOOP-DO-WITH SYSTEM::INSPECT-INDENT +- SYSTEM::GET-TEMP-DIR ANSI-LOOP::LOOP-ITERATION-DRIVER +- SYSTEM::WINE-TMP-REDIRECT SLOOP::PARSE-LOOP-COLLECT +- SYSTEM::DEFAULT-INFO-HOTLIST SLOOP::PARSE-LOOP1 +- SYSTEM::CLEANUP ANSI-LOOP::LOOP-DO-NAMED SYSTEM::DBL +- SYSTEM::ALL-TRACE-DECLARATIONS SYSTEM::TEST-ERROR +- ANSI-LOOP::LOOP-BIND-BLOCK ANSI-LOOP::LOOP-DO-REPEAT +- SYSTEM::ILLEGAL-BOA SYSTEM::SET-ENV SYSTEM::SET-CURRENT +- SYSTEM::INIT-BREAK-POINTS SYSTEM::GET-SIG-FN-NAME +- ANSI-LOOP::LOOP-DO-RETURN ANSI-LOOP::LOOP-CONTEXT +- SYSTEM::SHOW-RESTARTS SYSTEM::STEP-READ-LINE +- SLOOP::PARSE-LOOP-FOR SYSTEM::DM-TOO-MANY-ARGUMENTS +- COMMON-LISP::LISP-IMPLEMENTATION-VERSION SYSTEM::TOP-LEVEL +- ANSI-LOOP::LOOP-POP-SOURCE SYSTEM::DM-TOO-FEW-ARGUMENTS)) ++ (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::VECTOR COMMON-LISP::CHARACTER +- COMMON-LISP::*)) +- COMMON-LISP::T) +- SYSTEM::RESET-SYS-PATHS)) ++ (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::VECTOR COMMON-LISP::T)) +- SYSTEM::CONTEXT-VEC)) ++ (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::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ SYSTEM::EXPAND-WILD-DIRECTORY)) ++(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 SYSTEM::PARSE-DEFMACRO-LAMBDA-LIST)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::*) ++ SYSTEM::MME3)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ COMMON-LISP::T) ++ COMMON-LISP::T) ++ SYSTEM::SMALLNTHCDR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) +- SYSTEM::BREAK-HELP SYSTEM::BREAK-MESSAGE +- SYSTEM::SIMPLE-BACKTRACE ANSI-LOOP::LOOP-DO-FOR +- SYSTEM::BREAK-CURRENT SYSTEM::GCL-TOP-LEVEL +- SYSTEM::BREAK-RESUME)) +\ No newline at end of file ++ SYSTEM::GCL-TOP-LEVEL SYSTEM::BREAK-MESSAGE ++ SYSTEM::BREAK-RESUME SYSTEM::SIMPLE-BACKTRACE ++ SYSTEM::BREAK-HELP ANSI-LOOP::LOOP-DO-FOR ++ SYSTEM::BREAK-CURRENT)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++ SYSTEM::S-DATA-LENGTH SYSTEM::THE-START SYSTEM::INSTREAM-LINE ++ SYSTEM::S-DATA-SIZE FPE::REG-LOOKUP)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) ++ SYSTEM::MATCH-BEGINNING SYSTEM::MATCH-END)) +\ No newline at end of file +--- gcl-2.6.12.orig/o/fasdump.c ++++ gcl-2.6.12/o/fasdump.c +@@ -598,7 +598,7 @@ DEFUN_NEW("OPEN-FASD",object,fSopen_fasd + if(tabl==Cnil) tabl=funcall_cfun(Lmake_hash_table,2,sKtest,sLeq); + else + check_type(tabl,t_hashtable);} +- check_type(str,t_stream); ++ massert(str==stream); + result=alloc_simple_vector(sizeof(struct fasd)/sizeof(int),aet_object); + array_allocself(result,1,Cnil); + {struct fasd *fd= (struct fasd *)result->v.v_self; +@@ -608,7 +608,7 @@ DEFUN_NEW("OPEN-FASD",object,fSopen_fasd + fd->eof=eof; + fd->index=small_fixnum(0); + fd->package=symbol_value(sLApackageA); +- fd->filepos = make_fixnum(file_position(stream)); ++ fd->filepos = make_fixnum(ftell(stream->sm.sm_fp)); + + SETUP_FASD_IN(fd); + if (direction==sKoutput){ +@@ -649,13 +649,13 @@ DEFUN_NEW("CLOSE-FASD",object,fSclose_fa + {clrhash(fd->table); + SETUP_FASD_IN(fd); + PUT_OP(d_end_of_file); +- {int i = file_position(fd->stream); ++ {int i = ftell(fd->stream->sm.sm_fp); + if(type_of(fd->filepos) == t_fixnum) +- { file_position_set(fd->stream,fix(fd->filepos) +2); ++ { fseek(fd->stream->sm.sm_fp,fix(fd->filepos)+2,SEEK_SET); + /* record the length of array needed to read the indices */ + PUT4(fix(fd->index)); + /* move back to where we were */ +- file_position_set(fd->stream,i); ++ fseek(fd->stream->sm.sm_fp,i,SEEK_SET); + }} + + } +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -167,7 +167,6 @@ BEGIN: + case smm_probe: + return(FALSE); + +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -224,7 +223,6 @@ BEGIN: + case smm_probe: + return(FALSE); + +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -272,7 +270,6 @@ BEGIN: + case smm_socket: + return (sLcharacter); + +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -440,7 +437,7 @@ open_stream(object fn,enum smmode smm, o + x->sm.sm_buffer = 0; + x->sm.sm_object0 = sLcharacter; + x->sm.sm_object1 = vs_head; +- x->sm.sm_int0 = x->sm.sm_int1 = 0; ++ x->sm.sm_int = 0; + x->sm.sm_flags=0; + vs_push(x); + +@@ -522,8 +519,6 @@ DEFUN_NEW("OPEN-STREAM-P",object,fLopen_ + void + close_stream(object strm) { + +- object x; +- + if (FFN(fLopen_stream_p)(strm)==Cnil) + return; + +@@ -569,24 +564,15 @@ close_stream(object strm) { + strm->sm.sm_fd = -1; + break; + +- case smm_file_synonym: + case smm_synonym: +- strm = symbol_value(strm->sm.sm_object0); +- if (type_of(strm) != t_stream) +- TYPE_ERROR(strm,sLstream); +- close_stream(strm); + break; + + case smm_broadcast: + case smm_concatenated: +- for (x = strm->sm.sm_object0; !endp(x); x = x->c.c_cdr) +- close_stream(x->c.c_car); + break; + + case smm_two_way: + case smm_echo: +- close_stream(STREAM_INPUT_STREAM(strm)); +- close_stream(STREAM_OUTPUT_STREAM(strm)); + break; + + case smm_string_input: +@@ -616,7 +602,6 @@ DEFUN_NEW("INTERACTIVE-STREAM-P",object, + return Ct; + return Cnil; + break; +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -656,7 +641,7 @@ object istrm, ostrm; + strm->sm.sm_buffer = 0; + STREAM_INPUT_STREAM(strm) = istrm; + STREAM_OUTPUT_STREAM(strm) = ostrm; +- strm->sm.sm_int0 = strm->sm.sm_int1 = 0; ++ strm->sm.sm_int = 0; + strm->sm.sm_flags=0; + return(strm); + } +@@ -672,24 +657,30 @@ object istrm, ostrm; + return(strm); + } + +-object +-make_string_input_stream(strng, istart, iend) +-object strng; +-int istart, iend; +-{ +- object strm; ++DEFUN_NEW("MAKE-STRING-INPUT-STREAM-INT",object,fSmake_string_input_stream_int,SI,3,3,NONE,OO,II,OO,OO, ++ (object strng,fixnum istart,fixnum iend),"") { ++ ++ object strm; ++ ++ strm = alloc_object(t_stream); ++ strm->sm.sm_mode = (short)smm_string_input; ++ strm->sm.sm_fp = NULL; ++ strm->sm.sm_buffer = 0; ++ STRING_STREAM_STRING(strm) = strng; ++ strm->sm.sm_object1 = OBJNULL; ++ STRING_INPUT_STREAM_NEXT(strm)= istart; ++ STRING_INPUT_STREAM_END(strm)= iend; ++ strm->sm.sm_flags=0; ++ ++ RETURN1(strm); + +- strm = alloc_object(t_stream); +- strm->sm.sm_mode = (short)smm_string_input; +- strm->sm.sm_fp = NULL; +- strm->sm.sm_buffer = 0; +- STRING_STREAM_STRING(strm) = strng; +- strm->sm.sm_object1 = OBJNULL; +- STRING_INPUT_STREAM_NEXT(strm)= istart; +- STRING_INPUT_STREAM_END(strm)= iend; +- strm->sm.sm_flags=0; +- return(strm); + } ++#ifdef STATIC_FUNCTION_POINTERS ++object ++fSmake_string_input_stream_int(object x,fixnum y,fixnum z) { ++ return FFN(fSmake_string_input_stream_int)(x,y,z); ++} ++#endif + + DEFUN_NEW("STRING-INPUT-STREAM-P",object,fSstring_input_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + return type_of(x)==t_stream && x->sm.sm_mode == (short)smm_string_input ? Ct : Cnil; +@@ -722,7 +713,7 @@ int line_length; + strm->sm.sm_buffer = 0; + STRING_STREAM_STRING(strm) = strng; + strm->sm.sm_object1 = OBJNULL; +- strm->sm.sm_int0 = STREAM_FILE_COLUMN(strm) = 0; ++ strm->sm.sm_int = 0; + strm->sm.sm_flags=0; + vs_reset; + return(strm); +@@ -777,7 +768,6 @@ BEGIN: + /* strm->sm.sm_int0++; */ + return(c==EOF ? c : (c&0377)); + +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -880,7 +870,6 @@ BEGIN: + /* --strm->sm.sm_int0; */ /* use ftell now for position */ + break; + +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -982,7 +971,6 @@ BEGIN: + + break; + +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -1093,7 +1081,6 @@ BEGIN: + #endif + closed_stream(strm); + break; +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -1182,7 +1169,6 @@ BEGIN: + case smm_probe: + return(FALSE); + +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + check_stream(strm); +@@ -1308,7 +1294,6 @@ BEGIN: + #endif + return TRUE; + +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -1345,136 +1330,6 @@ BEGIN: + } + + int +-file_position(strm) +-object strm; +-{ +-BEGIN: +- switch (strm->sm.sm_mode) { +- case smm_input: +- case smm_output: +- case smm_io: +- /* return(strm->sm.sm_int0); */ +- if (strm->sm.sm_fp == NULL) +- closed_stream(strm); +- return(ftell(strm->sm.sm_fp)); +- case smm_socket: +- return -1; +- +- +- case smm_string_output: +- return(STRING_STREAM_STRING(strm)->st.st_fillp); +- +- case smm_file_synonym: +- case smm_synonym: +- strm = symbol_value(strm->sm.sm_object0); +- if (type_of(strm) != t_stream) +- FEwrong_type_argument(sLstream, strm); +- goto BEGIN; +- +- case smm_probe: +- case smm_broadcast: +- case smm_concatenated: +- case smm_two_way: +- case smm_echo: +- case smm_string_input: +- return(-1); +- +- default: +- error("illegal stream mode"); +- return(-1); +- } +-} +- +-int +-file_position_set(strm, disp) +-object strm; +-int disp; +-{ +-BEGIN: +- switch (strm->sm.sm_mode) { +- case smm_socket: +- return -1; +- case smm_input: +- case smm_output: +- case smm_io: +- +- if (fseek(strm->sm.sm_fp, disp, 0) < 0) +- return(-1); +- /* strm->sm.sm_int0 = disp; */ +- return(0); +- +- case smm_string_output: +- if (disp < STRING_STREAM_STRING(strm)->st.st_fillp) { +- STRING_STREAM_STRING(strm)->st.st_fillp = disp; +- /* strm->sm.sm_int0 = disp; */ +- } else { +- disp -= STRING_STREAM_STRING(strm)->st.st_fillp; +- while (disp-- > 0) +- writec_stream(' ', strm); +- } +- return(0); +- +- case smm_file_synonym: +- case smm_synonym: +- strm = symbol_value(strm->sm.sm_object0); +- if (type_of(strm) != t_stream) +- FEwrong_type_argument(sLstream, strm); +- goto BEGIN; +- +- case smm_probe: +- case smm_broadcast: +- case smm_concatenated: +- case smm_two_way: +- case smm_echo: +- case smm_string_input: +- return(-1); +- +- default: +- error("illegal stream mode"); +- return(-1); +- } +-} +- +-static int +-file_length(strm) +-object strm; +-{ +-BEGIN: +- switch (strm->sm.sm_mode) { +- case smm_input: +- case smm_output: +- case smm_io: +- +- if (strm->sm.sm_fp == NULL) +- closed_stream(strm); +- return(file_len(strm->sm.sm_fp)); +- +- +- +- case smm_file_synonym: +- case smm_synonym: +- strm = symbol_value(strm->sm.sm_object0); +- if (type_of(strm) != t_stream) +- FEwrong_type_argument(sLstream, strm); +- goto BEGIN; +- +- case smm_socket: +- case smm_probe: +- case smm_broadcast: +- case smm_concatenated: +- case smm_two_way: +- case smm_echo: +- case smm_string_input: +- case smm_string_output: +- return(-1); +- +- default: +- error("illegal stream mode"); +- return(-1); +- } +-} +- +-int + file_column(object strm) { + int i; + object x; +@@ -1491,7 +1346,6 @@ BEGIN: + case smm_two_way: + strm=STREAM_OUTPUT_STREAM(strm); + goto BEGIN; +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -1558,22 +1412,6 @@ load(const char *s) { + + + +-static int +-file_synonym_stream_p(object x) { +- switch(x->sm.sm_mode) { +- case smm_input: +- case smm_output: +- case smm_io: +- case smm_probe: +- case smm_file_synonym: +- return 1; +- case smm_synonym: +- return file_synonym_stream_p(x->sm.sm_object0->s.s_dbind); +- default: +- return 0; +- } +-} +- + LFD(Lmake_synonym_stream)() + { + object x; +@@ -1581,12 +1419,12 @@ LFD(Lmake_synonym_stream)() + check_arg(1); + check_type_sym(&vs_base[0]); + x = alloc_object(t_stream); +- x->sm.sm_mode = file_synonym_stream_p(vs_base[0]) ? (short)smm_file_synonym : (short)smm_synonym; ++ x->sm.sm_mode = (short)smm_synonym; + x->sm.sm_fp = NULL; + x->sm.sm_buffer = 0; + x->sm.sm_object0 = vs_base[0]; + x->sm.sm_object1 = OBJNULL; +- x->sm.sm_int0 = x->sm.sm_int1 = 0; ++ x->sm.sm_int = 0; + x->sm.sm_flags=0; + vs_base[0] = x; + } +@@ -1610,7 +1448,7 @@ LFD(Lmake_broadcast_stream)() + x->sm.sm_buffer = 0; + x->sm.sm_object0 = vs_base[0]; + x->sm.sm_object1 = OBJNULL; +- x->sm.sm_int0 = x->sm.sm_int1 = 0; ++ x->sm.sm_int = 0; + x->sm.sm_flags=0; + vs_base[0] = x; + } +@@ -1634,7 +1472,7 @@ LFD(Lmake_concatenated_stream)() + x->sm.sm_buffer = 0; + x->sm.sm_object0 = vs_base[0]; + x->sm.sm_object1 = OBJNULL; +- x->sm.sm_int0 = x->sm.sm_int1 = 0; ++ x->sm.sm_int = 0; + x->sm.sm_flags=0; + vs_base[0] = x; + } +@@ -1667,32 +1505,6 @@ LFD(Lmake_echo_stream)() + vs_popp; + } + +-@(static defun make_string_input_stream (strng &o istart iend) +- int s, e; +-@ +- check_type_string(&strng); +- if (istart == Cnil) +- s = 0; +- else if (type_of(istart) != t_fixnum) +- goto E; +- else +- s = fix(istart); +- if (iend == Cnil) +- e = strng->st.st_fillp; +- else if (type_of(iend) != t_fixnum) +- goto E; +- else +- e = fix(iend); +- if (s < 0 || e > strng->st.st_fillp || s > e) +- goto E; +- @(return `make_string_input_stream(strng, s, e)`) +- +-E: +- FEerror("~S and ~S are illegal as :START and :END~%\ +-for the string ~S.", +- 3, istart, iend, strng); +-@) +- + @(static defun make_string_output_stream (&k element_type) + @ + element_type=Cnil;/*FIXME*/ +@@ -1724,12 +1536,29 @@ LFD(siLoutput_stream_string)() + vs_base[0] = vs_base[0]->sm.sm_object0; + } + ++object ++file_stream(object x) { ++ if (type_of(x)==t_stream) ++ switch(x->sm.sm_mode) { ++ case smm_input: ++ case smm_output: ++ case smm_io: ++ case smm_probe: ++ return x; ++ case smm_synonym: ++ return file_stream(x->sm.sm_object0->s.s_dbind); ++ default: ++ break; ++ } ++ return Cnil; ++} ++ + DEFUN_NEW("FILE-STREAM-P",object,fSfile_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +- RETURN1(type_of(x)==t_stream && file_synonym_stream_p(x) ? Ct : Cnil); ++ RETURN1(file_stream(x)!=Cnil ? Ct : Cnil); + } + + DEFUN_NEW("SYNONYM-STREAM-P",object,fSsynonym_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +- RETURN1(type_of(x)==t_stream && (x->sm.sm_mode==smm_file_synonym || x->sm.sm_mode==smm_synonym) ? Ct : Cnil); ++ RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_synonym ? Ct : Cnil); + } + + DEFUN_NEW("TERMINAL-INPUT-STREAM-P",object,fSterminal_input_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +@@ -1802,43 +1631,6 @@ LFD(Lstream_element_type)() + @) + + +-@(defun file_position (file_stream &o position) +- int i=0; +-@ +- check_type_stream(&file_stream); +- if (position == Cnil) { +- i = file_position(file_stream); +- if (i < 0) +- @(return Cnil) +- @(return `make_fixnum(i)`) +- } else { +- if (position == sKstart) +- i = 0; +- else if (position == sKend) +- i = file_length(file_stream); +- else if (type_of(position) != t_fixnum || +- (i = fix((position))) < 0) +- FEerror("~S is an illegal file position~%\ +-for the file-stream ~S.", +- 2, position, file_stream); +- if (file_position_set(file_stream, i) < 0) +- @(return Cnil) +- @(return Ct) +- } +-@) +- +-LFD(Lfile_length)() +-{ +- int i; +- +- check_arg(1); +- check_type_stream(&vs_base[0]); +- i = file_length(vs_base[0]); +- if (i < 0) +- vs_base[0] = Cnil; +- else +- vs_base[0] = make_fixnum(i); +-} + + object sLAload_pathnameA; + DEFVAR("*COLLECT-BINARY-MODULES*",sSAcollect_binary_modulesA,SI,sLnil,""); +@@ -1911,17 +1703,6 @@ DEFUN_NEW("LOAD-FASL",object,fSload_fasl + + } + +-static void +-FFN(siLget_string_input_stream_index)() +-{ +- check_arg(1); +- check_type_stream(&vs_base[0]); +- if ((enum smmode)vs_base[0]->sm.sm_mode != smm_string_input) +- FEerror("~S is not a string-input stream.", 1, vs_base[0]); +- vs_base[0] = make_fixnum(STRING_INPUT_STREAM_NEXT(vs_base[0])); +-} +- +- + LFD(siLmake_string_output_stream_from_string)() + { + object strng, strm; +@@ -2042,7 +1823,6 @@ int out; + if (type_of(strm) != t_stream) + FEwrong_type_argument(sLstream, strm); + switch (strm->sm.sm_mode){ +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -2203,7 +1983,7 @@ object async; + x->sm.sm_buffer = 0; + x->sm.sm_object0 = list(3,server,host,port); + x->sm.sm_object1 = 0; +- x->sm.sm_int0 = x->sm.sm_int1 = 0; ++ x->sm.sm_int = 0; + x->sm.sm_flags=0; + SOCKET_STREAM_FD(x)= fd; + SET_STREAM_FLAG(x,mode,1); +@@ -2466,8 +2246,7 @@ gcl_init_file(void) + #ifdef UNIX + = make_simple_string("stdin"); + #endif +- standard_input->sm.sm_int0 = 0; /* unused */ +- standard_input->sm.sm_int1 = 0; /* unused */ ++ standard_input->sm.sm_int = 0; /* unused */ + standard_input->sm.sm_flags=0; + + standard_output = alloc_object(t_stream); +@@ -2479,8 +2258,7 @@ gcl_init_file(void) + #ifdef UNIX + = make_simple_string("stdout"); + #endif +- standard_output->sm.sm_int0 = 0; /* unused */ +- STREAM_FILE_COLUMN(standard_output) = 0; ++ standard_output->sm.sm_int = 0; /* unused */ + standard_output->sm.sm_flags=0; + + terminal_io = standard +@@ -2488,12 +2266,12 @@ gcl_init_file(void) + enter_mark_origin(&terminal_io); + + x = alloc_object(t_stream); +- x->sm.sm_mode = (short)smm_file_synonym; ++ x->sm.sm_mode = (short)smm_synonym; + x->sm.sm_fp = NULL; + x->sm.sm_buffer = 0; + x->sm.sm_object0 = sLAterminal_ioA; + x->sm.sm_object1 = OBJNULL; +- x->sm.sm_int0 = x->sm.sm_int1 = 0; /* unused */ ++ x->sm.sm_int = 0; /* unused */ + x->sm.sm_flags=0; + standard_io = x; + enter_mark_origin(&standard_io); +@@ -2561,8 +2339,6 @@ gcl_init_file_function() + Lmake_concatenated_stream); + make_function("MAKE-TWO-WAY-STREAM", Lmake_two_way_stream); + make_function("MAKE-ECHO-STREAM", Lmake_echo_stream); +- make_function("MAKE-STRING-INPUT-STREAM", +- Lmake_string_input_stream); + make_function("MAKE-STRING-OUTPUT-STREAM", + Lmake_string_output_stream); + make_function("GET-OUTPUT-STREAM-STRING", +@@ -2581,11 +2357,6 @@ gcl_init_file_function() + make_function("STREAM-ELEMENT-TYPE", Lstream_element_type); + make_function("CLOSE", Lclose); + +- make_function("FILE-POSITION", Lfile_position); +- make_function("FILE-LENGTH", Lfile_length); +- +- make_si_function("GET-STRING-INPUT-STREAM-INDEX", +- siLget_string_input_stream_index); + make_si_function("MAKE-STRING-OUTPUT-STREAM-FROM-STRING", + siLmake_string_output_stream_from_string); + make_si_function("COPY-STREAM", siLcopy_stream); +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -627,7 +627,6 @@ mark_object1(object x) { + } + break; + +- case smm_file_synonym: + case smm_synonym: + mark_object(x->sm.sm_object0); + break; +--- gcl-2.6.12.orig/o/pathname.d ++++ gcl-2.6.12/o/pathname.d +@@ -83,6 +83,11 @@ DEFUN_NEW("C-STREAM-OBJECT1",object,fSc_ + RETURN1(x->sm.sm_object1); + } + ++DEFUN_NEW("C-SET-STREAM-OBJECT0",object,fSc_set_stream_object0,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { ++ x->sm.sm_object0=y; ++ RETURN1(x); ++} ++ + DEFUN_NEW("C-SET-STREAM-OBJECT1",object,fSc_set_stream_object1,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { + x->sm.sm_object1=y; + RETURN1(x); +--- gcl-2.6.12.orig/o/print.d ++++ gcl-2.6.12/o/print.d +@@ -1260,7 +1260,6 @@ int level; + write_ch('>'); + break; + +- case smm_file_synonym: + case smm_synonym: + write_str("#sm.sm_object0, level); +--- gcl-2.6.12.orig/o/read.d ++++ gcl-2.6.12/o/read.d +@@ -2204,7 +2204,7 @@ object x; + object in; + vs_mark; + +- in = make_string_input_stream(x, 0, x->st.st_fillp); ++ in = fSmake_string_input_stream_int(x, 0, x->st.st_fillp); + vs_push(in); + preserving_whitespace_flag = FALSE; + detect_eos_flag = FALSE; +--- gcl-2.6.12.orig/o/run_process.c ++++ gcl-2.6.12/o/run_process.c +@@ -434,7 +434,7 @@ enum smmode smm; + + stream->sm.sm_object0 = sLcharacter; + stream->sm.sm_object1 = host_l; +- stream->sm.sm_int0 = stream->sm.sm_int1 = 0; ++ stream->sm.sm_int = 0; + stream->sm.sm_flags=0; + vs_push(stream); + setup_stream_buffer(stream); +@@ -503,8 +503,7 @@ make_socket_pair() + stream_in->sm.sm_mode = smm_input; + stream_in->sm.sm_fp = fp1; + stream_in->sm.sm_buffer = 0; +- stream_in->sm.sm_int0 = sockets_in[1]; +- stream_in->sm.sm_int1 = 0; ++ stream_in->sm.sm_int = sockets_in[1]; + stream_in->sm.sm_object0=stream_in->sm.sm_object1=OBJNULL; + stream_in->sm.sm_flags = 0; + stream_out = (object) alloc_object(t_stream); +@@ -513,8 +512,7 @@ make_socket_pair() + stream_out->sm.sm_buffer = 0; + setup_stream_buffer(stream_in); + setup_stream_buffer(stream_out); +- stream_out->sm.sm_int0 = sockets_out[1]; +- stream_out->sm.sm_int1 = 0; ++ stream_out->sm.sm_int = sockets_out[1]; + stream_out->sm.sm_flags = 0; + stream_out->sm.sm_object0=stream_out->sm.sm_object1=OBJNULL; + stream = make_two_way_stream(stream_in, stream_out); +@@ -538,8 +536,8 @@ char **argv; + int fdout; + if (istream->sm.sm_fp == NULL || ostream->sm.sm_fp == NULL) + FEerror("Cannot spawn process with given stream", 0); +- fdin = istream->sm.sm_int0; +- fdout = ostream->sm.sm_int0; ++ fdin = istream->sm.sm_int; ++ fdout = ostream->sm.sm_int; + if (pfork() == 0) + { /* the child --- replace standard in and out with descriptors given */ + close(0); +--- gcl-2.6.12.orig/o/sockets.c ++++ gcl-2.6.12/o/sockets.c +@@ -518,16 +518,6 @@ DEFUN_NEW("SET-SIGIO-FOR-FD",object,fSse + + } + +-DEFUN_NEW("RESET-STRING-INPUT-STREAM",object,fSreset_string_input_stream,SI,4,4,NONE,OO,OI,IO,OO,(object strm,object string,fixnum start,fixnum end), +- "Reuse a string output STREAM by setting its output to STRING \ +-and positioning the ouput/input to start at START and end at END") +- +-{ strm->sm.sm_object0 = string; +- strm->sm.sm_int0 = start; +- strm->sm.sm_int1 = end; +- return strm; +-} +- + DEFUN_NEW("CHECK-STATE-INPUT",object,fScheck_state_input,SI,2,2,NONE,OO,IO,OO,OO,(object osfd,fixnum timeout), + "") + { +--- gcl-2.6.12.orig/o/string.d ++++ gcl-2.6.12/o/string.d +@@ -564,28 +564,33 @@ LFD(Lnstring_capitalize)() { casefun = c + @(return `coerce_to_string(x)`) + @) + +-static void +-FFN(siLstring_concatenate)() +-{ +- int narg, i, l, m; +- object *v; ++DEFUN_NEW("STRING-CONCATENATE",object,fLstring_concatenate,SI,0,63,NONE,OO,OO,OO,OO,(object first,...),"") { ++ ++ fixnum i,l,m,narg=VFUN_NARGS; ++ object x; ++ va_list ap; ++ ++ va_start(ap,first); ++ vs_base=vs_top; ++ for (l=i=0;ist.st_fillp; ++ } ++ va_end(ap); ++ ++ { ++ object *p; ++ BEGIN_NO_INTERRUPT; ++ x=alloc_simple_string(l); ++ (x)->st.st_self = alloc_relblock(l); ++ for (l=0,p=vs_base;pst.st_fillp)>=0;p++,l+=m) ++ memcpy(x->st.st_self+l,(*p)->st.st_self,m); ++ END_NO_INTERRUPT; ++ ++ } ++ ++ RETURN1(x); + +- narg = vs_top - vs_base; +- for (i = 0, l = 0; i < narg; i++) { +- vs_base[i] = coerce_to_string(vs_base[i]); +- l += vs_base[i]->st.st_fillp; +- } +- v = vs_top; +- {BEGIN_NO_INTERRUPT; +- vs_push(alloc_simple_string(l)); +- (*v)->st.st_self = alloc_relblock(l); +- for (i = 0, l = 0; i < narg; i++) +- for (m = 0; m < vs_base[i]->st.st_fillp; m++) +- (*v)->st.st_self[l++] +- = vs_base[i]->st.st_self[m]; +- vs_base[0] = *v; +- vs_top = vs_base + 1; +- END_NO_INTERRUPT;} + } + + void +@@ -628,6 +633,4 @@ gcl_init_string_function() + make_function("NSTRING-CAPITALIZE", Lnstring_capitalize); + make_function("STRING", Lstring); + +- make_si_function("STRING-CONCATENATE", +- siLstring_concatenate); + } +--- gcl-2.6.12.orig/o/unixfsys.c ++++ gcl-2.6.12/o/unixfsys.c +@@ -55,7 +55,7 @@ get_string(object x) { + case smm_probe: + case smm_io: + return get_string(x->sm.sm_object1); +- case smm_file_synonym: ++ case smm_synonym: + return get_string(x->sm.sm_object0->s.s_dbind); + } + } +@@ -169,24 +169,6 @@ DEF_ORDINARY("DIRECTORY",sKdirectory,KEY + DEF_ORDINARY("LINK",sKlink,KEYWORD,""); + DEF_ORDINARY("FILE",sKfile,KEYWORD,""); + +-object +-file_stream(object x) { +- if (type_of(x)==t_stream) +- switch(x->sm.sm_mode) { +- case smm_input: +- case smm_output: +- case smm_io: +- case smm_probe: +- return x; +- case smm_synonym: +- return file_stream(x->sm.sm_object0->s.s_dbind); +- default: +- break; +- } +- return Cnil; +-} +- +- + DEFUNM_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + + struct stat ss; +--- gcl-2.6.12.orig/pcl/sys-proclaim.lisp ++++ gcl-2.6.12/pcl/sys-proclaim.lisp +@@ -2,29 +2,19 @@ + (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::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::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::FUNCTION COMMON-LISP::NIL COMMON-LISP::FIXNUM) ++ PCL::GET-WRAPPER-CACHE-NUMBER)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) PCL::FIELD-TYPE) +- PCL::CACHE-FIELD)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ PCL::NON-NEGATIVE-FIXNUM) ++ PCL::CACHE-NLINES PCL::CACHE-MASK PCL::CACHE-SIZE ++ PCL::CACHE-MAX-LOCATION)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) +@@ -32,296 +22,344 @@ + 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::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ PCL::ACCESSOR-VALUES-INTERNAL ++ PCL::MAKE-OPTIMIZED-STD-READER-METHOD-FUNCTION ++ PCL::|(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| ++ PCL::MAKE-FINAL-N-N-ACCESSOR-DFUN ++ PCL::|(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| ++ PCL::CHECK-METHOD-ARG-INFO ++ PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| ++ PCL::GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION ++ PCL::GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::|(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| ++ PCL::MAKE-OPTIMIZED-STD-BOUNDP-METHOD-FUNCTION ++ PCL::OPTIMIZE-SLOT-VALUE-BY-CLASS-P ++ ITERATE::WALK-GATHERING-BODY ++ PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER ++ PCL::|(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| ++ PCL::SLOT-BOUNDP-USING-CLASS-DFUN WALKER::WALK-FORM-INTERNAL ++ PCL::LOAD-LONG-DEFCOMBIN PCL::MAKE-FINAL-CACHING-DFUN ++ PCL::EMIT-READER/WRITER ++ PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION ++ PCL::SLOT-VALUE-USING-CLASS-DFUN PCL::CACHING-MISS ++ PCL::|(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| ++ PCL::EMIT-READER/WRITER-FUNCTION PCL::ACCESSOR-VALUES1 ++ PCL::GENERATING-LISP PCL::GET-CLASS-SLOT-VALUE-1 ++ PCL::MAKE-FINAL-CONSTANT-VALUE-DFUN PCL::CACHE-MISS-VALUES ++ WALKER::WALK-LET-IF ++ PCL::|(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| ++ PCL::|(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| ++ PCL::CHECKING-MISS ITERATE::EXPAND-INTO-LET ++ PCL::MAKE-OPTIMIZED-STD-WRITER-METHOD-FUNCTION ++ PCL::CONSTANT-VALUE-MISS ITERATE::RENAME-VARIABLES ++ PCL::|(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| ++ PCL::SET-SLOT-VALUE ++ PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| ++ PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| ++ PCL::|(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| ++ PCL::CONVERT-METHODS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- (COMMON-LISP::INTEGER 1 255)) +- PCL::CACHE-NKEYS)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ PCL::|(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| ++ PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| ++ PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| ++ PCL::|(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| ++ PCL::MAKE-TWO-CLASS-ACCESSOR-DFUN ++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| ++ PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| ++ PCL::ADD-METHOD-DECLARATIONS ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| ++ PCL::|(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| ++ PCL::WALK-METHOD-LAMBDA ++ PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))|)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::*) ++ PCL::GET-ACCESSOR-METHOD-FUNCTION ++ PCL::|(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| ++ PCL::MAKE-ONE-CLASS-ACCESSOR-DFUN ++ PCL::|(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| ++ PCL::GENERATE-DISCRIMINATION-NET ++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| ++ PCL::LOAD-SHORT-DEFCOMBIN ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| ++ PCL::|(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| ++ PCL::REAL-MAKE-METHOD-LAMBDA PCL::SET-CLASS-SLOT-VALUE-1 ++ PCL::BOOTSTRAP-ACCESSOR-DEFINITION ++ PCL::MAKE-FINAL-ONE-INDEX-ACCESSOR-DFUN ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| ++ PCL::ACCESSOR-MISS PCL::|(FAST-METHOD MAKE-INSTANCE (SYMBOL))| ++ PCL::ACCESSOR-VALUES ++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (T T))| ++ PCL::|(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| ++ PCL::EMIT-CHECKING-OR-CACHING-FUNCTION ++ PCL::INITIALIZE-INSTANCE-SIMPLE-FUNCTION ++ PCL::MAKE-FINAL-CHECKING-DFUN ++ PCL::MAKE-SHARED-INITIALIZE-FORM-LIST ++ PCL::|(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| ++ PCL::EMIT-CHECKING-OR-CACHING ++ PCL::|(FAST-METHOD CHANGE-CLASS (T SYMBOL))| ++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| ++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| ++ PCL::|(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| ++ PCL::SETF-SLOT-VALUE-USING-CLASS-DFUN ++ PCL::GET-ACCESSOR-FROM-SVUC-METHOD-FUNCTION ++ PCL::|(FAST-METHOD NO-APPLICABLE-METHOD (T))| ++ PCL::ORDER-SPECIALIZERS ++ PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| ++ PCL::|(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))|)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ PCL::MAKE-N-N-ACCESSOR-DFUN ++ PCL::GET-SIMPLE-INITIALIZATION-FUNCTION ++ PCL::MAKE-FINAL-ACCESSOR-DFUN ++ PCL::GET-EFFECTIVE-METHOD-FUNCTION PCL::MAKE-ACCESSOR-TABLE ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION PCL::MAKE-CHECKING-DFUN ++ PCL::GET-COMPLEX-INITIALIZATION-FUNCTIONS ++ PCL::MAKE-DEFAULT-INITARGS-FORM-LIST PCL::REAL-ADD-METHOD ++ PCL::SLOT-VALUE-OR-DEFAULT PCL::LOAD-DEFGENERIC PCL::CPL-ERROR ++ WALKER::NESTED-WALK-FORM PCL::TYPES-FROM-ARGUMENTS ++ PCL::COMPUTE-SECONDARY-DISPATCH-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::*) ++ PCL::MAKE-LONG-METHOD-COMBINATION-FUNCTION ++ PCL::GENERATE-DISCRIMINATION-NET-INTERNAL ++ PCL::CACHE-MISS-VALUES-INTERNAL ++ PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::DO-SHORT-METHOD-COMBINATION PCL::MEMF-CODE-CONVERTER)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::*) ++ PCL::MAKE-ONE-INDEX-ACCESSOR-DFUN WALKER::WALK-DECLARATIONS ++ PCL::GET-SECONDARY-DISPATCH-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::*) ++ PCL::|(FAST-METHOD SLOT-MISSING (T T T T))| ++ PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| ++ ITERATE::ITERATE-TRANSFORM-BODY)) ++(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::*) ++ ITERATE::RENAME-LET-BINDINGS ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1)) ++(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::MAPC + (COMMON-LISP::LAMBDA (COMPILER::X) + (COMMON-LISP::SETF +- (COMMON-LISP::GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE) ++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) + COMMON-LISP::T)) + '(PCL::REDEFINE-FUNCTION PCL::DO-STANDARD-DEFSETF-1 +- PCL::FDEFINE-CAREFULLY PCL::TRACE-METHOD-INTERNAL)) ++ PCL::TRACE-METHOD-INTERNAL PCL::FDEFINE-CAREFULLY)) + (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::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++ PCL::ANALYZE-LAMBDA-LIST PCL::GET-DISPATCH-FUNCTION ++ PCL::PARSE-DEFMETHOD PCL::MAKE-DISPATCH-DFUN ++ PCL::EMIT-IN-CHECKING-CACHE-P PCL::EMIT-ONE-INDEX-READERS ++ PCL::METHOD-PROTOTYPE-FOR-GF PCL::EMIT-ONE-CLASS-READER ++ PCL::GENERIC-FUNCTION-NAME-P PCL::DEFAULT-CODE-CONVERTER ++ PCL::CLASS-EQ-TYPE PCL::CONVERT-TO-SYSTEM-TYPE ++ PCL::COMPILE-IIS-FUNCTIONS PCL::EMIT-CONSTANT-VALUE ++ PCL::GET-GENERIC-FUNCTION-INFO PCL::EARLY-METHOD-FUNCTION ++ PCL::FIND-STRUCTURE-CLASS PCL::PCL-DESCRIBE ++ PCL::NET-CODE-CONVERTER PCL::PARSE-METHOD-GROUP-SPECIFIER ++ PCL::TYPE-FROM-SPECIALIZER PCL::EMIT-TWO-CLASS-WRITER ++ PCL::COMPUTE-APPLICABLE-METHODS-EMF PCL::EMIT-ONE-CLASS-WRITER ++ PCL::PROTOTYPES-FOR-MAKE-METHOD-LAMBDA ++ PCL::SPECIALIZER-FROM-TYPE PCL::EARLY-COLLECT-INHERITANCE ++ PCL::EMIT-TWO-CLASS-READER PCL::FIND-WRAPPER ++ PCL::*NORMALIZE-TYPE PCL::EMIT-ONE-INDEX-WRITERS ++ PCL::STRUCTURE-WRAPPER PCL::MAKE-FINAL-DISPATCH-DFUN)) + (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::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++ PCL::|__si::MAKE-INITIAL| PCL::|__si::MAKE-ARG-INFO| ++ PCL::STRING-APPEND PCL::|__si::MAKE-ONE-INDEX| ++ PCL::MAKE-INITIALIZE-INFO PCL::MAKE-FAST-METHOD-CALL ++ PCL::|__si::MAKE-STD-INSTANCE| ++ PCL::|__si::MAKE-ONE-INDEX-DFUN-INFO| ++ PCL::|__si::MAKE-CONSTANT-VALUE| PCL::|__si::MAKE-N-N| ++ PCL::FIX-EARLY-GENERIC-FUNCTIONS PCL::INTERN-PV-TABLE ++ PCL::FALSE PCL::|__si::MAKE-DFUN-INFO| ++ PCL::|__si::MAKE-CACHING| PCL::MAKE-PV-TABLE ++ PCL::MAKE-METHOD-CALL PCL::TRUE PCL::MAKE-PROGN ++ PCL::|__si::MAKE-CACHE| ++ PCL::|STRUCTURE-OBJECT class constructor| ++ PCL::|__si::MAKE-CLASS-PRECEDENCE-DESCRIPTION| ++ PCL::|__si::MAKE-NO-METHODS| PCL::|__si::MAKE-ONE-CLASS| ++ PCL::|__si::MAKE-PV-TABLE| PCL::PV-WRAPPERS-FROM-PV-ARGS ++ WALKER::UNBOUND-LEXICAL-FUNCTION PCL::|__si::MAKE-TWO-CLASS| ++ PCL::|__si::MAKE-ACCESSOR-DFUN-INFO| ++ PCL::|__si::MAKE-DEFAULT-METHOD-ONLY| ++ PCL::MAKE-FAST-INSTANCE-BOUNDP ++ PCL::CALLED-FIN-WITHOUT-FUNCTION PCL::USE-PACKAGE-PCL ++ PCL::|__si::MAKE-CHECKING| PCL::|__si::MAKE-INITIAL-DISPATCH| ++ PCL::|__si::MAKE-DISPATCH|)) + (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::FUNCTION (COMMON-LISP::T) COMMON-LISP::FUNCTION) ++ PCL::METHOD-CALL-FUNCTION PCL::FAST-METHOD-CALL-FUNCTION ++ PCL::CACHE-LIMIT-FN)) ++(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) +- PCL::NON-NEGATIVE-FIXNUM) +- PCL::CACHE-MAX-LOCATION PCL::CACHE-NLINES PCL::CACHE-SIZE +- PCL::CACHE-MASK)) ++ (COMMON-LISP::INTEGER 1 255)) ++ PCL::CACHE-NKEYS)) ++(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::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 COMMON-LISP::T) ++ (COMMON-LISP::*)) ++ PCL::SORT-APPLICABLE-METHODS PCL::SORT-METHODS)) + (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::COMPUTE-CALLS PCL::SET-STRUCTURE-SVUC-METHOD ++ PCL::UPDATE-STD-OR-STR-METHODS PCL::SET-METHODS ++ WALKER::NOTE-LEXICAL-BINDING ++ ITERATE::SIMPLE-EXPAND-ITERATE-FORM ++ PCL::|SETF PCL METHOD-FUNCTION-PLIST| PCL::SAUT-NOT-PROTOTYPE ++ PCL::VALUE-FOR-CACHING PCL::PROCLAIM-DEFMETHOD ++ PCL::MAKE-FAST-METHOD-CALL-LAMBDA-LIST ++ PCL::MAKE-STD-BOUNDP-METHOD-FUNCTION PCL::METHODS-CONVERTER ++ PCL::DEAL-WITH-ARGUMENTS-OPTION ++ PCL::UPDATE-ALL-PV-TABLE-CACHES ++ PCL::MAP-PV-TABLE-REFERENCES-OF PCL::UPDATE-CLASS ++ PCL::FIND-STANDARD-II-METHOD ++ PCL::METHOD-FUNCTION-RETURNING-NIL ++ PCL::REDIRECT-EARLY-FUNCTION-INTERNAL PCL::UPDATE-CPL ++ PCL::QUALIFIER-CHECK-RUNTIME PCL::COMPUTE-STD-CPL ++ PCL::COMPUTE-CONSTANTS PCL::ADD-FORMS PCL::AUGMENT-TYPE ++ PCL::MEMF-CONSTANT-CONVERTER PCL::SWAP-WRAPPERS-AND-SLOTS ++ PCL::SET-WRAPPER PCL::GET-KEY-ARG PCL::MAKE-PLIST ++ PCL::MAKE-PV-TABLE-INTERNAL ITERATE::EXTRACT-SPECIAL-BINDINGS ++ PCL::SAUT-NOT-EQL WALKER::VARIABLE-SYMBOL-MACRO-P ++ PCL::EMIT-1-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION + PCL::SET-FUNCTION-PRETTY-ARGLIST ++ PCL::GF-MAKE-FUNCTION-FROM-EMF PCL::FIND-SLOT-DEFINITION ++ PCL::SET-STANDARD-SVUC-METHOD PCL::ADD-TO-CVECTOR ++ PCL::PV-WRAPPERS-FROM-ALL-WRAPPERS COMMON-LISP::REMOVE-METHOD ++ PCL::CHECKING-DFUN-INFO PCL::PARSE-QUALIFIER-PATTERN ++ PCL::%SET-CCLOSURE-ENV PCL::MAKE-CDXR + PCL::FUNCALLABLE-STANDARD-INSTANCE-ACCESS ++ PCL::NET-CONSTANT-CONVERTER PCL::|SETF PCL FIND-CLASS| ++ PCL::METHOD-FUNCTION-RETURNING-T PCL::CHANGE-CLASS-INTERNAL ++ PCL::MAKE-DFUN-ARG-LIST PCL::DOCTOR-DFUN-FOR-THE-DEBUGGER ++ PCL::MAKE-STD-WRITER-METHOD-FUNCTION ITERATE::MV-SETQ ++ PCL::MAKE-EARLY-ACCESSOR PCL::GET-KEY-ARG1 ++ PCL::ADD-DIRECT-SUBCLASSES PCL::DO-SATISFIES-DEFTYPE ++ PCL::N-N-DFUN-INFO PCL::CLASSES-HAVE-COMMON-SUBCLASS-P ++ PCL::SAUT-NOT-CLASS PCL::CANONICALIZE-DEFCLASS-OPTION + 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 ++ WALKER::VARIABLE-LEXICAL-P WALKER::ENVIRONMENT-FUNCTION ++ PCL::PV-TABLE-LOOKUP PCL::DESTRUCTURE-INTERNAL ++ PCL::MAKE-INTERNAL-READER-METHOD-FUNCTION ++ PCL::REMOVE-SLOT-ACCESSORS ++ PCL::|SETF PCL FIND-CLASS-PREDICATE| ++ PCL::|SETF PCL GDEFINITION| PCL::MAKE-DFUN-LAMBDA-LIST ++ PCL::CANONICALIZE-SLOT-SPECIFICATION WALKER::WALK-REPEAT-EVAL + PCL::STANDARD-INSTANCE-ACCESS +- SYSTEM::%SET-COMPILED-FUNCTION-NAME PCL::FIND-SLOT-DEFINITION ++ PCL::PRINTING-RANDOM-THING-INTERNAL PCL::REMTAIL ++ PCL::ACCESSOR-MISS-FUNCTION PCL::COMPUTE-LAYOUT + 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)) ++ PCL::EMIT-N-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION ++ SYSTEM::%SET-COMPILED-FUNCTION-NAME PCL::PLIST-VALUE ++ PCL::MAKE-CAXR PCL::MAKE-DLAP-LAMBDA-LIST ++ PCL::MAKE-STD-READER-METHOD-FUNCTION WALKER::ENVIRONMENT-MACRO ++ PCL::UPDATE-SLOTS PCL::VARIABLE-CLASS ++ PCL::SET-FUNCALLABLE-INSTANCE-FUNCTION PCL::LIST-EQ ++ PCL::ADD-SLOT-ACCESSORS PCL::SAUT-NOT-CLASS-EQ PCL::COMPUTE-PV ++ PCL::PV-WRAPPERS-FROM-ALL-ARGS PCL::UPDATE-INITS ++ PCL::MEC-ALL-CLASS-LISTS PCL::RAISE-METATYPE ++ WALKER::NOTE-DECLARATION PCL::EMIT-1-NIL-DLAP ++ PCL::BOOTSTRAP-SLOT-INDEX PCL::SUPERCLASSES-COMPATIBLE-P ++ PCL::MEC-ALL-CLASSES-INTERNAL COMMON-LISP::SLOT-EXISTS-P ++ PCL::DESCRIBE-PACKAGE PCL::NO-SLOT PCL::PROCLAIM-DEFGENERIC ++ COMMON-LISP::ADD-METHOD PCL::MAKE-UNORDERED-METHODS-EMF ++ PCL::MEC-ALL-CLASSES PCL::SYMBOL-OR-CONS-LESSP ++ PCL::UPDATE-INITIALIZE-INFO-INTERNAL PCL::CLASS-CAN-PRECEDE-P ++ PCL::SYMBOL-LESSP PCL::COMPUTE-APPLICABLE-METHODS-FUNCTION ++ PCL::MAKE-CLASS-PREDICATE WALKER::VARIABLE-SPECIAL-P ++ PCL::REMOVE-DIRECT-SUBCLASSES)) + (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)) ++ PCL::MAKE-METHOD-FUNCTION-INTERNAL ++ PCL::MAKE-FINAL-DFUN-INTERNAL WALKER::MACROEXPAND-ALL ++ COMMON-LISP::ENSURE-GENERIC-FUNCTION ++ PCL::MAKE-METHOD-LAMBDA-INTERNAL PCL::MAKE-CONSTANT-VALUE-DFUN ++ PCL::GET-FUNCTION PCL::EXTRACT-DECLARATIONS ++ PCL::COERCE-TO-CLASS PCL::PARSE-METHOD-OR-SPEC ++ PCL::DISPATCH-DFUN-COST PCL::PARSE-SPECIALIZED-LAMBDA-LIST ++ PCL::MAP-ALL-CLASSES PCL::COMPILE-LAMBDA PCL::ENSURE-CLASS ++ PCL::GET-METHOD-FUNCTION WALKER::WALK-FORM ++ PCL::ALLOCATE-STRUCTURE-INSTANCE PCL::GET-FUNCTION1 ++ PCL::MAKE-CACHING-DFUN PCL::MAKE-INSTANCE-1 ++ PCL::GET-DFUN-CONSTRUCTOR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) +@@ -329,270 +367,405 @@ + PCL::MAKE-CLASS-PREDICATE-NAME PCL::MAKE-KEYWORD)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++ COMMON-LISP::*)) ++ PCL::CAPITALIZE-WORDS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE-1 PCL::SHOW-EMF-CALL-TRACE ++ PCL::CACHES-TO-ALLOCATE PCL::MAKE-CACHE ++ PCL::SHOW-FREE-CACHE-VECTORS PCL::MAKE-ARG-INFO ++ PCL::NO-METHODS-DFUN-INFO PCL::STRUCTURE-FUNCTIONS-EXIST-P ++ PCL::INITIALIZE-CHECKING-OR-CACHING-FUNCTION-LIST ++ PCL::BOOTSTRAP-BUILT-IN-CLASSES ++ PCL::%%ALLOCATE-INSTANCE--CLASS PCL::DISPATCH-DFUN-INFO ++ PCL::INITIAL-DISPATCH-DFUN-INFO PCL::BOOTSTRAP-META-BRAID ++ PCL::UPDATE-DISPATCH-DFUNS PCL::LIST-ALL-DFUNS ++ PCL::DEFAULT-METHOD-ONLY-DFUN-INFO PCL::RENEW-SYS-FILES ++ PCL::IN-THE-COMPILER-P PCL::GET-EFFECTIVE-METHOD-GENSYM ++ PCL::MAKE-CPD PCL::INITIAL-DFUN-INFO ++ PCL::SHOW-DFUN-CONSTRUCTORS ++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE-2)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::FIXNUM) ++ PCL::ZERO)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::T COMMON-LISP::STREAM COMMON-LISP::T) + 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)) ++ PCL::PRINT-DFUN-INFO)) ++(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::FIXNUM COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ PCL::COMPUTE-CACHE-PARAMETERS)) ++(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::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::MAKE-FINAL-DFUN PCL::SET-ARG-INFO PCL::TRACE-METHOD ++ PCL::MAKE-SPECIALIZABLE WALKER::WALKER-ENVIRONMENT-BIND-1 ++ ITERATE::FUNCTION-LAMBDA-P COMMON-LISP::FIND-CLASS ++ PCL::MAKE-WRAPPER PCL::UPDATE-DFUN ++ PCL::MAKE-TYPE-PREDICATE-NAME PCL::PV-TABLE-LOOKUP-PV-ARGS ++ PCL::USE-CONSTANT-VALUE-DFUN-P WALKER::RELIST ++ PCL::MAKE-EARLY-GF PCL::INITIALIZE-METHOD-FUNCTION ++ PCL::FIND-CLASS-CELL PCL::USE-DISPATCH-DFUN-P ++ PCL::FIND-CLASS-PREDICATE PCL::ALLOCATE-STANDARD-INSTANCE ++ PCL::INITIALIZE-INTERNAL-SLOT-GFS ITERATE::MAYBE-WARN ++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE ++ PCL::EARLY-METHOD-SPECIALIZERS WALKER::RELIST* PCL::SET-DFUN)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ PCL::SLOT-UNBOUND-INTERNAL ITERATE::PARSE-DECLARATIONS ++ PCL::EMIT-CACHING PCL::COMPUTE-STD-CPL-PHASE-1 ++ PCL::INITIAL-DFUN PCL::INSURE-DFUN PCL::EMIT-CHECKING ++ PCL::COMPUTE-TEST PCL::COMPUTE-CODE PCL::MAKE-DIRECT-SLOTD ++ PCL::SAUT-CLASS COMMON-LISP::SLOT-MAKUNBOUND ++ PCL::CPL-FORWARD-REFERENCED-CLASS-ERROR PCL::INVOKE-EMF ++ PCL::*SUBTYPEP PCL::SPECIALIZER-APPLICABLE-USING-TYPE-P ++ PCL::COMPUTE-APPLICABLE-METHODS-USING-TYPES ++ PCL::REAL-REMOVE-METHOD PCL::SAUT-PROTOTYPE ++ PCL::MUTATE-SLOTS-AND-CALLS PCL::FIND-SUPERCLASS-CHAIN ++ COMMON-LISP::SLOT-BOUNDP PCL::FORM-LIST-TO-LISP ++ PCL::CPL-INCONSISTENT-ERROR PCL::EMIT-DEFAULT-ONLY-FUNCTION ++ PCL::ENSURE-CLASS-VALUES PCL::CHECK-INITARGS-VALUES ++ PCL::SAUT-EQL PCL::SPLIT-DECLARATIONS ++ PCL::UPDATE-SLOT-VALUE-GF-INFO PCL::SAUT-AND ++ PCL::SLOT-NAME-LISTS-FROM-SLOTS ++ PCL::MAKE-INSTANCE-FUNCTION-TRAP PCL::EMIT-DEFAULT-ONLY ++ PCL::SAUT-NOT PCL::SAUT-CLASS-EQ COMMON-LISP::SLOT-VALUE ++ PCL::DESTRUCTURE PCL::GENERATE-FAST-CLASS-SLOT-ACCESS-P ++ PCL::GET-NEW-FUNCTION-GENERATOR-INTERNAL ++ PCL::CLASS-APPLICABLE-USING-CLASS-P PCL::SDFUN-FOR-CACHING ++ PCL::SET-FUNCTION-NAME)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++ PCL::ARG-INFO-NUMBER-REQUIRED PCL::CACHING-LIMIT-FN ++ PCL::PV-CACHE-LIMIT-FN PCL::ONE-INDEX-LIMIT-FN ++ PCL::PV-TABLE-PV-SIZE PCL::CACHE-COUNT PCL::DEFAULT-LIMIT-FN ++ PCL::CPD-COUNT PCL::CHECKING-LIMIT-FN ++ PCL::N-N-ACCESSORS-LIMIT-FN PCL::EARLY-CLASS-SIZE ++ 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::FIXNUM COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::GET-CACHE-FROM-CACHE)) ++(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) PCL::FIELD-TYPE) ++ PCL::CACHE-FIELD)) ++(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::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))| ++ WALKER::WALK-TEMPLATE PCL::|(FAST-METHOD PRINT-OBJECT (T T))| ++ WALKER::WALK-DO/DO* PCL::LOAD-PRECOMPILED-DFUN-CONSTRUCTOR + 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))| ++ WALKER::WALK-LET/LET* ++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| ++ PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-TYPE ++ PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| + 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 ADD-DIRECT-METHOD (CLASS METHOD))| ++ PCL::INITIALIZE-INSTANCE-SIMPLE ++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| ++ PCL::EXPAND-SYMBOL-MACROLET-INTERNAL + 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 VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| + 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 MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| + 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 LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ PCL::|(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++ PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| ++ PCL::|(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| ++ PCL::|(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| ++ PCL::|(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| + PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| ++ PCL::|(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| ++ PCL::|(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| ++ PCL::MAKE-DISPATCH-LAMBDA ++ PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++ PCL::EXPAND-DEFCLASS ++ PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++ PCL::|(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| ++ PCL::OPTIMIZE-WRITER ++ PCL::|(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD DOCUMENTATION (T))| ++ PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| + 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::OPTIMIZE-READER WALKER::WALK-PROG/PROG* ++ PCL::BOOTSTRAP-SET-SLOT + 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 COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| ++ PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++ PCL::TWO-CLASS-DFUN-INFO ++ PCL::|(FAST-METHOD MAKE-INSTANCE (CLASS))| ++ PCL::|(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++ PCL::ADJUST-CACHE ++ PCL::|(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| ++ PCL::|(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| ++ PCL::EXPAND-CACHE ++ PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| ++ PCL::|(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (CLASS T))| ++ PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++ PCL::|(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| ++ PCL::|(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| ++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| ++ PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| + 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::GET-WRAPPERS-FROM-CLASSES ++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| ++ PCL::MAYBE-EXPAND-ACCESSOR-FORM WALKER::WALK-BINDINGS-2 ++ PCL::FILL-CACHE-P PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-INTERNAL + 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))|)) ++ PCL::|(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| ++ PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| ++ PCL::LOAD-PRECOMPILED-IIS-ENTRY PCL::MEMF-TEST-CONVERTER ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))|)) ++(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::REAL-ADD-NAMED-METHOD PCL::EARLY-ADD-NAMED-METHOD ++ PCL::FILL-DFUN-CACHE)) + (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::OBSOLETE-INSTANCE-TRAP + 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))| ++ WALKER::WALK-TAGBODY ++ PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++ PCL::ENTRY-IN-CACHE-P WALKER::WALK-COMPILER-LET + 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::NOTE-PV-TABLE-REFERENCE PCL::COMPUTE-EFFECTIVE-METHOD ++ PCL::MAKE-DFUN-CALL PCL::|SETF PCL PLIST-VALUE| ++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| ++ PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| ++ PCL::|(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| ++ PCL::|(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++ WALKER::WALK-UNEXPECTED-DECLARE + PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL ++ PCL::SKIP-FAST-SLOT-ACCESS-P PCL::SET-FUNCTION-NAME-1 ++ WALKER::WALK-DO PCL::EMIT-1-T-DLAP PCL::PRINT-STD-INSTANCE ++ PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| ++ WALKER::WALK-LAMBDA PCL::MAKE-METHOD-SPEC ++ PCL::|(FAST-METHOD CLASS-PREDICATE-NAME (T))| ++ PCL::|(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| ++ PCL::OPTIMIZE-SET-SLOT-VALUE ++ PCL::MAKE-OPTIMIZED-STD-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::EXPAND-DEFGENERIC WALKER::VARIABLE-DECLARATION ++ ITERATE::RENAME-AND-CAPTURE-VARIABLES ++ PCL::|(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| ++ PCL::MAP-ALL-ORDERS ++ PCL::|(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| ++ PCL::DECLARE-STRUCTURE WALKER::WALK-PROG ++ PCL::|(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| ++ PCL::OPTIMIZE-SLOT-VALUE WALKER::WALK-MULTIPLE-VALUE-BIND + PCL::|(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| ++ PCL::STANDARD-COMPUTE-EFFECTIVE-METHOD WALKER::WALK-LOCALLY ++ PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| ++ WALKER::WALK-DO* + PCL::|(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| ++ PCL::MAKE-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::EMIT-BOUNDP-CHECK WALKER::RECONS ++ PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| ++ PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| ++ WALKER::WALK-LET* WALKER::WALK-TAGBODY-1 PCL::FLUSH-CACHE-TRAP ++ WALKER::WALK-FLET ++ PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| ++ PCL::|(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| ++ PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| ++ PCL::PRINT-CACHE + 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::INVALIDATE-WRAPPER PCL::GET-NEW-FUNCTION-GENERATOR ++ ITERATE::OPTIMIZE-ITERATE-FORM WALKER::RELIST-INTERNAL ++ PCL::CAN-OPTIMIZE-ACCESS PCL::MAKE-TOP-LEVEL-FORM + PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| ++ WALKER::WALK-MULTIPLE-VALUE-SETQ WALKER::WALK-LABELS ++ PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| ++ PCL::|(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| ++ PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| ++ WALKER::WALK-SETQ WALKER::WALK-LET ++ PCL::|SETF PCL METHOD-FUNCTION-GET| WALKER::WALK-IF ++ PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| ++ ITERATE::SIMPLE-EXPAND-GATHERING-FORM ++ PCL::|(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| ++ WALKER::WALK-NAMED-LAMBDA PCL::FIRST-FORM-TO-LISP ++ PCL::ONE-CLASS-DFUN-INFO ++ WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL ++ PCL::EMIT-GREATER-THAN-1-DLAP PCL::CONVERT-TABLE ++ PCL::|(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| + PCL::INITIALIZE-INTERNAL-SLOT-GFS* ++ ITERATE::OPTIMIZE-GATHERING-FORM ++ PCL::|(FAST-METHOD SPECIALIZER-CLASS (CLASS))| ++ PCL::OPTIMIZE-SLOT-BOUNDP ++ PCL::|(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| ++ PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| ++ PCL::WRAP-METHOD-GROUP-SPECIFIER-BINDINGS ++ WALKER::WALK-SYMBOL-MACROLET ITERATE::VARIABLE-SAME-P ++ PCL::EMIT-SLOT-READ-FORM ++ PCL::SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P ++ PCL::|(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| ++ PCL::GET-FUNCTION-GENERATOR ++ PCL::MAKE-OPTIMIZED-STD-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION ++ PCL::FIX-SLOT-ACCESSORS + 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::OPTIMIZE-GF-CALL-INTERNAL ++ PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| + PCL::|(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| ++ PCL::|(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| ++ PCL::|(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| + 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)) ++ PCL::|(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++ WALKER::WALK-PROG* PCL::ONE-INDEX-DFUN-INFO ++ PCL::COMPUTE-PRECEDENCE PCL::TRACE-EMF-CALL-INTERNAL ++ WALKER::WALK-MACROLET)) ++(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::MAKE-DEFMETHOD-FORM-INTERNAL PCL::LOAD-DEFMETHOD ++ PCL::EARLY-MAKE-A-METHOD PCL::MAKE-DEFMETHOD-FORM)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::GET-EFFECTIVE-METHOD-FUNCTION1 ++ PCL::ENSURE-GENERIC-FUNCTION-USING-CLASS ++ PCL::MAKE-EMF-FROM-METHOD ++ PCL::REAL-ENSURE-GF-USING-CLASS--NULL PCL::PROBE-CACHE ++ PCL::MAP-CACHE PCL::GET-DECLARATION ++ PCL::REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION ++ WALKER::CONVERT-MACRO-TO-LAMBDA ++ PCL::EXPAND-EFFECTIVE-METHOD-FUNCTION PCL::EMIT-MISS ++ PCL::GET-METHOD-FUNCTION-PV-CELL PCL::METHOD-FUNCTION-GET ++ PCL::FIND-CLASS-FROM-CELL PCL::RECORD-DEFINITION ++ PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION1 ++ PCL::FIND-CLASS-PREDICATE-FROM-CELL ++ PCL::NAMED-OBJECT-PRINT-FUNCTION ++ PCL::PRECOMPUTE-EFFECTIVE-METHODS PCL::INITIALIZE-INFO ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE)) + (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::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| ++ PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL1 + 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::BOOTSTRAP-ACCESSOR-DEFINITIONS1 PCL::MAKE-EMF-CACHE ++ PCL::|(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| ++ PCL::MAKE-FGEN + PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| +- PCL::REAL-MAKE-METHOD-INITARGS-FORM ++ PCL::BOOTSTRAP-MAKE-SLOT-DEFINITIONS ++ PCL::|(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::OPTIMIZE-ACCESSOR-CALL ++ PCL::MAKE-INSTANCE-FUNCTION-COMPLEX PCL::UPDATE-SLOTS-IN-PV ++ PCL::COMPUTE-PV-SLOT + 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 ENSURE-CLASS-USING-CLASS (T NULL))| ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| + PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T T))| ++ PCL::OPTIMIZE-INSTANCE-ACCESS ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| ++ PCL::MAKE-INSTANCE-FUNCTION-SIMPLE ++ PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::OPTIMIZE-GENERIC-FUNCTION-CALL ++ PCL::LOAD-FUNCTION-GENERATOR WALKER::WALK-BINDINGS-1 + 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::REAL-MAKE-METHOD-INITARGS-FORM ++ PCL::|(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| ++ PCL::|(FAST-METHOD REMOVE-NAMED-METHOD (T T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| ++ WALKER::WALK-TEMPLATE-HANDLE-REPEAT + PCL::MAKE-PARAMETER-REFERENCES +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| ++ PCL::|(FAST-METHOD SLOT-UNBOUND (T T T))| + PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| ++ PCL::EXPAND-EMF-CALL-METHOD ++ PCL::|(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| + 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)) ++ PCL::MAKE-FINAL-ORDINARY-DFUN-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::GET-METHOD WALKER::WALK-ARGLIST PCL::REAL-GET-METHOD + 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)) ++ PCL::FILL-CACHE PCL::CHECK-INITARGS-2-PLIST PCL::MAKE-EMF-CALL ++ PCL::CHECK-INITARGS-1 PCL::CAN-OPTIMIZE-ACCESS1)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -605,394 +778,250 @@ + '(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::REAL-LOAD-DEFCLASS PCL::LOAD-DEFCLASS PCL::SET-ARG-INFO1 ++ PCL::BOOTSTRAP-MAKE-SLOT-DEFINITION PCL::EMIT-SLOT-ACCESS ++ WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1 PCL::OPTIMIZE-GF-CALL + 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)) ++ 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::FIXNUM) + COMMON-LISP::T) +- PCL::EMIT-DLAP PCL::GET-SECONDARY-DISPATCH-FUNCTION1)) ++ PCL::GET-CACHE PCL::FILL-CACHE-FROM-CACHE-P)) + (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::T COMMON-LISP::FIXNUM COMMON-LISP::*) ++ COMMON-LISP::FIXNUM) ++ PCL::COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION)) + (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::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ PCL::EVAL-FORM PCL::EARLY-CLASS-NAME-OF PCL::DFUN-INFO-CACHE ++ PCL::MAKE-CONSTANT-FUNCTION PCL::EXPAND-SHORT-DEFCOMBIN ++ PCL::COPY-CACHE PCL::PROCLAIM-INCOMPATIBLE-SUPERCLASSES ++ PCL::MAKE-INITIAL-DFUN PCL::ECD-METACLASS ++ PCL::EXTRACT-SPECIALIZER-NAMES PCL::GBOUNDP ++ PCL::GET-SETF-FUNCTION-NAME PCL::USE-CACHING-DFUN-P ++ PCL::INITIALIZE-INFO-CACHED-CONSTANTS ++ PCL::STRUCTURE-TYPE-INTERNAL-SLOTDS COMMON-LISP::CLASS-OF ++ PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-NIL-FUNCTION ++ PCL::ARG-INFO-KEY/REST-P PCL::METHOD-CALL-CALL-METHOD-ARGS ++ PCL::FGEN-GENSYMS PCL::EARLY-CLASS-PRECEDENCE-LIST ++ PCL::EARLY-SLOT-DEFINITION-LOCATION ++ PCL::EXPAND-MAKE-INSTANCE-FORM PCL::INTERN-EQL-SPECIALIZER ++ PCL::METHOD-FUNCTION-METHOD PCL::FGEN-GENERATOR-LAMBDA ++ PCL::SLOT-READER-SYMBOL PCL::CACHING-P ++ PCL::EARLY-METHOD-QUALIFIERS ++ PCL::EARLY-COLLECT-DEFAULT-INITARGS PCL::KEYWORD-SPEC-NAME ++ PCL::ONE-INDEX-P PCL::COMPLICATED-INSTANCE-CREATION-METHOD ++ PCL::DFUN-ARG-SYMBOL PCL::N-N-CACHE ++ PCL::ONE-INDEX-DFUN-INFO-INDEX PCL::INITIAL-DISPATCH-CACHE ++ PCL::CPD-CLASS PCL::FAST-METHOD-CALL-ARG-INFO ++ PCL::MAKE-PV-TYPE-DECLARATION PCL::COMPUTE-STD-CPL-PHASE-2 ++ PCL::GET-BUILT-IN-CLASS-SYMBOL ++ PCL::INITIALIZE-INFO-CACHED-RI-VALID-P ++ PCL::UPDATE-GFS-OF-CLASS PCL::STRUCTURE-SVUC-METHOD ++ PCL::SLOT-BOUNDP-SYMBOL PCL::FGEN-SYSTEM ++ PCL::FIND-CYCLE-REASONS ITERATE::SEQUENCE-ACCESSOR ++ PCL::GF-INFO-C-A-M-EMF-STD-P PCL::STRUCTURE-TYPE-P ++ PCL::TWO-CLASS-CACHE PCL::METHOD-LL->GENERIC-FUNCTION-LL ++ PCL::ONE-CLASS-ACCESSOR-TYPE PCL::WRAPPER-FOR-STRUCTURE ++ PCL::ACCESSOR-DFUN-INFO-CACHE PCL::%SYMBOL-FUNCTION ++ PCL::STRUCTURE-TYPE PCL::NET-TEST-CONVERTER ++ PCL::CONSTANT-SYMBOL-P PCL::GMAKUNBOUND PCL::INITIAL-P ++ PCL::GF-DFUN-CACHE PCL::STRUCTURE-SLOTD-TYPE ++ PCL::%STD-INSTANCE-WRAPPER PCL::INITIALIZE-INFO-P ++ PCL::CACHING-DFUN-INFO ++ PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::FAST-METHOD-CALL-P PCL::GF-DFUN-INFO ++ PCL::INITIALIZE-INFO-BOUND-SLOTS PCL::ECD-CLASS-NAME ++ PCL::MAKE-INSTANCE-FUNCTION-SYMBOL ++ PCL::INITIALIZE-INFO-CACHED-DEFAULT-INITARGS-FUNCTION ++ PCL::STD-INSTANCE-P PCL::EXTRACT-PARAMETERS ++ WALKER::GET-WALKER-TEMPLATE PCL::SYMBOL-PKG-NAME ++ PCL::CCLOSUREP PCL::LOOKUP-FGEN PCL::CPD-SUPERS ++ PCL::ARG-INFO-KEYWORDS PCL::DISPATCH-P ++ PCL::INITIALIZE-INFO-CACHED-NEW-KEYS ++ PCL::MAKE-CALLS-TYPE-DECLARATION PCL::INITIALIZE-INFO-WRAPPER ++ PCL::%FBOUNDP PCL::DEFAULT-STRUCTURE-INSTANCE-P ++ WALKER::ENV-WALK-FORM PCL::EARLY-CLASS-DEFINITION ++ PCL::SORT-CALLS PCL::EARLY-METHOD-STANDARD-ACCESSOR-SLOT-NAME ++ PCL::DISPATCH-CACHE PCL::INITIALIZE-INFO-KEY ++ PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION ++ PCL::ARG-INFO-METATYPES PCL::GF-LAMBDA-LIST ++ WALKER::ENV-LEXICAL-VARIABLES PCL::ACCESSOR-DFUN-INFO-P ++ PCL::GF-PRECOMPUTE-DFUN-AND-EMF-P PCL::COMPUTE-LINE-SIZE ++ PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-T-FUNCTION ++ PCL::FORCE-CACHE-FLUSHES PCL::TWO-CLASS-P PCL::DFUN-INFO-P ++ PCL::MAP-SPECIALIZERS PCL::MAKE-PERMUTATION-VECTOR ++ WALKER::ENV-LOCK PCL::CPD-AFTER PCL::EARLY-CLASS-SLOTS ++ PCL::GET-PV-CELL-FOR-CLASS PCL::ARG-INFO-P ++ PCL::EXTRACT-REQUIRED-PARAMETERS ++ PCL::STRUCTURE-SLOTD-READER-FUNCTION PCL::COMPUTE-CLASS-SLOTS ++ PCL::INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS ++ PCL::TWO-CLASS-WRAPPER0 ++ PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION-SYMBOL ++ PCL::COMPILE-LAMBDA-UNCOMPILED PCL::EARLY-CLASS-NAME ++ PCL::SFUN-P PCL::EXTRACT-LAMBDA-LIST PCL::UNDEFMETHOD-1 ++ PCL::ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE PCL::WRAPPER-OF ++ PCL::ARG-INFO-LAMBDA-LIST PCL::LIST-DFUN ++ PCL::NEXT-WRAPPER-FIELD PCL::CHECK-WRAPPER-VALIDITY ++ PCL::STRUCTURE-SLOTD-NAME PCL::BUILT-IN-WRAPPER-OF ++ PCL::GET-MAKE-INSTANCE-FUNCTIONS ++ PCL::GENERIC-CLOBBERS-FUNCTION PCL::NO-METHODS-P ++ PCL::CONSTANT-VALUE-P WALKER::ENV-WALK-FUNCTION ++ PCL::INITIAL-CACHE PCL::SLOT-INITARGS-FROM-STRUCTURE-SLOTD ++ PCL::MAKE-CLASS-EQ-PREDICATE ++ PCL::GET-MAKE-INSTANCE-FUNCTION-SYMBOL ++ PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS ++ PCL::FUNCTION-PRETTY-ARGLIST ++ PCL::MAKE-OPTIMIZED-STRUCTURE-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::FTYPE-DECLARATION-FROM-LAMBDA-LIST PCL::TYPE-CLASS ++ PCL::CHECK-CACHE PCL::STANDARD-SVUC-METHOD ++ PCL::STRUCTURE-SLOTD-ACCESSOR-SYMBOL PCL::GF-INFO-FAST-MF-P ++ PCL::STRUCTURE-SLOTD-WRITER-FUNCTION ++ PCL::BOOTSTRAP-CLASS-PREDICATES PCL::DEFAULT-METHOD-ONLY-CACHE ++ PCL::GET-CACHE-VECTOR PCL::SLOT-WRITER-SYMBOL ++ PCL::FGEN-GENERATOR PCL::DNET-METHODS-P ++ PCL::DEFAULT-STRUCTURE-TYPE ++ PCL::INITIALIZE-INFO-CACHED-COMBINED-INITARGS-FORM-LIST ++ PCL::N-N-ACCESSOR-TYPE ++ PCL::STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST ++ WALKER::ENV-DECLARATIONS WALKER::VARIABLE-GLOBALLY-SPECIAL-P ++ PCL::ONE-INDEX-INDEX PCL::ONE-INDEX-DFUN-INFO-CACHE ++ PCL::EARLY-ACCESSOR-METHOD-SLOT-NAME PCL::EARLY-CLASS-SLOTDS ++ PCL::CANONICAL-SLOT-NAME PCL::EARLY-COLLECT-CPL ++ PCL::RESET-CLASS-INITIALIZE-INFO-1 ++ PCL::BUILT-IN-OR-STRUCTURE-WRAPPER1 PCL::ONE-INDEX-CACHE ++ PCL::MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION ++ PCL::MAKE-TYPE-PREDICATE PCL::FREE-CACHE ++ ITERATE::VARIABLES-FROM-LET ++ PCL::EARLY-METHOD-STANDARD-ACCESSOR-P ++ PCL::DEFAULT-CONSTANT-CONVERTER PCL::CLASS-PREDICATE ++ PCL::CHECKING-CACHE PCL::ARG-INFO-PRECEDENCE ++ PCL::METHOD-FUNCTION-NEEDS-NEXT-METHODS-P ++ PCL::DEFAULT-METHOD-ONLY-P ++ PCL::COMPUTE-APPLICABLE-METHODS-EMF-STD-P ++ PCL::STRUCTURE-SLOT-BOUNDP PCL::ONE-INDEX-ACCESSOR-TYPE ++ PCL::TWO-CLASS-ACCESSOR-TYPE ++ PCL::USE-DEFAULT-METHOD-ONLY-DFUN-P PCL::METHOD-CALL-P ++ PCL::UPDATE-CLASS-CAN-PRECEDE-P PCL::CONSTANT-VALUE-DFUN-INFO ++ PCL::COMPILE-LAMBDA-DEFERRED PCL::SETFBOUNDP ++ PCL::CLASS-HAS-A-FORWARD-REFERENCED-SUPERCLASS-P ++ PCL::PV-TABLEP PCL::STRUCTURE-OBJECT-P PCL::TWO-CLASS-INDEX ++ PCL::METHOD-FUNCTION-PV-TABLE PCL::ECD-OTHER-INITARGS ++ WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE ++ PCL::EARLY-GF-P PCL::STRUCTURE-SLOTD-INIT-FORM ++ PCL::FUNCALLABLE-INSTANCE-P PCL::CHECKING-FUNCTION ++ PCL::FUNCTION-RETURNING-NIL PCL::FUNCTION-RETURNING-T ++ PCL::UPDATE-C-A-M-GF-INFO PCL::COUNT-DFUN ++ PCL::UNPARSE-SPECIALIZERS PCL::CACHE-OWNER ++ PCL::EARLY-METHOD-CLASS ++ PCL::INITIALIZE-INFO-CACHED-COMBINED-INITIALIZE-FUNCTION ++ PCL::EARLY-SLOT-DEFINITION-NAME ++ PCL::GET-MAKE-INSTANCE-FUNCTION ++ PCL::STRUCTURE-TYPE-INCLUDED-TYPE-NAME ++ PCL::ECD-SUPERCLASS-NAMES PCL::GFS-OF-TYPE PCL::SORT-SLOTS ++ PCL::DO-STANDARD-DEFSETFS-FOR-DEFCLASS ++ PCL::COMPUTE-MCASE-PARAMETERS PCL::METHOD-FUNCTION-PLIST ++ PCL::ARG-INFO-NKEYS PCL::FINAL-ACCESSOR-DFUN-TYPE ++ PCL::EARLY-COLLECT-SLOTS PCL::EARLY-METHOD-LAMBDA-LIST ++ PCL::FAST-INSTANCE-BOUNDP-P PCL::GDEFINITION ++ PCL::%CCLOSURE-ENV SYSTEM::%COMPILED-FUNCTION-NAME ++ PCL::RESET-INITIALIZE-INFO PCL::ARG-INFO-NUMBER-OPTIONAL ++ PCL::RESET-CLASS-INITIALIZE-INFO ++ PCL::INITIALIZE-INFO-CACHED-VALID-P PCL::INTERNED-SYMBOL-P ++ PCL::EARLY-GF-NAME PCL::FGEN-TEST PCL::MAKE-INITFUNCTION ++ PCL::MAP-ALL-GENERIC-FUNCTIONS PCL::SHOW-DFUN-COSTS ++ PCL::CLASS-FROM-TYPE PCL::EXPAND-LONG-DEFCOMBIN ++ PCL::MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION ++ PCL::FREE-CACHE-VECTOR PCL::%STD-INSTANCE-SLOTS ++ PCL::ALLOCATE-CACHE-VECTOR PCL::ONE-CLASS-P ++ PCL::CLASS-PRECEDENCE-DESCRIPTION-P PCL::SLOT-VECTOR-SYMBOL ++ PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION ++ PCL::ONE-CLASS-WRAPPER0 PCL::N-N-P ++ PCL::UPDATE-ALL-C-A-M-GF-INFO PCL::CHECKING-P ++ PCL::TWO-CLASS-WRAPPER1 PCL::PARSE-SPECIALIZERS ++ PCL::FORMAT-CYCLE-REASONS PCL::FLUSH-CACHE-VECTOR-INTERNAL ++ PCL::UNENCAPSULATED-FDEFINITION PCL::ONE-CLASS-INDEX ++ PCL::DEFAULT-CONSTANTP PCL::UPDATE-GF-INFO ++ PCL::ACCESSOR-DFUN-INFO-ACCESSOR-TYPE ++ PCL::INITIALIZE-INFO-CACHED-INITARGS-FORM-LIST ++ PCL::MAKE-EQL-PREDICATE PCL::ARG-INFO-VALID-P ++ PCL::CACHING-CACHE PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION ++ PCL::FAST-METHOD-CALL-NEXT-METHOD-CALL ++ PCL::DEFAULT-SECONDARY-DISPATCH-FUNCTION ++ PCL::MAKE-FUNCTION-INLINE PCL::STORE-FGEN ++ PCL::LIST-LARGE-CACHE PCL::METHODS-CONTAIN-EQL-SPECIALIZER-P ++ PCL::ARG-INFO-APPLYP SYSTEM::%STRUCTURE-NAME ++ PCL::GF-INFO-SIMPLE-ACCESSOR-TYPE PCL::ECD-SOURCE ++ PCL::EARLY-CLASS-DIRECT-SUBCLASSES ++ PCL::UPDATE-PV-TABLE-CACHE-INFO PCL::DEFAULT-TEST-CONVERTER ++ PCL::MAKE-CALL-METHODS PCL::GET-BUILT-IN-WRAPPER-SYMBOL ++ PCL::GF-INFO-STATIC-C-A-M-EMF PCL::DEFAULT-STRUCTUREP ++ PCL::CONSTANT-VALUE-CACHE PCL::INITIAL-DISPATCH-P ++ PCL::ECD-CANONICAL-SLOTS PCL::WRAPPER-FIELD ++ PCL::UPDATE-GF-SIMPLE-ACCESSOR-TYPE PCL::ONE-CLASS-CACHE ++ PCL::CACHING-DFUN-COST PCL::LEGAL-CLASS-NAME-P ++ PCL::INTERN-FUNCTION-NAME PCL::FAST-METHOD-CALL-PV-CELL ++ PCL::CACHE-P PCL::ONE-INDEX-DFUN-INFO-P ++ PCL::MAKE-PV-TABLE-TYPE-DECLARATION PCL::NO-METHODS-CACHE)) + (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::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++ PCL::UPDATE-MAKE-INSTANCE-FUNCTION-TABLE PCL::UNTRACE-METHOD ++ COMMON-LISP::METHOD-COMBINATION-ERROR ++ COMMON-LISP::INVALID-METHOD-ERROR PCL::LIST-LARGE-CACHES)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::FIXNUM) ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + 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)) ++ PCL::EMIT-DLAP PCL::GET-SECONDARY-DISPATCH-FUNCTION1)) + (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 COMMON-LISP::T ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) + 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)) ++ 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::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::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::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::*) + 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)) ++ PCL::BOOTSTRAP-INITIALIZE-CLASS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::FIXNUM) +- PCL::GET-WRAPPER-CACHE-NUMBER)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::LIST) ++ PCL::PV-TABLE-CALL-LIST PCL::CACHE-OVERFLOW ++ PCL::PV-TABLE-SLOT-NAME-LISTS)) + (IN-PACKAGE "PCL") + +-(DOLIST (V '(|(FAST-WRITER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| +- |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-METHODS)| ++(DOLIST (V '(|(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-METHODS)| + |(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 FROM-DEFCLASS-P)| + |(FAST-WRITER-METHOD SLOT-OBJECT METHODS)| + |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHODS)| + |(FAST-WRITER-METHOD SLOT-OBJECT OPTIONS)| +@@ -1034,17 +1063,16 @@ + COMPATIBLE-META-CLASS-CHANGE-P + |(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 READER-FUNCTION)| |(BOUNDP PREDICATE-NAME)| ++ |(BOUNDP READERS)| UPDATE-GF-DFUN ++ |(BOUNDP CLASS-PRECEDENCE-LIST)| + |(BOUNDP ACCESSOR-FLAGS)| |(BOUNDP LOCATION)| + |(BOUNDP DOCUMENTATION)| SPECIALIZER-OBJECT + |(BOUNDP INCOMPATIBLE-SUPERCLASS-LIST)| + ACCESSOR-METHOD-SLOT-NAME |(BOUNDP SPECIALIZERS)| + |(BOUNDP IDENTITY-WITH-ONE-ARGUMENT)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)| +- REDEFINE-FUNCTION SPECIALIZER-CLASS +- |(BOUNDP PRETTY-ARGLIST)| ++ SPECIALIZER-CLASS |(BOUNDP PRETTY-ARGLIST)| + |PCL::PCL-CLASS class predicate| + |PCL::STD-CLASS class predicate| + |(BOUNDP DEFSTRUCT-FORM)| +@@ -1082,104 +1110,104 @@ + |(BOUNDP OPTIONS)| |(WRITER METHOD)| + |PCL::DEPENDENT-UPDATE-MIXIN class predicate| + GENERIC-FUNCTION-PRETTY-ARGLIST |(WRITER SOURCE)| ++ |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| + |(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 REINITIALIZE-INSTANCE (SLOT-OBJECT))| + |(FAST-METHOD INITIALIZE-INSTANCE (SLOT-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 (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| + |(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| ++ |(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| ++ |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| + MAKE-BOUNDP-METHOD-FUNCTION + |(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| + |(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| + |PCL::METAOBJECT class predicate| +- |(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-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| ++ |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| ++ |(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| ++ |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| ++ |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| + |(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| ++ |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| + |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| ++ |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| ++ |(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| + |(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 METHOD-FUNCTION (STANDARD-METHOD))| ++ |(FAST-METHOD CHANGE-CLASS (T SYMBOL))| ++ |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| + |(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 REMOVE-DIRECT-METHOD (CLASS METHOD))| + |(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-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 SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| ++ |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD MAKE-INSTANCE (SYMBOL))| ++ |(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 (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| +- |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| +- |(FAST-METHOD SLOTS-FETCHER (STANDARD-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 SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD SPECIALIZER-CLASS (CLASS))| ++ |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| ++ |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| ++ |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| + |(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| ++ |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| ++ |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| ++ |(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| + |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++ |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| + |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| +- |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| ++ |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| + |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| +- |(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| ++ |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS 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 COMPUTE-SLOTS (STRUCTURE-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 COMPUTE-SLOTS (STD-CLASS))| ++ |(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-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 FINALIZE-INHERITANCE (STRUCTURE-CLASS))| ++ |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| + |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| ++ |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| ++ |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| ++ |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| ++ |(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| ++ |(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| ++ |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| ++ |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| ++ |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| ++ |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| + |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| + |(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| ++ |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| ++ |(FAST-METHOD MAKE-INSTANCE (CLASS))| + |(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| +- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| ++ |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| ++ |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| ++ |(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| ++ |(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| + CLASS-PREDICATE-NAME + |PCL::STRUCTURE-SLOT-DEFINITION class predicate| + |PCL::STRUCTURE-DIRECT-SLOT-DEFINITION class predicate| +@@ -1205,8 +1233,8 @@ + |(WRITER PREDICATE-NAME)| |(WRITER READERS)| + |(READER WRITER-FUNCTION)| |(READER INITFUNCTION)| + INITIALIZE-INTERNAL-SLOT-FUNCTIONS +- |SETF PCL SLOT-DEFINITION-TYPE| |(READER WRITERS)| +- |(WRITER CLASS-PRECEDENCE-LIST)| ++ |SETF PCL SLOT-DEFINITION-TYPE| ++ |(WRITER CLASS-PRECEDENCE-LIST)| |(READER WRITERS)| + |(WRITER ACCESSOR-FLAGS)| |(READER INITFORM)| + METHOD-COMBINATION-P |(WRITER LOCATION)| + |(WRITER DOCUMENTATION)| +@@ -1220,11 +1248,11 @@ + |(READER ALLOCATION)| |(WRITER SPECIALIZERS)| + |(CALL REAL-ENSURE-GF-USING-CLASS--NULL)| + |(WRITER IDENTITY-WITH-ONE-ARGUMENT)| +- |(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)| ++ |(SETF METHOD-GENERIC-FUNCTION)| LEGAL-SPECIALIZERS-P ++ |(WRITER PRETTY-ARGLIST)| |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 SLOT-DEFINITION-INITFORM| + |SETF PCL CLASS-DEFSTRUCT-FORM| +@@ -1245,16 +1273,17 @@ + |SETF PCL SLOT-DEFINITION-ALLOCATION| + |SETF PCL SLOT-DEFINITION-INITFUNCTION| + |(WRITER SLOT-NAME)| |(BOUNDP NAME)| +- |(READER FAST-FUNCTION)| |(WRITER ALLOCATION)| ++ |(WRITER ALLOCATION)| |(READER FAST-FUNCTION)| + |(READER METHOD-CLASS)| |(SETF OBJECT-PLIST)| + |(READER INTERNAL-WRITER-FUNCTION)| + |(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)| ++ |SETF PCL SLOT-DEFINITION-READERS| ++ |(READER BOUNDP-FUNCTION)| |(WRITER FUNCTION)| ++ |(WRITER GENERIC-FUNCTION)| |SETF PCL DOCUMENTATION| ++ |(READER DIRECT-SUBCLASSES)| + |(READER DIRECT-SUPERCLASSES)| |(WRITER LAMBDA-LIST)| + FUNCALLABLE-STANDARD-CLASS-P + |(FAST-WRITER-METHOD SLOT-OBJECT METHOD)| +@@ -1265,7 +1294,7 @@ + |SETF PCL SLOT-VALUE-USING-CLASS| + |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)| + |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)| +- |(WRITER PROTOTYPE)| |(BOUNDP TYPE)| |(BOUNDP OBJECT)| ++ |(WRITER PROTOTYPE)| |(BOUNDP OBJECT)| |(BOUNDP TYPE)| + CLASS-CAN-PRECEDE-LIST |SETF PCL CLASS-DIRECT-SLOTS| + |SETF PCL CLASS-SLOTS| SLOT-ACCESSOR-FUNCTION + |(BOUNDP PLIST)| +@@ -1280,11 +1309,11 @@ + |(FAST-WRITER-METHOD SLOT-OBJECT ARG-INFO)| + |PCL::PLIST-MIXIN class predicate| + |(WRITER FAST-FUNCTION)| |(WRITER METHOD-CLASS)| +- |(FAST-WRITER-METHOD SLOT-OBJECT WRAPPER)| GET-METHOD ++ |(FAST-WRITER-METHOD SLOT-OBJECT WRAPPER)| + |(WRITER INTERNAL-WRITER-FUNCTION)| + |(WRITER INTERNAL-READER-FUNCTION)| +- |(WRITER METHOD-COMBINATION)| |(WRITER DIRECT-SLOTS)| +- |(WRITER DIRECT-METHODS)| ++ |(WRITER METHOD-COMBINATION)| GET-METHOD ++ |(WRITER DIRECT-SLOTS)| |(WRITER DIRECT-METHODS)| + |(FAST-WRITER-METHOD SLOT-OBJECT INITARGS)| + |(FAST-WRITER-METHOD SLOT-DEFINITION INITARGS)| + |(FAST-WRITER-METHOD SLOT-OBJECT OPERATOR)| +@@ -1354,18 +1383,18 @@ + |(FAST-READER-METHOD SLOT-DEFINITION READERS)| + |(FAST-READER-METHOD SLOT-OBJECT SPECIALIZERS)| + |(FAST-READER-METHOD STANDARD-METHOD SPECIALIZERS)| ++ |(FAST-READER-METHOD SHORT-METHOD-COMBINATION IDENTITY-WITH-ONE-ARGUMENT)| ++ |(FAST-READER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| + |(FAST-READER-METHOD SPECIALIZER TYPE)| + |(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-DEFINITION TYPE)| ++ |(FAST-READER-METHOD SLOT-OBJECT TYPE)| ++ |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION TYPE)| + |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| + |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)| + |(FAST-READER-METHOD SLOT-OBJECT INITFORM)| +@@ -1387,11 +1416,11 @@ + |(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 FROM-DEFCLASS-P)| + |(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)| +@@ -1429,8 +1458,8 @@ + |(FAST-BOUNDP-METHOD SLOT-OBJECT READERS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT SPECIALIZERS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT PROTOTYPE)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT TYPE)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT OBJECT)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT TYPE)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT INITFORM)| + |(SETF SLOT-VALUE-USING-CLASS)| +@@ -1456,10 +1485,10 @@ + |(SETF SLOT-DEFINITION-TYPE)| + |(SETF SLOT-DEFINITION-INITFORM)| + |(BOUNDP INITIALIZE-INFO)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| + |(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 FROM-DEFCLASS-P)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT METHODS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT OPTIONS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)| +@@ -1468,94 +1497,95 @@ + |(BOUNDP INITARGS)| LONG-METHOD-COMBINATION-FUNCTION + GENERIC-FUNCTION-P + |PCL::SLOT-DEFINITION class predicate| |(READER NAME)| +- |(READER CLASS)| |(FAST-METHOD SLOT-UNBOUND (T T T))| +- |(FAST-METHOD (SETF DOCUMENTATION) (T 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 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))| ++ |(READER CLASS)| ++ |(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| ++ |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| ++ |(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| ++ |(FAST-METHOD DESCRIBE-OBJECT (T T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| ++ |(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| ++ |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| ++ |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| ++ |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| + |(FAST-METHOD REMOVE-NAMED-METHOD (T T))| ++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| ++ |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD 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 :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 SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| ++ |(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| ++ |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| + |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| +- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| ++ |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| ++ |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| ++ |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| ++ |(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| ++ |(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| ++ |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| ++ |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| ++ |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| ++ |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION 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 MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++ |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS 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 ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| ++ |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T 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-BOUNDP-METHOD-FUNCTION (SLOT-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 REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| ++ |(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| ++ |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| ++ |(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T 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 WRITER-METHOD-CLASS (SLOT-CLASS 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 READER-METHOD-CLASS (SLOT-CLASS T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| ++ |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| ++ |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++ |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| ++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| ++ |(FAST-METHOD (SETF DOCUMENTATION) (T T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| ++ |(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| ++ |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| ++ |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| ++ |(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| ++ |(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION 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 ADD-BOUNDP-METHOD (SLOT-CLASS T 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 UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T 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-UNBOUND (T T T))| + |(FAST-METHOD SLOT-MISSING (T T T T))| +- |(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| +- LEGAL-SLOT-NAME-P |(READER TYPE)| |(READER OBJECT)| ++ |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| ++ |(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| ++ LEGAL-SLOT-NAME-P |(READER OBJECT)| |(READER TYPE)| + CLASS-WRAPPER |(READER PLIST)| + |(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 TYPE)| +- |(WRITER OBJECT)| ++ |(WRITER CLASS)| CLASS-SLOT-VALUE |(WRITER OBJECT)| ++ |(WRITER TYPE)| + |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| + |(WRITER PLIST)| |(WRITER SLOTS)| + |PCL::DOCUMENTATION-MIXIN class predicate| +@@ -1595,10 +1625,10 @@ + |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 ++ |(SETF CLASS-DIRECT-SLOTS)| |(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)| +@@ -1607,8 +1637,8 @@ + |(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 ++ STANDARD-BOUNDP-METHOD-P |(SETF DOCUMENTATION)| ++ RAW-INSTANCE-ALLOCATOR + |SETF PCL SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL| + |SETF PCL CLASS-INITIALIZE-INFO| |(WRITER OPERATOR)| + |(WRITER ARG-INFO)| +@@ -1621,8 +1651,9 @@ + METHOD-COMBINATION-DOCUMENTATION + |SETF PCL SLOT-DEFINITION-INITARGS| + REMOVE-BOUNDP-METHOD ADD-NAMED-METHOD ++ |(WRITER INITARGS)| + |SETF PCL CLASS-DEFSTRUCT-CONSTRUCTOR| +- |(WRITER INITARGS)| |(BOUNDP METHOD)| ++ |(BOUNDP METHOD)| + |(FAST-WRITER-METHOD SLOT-OBJECT PREDICATE-NAME)| + |(FAST-WRITER-METHOD CLASS NAME)| + |(FAST-WRITER-METHOD SLOT-DEFINITION NAME)| +@@ -1668,11 +1699,11 @@ + |(FAST-WRITER-METHOD SLOT-OBJECT READERS)| + |(FAST-WRITER-METHOD SLOT-DEFINITION READERS)| + |(FAST-WRITER-METHOD SLOT-OBJECT SPECIALIZERS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| + |(FAST-WRITER-METHOD SLOT-OBJECT PROTOTYPE)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT OBJECT)| + |(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-OBJECT DEFSTRUCT-FORM)| + |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)| +@@ -1725,6 +1756,5 @@ + ENSURE-CLASS-USING-CLASS NO-APPLICABLE-METHOD + SLOT-DEFINITION-WRITERS + COMPUTE-APPLICABLE-METHODS-USING-CLASSES +- CLASS-PRECEDENCE-LIST DISASSEMBLE DESCRIBE-OBJECT +- COMPILE)) +- (SETF (GET V 'SYSTEM::PROCLAIMED-CLOSURE) T)) ++ CLASS-PRECEDENCE-LIST DESCRIBE-OBJECT)) ++ (SETF (GET V 'COMPILER::PROCLAIMED-CLOSURE) T)) diff --git a/patches/real_list_order.12 b/patches/real_list_order.12 new file mode 100644 index 00000000..9da00c36 --- /dev/null +++ b/patches/real_list_order.12 @@ -0,0 +1,159 @@ +Description: + 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-56) unstable; urgency=medium + . + * list_order.12 +Author: Camm Maguire + +--- +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: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-08-25 + +--- gcl-2.6.12.orig/o/print.d ++++ gcl-2.6.12/o/print.d +@@ -702,18 +702,18 @@ print_symbol_name_body(object x) { + #define FOUND -1 + + static int +-write_sharp_eq(object *vp,bool dot) { ++do_write_sharp_eq(object x,bool dot) { + +- bool defined=vp[1]!=Cnil; ++ bool defined=x->c.c_cdr!=Cnil; + + if (dot) { + write_str(" . "); + if (!defined) return FOUND; + } + +- vp[1]=Ct; ++ x->c.c_cdr=Ct; + write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2); ++ write_decimal(fix(x->c.c_car)); + write_ch(defined ? '#' : '='); + + return defined ? DONE : FOUND; +@@ -721,15 +721,12 @@ write_sharp_eq(object *vp,bool dot) { + } + + static int +-write_sharp_eqs(object x,bool dot) { ++write_sharp_eq(object x,bool dot) { + +- object *vp; ++ struct htent *e; + +- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) +- if (x == *vp) +- return write_sharp_eq(vp,dot); +- +- return 0; ++ return PRINTvs_top[0]!=Cnil && (e=gethash(x,PRINTvs_top[0]))->hte_key!=OBJNULL ? ++ do_write_sharp_eq(e->hte_value,dot) : 0; + + } + +@@ -916,7 +913,7 @@ int level; + if (PRINTescape) { + if (x->s.s_hpack == Cnil) { + if (PRINTcircle) +- if (write_sharp_eqs(x,FALSE)==DONE) return; ++ if (write_sharp_eq(x,FALSE)==DONE) return; + if (PRINTgensym) + write_str("#:"); + } else if (x->s.s_hpack == keyword_package) { +@@ -952,7 +949,7 @@ int level; + break; + } + if (PRINTcircle) +- if (write_sharp_eqs(x,FALSE)==DONE) return; ++ if (write_sharp_eq(x,FALSE)==DONE) return; + if (PRINTlevel >= 0 && level >= PRINTlevel) { + write_ch('#'); + break; +@@ -1028,7 +1025,7 @@ int level; + break; + } + if (PRINTcircle) +- if (write_sharp_eqs(x,FALSE)==DONE) return; ++ if (write_sharp_eq(x,FALSE)==DONE) return; + if (PRINTlevel >= 0 && level >= PRINTlevel) { + write_ch('#'); + break; +@@ -1099,7 +1096,7 @@ int level; + break; + } + if (PRINTcircle) +- if (write_sharp_eqs(x,FALSE)==DONE) return; ++ if (write_sharp_eq(x,FALSE)==DONE) return; + if (PRINTpretty) { + if (x->c.c_car == sLquote && + type_of(x->c.c_cdr) == t_cons && +@@ -1146,7 +1143,7 @@ int level; + break; + } + if (PRINTcircle) +- switch (write_sharp_eqs(x,TRUE)) { ++ switch (write_sharp_eq(x,TRUE)) { + case FOUND: + write_object(x, level); + case DONE: +@@ -1316,7 +1313,7 @@ int level; + + case t_structure: + if (PRINTcircle) +- if (write_sharp_eqs(x,FALSE)==DONE) return; ++ if (write_sharp_eq(x,FALSE)==DONE) return; + if (PRINTlevel >= 0 && level >= PRINTlevel) { + write_ch('#'); + break; +@@ -1415,7 +1412,6 @@ travel_push(object x) { + + if (!travel_pushed(x)) { + vs_check_push(x); +- vs_check_push(Cnil); + travel_pushed(x)=1; + } + +@@ -1519,10 +1515,13 @@ travel_clear(object x) { + + } + ++object sLeq; + + static void + setupPRINTcircle(object x,int dogensyms) { + ++ object *xp; ++ + BEGIN_NO_INTERRUPT; + dgs=dogensyms; + travel_push(x); +@@ -1531,6 +1530,12 @@ setupPRINTcircle(object x,int dogensyms) + travel_clear(x); + END_NO_INTERRUPT; + ++ vs_check_push(PRINTvs_limit>PRINTvs_top ? funcall_cfun(Lmake_hash_table,2,sKtest,sLeq) : Cnil); ++ for (xp=PRINTvs_top;xp\n" +"Language-Team: Czech \n" +"Language: cs\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Používat implicitně ANSI verzi (stále ve vývoji)?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL se nachází ve fázi, kdy kromě tradičního obrazu CLtL1 (který se stále " +"používá) poskytuje i obraz kompatibilní s ANSI." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Pro stručný popis těchto termínů si prosím přečtěte soubor README.Debian. " +"Touto odpovědí určujete, který obraz se spustí po zadání „gcl@EXT@“. " + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Toto nastavení můžete přebít nastavením proměnné prostředí GCL_ANSI na " +"neprázdný řetězec (použije ANSI verzi) nebo na prázdnou hodnotu (použije " +"CLtL1 verzi). Například GCL_ANSI=t gcl@EXT@. Aktuálně použitá verze se " +"zobrazí na úvodní obrazovce." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Používat implicitně profilování?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL nyní podporuje profilování přes gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Podrobnosti naleznete v dokumentaci si::gprof-start a si::gprof-quit. Tato " +"verze je pomalejší než verze bez podpory gprof, tudíž ji nedoporučujeme pro " +"koncové produkční nasazení." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Toto nastavení můžete přebít nastavením proměnné prostředí GCL_PROF na " +"neprázdný řetězec (zapne profilování) nebo na prázdnou hodnotu (povolí lepší " +"optimalizace). Například GCL_PROF=t gcl@EXT@. Pokud je profilování zapnuto, " +"dozvíte se o tom z úvodní obrazovky." + +#~ msgid "" +#~ "GCL is one of the oldest free common lisp systems still in use. Several " +#~ "production systems have used it for over a decade. The common lisp " +#~ "standard in effect when GCL was first released is known as \"Common Lisp, " +#~ "the Language\" (CLtL1) after a book by Steele of the same name providing " +#~ "this specification. Subsequently, a much expanded standard was adopted " +#~ "by the American National Standards Institute (ANSI), which is still " +#~ "considered the definitive common lisp language specification to this " +#~ "day. GCL is in the process of providing an ANSI compliant image in " +#~ "addition to its traditional CLtL1 image still in production use. Setting " +#~ "this variable will determine which image you will use by default on " +#~ "executing 'gcl'. You can locally override this choice by setting the " +#~ "GCL_ANSI environment variable to any non-empty string for the ANSI build, " +#~ "and to the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl. You " +#~ "may be interested in reviewing the ANSI test results sketching the level " +#~ "of compliance achieved thus far in /usr/share/doc/gcl/test_results.gz. " +#~ "The flavor of the build in force will be reported in the initial startup " +#~ "banner." +#~ msgstr "" +#~ "GCL je jedním z nejstarších svobodných systémů common lispu, který se " +#~ "dosud používá. Několik produkčních systémů jej používá déle než dekádu. " +#~ "Při prvním vydání GCL byl v platnosti standard common lispu známý jako " +#~ "\"Common Lisp, the Language\" (CLtL1) pojmenovaný podle Steelovy knihy " +#~ "stejného jména, která tento standard definovala. Americkým národním " +#~ "institutem pro standardizaci (ANSI) pak byl přijat podstatně rozšířený " +#~ "standard, který se do dneÅ¡ní doby považuje za konečnou specifikaci common " +#~ "lispu. Kromě tradičního CLtL1 se GCL snaží nabídnout i verzi odpovídající " +#~ "ANSI standardu. Nastavením této proměnné určíte, jakým způsobem se má " +#~ "binárka 'gcl' chovat. Lokálně můžete toto nastavení přepsat nastavením " +#~ "proměnné prostředí GCL_ANSI na neprázdný řetězec (zapne ANSI chování) " +#~ "nebo na prázdnou hodnotu (zapne CLtL1 chování). Například GCL_ANSI-t gcl. " +#~ "Aktuálně vybraný standard bude zobrazen v úvodní obrazovce prostředí. " +#~ "Zajímavé může být porovnání dosud dosažené shody s ANSI standardem v " +#~ "souboru /usr/share/doc/gcl/test_results.gz." diff --git a/po/da.po b/po/da.po new file mode 100644 index 00000000..11d3fc63 --- /dev/null +++ b/po/da.po @@ -0,0 +1,97 @@ +# Danish translation gcl. +# Copyright (C) 2012 gcl & nedenstÃ¥ende oversættere. +# This file is distributed under the same license as the gcl package. +# Joe Hansen (joedalton2@yahoo.dk), 2012. +# +msgid "" +msgstr "" +"Project-Id-Version: gcl\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2012-03-31 12:42+0000\n" +"Last-Translator: Joe Hansen \n" +"Language-Team: Danish \n" +"Language: da\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Brug den foreløbige ANSI bygget som standard?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL er i gang med at tilbyde et ANSI-overholdende aftryk udover det " +"traditionelle CLtL1-aftryk som stadig er i produktionsbrug." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Se venligst filen README.Debian for en kort beskrivelse af disse termer. " +"Valg af denne indstilling vil bestemme hvilket aftryk som vil blive brugt " +"som standard, nÃ¥r der køres »gcl@EXT@«." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Denne indstilling kan overskrives ved at angive miljøvariablen GCL_ANSI til " +"enhver streng der ikke er tom for ANSI-bygningen, og til den tomme streng " +"for CLtL1-bygningen, f.eks. GCL_ANSI=t gcl@EXT@. Den aktuelt tvungne " +"byggevariant vil blive rapporteret i det oprindelige opstartsbanner." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Brug profileringen bygget som standard?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL har valgfri understøttelse for profilering via gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Se venligst dokumentationen for si::gprof-start og si::gprof-quit for " +"detaljer. Da denne bygning er langsommere end bygninger uden gprof-" +"understøttelse, sÃ¥ anbefales den ikke for endelig produktionsbrug." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Angiv miljøvariablen GCL_PROF til den tomme streng for bedre optimerede " +"bygninger, eller enhver streng der ikke er tom for " +"profileringsunderstøttelse; f.eks. GCL_PROF=t gcl@EXT@. Hvis profilering er " +"aktiveret, vil denne blive rapporteret i det oprindelige opstartsbanner." diff --git a/po/de.po b/po/de.po new file mode 100644 index 00000000..e8b0ff3a --- /dev/null +++ b/po/de.po @@ -0,0 +1,139 @@ +# Translation of gcl debconf templates to German +# Copyright (C) Stefan Bauer , 2007. +# Copyright (C) Helge Kreutzmann , 2007, 2008. +# This file is distributed under the same license as the gcl package. +# +msgid "" +msgstr "" +"Project-Id-Version: gcl 2.6.7-36\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-01-09 11:49+0100\n" +"Last-Translator: Stefan Bauer \n" +"Language-Team: de \n" +"Language: \n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=ISO-8859-15\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Verwende standardmäßig den sich in Arbeit befindlichen ANSI-Build?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL ist derzeit dabei, zusätzlich zu dem noch im Einsatz befindlichen " +"traditionellen CLtL1-Image ein ANSI-konformes Image bereitzustellen." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Bitte lesen Sie die Datei README.Debian für eine kurze Beschreibung dieser " +"Begriffe. Die Wahl dieser Option bestimmen, welches Image standardmäßig " +"verwendet wird, wenn »gcl@EXT@« ausgeführt wird." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Diese Einstellung kann mit der Umgebungsvariablen GCL_ANSI überschrieben " +"werden. Jede nicht-leere Zeichenkette führt zur ANSI-Erstellung, und die " +"leere Zeichenkette führt zum CLtL1-Bau, z.B. GCL_ANSI=t gcl@EXT@. In der " +"Startmeldung wird die derzeit erzwungene Bauart berichtet." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Verwende standardmäßig den Profiling-Build?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL besitzt optionale Unterstützung für Profiling mittels Gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Bitte lesen Sie die Dokumentation für si::gprof-start und si::gprof-quit für " +"Details. Da ein solches Programm langsamer ist als ein Programm ohne Gprof-" +"Unterstützung, wird dies für den Produktiveinsatz nicht empfohlen." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Setzen Sie die Umgebungsvariable GCL_PROF auf die leere Zeichenkette, um ein " +"optimiertes Programm zu erhalten oder auf irgendeine nicht-leere " +"Zeichenkette, für Profiling-Unterstützung; z.B. GCL_PROF=t gcl@EXT@. Falls " +"Profiling aktiviert ist, wird dies in der Startmeldung angezeigt." + +#~ msgid "" +#~ "GCL is in the process of providing an ANSI compliant image in addition to " +#~ "its traditional CLtL1 image still in production use. Please see the " +#~ "README.Debian file for a brief description of these terms. Setting this " +#~ "variable will determine which image you will use by default on executing " +#~ "'gcl@EXT@'. You can locally override this choice by setting the GCL_ANSI " +#~ "environment variable to any non-empty string for the ANSI build, and to " +#~ "the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The " +#~ "flavor of the build in force will be reported in the initial startup " +#~ "banner." +#~ msgstr "" +#~ "GCL arbeitet neben dem traditionellen CLtL1-Image für den " +#~ "Produktiveinsatz zusätzlich an der Bereitstellung eines kompatiblen ANSI-" +#~ "Images. Bitte beachten Sie die README.Debian-Datei für eine kurze " +#~ "Beschreibung dieses Themas. Durch diese Variable definieren Sie, welches " +#~ "Image voreingestellt bei der Ausführung von »gcl@EXT@« verwendet wird. " +#~ "Diese Auswahl kann lokal, durch einen nicht leeren Wert in der " +#~ "Umgebungsvariable »GCL_ANSI« für den ANSI-Build, bzw. einen leeren Wert " +#~ "für den CLtL1-Build, z.B. GCL_ANSI=t gcl@EXT@ definiert werden. Es " +#~ "erfolgt eine Meldung über die aktive Erstellung im einführenden Start-" +#~ "Banner." + +#~ msgid "" +#~ "GCL now has optional support for profiling via gprof. Please see the " +#~ "documentation for si::gprof-start and si::gprof-quit for details. As this " +#~ "build is slower than builds without gprof support, it is not recommended " +#~ "for final production use. You can locally override the default choice " +#~ "made here by setting the GCL_PROF environment variable to any non-empty " +#~ "string for profiling support, and to the empty string for the more " +#~ "optimized builds, e.g. GCL_PROF=t gcl@EXT@. If profiling is enabled, " +#~ "this will be reported in the initial startup banner." +#~ msgstr "" +#~ "GCL besitzt optionale Unterstützung für Profiling mit gprof. Bitte lesen " +#~ "Sie hierzu die Dokumentation von si::gprof-start und si::gprof-quit für " +#~ "weiterführende Informationen. Da dieser Build langsamer ist als ohne " +#~ "gprof-Unterstützung, wird dieser Weg nicht für den endgültig produktiven " +#~ "Einsatz empfohlen. Sie können die hier gemachten Angaben lokal über die " +#~ "GCL_PROF-Umgebungsvariable durch einen beliebigen Wert ändern, bzw. durch " +#~ "einen leeren Wert für das weitaus anpassungsfähigere Build, z.B. " +#~ "GCL_PROF=t gcl@EXT@. Falls Profiling aktiviert ist, erfolgt eine Meldung " +#~ "im einführenden Start-Banner." diff --git a/po/es.po b/po/es.po new file mode 100644 index 00000000..e4cb113e --- /dev/null +++ b/po/es.po @@ -0,0 +1,209 @@ +# gcl po-debconf translation to Spanish +# Copyright (C) 2005, 2007, 2008 Software in the Public Interest +# This file is distributed under the same license as the gcl package. +# +# Changes: +# - Initial translation +# César Gómez Martín , 2005 +# +# - Updates +# Rudy Godoy Guillén , 2007 +# Francisco Javier Cuadrado , 2008 +# +# Traductores, si no conoce el formato PO, merece la pena leer la +# documentación de gettext, especialmente las secciones dedicadas a este +# formato, por ejemplo ejecutando: +# +# info -n '(gettext)PO Files' +# info -n '(gettext)Header Entry' +# +# Equipo de traducción al español, por favor, lean antes de traducir +# los siguientes documentos: +# +# - El proyecto de traducción de Debian al español +# http://www.debian.org/intl/spanish/ +# especialmente las notas de traducción en +# http://www.debian.org/intl/spanish/notas +# +# - La guía de traducción de po's de debconf: +# /usr/share/doc/po-debconf/README-trans +# o http://www.debian.org/intl/l10n/po-debconf/README-trans +# +msgid "" +msgstr "" +"Project-Id-Version: gcl 2.6.7-45\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-12-04 20:00+0100\n" +"Last-Translator: Francisco Javier Cuadrado \n" +"Language-Team: Debian l10n spanish \n" +"Language: \n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=utf-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Poedit-Language: Spanish\n" +"X-Poedit-Country: SPAIN\n" +"X-Poedit-SourceCharset: utf-8\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "" +"¿Utilizar la generación ANSI todavía en desarrollo de manera predeterminada?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GL está en el proceso de proporcionar una imagen ANSI, además de su imagen " +"CLtL1 tradicional que todavía se usa." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Por favor, véase el archivo README.Debian para una descripción corta de " +"estos términos. Eligiendo esta opción determinará que imagen se usará de " +"manera predeterminada al ejecutar «gcl@EXT@»." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Esta configuración se puede sobrescribir cambiando la variable de entorno " +"GCL_ANSI a cualquier cadena de caracteres no vacía para la generación ANSI, " +"y a una cadena de caracteres vacía para la generación CLtL1, por ejemplo: " +"«GCL_ANSI=t gcl@EXT@». El actual tipo de generación se mostrará en la " +"información inicial del arranque." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "¿Utilizar la generación con «profiling» de manera predeterminada?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL permite usar «profiling», de manera opcional, mediante gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Por favor, véase la documentación para los detalles de «si::gprof-start» y " +"«si::gprof-quit». Ya que esta generación es más lenta que sin el uso de " +"gprof, no se recomienda para su uso final." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Cambie el valor de la variable de entorno GCL_PROF a una cadena de " +"caracteres vacía para generación más optimizadas, o a una cadena de " +"caracteres no vacía para usar el «profiling», por ejemplo: «GCL_PROF=t " +"gcl@EXT@». Si el «profiling» está activado, se mostrará en la información " +"inicial del arranque." + +#~ msgid "" +#~ "GCL is in the process of providing an ANSI compliant image in addition to " +#~ "its traditional CLtL1 image still in production use. Please see the " +#~ "README.Debian file for a brief description of these terms. Setting this " +#~ "variable will determine which image you will use by default on executing " +#~ "'gcl@EXT@'. You can locally override this choice by setting the GCL_ANSI " +#~ "environment variable to any non-empty string for the ANSI build, and to " +#~ "the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The " +#~ "flavor of the build in force will be reported in the initial startup " +#~ "banner." +#~ msgstr "" +#~ "GCL está en proceso de incorporar una imagen compatible con ANSI en " +#~ "adición a su imagen CLtL1 tradicional que todavía se usa en producción. " +#~ "Por favor, véase el fichero README de Debian para una breve descripción " +#~ "acerca de estos términos. El definir esta variable determinará qué imagen " +#~ "utilizar de manera predeterminada cuando ejecute «gcl@EXT@».\n" +#~ "Puede anular esta elección localmente definiendo la variable de entorno " +#~ "GCL_ANSI a una cadena no vacía para la compilación ANSI, y a una vacía " +#~ "para la compilación CLtL1, ejemplo: GCL_ANSI=t gcl@EXT@. La versión de la " +#~ "compilación se indicará en el anuncio inicial de arranque." + +#~ msgid "" +#~ "GCL now has optional support for profiling via gprof. Please see the " +#~ "documentation for si::gprof-start and si::gprof-quit for details. As this " +#~ "build is slower than builds without gprof support, it is not recommended " +#~ "for final production use. You can locally override the default choice " +#~ "made here by setting the GCL_PROF environment variable to any non-empty " +#~ "string for profiling support, and to the empty string for the more " +#~ "optimized builds, e.g. GCL_PROF=t gcl@EXT@. If profiling is enabled, " +#~ "this will be reported in the initial startup banner." +#~ msgstr "" +#~ "Ahora GCL tiene soporte opcional para perfilado a través de gprof. Por " +#~ "favor, mire la documentación de «si::gprof-start» y de «si::gprof-quit» y " +#~ "«si::gprof-quit» si desea más detalles. Dado que esta compilación es más " +#~ "lenta que otras sin soporte para gprof, no se recomienda usarlo en " +#~ "producción. Puede anular esta elección de forma local mediante el " +#~ "establecimiento de la variable de entorno GCL_PROF a cualquier cadena no " +#~ "vacía para soporte de perfiles, y a la cadena vacía para los paquetes más " +#~ "optimizados, es decir GCL_PROF=t gcl. Si el perfilado está activo se " +#~ "indicará en el anuncio inicial de arranque." + +#~ msgid "" +#~ "GCL is one of the oldest free common lisp systems still in use. Several " +#~ "production systems have used it for over a decade. The common lisp " +#~ "standard in effect when GCL was first released is known as \"Common Lisp, " +#~ "the Language\" (CLtL1) after a book by Steele of the same name providing " +#~ "this specification. Subsequently, a much expanded standard was adopted " +#~ "by the American National Standards Institute (ANSI), which is still " +#~ "considered the definitive common lisp language specification to this " +#~ "day. GCL is in the process of providing an ANSI compliant image in " +#~ "addition to its traditional CLtL1 image still in production use. Setting " +#~ "this variable will determine which image you will use by default on " +#~ "executing 'gcl'. You can locally override this choice by setting the " +#~ "GCL_ANSI environment variable to any non-empty string for the ANSI build, " +#~ "and to the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl. You " +#~ "may be interested in reviewing the ANSI test results sketching the level " +#~ "of compliance achieved thus far in /usr/share/doc/gcl/test_results.gz. " +#~ "The flavor of the build in force will be reported in the initial startup " +#~ "banner." +#~ msgstr "" +#~ "GCL es uno de los sistemas libres de «common lisp» más antiguos que " +#~ "todavía se usan. Varios sistemas en producción han estado usándolo " +#~ "durante más de una década. Cuando GCL se liberó por primera vez, el " +#~ "estándar «common lisp» se conocía como «Common Lisp, the " +#~ "Language» (CLtL1) después de un libro escrito por Steele que llevaba el " +#~ "mismo nombre y que proporcionaba esta especificación. Posteriormente se " +#~ "adoptó en el Instituto Nacional de Estándares Americano (ANSI) un " +#~ "estándar más extendido, que todavía se considera la especificación " +#~ "definitiva del lenguaje «common lisp» hasta hoy. GCL está en el proceso " +#~ "de proporcionar una imagen conforme a ANSI además de su imagen CltL1 " +#~ "tradicional que todavía se usa en producción. Al establecer esta variable " +#~ "se determinará la imagen por omisión que usará al ejecutar «gcl». Puede " +#~ "anular esta elección de forma local mediante el establecimiento de la " +#~ "variable de entorno GCL_ANSI a cualquier cadena no vacía para el paquete " +#~ "ANSI, y a la cadena vacía para el paquete CLtL1, i.e. GCL_ANSI=t gcl. " +#~ "Quizás esté interesado en revisar los resultados de las pruebas ANSI " +#~ "describiendo el nivel de conformidad logrado hasta ahora en /usr/share/" +#~ "doc/gcl/test_results.gz. Se informará del tipo de paquete usado en el " +#~ "anuncio inicial de arranque." diff --git a/po/fi.po b/po/fi.po new file mode 100644 index 00000000..e9dc116f --- /dev/null +++ b/po/fi.po @@ -0,0 +1,95 @@ +msgid "" +msgstr "" +"Project-Id-Version: gcl\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2007-12-29 23:28+0200\n" +"Last-Translator: Esko Arajärvi \n" +"Language-Team: Finnish \n" +"Language: fi\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Poedit-Language: Finnish\n" +"X-Poedit-Country: Finland\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Käytetäänkö kehitettävää ANSI-käännöstä oletuksena?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL:n on tarkoitus tarjota ANSI-yhteensopiva kuva perinteisen, vielä " +"tuotantokäytössä olevan CLtL1-kuvan lisäksi." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Tiedostosta README.Debian löytyy (englanniksi) näiden termien lyhyet " +"kuvaukset. Tämä valinta vaikuttaa siihen mitä kuvaa käytetään oletuksena " +"ajettaessa ”gcl@EXT@”." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Tämä asetus voidaan ohittaa asettamalla GCL_ANSI-ympäristömuuttuja. Jos " +"muuttujan arvo on mikä tahansa ei-tyhjä merkkijono, käytetään ANSI-" +"käännöstä, ja jos muuttujan arvo on tyhjä merkkijono, käytetään CLtL1-" +"käännöstä. Esimerkiksi: GCL_ANSI=t gcl@EXT@. Käytetty pakotettu käännöstapa " +"raportoidaan käynnistysruudussa." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Käytetäänkö profilointia oletuksena?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL tukee valinnaisesti profilointia gprofin avulla." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Katso yksityiskohdat (englanniksi) dokumentaatiosta kohdista si::gprof-start " +"ja si::gprof-quit. Koska tämä käännös on hitaampi kuin käännökset ilman " +"gprof-tukea, tätä ei suositella tuotantokäyttöön." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Aseta GCL_PROF-ympäristömuuttuja tyhjäksi merkkijonoksi käyttääksesi " +"optimoidumpia käännöksiä ja miksi tahansa ei-tyhjäksi merkkijonoksi " +"käyttääksesi profilointia. Esimerkiksi: GCL_PROF=t gcl@EXT@. Jos profilointi " +"on aktivoituna, se raportoidaan käynnistysruudussa." diff --git a/po/fr.po b/po/fr.po new file mode 100644 index 00000000..b21eac88 --- /dev/null +++ b/po/fr.po @@ -0,0 +1,141 @@ +# Translation of gcl debconf templates to French +# Copyright (C) 2007 Sylvain Archenault +# This file is distributed under the same license as the iodine package. +# +# Sylvain Archenault , 2007. +msgid "" +msgstr "" +"Project-Id-Version: gcl 2.6.7-1\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2007-12-23 13:03+0100\n" +"Last-Translator: Sylvain Archenault \n" +"Language-Team: French \n" +"Language: fr\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=ISO-8859-15\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Faut-il utiliser la compilation ANSI par défaut ?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL est en passe de fournir une image respectant la norme ANSI en plus de " +"l'image traditionnelle CLtL1, toujours utilisée en production." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Veuillez lire le fichier README.Debian pour une brève description de ces " +"termes. Le choix de cette option déterminera quelle image sera utilisée par " +"défaut en exécutant « gcl@EXT@ »." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Ce réglage peut être changé en affectant à la variable d'environnement " +"GCL_ANSI une chaîne non vide pour la compilation ANSI, et une chaîne vide " +"pour la compilation CLtL1, par exemple GCL_ANSI=t gcl@EXT@. Le type de " +"compilation sera affiché dans le bandeau de démarrage." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Faut-il utiliser le profilage par défaut ?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL permet optionnellement la gestion du profilage via gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Veuillez vous reporter à la documentation de « si::gprof-start » et « si::" +"gprof-quit » pour plus de détails. Comme cet exécutable est plus lent que " +"les exécutables sans la gestion de gprof, il n'est pas recommandé de " +"l'utiliser en production." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Veuillez affecter une chaîne vide à la variable d'environnement GCL_PROF " +"pour des compilations optimisées, ou une chaîne non vide pour avoir la " +"gestion du profilage; par exemple GCL_PROF=t gcl@EXT@. Si le profilage est " +"activé, cela sera affiché dans le bandeau de démarrage." + +#~ msgid "" +#~ "GCL is in the process of providing an ANSI compliant image in addition to " +#~ "its traditional CLtL1 image still in production use. Please see the " +#~ "README.Debian file for a brief description of these terms. Setting this " +#~ "variable will determine which image you will use by default on executing " +#~ "'gcl@EXT@'. You can locally override this choice by setting the GCL_ANSI " +#~ "environment variable to any non-empty string for the ANSI build, and to " +#~ "the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The " +#~ "flavor of the build in force will be reported in the initial startup " +#~ "banner." +#~ msgstr "" +#~ "GCL a pour but de fournir une image conforme à la définition de " +#~ "l'ANSI en plus de son image traditionnelle CLtL1 qui est toujours " +#~ "utilisée en production. Veuillez consulter le fichier README.Debian " +#~ "pour plus d'informations sur ces normes. Ce choix déterminera quelle " +#~ "norme vous allez utiliser par défaut lors de l'exécution de " +#~ "« gcl@EXT@ ». Vous pouvez localement modifier ce choix en " +#~ "affectant une chaîne non vide à la variable d'environnement GCL_ANSI " +#~ "pour une compilation respectant la norme définie par l'ANSI, et une " +#~ "chaîne vide pour une compilation en accord avec la norme CLtL1, par " +#~ "exemple GCL_ANSI=t gcl@EXT@. Le type de compilation sera affiché dans " +#~ "le bandeau de démarrage." + +#~ msgid "" +#~ "GCL now has optional support for profiling via gprof. Please see the " +#~ "documentation for si::gprof-start and si::gprof-quit for details. As this " +#~ "build is slower than builds without gprof support, it is not recommended " +#~ "for final production use. You can locally override the default choice " +#~ "made here by setting the GCL_PROF environment variable to any non-empty " +#~ "string for profiling support, and to the empty string for the more " +#~ "optimized builds, e.g. GCL_PROF=t gcl@EXT@. If profiling is enabled, " +#~ "this will be reported in the initial startup banner." +#~ msgstr "" +#~ "GCL gÚre désormais le profilage via gprof. Veuillez consulter la " +#~ "documentation de si::gprof-start et de si::gprof-quit pour plus " +#~ "d'informations. La construction produite avec cette option est plus lente " +#~ "que la construction classique. Par conséquent il n'est pas recommandé " +#~ "de l'utiliser en production. Vous pouvez localement modifier ce choix en " +#~ "affectant à la variable d'environnement GCL_PROF, une chaîne non vide " +#~ "pour activer le profilage, ou une chaîne vide pour une compilation " +#~ "optimisée, par exemple GCL_PROF=t gcl@EXT@. Si le profilage est " +#~ "activé, cela sera affiché dans le bandeau de démarrage." diff --git a/po/gl.po b/po/gl.po new file mode 100644 index 00000000..951ca9f0 --- /dev/null +++ b/po/gl.po @@ -0,0 +1,138 @@ +# Galician translation of gclcvs's debconf templates +# This file is distributed under the same license as the gclcvs package. +# Jacobo Tarrio , 2007. +# +msgid "" +msgstr "" +"Project-Id-Version: gclcvs\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-01-01 13:38+0000\n" +"Last-Translator: Jacobo Tarrio \n" +"Language-Team: Galician \n" +"Language: gl\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "¿Empregar por defecto a versión ANSI que se está a facer?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"Estase a traballar para que GCL forneza unha imaxe ANSI ademáis da imaxe " +"CLtL1 que aínda se emprega en produción." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Consulte o ficheiro README.Debian para ver unha descrición breve deses " +"termos. Ao establecer esa variable ha determinar a imaxe que ha empregar por " +"defecto ao executar \"gcl@EXT@\"." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Pode empregar a outra imaxe establecendo a variable de ambiente GCL_ANSI a " +"calquera cadea non baleira para empregar a versión ANSI, e á cadea baleira " +"para empregar a versión CLtL1; por exemplo, GCL_ANSI=t gcl@EXT@. Hase " +"informar da versión en uso no cartel que aparece ao iniciar o programa." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "¿Empregar por defecto a versión con cronometrado?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL agora ten soporte opcional de cronometrado mediante gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Consulte a documentación de si::gprof-start e si::gprof-quit para máis " +"detalles. Xa que esta versión é máis lenta que as que non teñen soporte de " +"gprof, non se recomenda que a empregue para o uso en produción." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Pode empregar unha versión distinta á seleccionada establecendo a variable " +"de ambiente GCL_PROF a calquera cadea non baleira para empregar o soporte de " +"cronometrado, ou á cadea baleira para as versións máis optimizadas; por " +"exemplo, GCL_PROF=t gcl@EXT@. Se está activado o cronometrado, hase informar " +"diso no cartel que aparece ao iniciar o programa." + +#~ msgid "" +#~ "GCL is in the process of providing an ANSI compliant image in addition to " +#~ "its traditional CLtL1 image still in production use. Please see the " +#~ "README.Debian file for a brief description of these terms. Setting this " +#~ "variable will determine which image you will use by default on executing " +#~ "'gcl@EXT@'. You can locally override this choice by setting the GCL_ANSI " +#~ "environment variable to any non-empty string for the ANSI build, and to " +#~ "the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The " +#~ "flavor of the build in force will be reported in the initial startup " +#~ "banner." +#~ msgstr "" +#~ "Estase a traballar para que GCL forneza unha imaxe ANSI ademáis da imaxe " +#~ "CLtL1 que aínda se emprega en produción. Consulte o ficheiro README." +#~ "Debian para ver unha descrición breve deses termos. Ao estabrecer esa " +#~ "variable ha determinar a imaxe que ha empregar por defecto ao executar " +#~ "\"gcl@EXT@\". Pode empregar a outra imaxe estabrecendo a variable de " +#~ "ambiente GCL_ANSI a calquera cadea non baleira para empregar a versión " +#~ "ANSI, e á cadea baleira para empregar a versión CLtL1; por exemplo, " +#~ "GCL_ANSI=t gcl@EXT@. Hase informar da versión en uso no cartel que " +#~ "aparece ao iniciar o programa." + +#~ msgid "" +#~ "GCL now has optional support for profiling via gprof. Please see the " +#~ "documentation for si::gprof-start and si::gprof-quit for details. As this " +#~ "build is slower than builds without gprof support, it is not recommended " +#~ "for final production use. You can locally override the default choice " +#~ "made here by setting the GCL_PROF environment variable to any non-empty " +#~ "string for profiling support, and to the empty string for the more " +#~ "optimized builds, e.g. GCL_PROF=t gcl@EXT@. If profiling is enabled, " +#~ "this will be reported in the initial startup banner." +#~ msgstr "" +#~ "GCL agora ten soporte opcional de cronometrado mediante gprof. Consulte a " +#~ "documentación de si::gprof-start e si::gprof-quit para máis detalles. Xa " +#~ "que esta versión é máis lenta que as que non teñen soporte de gprof, non " +#~ "se recomenda que a empregue para o uso en produción. Pode empregar unha " +#~ "versión distinta á seleccionada estabrecendo a variable de ambiente " +#~ "GCL_PROF a calquera cadea non baleira para empregar o soporte de " +#~ "cronometrado, ou á cadea baleira para as versións máis optimizadas; por " +#~ "exemplo, GCL_PROF=t gcl@EXT@. Se está activado o cronometrado, hase " +#~ "informar diso no cartel que aparece ao iniciar o programa." diff --git a/po/it.po b/po/it.po new file mode 100644 index 00000000..a4885612 --- /dev/null +++ b/po/it.po @@ -0,0 +1,102 @@ +# ITALIAN TRANSLATION OF GCL'S PO-DEBCONF FILE. +# COPYRIGHT (C) 2009 THE GCL'S COPYRIGHT HOLDER +# This file is distributed under the same license as the gcl package. +# +# Vincenzo Campanella , 2009. +# +msgid "" +msgstr "" +"Project-Id-Version: gcl\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2009-11-29 08:39+0100\n" +"Last-Translator: Vincenzo Campanella \n" +"Language-Team: Italian \n" +"Language: it\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "" +"Usare in modo predefinito la compilazione ANSI, che è in fase di " +"approntamento?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"Accanto all'immagine tradizionale CLtL1, in uso in realtà produttive, GCL " +"sta preparando un'immagine conforme ad ANSI." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Per maggiori informazioni consultare il file «README.Debian». La scelta di " +"questa opzione determinerà quale immagine verrà utilizzata in modo " +"predefinito durante l'esecuzione di «gcl@EXT@»." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Questa impostazione può essere sovrascritta impostando la variabile " +"d'ambiente «GCL_ANSI» con una stringa non vuota per la compilazione ANSI e " +"con una stringa vuota per la compilazione CLtL1, per esempio: «GCL_ANSI=t " +"gcl@EXT@». Il tipo di compilazione attualmente in uso viene mostrato nella " +"schermata di avvio." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Usare il profiling in modo predefinito?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL possiede un supporto opzionale per il profiling tramite gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Per maggiori dettagli consultare la documentazione per «si::gprof-start» e " +"«si::gprof-quit». Poiché questa compilazione è più lenta, rispetto a quella " +"senza supporto per gprof, non è raccomandata per un utilizzo in realtà " +"produttive." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Per compilazioni ottimizzate impostare la variabile d'ambiente «GCL_PROF» a " +"una stringa vuota, oppure per impostare il supporto al profiling impostarla " +"a una stringa non vuota, per esempio «GCL_PROF=t gcl@EXT@». La schermata " +"d'avvio indicherà se il profiling è abilitato." diff --git a/po/ja.po b/po/ja.po new file mode 100644 index 00000000..169782b6 --- /dev/null +++ b/po/ja.po @@ -0,0 +1,96 @@ +# SOME DESCRIPTIVE TITLE. +# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER +# This file is distributed under the same license as the gcl package. +# victory , 2013. +# +msgid "" +msgstr "" +"Project-Id-Version: gcl\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2013-07-27 14:28+0000\n" +"PO-Revision-Date: 2013-07-27 23:28+0900\n" +"Last-Translator: victory \n" +"Language-Team: Japanese \n" +"Language: ja\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "未完成の ANSI ビルドをデフォルトで使用しますか?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL は未だに生産利用されている従来の CLtL1 イメージに加えて ANSI 準拠のイメー" +"ジを提供する過程にあります。" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"用語については README.Debian ファイルに簡単な説明があります。このオプションの" +"選択「gcl@EXT@」を実行するときにどのイメージをデフォルトで利用するのか決定する" +"ことになります。" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"この設定は、GCL_ANSI 環境変数に ANSI ビルドでは空白ではない任意の文字列、" +"CLtL1 ビルドでは空白文字列をセットすることで上書きできます。例えば GCL_ANSI=t " +"gcl@EXT@。現在実行しているビルドの種類は初期の開始時バナーで報告されます。" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "デフォルトで profiling ビルドを使いますか?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "" +"GCL にはオプションで gprof 経由の profiling サポートがあります。" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"詳細については si::gprof-start や si::gprof-quit の文書を見てください。このビ" +"ルドは gprof サポートのないビルドより遅いため、最終的な生産利用にはお勧めしま" +"せん。" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"ビルドをもっと最適化する場合は GCL_PROF 環境変数に空白文字列を、profiling をサ" +"ポートさせる場合は空白ではない任意の文字列をセットしてください。例えば GCL_" +"PROF=t gcl@EXT@。profiling が有効な場合、初期の開始時バナーで報告されます。" diff --git a/po/nl.po b/po/nl.po new file mode 100644 index 00000000..c46d99fb --- /dev/null +++ b/po/nl.po @@ -0,0 +1,101 @@ +# SOME DESCRIPTIVE TITLE. +# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER +# This file is distributed under the same license as the PACKAGE package. +# FIRST AUTHOR , YEAR. +# +msgid "" +msgstr "" +"Project-Id-Version: gcl\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-01-01 21:15+0100\n" +"Last-Translator: Bart Cornelis \n" +"Language-Team: debian-l10n-dutch \n" +"Language: \n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=utf-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Poedit-Language: Dutch\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Wilt u standaard de in-ontwikkeling-zijnde ansi-compilatie gebruiken?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL is bezig om, aanvullend op het traditionele CLtL1-compilatie dat nog " +"steeds in gebruik is, een aan ANSI voldoend compilatie te voorzien." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Meer informatie hierover vindt u in het bestand /usr/share/doc/gcl/README." +"Debian . Deze optie bepaalt welk compilatie standaard gebruikt wordt wanneer " +"u 'gcl@EXT@' uitvoert. " + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Deze instelling kan altijd overstegen worden door de omgevingsvariabele " +"GCL_ANSI in te stellen op een niet-lege string om de ANSI-compilatie te " +"bekomen, en op een lege string om de CLtL1-compilatie te bekomen (bv. " +"GCL_ANSI=t gcl@EXT@). De momenteel afgedwongen compilatie-soort wordt " +"weergegeven in de initiële opstartbanier." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "" +"Wilt u standaard een compilatie met ondersteuning voor profilering gebruiken?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL heeft optionele ondersteuning voor profilering via gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Meer informatie vindt u in de documentatie voor si::gprof-start en si::gprof-" +"quit . Aangezien compilaties met gprof-ondersteuning trager zijn dan deze " +"zonder is dit niet aan te raden voor productie-gebruik." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Om een geoptimaliseerde compilatie te verkrijgen stelt u de " +"omgevingsvariabele GCL_PROF in op een lege string, of op een niet-lege " +"string als u profilering wilt ondersteunen (bv. GCL_PROF=t gcl@EXT@). Als " +"profilering geactiveerd is wordt dit weergegeven in de initiële " +"opstartbanier ." diff --git a/po/pt.po b/po/pt.po new file mode 100644 index 00000000..fb8b56b7 --- /dev/null +++ b/po/pt.po @@ -0,0 +1,99 @@ +# translation of gcl debconf to Portuguese +# Copyright (C) 2007 Américo Monteiro +# This file is distributed under the same license as the gcl package. +# +# Américo Monteiro , 2007. +msgid "" +msgstr "" +"Project-Id-Version: gcl 2.6.7-36\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2007-12-23 16:44+0000\n" +"Last-Translator: Américo Monteiro \n" +"Language-Team: Portuguese \n" +"Language: pt\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Generator: KBabel 1.11.4\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Usar a compilação 'ainda em desenvolvimento' ANSI por prédefinição? " + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL está no processo de disponibilizar uma imagem compatível com ANSI como " +"adição à sua imagem tradicional CLtL1 ainda em utilização de produção." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Por favor veja o ficheiro README.Debian para uma breve descrição destes " +"termos. Escolher esta opção irá determinar qual imagem será usada por " +"prédefinição ao executar 'gcl@EXT@'." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Esta opção pode ser sobreposta ao regular a variável de ambiente GCL_ANSI " +"para qualquer string não-vazia para a compilação ANSI, e para uma string " +"vazia para a compilação CLtL1, como por exemplo GCL_ANSI=t gcl@EXT@. O tipo " +"de compilação actualmente imposto será reportado no banner inicial de " +"arranque." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Usar, como pré-definição, a compilação com 'profiling'?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "O GCL tem suporte opcional para 'profiling' via gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Por favor veja a documentação de si::gprof-start e si::gprof-quit para mais " +"detalhes. Como esta compilação é mais lenta do que as compilações sem o " +"suporte para gprof, não é recomendada para utilização de produção final." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Regule a variável de ambiente GCL_PROF para uma string vazia para mais " +"compilações optimizadas, ou para qualquer string não-vazia para suporte de " +"'profiling'; como por exemplo GCL_PROF=t gcl@EXT@. Se o 'profiling' estiver " +"activo, isto será reportado no banner inicial de arranque." diff --git a/po/pt_BR.po b/po/pt_BR.po new file mode 100644 index 00000000..74f2f037 --- /dev/null +++ b/po/pt_BR.po @@ -0,0 +1,98 @@ +# Debconf translations for gcl. +# Copyright (C) 2016 THE gcl'S COPYRIGHT HOLDER +# This file is distributed under the same license as the gcl package. +# Adriano Rafael Gomes , 2016. +# +msgid "" +msgstr "" +"Project-Id-Version: gcl\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2016-01-05 11:09-0200\n" +"Last-Translator: Adriano Rafael Gomes \n" +"Language-Team: Brazilian Portuguese \n" +"Language: pt_BR\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Usar a versão ANSI em desenvolvimento por padrão?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"O GCL está em processo de fornecer uma imagem de acordo com o padrão ANSI em " +"adição à sua imagem CLtL1 tradicional, ainda em uso em produção." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Por favor, veja o arquivo README.Debian para uma breve descrição desses " +"termos. Escolher essa opção determinará qual imagem será usada por padrão ao " +"executar \"gcl@EXT@\"." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Essa configuração pode ser sobreposta definindo a variável de ambiente " +"GCL_ANSI para qualquer texto não vazio para a versão ANSI, e para um texto " +"vazio para a versão CLtL1, por exemplo, GCL_ANSI=t gcl@EXT@. O sabor da " +"versão atualmente definida será exibida na mensagem de inicialização." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Usar a versão de \"profiling\" por padrão?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "O GCL tem suporte opcional a \"profiling\" via gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Por favor, veja a documentação para si::gprof-start e si::gprof-quit para " +"detalhes. Como essa versão é mais lenta que versões sem suporte a gprof, ela " +"não é recomendada para uso final em produção." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Defina a variável de ambiente GCL_PROF para um texto vazio para versões mais " +"otimizadas, ou para qualquer texto não vazio para ter suporte a \"profiling" +"\"; por exemplo, GCL_PROF=t gcl@EXT@. Se o \"profiling\" estiver habilitado, " +"isso será exibido na mensagem de inicialização." diff --git a/po/ru.po b/po/ru.po new file mode 100644 index 00000000..dfd56cbc --- /dev/null +++ b/po/ru.po @@ -0,0 +1,100 @@ +# translation of ru.po to Russian +# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER +# This file is distributed under the same license as the PACKAGE package. +# +# Yuri Kozlov , 2008. +msgid "" +msgstr "" +"Project-Id-Version: 2.6.7-36\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-01-03 10:22+0300\n" +"Last-Translator: Yuri Kozlov \n" +"Language-Team: Russian \n" +"Language: ru\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Generator: KBabel 1.11.4\n" +"Plural-Forms: nplurals=3; plural=(n%10==1 && n%100!=11 ? 0 : n%10>=2 && n" +"%10<=4 && (n%100<10 || n%100>=20) ? 1 : 2);\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Использовать разрабатываемую ANSI сборку по умолчанию?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"Помимо обычного образа CLtL1, используемого в повсеместной работе, GCL имеет " +"практически готовый образ, соответствующий ANSI." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Краткое описание приведено в файле README.Debian. Данным выбором " +"определяется, какой из образов будет использован по умолчанию при выполнении " +"'gcl@EXT@'." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Эта настройка может быть переопределена установкой переменной окружения " +"GCL_ANSI в непустое значение для ANSI сборки, а пустым значением выбирается " +"CLtL1 сборка, например GCL_ANSI=t gcl@EXT@. Текущий используемый тип сборки " +"будет показан при первом запуске." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Использовать по умолчанию профилируемую сборку?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL поддерживает необязательное профилирование через gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Подробней об этом смотрите в документации на si::gprof-start и si::gprof-" +"quit. Так как данная сборка работает медленнее чем без поддержки gprof, её " +"не рекомендуется использовать в реальной работе." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Задание переменной окружения GCL_PROF пустого значения включает более " +"оптимизированную сборку, а любое непустое -- поддержку профилирования; " +"например GCL_PROF=t gcl@EXT@. Если профилирование включено, то об этом будет " +"написано при первом запуске." diff --git a/po/sv.po b/po/sv.po new file mode 100644 index 00000000..6a3a93f3 --- /dev/null +++ b/po/sv.po @@ -0,0 +1,106 @@ +# translation of gcl_2.6.7-36.1_sv.po to Swedish +# Translators, if you are not familiar with the PO format, gettext +# documentation is worth reading, especially sections dedicated to +# this format, e.g. by running: +# info -n '(gettext)PO Files' +# info -n '(gettext)Header Entry' +# Some information specific to po-debconf are available at +# /usr/share/doc/po-debconf/README-trans +# or http://www.debian.org/intl/l10n/po-debconf/README-trans +# Developers do not need to manually edit POT or PO files. +# +# Martin Ågren , 2008. +msgid "" +msgstr "" +"Project-Id-Version: gcl_2.6.7-36.1_sv\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-07-24 18:21+0200\n" +"Last-Translator: Martin Ågren \n" +"Language-Team: Swedish \n" +"Language: sv\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=ISO-8859-1\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Generator: KBabel 1.11.4\n" +"Plural-Forms: nplurals=2; plural=(n != 1);\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Använd det ännu inte färdiga ANSI-bygget som standard?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL arbetar på att tillhandahålla en ANSI-godkänd bild förutom dess " +"traditionella CLtL1-bild som fortfarande används i produktionsmiljön." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Se README.Debian-filen för en översiktlig beskrivning av dessa termer. När " +"du väljer det här alternativet avgörs vilken bild som kommer användas som " +"standard när 'gcl@EXT@' körs." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Denna inställning kan överskridas genom att sätta miljövariabeln GCL_ANSI " +"till en icke-tom sträng för ANSI-bygget, och till den tomma strängen för " +"CLtL1-bygget, t. ex. GCL_ANSI=t gcl@EXT@. Det bygge som för tillfället " +"används kommer anges i uppstartsutskriften." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Använd profileringsbygget som standard?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL har valfritt stöd för profilering via gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Se dokumentationen för si::gprof-start och si::gprof-quit för detaljer. " +"Eftersom detta bygge är långsammare än byggen utan stöd för gprof, " +"rekommenderas det inte för slutlig användning i produktionsmiljö." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Sätt miljövariabeln GCL_PROF till den tomma strängen för mer optimiserade " +"byggen, eller en icke-tom sträng för profileringsstöd; t. ex. GCL_PROF=t " +"gcl@EXT@. Om profilering är aktiverad, kommer denna rapporteras i den " +"ursprungliga uppstartsutskriften." diff --git a/po/templates.pot b/po/templates.pot new file mode 100644 index 00000000..86276ce4 --- /dev/null +++ b/po/templates.pot @@ -0,0 +1,82 @@ +# SOME DESCRIPTIVE TITLE. +# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER +# This file is distributed under the same license as the PACKAGE package. +# FIRST AUTHOR , YEAR. +# +#, fuzzy +msgid "" +msgstr "" +"Project-Id-Version: gcl\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" +"Last-Translator: FULL NAME \n" +"Language-Team: LANGUAGE \n" +"Language: \n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=CHARSET\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" diff --git a/po/vi.po b/po/vi.po new file mode 100644 index 00000000..d1fa6ded --- /dev/null +++ b/po/vi.po @@ -0,0 +1,98 @@ +# Vietnamese translation for GCL. +# Copyright © 2007 Free Software Foundation, Inc. +# Clytie Siddall , 2007 +# +msgid "" +msgstr "" +"Project-Id-Version: gcl 2.6.7-36\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-01-04 16:27+1030\n" +"Last-Translator: Clytie Siddall \n" +"Language-Team: Vietnamese \n" +"Language: vi\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"Plural-Forms: nplurals=1; plural=0;\n" +"X-Generator: LocFactoryEditor 1.7b1\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Dùng bản xây dá»±ng đang phát triển ANSI theo mặc định không?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL đang phát triển chức năng cung cấp ảnh tùy theo ANSI thêm vào ảnh CLtL1 " +"truyền thống vẫn còn được sá»­ dụng trong trường hợp sản xuất." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Xem tài liệu Đọc Đi (README.Debian) để tìm mô tả ngắn về các thuật ngữ này. " +"Bật tùy chọn này thì xác định ảnh nào cần dùng theo mặc định khi thá»±c hiện " +"lệnh « gcl@EXT@ »." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Vẫn còn có thể ghi đè lên thiết lập này bằng cách đặt biến môi trường « " +"GCL_ANSI » thành bắt cứ chuỗi không rỗng cho bản xây dá»±ng ANSI, và cho chuỗi " +"rỗng cho bản xây dá»±ng CLtL1, v.d. « GCL_ANSI=t gcl@EXT@ ». Kiểu bản xây dá»±ng " +"hiện thời được chọn sẽ được thông báo trên băng cờ khởi chạy đầu tiên." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Dùng bản xây dá»±ng đo hiệu năng sá»­ dụng theo mặc định không?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL có hỗ trợ tùy chọn để đo hiệu năng sá»­ dụng thông qua gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Xem tài liệu hướng dẫn về « si::gprof-start » và « si::gprof-quit » để tìm " +"chi tiết. Vì bản xây dá»±ng này chạy chậm hÆ¡n các bản xây dá»±ng không hỗ trợ " +"gprof, không khuyên bạn sá»­ dụng nó trong trường hợp sản xuất cuối cùng." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Đặt biến môi trường « GCL_PROF » thành chuỗi rỗng cho các bản xây dá»±ng tối " +"Æ°u hÆ¡n, hoặc cho bất cứ chuỗi không rỗng nào để hỗ trợ chức năng đo hiệu " +"năng sá»­ dụng, v.d. « GCL_PROF=t gcl@EXT@ ». Hiệu lá»±c chức năng đo hiệu năng " +"sá»­ dụng thì nó được thông báo trên băng cờ khởi chạy đầu tiên." diff --git a/rules b/rules new file mode 100755 index 00000000..8145de6f --- /dev/null +++ b/rules @@ -0,0 +1,269 @@ +#!/usr/bin/make -f +# Sample debian/rules that uses debhelper. +# GNU copyright 1997 by Joey Hess. +# +# This version is for a hypothetical package that builds an +# architecture-dependant package, as well as an architecture-independent +# package. + +# Uncomment this to turn on verbose mode. +#export DH_VERBOSE=1 + +# This is the debhelper compatability version to use. +ARCHT:=$(shell dpkg-architecture -qDEB_HOST_ARCH) + +MCC:=gcc +# ifeq ($(ARCHT),alpha) +# MCC:=gcc-4.6 +# endif +# ifeq ($(ARCHT),mips) +# MCC:=gcc-4.6 +# endif +# ifeq ($(ARCHT),mipsel) +# MCC:=gcc-4.6 +# endif +# ifeq ($(ARCHT),ia64) +# MCC:=gcc-4.6 +# endif +# ifeq ($(ARCHT),armel) +# MCC:=gcc-4.6 +# endif +# ifeq ($(ARCHT),armhf) +# MCC:=gcc-4.6 +# endif + +#RELOC=locbfd +#RELOC?=statsysbfd +RELOC?=custreloc +ifeq ($(ARCHT),ia64) +RELOC=dlopen +endif +# ifeq ($(ARCHT),ppc64) +# RELOC=dlopen +# endif +#ifeq ($(ARCHT),hppa) +#RELOC=dlopen +#endif + +GMP?= + +DEBUG= + +#ifeq ($(ARCHT),hppa) +#DEBUG=--enable-debug +#endif + +VERS=$(shell echo $$(cat majvers).$$(cat minvers)) +#EXT:=cvs + +CFG:=$(addsuffix /config.,.)# gmp4/configfsf. +# Bug in autoconf dependency on emacsen-common workaround +#CFGS:=$(addsuffix .ori,configure $(addsuffix guess,$(CFG)) $(addsuffix sub,$(CFG))) +CFGS:=$(addsuffix .ori,$(addsuffix guess,$(CFG)) $(addsuffix sub,$(CFG))) + +$(filter %.guess.ori,$(CFGS)): %.ori: /usr/share/misc/config.guess % + ! [ -e $* ] || [ -e $@ ] || cp $* $@ + [ $$($< -t | tr -d '-') -le $$(./$* -t | tr -d '-') ] || cp $< $* + touch $@ + +$(filter %.sub.ori,$(CFGS)): %.ori: /usr/share/misc/config.sub % + ! [ -e $* ] || [ -e $@ ] || cp $* $@ + [ $$($< -t | tr -d '-') -le $$(./$* -t | tr -d '-') ] || cp $< $* + touch $@ + +configure.ori: %.ori: configure.in + ! [ -e $* ] || [ -e $@ ] || cp $* $@ + cd $(@D) && autoconf + touch $@ + +configure-%-stamp: $(CFGS) + + dh_testdir + + ! [ -e unixport/saved_pre_gcl ] || $(MAKE) clean + +# chmod -R +x gmp4/* + + [ "$*" != "trad" ] || FLAGS="--disable-ansi" ; \ + [ "$*" != "gprof" ] || FLAGS="--disable-ansi --enable-gprof" ; \ + [ "$*" != "ansi-gprof" ] || FLAGS="--enable-gprof" ; \ + eval `dpkg-buildflags --export=sh` && CC=$(MCC) ./configure \ + --host=$$(dpkg-architecture -qDEB_HOST_GNU_TYPE) \ + --disable-statsysbfd \ + --disable-custreloc \ + --disable-dlopen \ + --enable-prelink \ + --enable-$(RELOC) \ + $(GMP) \ + $(DEBUG) \ + $$FLAGS \ + --prefix=/usr \ + --mandir=\$${prefix}/share/man \ + --enable-infodir=\$${prefix}/share/info \ + --enable-emacsdir=\$${prefix}/share/emacs/site-lisp + + touch $@ + + +build-%-stamp: configure-%-stamp + dh_testdir + + $(MAKE) + + rm -rf debian/$* + mkdir -p debian/$* + $(MAKE) install DESTDIR=$$(pwd)/debian/$* + [ "$(findstring gprof,$*)" = "" ] || (\ + tmp=debian/$*; old=/usr/lib/gcl-$(VERS); new=$$old-prof;\ + if [ "$(findstring ansi,$*)" = "" ] ; then i=saved_gcl ; else i=saved_ansi_gcl ; fi;\ + mv $$tmp/$$old $$tmp/$$new ;\ + echo "(si::reset-sys-paths \"$$new/\")(si::save-system \"debian/tmp-image\")" | $$tmp/$$new/unixport/$$i &&\ + mv debian/tmp-image $$tmp/$$new/unixport/$$i;) + + touch $@ + +bclean-stamp: + $(MAKE) clean + touch $@ + +ansi-tests/test_results: build-ansi-stamp + $(MAKE) $@ + +build: build-arch build-indep +build-arch: build-stamp +build-indep: build-stamp +build-stamp: build-gprof-stamp build-ansi-gprof-stamp build-trad-stamp build-ansi-stamp ansi-tests/test_results + touch $@ + +debian/control.rm: + rm -f `echo $@ | sed 's,\.rm$$,,1'` + +debian/control: debian/control.rm + cp debian/control.$(EXT) debian/control + +clean: debian/control debian/gcl.templates + dh_testdir + dh_testroot + rm -f *stamp + debconf-updatepo + + $(MAKE) clean + + dh_clean + rm -rf debian/gprof debian/ansi-gprof debian/trad debian/ansi $(INS) debian/substvars debian.upstream + rm -rf *stamp + for i in $(CFGS) ; do ! [ -e $$i ] || mv $$i $${i%.ori} ; done + +INS:=$(shell for i in debian/in.* ; do echo $$i | sed 's,in.,,1' ; done |sed "s,gcl,gcl$(EXT),g") + +$(INS): debian/gcl$(EXT)% : debian/in.gcl% + cat $< | sed 's,@EXT@,$(EXT),g' >$@ + +install: install-stamp +install-stamp: build-stamp debian/control $(INS) + dh_testdir + dh_testroot +# dh_clean -k + dh_prep + dh_installdirs + + mkdir -p debian/tmp + cp -a debian/ansi/* debian/tmp/ + cp -a debian/trad/* debian/tmp/ + cp -a debian/gprof/* debian/tmp/ + cp -a debian/ansi-gprof/* debian/tmp/ + + mv debian/tmp/usr/share/emacs/site-lisp debian/tmp/usr/share/emacs/foo + mkdir -p debian/tmp/usr/share/emacs/site-lisp + mv debian/tmp/usr/share/emacs/foo debian/tmp/usr/share/emacs/site-lisp/gcl$(EXT) + + cat debian/tmp/usr/share/emacs/site-lisp/gcl$(EXT)/gcl.el |\ + sed "s,(provide 'gcl),(provide 'gcl$(EXT)),1" >tmp &&\ + mv tmp debian/tmp/usr/share/emacs/site-lisp/gcl$(EXT)/gcl$(EXT).el + [ "$(EXT)" = "" ] || rm debian/tmp/usr/share/emacs/site-lisp/gcl$(EXT)/gcl.el + + cat debian/tmp/usr/share/emacs/site-lisp/gcl$(EXT)/dbl.el |\ + sed "s,(provide 'dbl),(provide 'dbl$(EXT)),1" >tmp &&\ + mv tmp debian/tmp/usr/share/emacs/site-lisp/gcl$(EXT)/dbl$(EXT).el + [ "$(EXT)" = "" ] || rm debian/tmp/usr/share/emacs/site-lisp/gcl$(EXT)/dbl.el + + [ "$(EXT)" = "" ] || \ + for i in debian/tmp/usr/share/info/*.info*; do \ + mv $$i $$(echo $$i | sed "s,gcl,gcl$(EXT),g"); done + + mv debian/tmp/usr/share/doc debian/tmp/usr/share/foo + mkdir -p debian/tmp/usr/share/doc/gcl-doc + mv debian/tmp/usr/share/foo/* debian/tmp/usr/share/doc/gcl-doc + rmdir debian/tmp/usr/share/foo + + [ "$(EXT)" = "" ] || \ + mv debian/tmp/usr/share/doc/gcl-doc debian/tmp/usr/share/doc/gcl$(EXT)-doc + + [ "$(EXT)" = "" ] || \ + (cat debian/tmp/usr/share/man/man1/gcl.1 |sed -e 's, gcl , gcl$(EXT) ,g' 's, GCL , GCL$(EXT) ,g' >debian/foo && \ + mv debian/foo debian/tmp/usr/share/man/man1/gcl$(EXT).1) + + cat debian/tmp/usr/lib/gcl-$(VERS)/gcl-tk/demos/index.lsp | \ + sed "s,$$(pwd)/debian/tmp,,1" >debian/foo + mv debian/foo debian/tmp/usr/lib/gcl-$(VERS)/gcl-tk/demos/index.lsp + + rm -f debian/tmp/usr/bin/*.exe debian/tmp/usr/bin/*.bat + + find debian/tmp -type f -name "*.lsp" -exec chmod ugo-x {} \; + find debian/tmp -type f -name "*.lisp" -exec chmod ugo-x {} \; + find debian/tmp -type f -name "*.el" -exec chmod ugo-x {} \; + find debian/tmp -type f -name "*.tcl" -exec chmod ugo-x {} \; + + rm -f debian/tmp/usr/bin/gcl + TKVERS=$$(cat bin/gcl | grep /tk | head -1l | sed "s,.*/tk\([0-9.]*\)\").*,\1,1"); \ + cat debian/gcl.sh | sed -e "s,@EXT@,$(EXT),g" \ + -e "s,@VERS@,$(VERS),g" \ + -e "s,@TKVERS@,$$TKVERS,g" >debian/tmp/usr/bin/gcl$(EXT) + chmod 0755 debian/tmp/usr/bin/gcl$(EXT) + + rm -rf debian/tmp/usr/lib/gcl-$(VERS)/info + + dh_install + + touch $@ + +# Build architecture-independent files here. +# Pass -i to all debhelper commands in this target to reduce clutter. +binary-indep: build install + dh_testdir -i + dh_testroot -i + dh_installdocs -i + dh_installinfo -i + dh_installchangelogs ChangeLog -i + dh_link -i + dh_compress -i + dh_fixperms -i + dh_installdeb -i + dh_gencontrol -i + dh_md5sums -i + dh_builddeb -i + +binary-arch: build install #debian/substvars + dh_testdir -a + dh_testroot -a + dh_installdocs -a -XRELEASE-2.6.2.html + dh_installemacsen -a + dh_installman -a + dh_installdebconf -a + sed -i -e 's,@EXT@,$(EXT),g' debian/gcl$(EXT)/DEBIAN/templates + dh_installchangelogs ChangeLog -a + dh_strip -a -Xlibgcl -Xlibansi_gcl +# -Xgcl-$(VERS)-prof/unixport/saved_gcl -Xgcl-$(VERS)-prof/unixport/saved_ansi_gcl + dh_lintian -a + dh_link -a + dh_compress -a + dh_fixperms -a + dh_installdeb -a + dh_shlibdeps -a + dh_gencontrol -a -u"-Vgcc=$(MCC)" + dh_md5sums -a + dh_builddeb -a + +binary: binary-indep binary-arch +.PHONY: build clean binary-indep binary-arch binary install configure +.PRECIOUS: configure-trad-stamp configure-ansi-stamp configure-gprof-stamp configure-ansi-gprof-stamp diff --git a/source/format b/source/format new file mode 100644 index 00000000..163aaf8d --- /dev/null +++ b/source/format @@ -0,0 +1 @@ +3.0 (quilt) diff --git a/source/include-binaries b/source/include-binaries new file mode 100644 index 00000000..f95b9a3e --- /dev/null +++ b/source/include-binaries @@ -0,0 +1,4 @@ +info/gcl-si.pdf +info/gcl-tk.pdf +xgcl-2/dwdoc.pdf +unixport/ff diff --git a/texi.awk b/texi.awk new file mode 100755 index 00000000..ccf9cdbe --- /dev/null +++ b/texi.awk @@ -0,0 +1,27 @@ +#!/usr/bin/awk -f + +/^@defun/ { + a=split($0,A,"("); + b=split($0,B,")"); + if (a==b) + print ; + else { + i=1; + c=$0; + } + next; +} +{ + if (i) { + sub("^ *",""); + c=c " " $0; + a=split(c,A,"("); + b=split(c,B,")"); + if (a==b) { + print c; + c=""; + i=0; + } + } else + print; +} diff --git a/upstream/signing-key.asc b/upstream/signing-key.asc new file mode 100644 index 00000000..741d3145 --- /dev/null +++ b/upstream/signing-key.asc @@ -0,0 +1,88 @@ +-----BEGIN PGP PUBLIC KEY BLOCK----- +Version: GnuPG v1 + +mQGiBD1mWk0RBADdQYIiaNJJOHAZdBpzOBm31v5AlQa1jjYx1W6zKd+ECqZVdonw +e+CP/qpVCUXRYmQ3v/ZYpINtcRR2IckTQCs4fvYUAuQir2cpKmRqImnGhzFJ1pd9 +Rf2aqPspycMx9IlqKkeY1LwNahitQ93YwyCT1HUCTB0hIuNMtFNte18DpwCgwbYP +bBuLYCG/8g+MqoG7SBhN4hkEANafxrX2EEwUCpQlKGkw4P18wCinbs7tjgXwL7SK +WV9qpIDkUEnW2cnzfDBrNW24LtHt0qMsGa8sCJW30ZPUv0sebsyzVTJR0O5g6Lpi +zlznB1LtmbkDdd79R4Qrs01k+2OK2K0r54xnOlL+ZZQFamP3jvTZAKxyUGI2Fiqu +1O7OA/4xp5/WNyuIUWUho+nfhp0sakzAiC1aBHLtAvhL470sBm3xojM6w3vicTT2 +7rnzS1teeUnCOMK+CUzzITXHrnljCkyg8d6QqtlWJCc4T6tTYJNOuWte3AckYDaF +4HhJbwNamrDGKQJ0kYOqtquz5WE8EjkxwglRQSrGanxMXnCsB7QgQ2FtbSBNYWd1 +aXJlIDxjYW1tQGVuaGFuY2VkLmNvbT6IXwQTEQIAFwUCPWZaTQULBwoDBAMVAwID +FgIBAheAABIJEHMxtcBX8EXcB2VHUEcAAQFCkQCeL84DKju0u23VHI2a9S3CZwpw +cEMAn03Jgjje37YEbLCnfh/JN4zhcUeFiQCVAwUQPXktv1RjAAQhp2rpAQEynwP5 +AZT5Fmlc6FbnVeusUNz1jtEKysdFc7TBFZSdWK2ftjuQiiiYgLOSM6kLpc6DJxLU +0gc6FmQCme1G3wnQFpi5GXFlYcW5mfe3V5/0Paxcc/CijULb4IRU41KO3tTy7wpY +NARRB5I+MeLT39bpqljO0b7PRETncVnXgkm5PEJGV3C0HkNhbW0gTWFndWlyZSA8 +Y2FtbUBkZWJpYW4ub3JnPohgBBMRAgAgBQJJmevSAhsjBgsJCAcDAgQVAggDBBYC +AwECHgECF4AACgkQczG1wFfwRdxZywCeLfMYW3CQAi8e0C8NAauuIpZJx+wAoJAW +eBe0arj/lrwecpn26l63nC5KuQENBD1mWk4QBADRBvXyQ0uxFCkac7ZVSuwEJrbw +NdhS3ossQi+gm8aDPSokKFASs75SLNQMfIRhyToGcyplP75OYaMxvyih7DFGBLoB +kzCuhBJ09VgLC0BiuJAtEI5orQf9sNt7CwBEG2KZ/X4oHXmKitgP0F4xff9XociT +ZusPI90z9yg2treJ4wADBQP/aDZ839IYpwL6ZDZ8faVtgMz65lKaFkLzi/2pHWao +SEWYiGcLozizNt+w+qcyMGUDNkDMtTY0Y9cbC8Dn7r/0/CZW1UQ2D3fSeAfsgxEE +PnYYFiFr0Xyi+oDu7fkcV9wQdqLZ6OvR0SZqoJwLdmJqjTzz1TJTOfdTcSV/+POJ +qCuITgQYEQIABgUCPWZaTgASCRBzMbXAV/BF3AdlR1BHAAEBn/kAn2saGr0hmMfO +Nn4j36onyp18oNqYAKCTJZU26kWZcORo+FbyOMQ3+Yd8EZkBogQ6A9NcEQQAiUvw +61oHv/VZvl8uo5hTAaka2HEfECf5aMvG7N1ytUXzKTldnyEBGiqOdbLtF1wL2SUV +rdhX0VhH0fi19K2graTGqSQYzdA7uIIOQHOAZ5py5mKQr9zFkKyf5W4RKAbTIUAS +uTlSy1NiyKPMXdBlu0f5rkl/m5KODlf1nVtDposAoPuMTY9/D/cOqzB4fmEQ6gMG +M2/PA/9nHj4Mow5EkvSLsuAkn/mpI0Rv+ly1pmKJtbsJZIs1PWk/J47TRVigUgft +LOlfYMAHXwfF6svodOKF0eOaBjeZmyu1KnDDy9EWWhZwdoT08AD664/bbN1goNzE +XFlfD83yPWa1VrPNME2fq6jdY/WKZB5+viKu7yaMGGwQfjg9EwP/QCbz4cZvUiF5 +SmlI3u8+wgThk3DXnL9L3GlOASacET6wRFX6C3HYnRBTB0EypYJoUPIj7rt/Ptyl +CRHQtMUuSouyq/Smj5ybw8kvGRRH4SgfoghjL+q+sVGwIZiUQXu+g96vSSBuQTE2 +x8iZ8mXpPud7jjMc98CfjiB9/ujnqK+0MEVyaWMgU2hhcmtleSA8c2hhcmtleUBz +dXBlcmsucGh5c2ljcy5zdW55c2IuZWR1PohfBBMRAgAXBQI6A9NcBQsHCgMEAxUD +AgMWAgECF4AAEgkQclUlAyIk+rwHZUdQRwABAcGdAJ45RrdVItJxXhDiCWeXpHKq +DfkBIQCg97TpqcIbuDGD1r8gkSb6ErXA+4SJAJUDBRA6L65Bj/xAXv1aZ80BAVlU +A/oD8wBcQeTD3HzeBcK6SVygQZlQS2g8v7H4G91Fu9yTESbDdYLjmybniGwTgS7q +0/RbQDRCmh+fyBD38CmB2B23VdpXRYaChDeKTP+Lvg+mQn9zdMFkERD2/W40+TID +1g7lafk3XDe+dOX59Ie0qeCXcccsv8OfhJwoEwHKPC9ZeIhGBBARAgAGBQI87l/I +AAoJEHIxQb2lt4IBM5MAnj9wqSGdaLTfHAQb7xk36abh0vboAJwIGkIMfE7HkvbX +9nXqefmNfrns3IhGBBARAgAGBQI9eSPnAAoJEHMxtcBX8EXcnq8An2DneOdg2qBr +xF5ZBzEfGBcZHMbCAJ0Z+QKVo1/XQUVcHbGrHo+kF4IfmrQhRXJpYyBTaGFya2V5 +IDxzaGFya2V5QGRlYmlhbi5vcmc+iF8EExECABcFAjo5dzoFCwcKAwQDFQMCAxYC +AQIXgAASCRByVSUDIiT6vAdlR1BHAAEBo0MAoKXjeu7EYrx9uSrlC6rQHavvmq1u +AJsFXSfzM+lgT5lO9a3K0/N+Wr4ZRIhGBBARAgAGBQI87l/fAAoJEHIxQb2lt4IB +8BgAn3ZJz4t/JBnRhEB2I0BA5CiIxKtAAKCf5FHs+3/1vYmhtAX3ouSWyN0jFIhG +BBARAgAGBQI9eSPtAAoJEHMxtcBX8EXci7YAnRnwG8BddR4vdcvNGewRxCxweOrz +AKCgcm8lYWrd0Ubz4/CtelbxA16yV7kBDQQ6A9NrEAQAyXOKw6Zg+VjOiw10ZKtP +mQNmkEA5qUcGgcXKIPwwZ8sMZLzsqzdSM6UVwlN/1D/kH9U5Lkh1LqUxQ+NVC5Qm +bGV+Wq52I9id/lpYycfxNkjURk/wXnOdFCY55pJiS2851DiCBpNC/ClFZZe1Yhdd +HhUFnJrGRjaKTMoKI3sWUDsAAwYEAIuBP5eMx8I4qzVrt9tgDEx9LZZyd18jqC42 +FcMesLMdUi/UKOzrSr/tQ/eiOVMai/RUMmtoyvJzm6bt4UsO54Ynhhul4ySreB4h +4TA7C9vKYTvPmZ5hsOAmguhtvkGOiN+7cXUa35xpL1dbBjelJR8cSFJtAQn2PKkJ +JeS6N4LHiE4EGBECAAYFAjoD02sAEgkQclUlAyIk+rwHZUdQRwABAS1yAJwO6YAP +f1tU5MvrXRbHC52/dn82kgCgkxPi+HiFgqOc1FCfMByu9ZvzwGaZAaIEPKkVqhEE +AMqWl8BYusXdZEt7EE7gDfTtYgCCREiy3B2jTERJ4DXP0hPQDxBOQh6AW0JCtcxT +vuNOZnAlMqXKPvV4tc55dSYTBYW6U2ySN+xrHi9GvS9k5JjpsZdstS5MVkTppOS0 +nTEBw8KofAHBfFpwisCsz38P5ehLnbpm1M7WNXGxmvDTAKDFxuwQL9S8gRUhXIS3 +kAOkDW2eTwP+I5Xil4aIAUnw/JVUaP7wRGUYnFnIisgPftZ+k+R/RfirSlnpPMZr +cqC8JpR0Zm2jQ7jSzTdjj4yFM0PTdUg3mUo5IANd31XshDO7utppX8QBQ9c9PYml +PSVZTRLiDT50HB4rjsoLTlYQOMsFxG4v9v6ybKCvhmZRvD1J97Q5EEsD/3V+Kor5 +8j72RZwrjTspT7roljxyly5D/p6dqiNFLOHjjfuj3SYah7TAlAxtb7CFGsPdNJJf +jZvb//IzZw7XNG1EU9+PaV6mbTZNbrXavbKrIkz6AnLB9GDFE1oDWv7c2b5v5HVv +SO/hakFEDcgxSPzkMVkc7wGOq+6kClG8z2DMtC1CcmlhbiBSIEZ1cnJ5IChUcnVz +dCBObyBPbmUpIDxmYnJpYW5AbmFjLm5ldD6IZQQTEQIAHQUCPKkVqgUJBaOagAUL +BwoDBAMVAwIDFgIBAheAABIJEHIxQb2lt4IBB2VHUEcAAQHvmwCfV6KEnp4tIKHz +dZwBGsqnlKSBkpcAmgNdv300le8RtsGdhsDCRT6cUl1TiEYEEBECAAYFAjzqw3EA +CgkQclUlAyIk+rw0sgCg6jCNQKL71DqAifPm6o07tkkYoc0An3duMoIdm9g2qV2d +OSOpJn63WXKoiEYEEBECAAYFAj15JjIACgkQczG1wFfwRdyRHQCeK2xhxX1ccxDG +DzMYZKivG5uUdBoAnRJ62vbPCyQ1I9ihAf1nzygCdxrytC1CcmlhbiBSIEZ1cnJ5 +IChUcnVzdCBObyBPbmUpIDxiZnVycnlAbmFjLm5ldD6IZQQTEQIAHQUCPUsJiQUJ +BaOagAULBwoDBAMVAwIDFgIBAheAABIJEHIxQb2lt4IBB2VHUEcAAQHzcACfeVya +lc6NRe3Kle9aX9AXxljfdnUAniXqub/sS6WetxJwKrivk3WhyQnEiEYEEBECAAYF +Aj15JjgACgkQczG1wFfwRdxRyACgv7su7KfZvI07M31IcMtS0PHL4L4AoL5wr/os +n198CXGT8C5eXCRBVa8zuQENBDypFbgQBAC3VMeu+Qsa4IlZzzvFeB9sbnIr7e6P +TWuTR3EUnOzEd/h5k/bDdLW11uDnXyhbMSOXzGJaB9HbW5NXUuHIzTEwDzP+/hSJ +HNhc3YXREOs4YMrexeTgKEE3RFJ/ulTJ2EvTVdb7+uwKEMctKC+xaK/cIiRZt8Fg +Da1KjYBnpr5DvwADBQP5AaCubKcP0z202ys6EuvY/xIgYxJ95x/ermkV91cur7e1 +J9NqLOdbgj/yLcco9T92IBMm7zAnzDEtPC7UaqvrtuISvWc+z48Lk19AN7JOOH+g +2oIvspF4Gj2RVc7vijh7gMav5tIflZxqNi2U/QFYqgVTnE0facclV3w2IpMPUpyI +VAQYEQIADAUCPKkVuAUJBaOagAASCRByMUG9pbeCAQdlR1BHAAEB+GUAn0etwV2m +fUKduxyMlCzpoCtLBzy3AJ99bcVPGhgGkpMktMMRlLjPXiLgGA== +=tBlv +-----END PGP PUBLIC KEY BLOCK----- diff --git a/watch b/watch new file mode 100644 index 00000000..4daeb724 --- /dev/null +++ b/watch @@ -0,0 +1,2 @@ +version=2 +options=pasv,pgpsigurlmangle=s/$/.sig/ ftp://ftp.gnu.org/pub/gnu/gcl gcl-([0-9.]*).tar.gz debian uupdate