--- /dev/null
+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 <camm@enhanced.com>, Wed Dec 14 18:55:19 2005
--- /dev/null
+gcl (2.6.12-97) unstable; urgency=medium
+
+ * Bug fix: "Removal of obsolete debhelper compat 5 and 6 in bookworm",
+ thanks to Niels Thykier (Closes: #965543).
+ * Version_2.6.13pre93
+
+ -- Camm Maguire <camm@debian.org> Sat, 29 Aug 2020 16:23:07 +0000
+
+gcl (2.6.12-96) unstable; urgency=high
+
+ * Version_2.6.13pre92: Work around armhf strip bug producing undefined
+ instruction in .plt
+
+ -- Camm Maguire <camm@debian.org> Sun, 23 Aug 2020 17:53:14 +0000
+
+gcl (2.6.12-95) unstable; urgency=high
+
+ * Version_2_6_13pre90
+ * build under GCL_MEM_MULTIPLE=0.1
+ * Bug fix: "FTBFS: Unrecoverable error: Segmentation violation..",
+ thanks to Lucas Nussbaum (Closes: #952334).
+
+ -- Camm Maguire <camm@debian.org> Fri, 01 May 2020 12:55:02 +0000
+
+gcl (2.6.12-94) unstable; urgency=medium
+
+ * re-release to overcome hopefully transient buildd failure
+
+ -- Camm Maguire <camm@debian.org> Mon, 24 Feb 2020 20:02:52 +0000
+
+gcl (2.6.12-93) unstable; urgency=medium
+
+ * Version_2_6_13pre90
+
+ -- Camm Maguire <camm@debian.org> Fri, 21 Feb 2020 19:06:56 +0000
+
+gcl (2.6.12-92) unstable; urgency=medium
+
+ * Version_2_6_13pre89
+
+ -- Camm Maguire <camm@debian.org> Mon, 30 Dec 2019 15:46:22 +0000
+
+gcl (2.6.12-91) unstable; urgency=medium
+
+ * Version_2_6_13pre88
+
+ -- Camm Maguire <camm@debian.org> Wed, 18 Dec 2019 20:14:09 +0000
+
+gcl (2.6.12-90) unstable; urgency=medium
+
+ * Version_2_6_13pre87
+ * latest standards
+
+ -- Camm Maguire <camm@debian.org> 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</a>; (Closes: #942312).
+ * Bug fix: "FTBFS on ppc64el", thanks to Ivo De Decker (Closes:
+ #944651).
+
+ -- Camm Maguire <camm@debian.org> Sat, 07 Dec 2019 23:27:53 +0000
+
+gcl (2.6.12-88) unstable; urgency=medium
+
+ * Source only upload
+
+ -- Camm Maguire <camm@debian.org> Fri, 11 Oct 2019 19:18:44 +0000
+
+gcl (2.6.12-87) unstable; urgency=medium
+
+ * Version_2_6_13pre84
+
+ -- Camm Maguire <camm@debian.org> Sat, 06 Apr 2019 13:03:21 +0000
+
+gcl (2.6.12-86) unstable; urgency=medium
+
+ * Version_2_6_13pre83
+
+ -- Camm Maguire <camm@debian.org> Tue, 02 Apr 2019 19:57:15 +0000
+
+gcl (2.6.12-85) unstable; urgency=medium
+
+ * Version_2_6_13pre82
+
+ -- Camm Maguire <camm@debian.org> Thu, 28 Mar 2019 18:48:55 +0000
+
+gcl (2.6.12-84) unstable; urgency=medium
+
+ * Version_2_6_13pre80
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Tue, 05 Feb 2019 21:54:42 +0000
+
+gcl (2.6.12-82) unstable; urgency=high
+
+ * Version_2_6_13pre74
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> Tue, 30 Oct 2018 17:20:43 +0000
+
+gcl (2.6.12-79) unstable; urgency=medium
+
+ * Version_2_6_13pre70
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> Tue, 24 Jul 2018 20:06:45 +0000
+
+gcl (2.6.12-76) unstable; urgency=medium
+
+ * Version_2_6_13pre67
+
+ -- Camm Maguire <camm@debian.org> Fri, 23 Mar 2018 19:25:22 +0000
+
+gcl (2.6.12-75) unstable; urgency=medium
+
+ * Version_2_6_13pre65
+
+ -- Camm Maguire <camm@debian.org> Wed, 21 Mar 2018 20:28:08 +0000
+
+gcl (2.6.12-74) unstable; urgency=medium
+
+ * Version_2_6_13pre63
+
+ -- Camm Maguire <camm@debian.org> Sat, 17 Mar 2018 11:56:05 +0000
+
+gcl (2.6.12-73) unstable; urgency=medium
+
+ * Version_2_6_13pre62
+
+ -- Camm Maguire <camm@debian.org> Wed, 14 Mar 2018 15:38:43 +0000
+
+gcl (2.6.12-72) unstable; urgency=medium
+
+ * Version_2_6_13pre61
+
+ -- Camm Maguire <camm@debian.org> Tue, 13 Mar 2018 15:32:44 +0000
+
+gcl (2.6.12-71) unstable; urgency=medium
+
+ * Version_2_6_13pre60
+
+ -- Camm Maguire <camm@debian.org> Mon, 12 Mar 2018 19:44:47 +0000
+
+gcl (2.6.12-70) unstable; urgency=medium
+
+ * Version_2_6_13pre59
+
+ -- Camm Maguire <camm@debian.org> Mon, 12 Mar 2018 16:19:00 +0000
+
+gcl (2.6.12-69) unstable; urgency=medium
+
+ * Version_2_6_13pre58
+
+ -- Camm Maguire <camm@debian.org> Fri, 09 Mar 2018 17:10:51 +0000
+
+gcl (2.6.12-68) unstable; urgency=medium
+
+ * Version_2_6_13pre57
+
+ -- Camm Maguire <camm@debian.org> Sun, 04 Mar 2018 13:21:00 +0000
+
+gcl (2.6.12-67) unstable; urgency=medium
+
+ * Version_2_6_13pre55
+
+ -- Camm Maguire <camm@debian.org> Sat, 03 Mar 2018 14:27:51 +0000
+
+gcl (2.6.12-66) unstable; urgency=medium
+
+ * Version_2_6_13pre54
+
+ -- Camm Maguire <camm@debian.org> 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</a>;
+ (Closes: #802593).
+
+ -- Camm Maguire <camm@debian.org> Fri, 23 Feb 2018 15:55:23 +0000
+
+gcl (2.6.12-64) unstable; urgency=medium
+
+ * list_order.24
+
+ -- Camm Maguire <camm@debian.org> Sun, 04 Feb 2018 13:26:27 +0000
+
+gcl (2.6.12-63) unstable; urgency=medium
+
+ * list_order.23
+
+ -- Camm Maguire <camm@debian.org> Thu, 01 Feb 2018 18:36:29 +0000
+
+gcl (2.6.12-62) unstable; urgency=medium
+
+ * list_order.22
+
+ -- Camm Maguire <camm@debian.org> Thu, 01 Feb 2018 01:05:10 +0000
+
+gcl (2.6.12-61) unstable; urgency=medium
+
+ * list_order.21
+
+ -- Camm Maguire <camm@debian.org> Tue, 30 Jan 2018 21:13:13 +0000
+
+gcl (2.6.12-60) unstable; urgency=medium
+
+ * list_order.19
+
+ -- Camm Maguire <camm@debian.org> Tue, 23 Jan 2018 18:11:59 +0000
+
+gcl (2.6.12-59) unstable; urgency=medium
+
+ * list_order.16
+
+ -- Camm Maguire <camm@debian.org> Fri, 12 Jan 2018 03:25:08 +0000
+
+gcl (2.6.12-58) unstable; urgency=medium
+
+ * list_order.14
+
+ -- Camm Maguire <camm@debian.org> Mon, 18 Sep 2017 15:45:10 +0000
+
+gcl (2.6.12-57) unstable; urgency=medium
+
+ * list_order.13
+
+ -- Camm Maguire <camm@debian.org> Fri, 25 Aug 2017 13:44:10 +0000
+
+gcl (2.6.12-56) unstable; urgency=medium
+
+ * list_order.12
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Thu, 24 Aug 2017 16:37:07 +0000
+
+gcl (2.6.12-54) unstable; urgency=medium
+
+ * list_order.11
+
+ -- Camm Maguire <camm@debian.org> Wed, 23 Aug 2017 22:19:14 +0000
+
+gcl (2.6.12-53) unstable; urgency=medium
+
+ * list_order.9
+
+ -- Camm Maguire <camm@debian.org> Sun, 18 Jun 2017 18:32:30 +0000
+
+gcl (2.6.12-52) unstable; urgency=medium
+
+ * list_order.8
+
+ -- Camm Maguire <camm@debian.org> Thu, 15 Jun 2017 18:04:41 +0000
+
+gcl (2.6.12-51) unstable; urgency=medium
+
+ * list_order.7
+
+ -- Camm Maguire <camm@debian.org> Wed, 14 Jun 2017 18:30:46 +0000
+
+gcl (2.6.12-50) unstable; urgency=medium
+
+ * list_order.6
+
+ -- Camm Maguire <camm@debian.org> Tue, 13 Jun 2017 22:38:52 +0000
+
+gcl (2.6.12-49) unstable; urgency=medium
+
+ * list_order.5
+
+ -- Camm Maguire <camm@debian.org> Thu, 08 Jun 2017 17:21:01 +0000
+
+gcl (2.6.12-48) unstable; urgency=medium
+
+ * list_order.1
+
+ -- Camm Maguire <camm@debian.org> Sun, 28 May 2017 01:42:29 +0000
+
+gcl (2.6.12-47) unstable; urgency=high
+
+ * pathnames1.13
+
+ -- Camm Maguire <camm@debian.org> 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</a>; (Closes: #843303).
+
+ -- Camm Maguire <camm@debian.org> Fri, 18 Nov 2016 18:27:53 +0000
+
+gcl (2.6.12-45) unstable; urgency=high
+
+ * pathnames1.11
+
+ -- Camm Maguire <camm@debian.org> Mon, 31 Oct 2016 22:57:27 +0000
+
+gcl (2.6.12-44) unstable; urgency=high
+
+ * pathnames1.9
+
+ -- Camm Maguire <camm@debian.org> Fri, 28 Oct 2016 17:04:38 +0000
+
+gcl (2.6.12-43) unstable; urgency=medium
+
+ * pathnames1.7
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Wed, 26 Oct 2016 23:04:57 +0000
+
+gcl (2.6.12-41) unstable; urgency=medium
+
+ * pathnames1.4, kfreebsd fix
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Wed, 12 Oct 2016 18:09:26 +0000
+
+gcl (2.6.12-39) unstable; urgency=medium
+
+ * pathnames1.1
+ * ansi-test clean target
+
+ -- Camm Maguire <camm@debian.org> Wed, 12 Oct 2016 01:32:05 +0000
+
+gcl (2.6.12-38) unstable; urgency=medium
+
+ * Version_2_6_13pre50
+
+ -- Camm Maguire <camm@debian.org> Tue, 04 Oct 2016 19:45:38 +0000
+
+gcl (2.6.12-37) unstable; urgency=medium
+
+ * Version_2_6_13pre49
+
+ -- Camm Maguire <camm@debian.org> Mon, 03 Oct 2016 14:54:09 +0000
+
+gcl (2.6.12-36) unstable; urgency=medium
+
+ * Version_2_6_13pre48
+
+ -- Camm Maguire <camm@debian.org> Sat, 01 Oct 2016 12:10:25 +0000
+
+gcl (2.6.12-35) unstable; urgency=medium
+
+ * Version_2_6_13pre47
+
+ -- Camm Maguire <camm@debian.org> Fri, 30 Sep 2016 21:21:43 +0000
+
+gcl (2.6.12-34) unstable; urgency=medium
+
+ * Version_2_6_13pre45
+
+ -- Camm Maguire <camm@debian.org> Fri, 23 Sep 2016 19:42:37 +0000
+
+gcl (2.6.12-33) unstable; urgency=medium
+
+ * Version_2_6_13pre43
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Wed, 20 Apr 2016 15:18:35 +0000
+
+gcl (2.6.12-31) unstable; urgency=medium
+
+ * Version_2_6_13pre39
+
+ -- Camm Maguire <camm@debian.org> Mon, 11 Apr 2016 00:41:11 +0000
+
+gcl (2.6.12-30) unstable; urgency=medium
+
+ * Version_2_6_13pre38
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> Tue, 27 Oct 2015 16:35:06 +0000
+
+gcl (2.6.12-26) unstable; urgency=medium
+
+ * Version_2_6_13pre32
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Fri, 16 Oct 2015 15:03:03 +0000
+
+gcl (2.6.12-24) unstable; urgency=medium
+
+ * Version_2_6_13pre30
+
+ -- Camm Maguire <camm@debian.org> Fri, 16 Oct 2015 02:44:23 +0000
+
+gcl (2.6.12-23) unstable; urgency=medium
+
+ * Version_2_6_13pre29
+
+ -- Camm Maguire <camm@debian.org> Thu, 15 Oct 2015 18:09:59 +0000
+
+gcl (2.6.12-22) unstable; urgency=medium
+
+ * Version_2_6_13pre27
+
+ -- Camm Maguire <camm@debian.org> Tue, 13 Oct 2015 14:38:53 +0000
+
+gcl (2.6.12-21) unstable; urgency=medium
+
+ * Version_2_6_13pre26
+
+ -- Camm Maguire <camm@debian.org> Wed, 07 Oct 2015 15:14:27 +0000
+
+gcl (2.6.12-20) unstable; urgency=medium
+
+ * Version_2_6_13pre25
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Wed, 30 Sep 2015 15:45:20 +0000
+
+gcl (2.6.12-18) unstable; urgency=medium
+
+ * Version_2_6_13pre22
+
+ -- Camm Maguire <camm@debian.org> Tue, 29 Sep 2015 16:51:03 +0000
+
+gcl (2.6.12-17) unstable; urgency=medium
+
+ * Version_2_6_13pre20
+
+ -- Camm Maguire <camm@debian.org> Sat, 26 Sep 2015 10:34:23 -0400
+
+gcl (2.6.12-16) unstable; urgency=medium
+
+ * Version_2_6_13pre19
+
+ -- Camm Maguire <camm@debian.org> Fri, 25 Sep 2015 18:39:52 -0400
+
+gcl (2.6.12-15) unstable; urgency=medium
+
+ * Version_2_6_13pre18
+
+ -- Camm Maguire <camm@debian.org> Fri, 25 Sep 2015 15:08:50 +0000
+
+gcl (2.6.12-14) unstable; urgency=medium
+
+ * Version_2_6_13pre17
+
+ -- Camm Maguire <camm@debian.org> Thu, 28 May 2015 03:37:47 +0000
+
+gcl (2.6.12-13) unstable; urgency=medium
+
+ * Version_2_6_13pre16
+
+ -- Camm Maguire <camm@debian.org> Fri, 15 May 2015 18:09:38 +0000
+
+gcl (2.6.12-12) unstable; urgency=medium
+
+ * Version_2_6_13pre13
+
+ -- Camm Maguire <camm@debian.org> Fri, 01 May 2015 11:08:46 -0400
+
+gcl (2.6.12-11) unstable; urgency=medium
+
+ * Version_2_6_13pre12
+
+ -- Camm Maguire <camm@debian.org> Thu, 30 Apr 2015 12:49:16 -0400
+
+gcl (2.6.12-10) unstable; urgency=medium
+
+ * rebuild in clean sid environment
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Mon, 27 Apr 2015 12:32:49 -0400
+
+gcl (2.6.12-8) unstable; urgency=medium
+
+ * Version_2_6_13pre7
+
+ -- Camm Maguire <camm@debian.org> Fri, 24 Apr 2015 13:38:30 -0400
+
+gcl (2.6.12-7) unstable; urgency=medium
+
+ * Version_2_6_13pre6
+
+ -- Camm Maguire <camm@debian.org> Thu, 23 Apr 2015 13:43:45 -0400
+
+gcl (2.6.12-6) unstable; urgency=medium
+
+ * Version_2_6_13pre5
+
+ -- Camm Maguire <camm@debian.org> Wed, 22 Apr 2015 17:14:16 -0400
+
+gcl (2.6.12-5) unstable; urgency=medium
+
+ * Version_2_6_13pre4
+
+ -- Camm Maguire <camm@debian.org> Wed, 22 Apr 2015 10:25:36 -0400
+
+gcl (2.6.12-4) unstable; urgency=medium
+
+ * Version_2_6_13pre3a
+
+ -- Camm Maguire <camm@debian.org> Mon, 20 Apr 2015 13:26:36 -0400
+
+gcl (2.6.12-3) unstable; urgency=medium
+
+ * Version_2_6_13pre2
+
+ -- Camm Maguire <camm@debian.org> Fri, 17 Apr 2015 15:50:37 -0400
+
+gcl (2.6.12-2) unstable; urgency=medium
+
+ * Version_2_6_13pre1
+
+ -- Camm Maguire <camm@debian.org> Wed, 26 Nov 2014 11:12:46 -0500
+
+gcl (2.6.12-1) unstable; urgency=medium
+
+ * New upstream release
+
+ -- Camm Maguire <camm@debian.org> Tue, 28 Oct 2014 09:56:15 -0400
+
+gcl (2.6.11-6) unstable; urgency=medium
+
+ * 2.6.12pre5
+
+ -- Camm Maguire <camm@debian.org> Thu, 23 Oct 2014 17:33:22 -0400
+
+gcl (2.6.11-5) unstable; urgency=medium
+
+ * 2.6.12pre4
+
+ -- Camm Maguire <camm@debian.org> Sat, 18 Oct 2014 09:46:34 -0400
+
+gcl (2.6.11-4) unstable; urgency=medium
+
+ * 2.6.12pre3
+
+ -- Camm Maguire <camm@debian.org> Thu, 16 Oct 2014 11:56:15 -0400
+
+gcl (2.6.11-3) unstable; urgency=medium
+
+ * 2.6.12pre2
+
+ -- Camm Maguire <camm@debian.org> Sun, 28 Sep 2014 20:56:18 -0400
+
+gcl (2.6.11-2) unstable; urgency=medium
+
+ * 2.6.12pre1
+
+ -- Camm Maguire <camm@debian.org> Fri, 19 Sep 2014 14:49:25 -0400
+
+gcl (2.6.11-1) unstable; urgency=medium
+
+ * New upstream release
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Fri, 05 Sep 2014 10:35:46 -0400
+
+gcl (2.6.10-53) unstable; urgency=medium
+
+ * ppc64le-support-headers
+
+ -- Camm Maguire <camm@debian.org> Wed, 03 Sep 2014 15:02:12 -0400
+
+gcl (2.6.10-52) unstable; urgency=medium
+
+ * accept-TMP-paths-with-types-versions
+
+ -- Camm Maguire <camm@debian.org> Fri, 29 Aug 2014 17:51:04 -0400
+
+gcl (2.6.10-51) unstable; urgency=medium
+
+ * fix-match-function-proclaim-skew
+
+ -- Camm Maguire <camm@debian.org> Fri, 29 Aug 2014 16:40:30 +0000
+
+gcl (2.6.10-50) unstable; urgency=medium
+
+ * trial_selinux_support
+
+ -- Camm Maguire <camm@debian.org> Thu, 21 Aug 2014 17:29:50 +0000
+
+gcl (2.6.10-49) unstable; urgency=medium
+
+ * R_ARM_JUMP24
+
+ -- Camm Maguire <camm@debian.org> Wed, 20 Aug 2014 17:08:23 +0000
+
+gcl (2.6.10-48) unstable; urgency=medium
+
+ * try-SGC-for-aarch64
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Thu, 14 Aug 2014 19:36:48 +0000
+
+gcl (2.6.10-46) unstable; urgency=medium
+
+ * R_AARCH64_LDST128_ABS_LO12_NC
+
+ -- Camm Maguire <camm@debian.org> Wed, 13 Aug 2014 21:39:50 +0000
+
+gcl (2.6.10-45) unstable; urgency=medium
+
+ * fix sh4 CLEAR_CACHE
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> Fri, 08 Aug 2014 23:42:42 +0000
+
+gcl (2.6.10-42) unstable; urgency=medium
+
+ * backport travel_push_new from master
+
+ -- Camm Maguire <camm@debian.org> Wed, 06 Aug 2014 20:14:14 +0000
+
+gcl (2.6.10-41) unstable; urgency=medium
+
+ * protos and CFLAGS for axiom extensions
+
+ -- Camm Maguire <camm@debian.org> Wed, 06 Aug 2014 01:54:38 +0000
+
+gcl (2.6.10-40) unstable; urgency=medium
+
+ * better solaris unexec fix
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Mon, 04 Aug 2014 16:52:09 +0000
+
+gcl (2.6.10-38) unstable; urgency=medium
+
+ * error on overflow of array dimensions
+
+ -- Camm Maguire <camm@debian.org> Fri, 01 Aug 2014 14:35:44 +0000
+
+gcl (2.6.10-37) unstable; urgency=medium
+
+ * FILE * casts for windows feof wrapper
+
+ -- Camm Maguire <camm@debian.org> Thu, 31 Jul 2014 02:17:11 +0000
+
+gcl (2.6.10-36) unstable; urgency=medium
+
+ * better casts for frs_jmpbuf
+
+ -- Camm Maguire <camm@debian.org> Wed, 30 Jul 2014 17:00:06 +0000
+
+gcl (2.6.10-35) unstable; urgency=medium
+
+ * find_sym_ptable typo fix
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> Wed, 23 Jul 2014 18:12:56 +0000
+
+gcl (2.6.10-31) unstable; urgency=medium
+
+ * dpkg-buildflags trial
+
+ -- Camm Maguire <camm@debian.org> Tue, 22 Jul 2014 20:06:10 +0000
+
+gcl (2.6.10-30) unstable; urgency=medium
+
+ * fix offsets ppc
+
+ -- Camm Maguire <camm@debian.org> Tue, 22 Jul 2014 17:12:27 +0000
+
+gcl (2.6.10-29) unstable; urgency=medium
+
+ * fix unexec file offsets
+
+ -- Camm Maguire <camm@debian.org> Tue, 22 Jul 2014 15:36:45 +0000
+
+gcl (2.6.10-28) unstable; urgency=high
+
+ * enable prelink
+
+ -- Camm Maguire <camm@debian.org> Fri, 18 Jul 2014 19:24:38 +0000
+
+gcl (2.6.10-27) unstable; urgency=high
+
+ * protect closure calls from gc
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> Wed, 09 Jul 2014 17:34:21 +0000
+
+gcl (2.6.10-23) unstable; urgency=high
+
+ * rebuild latest binutils
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Fri, 04 Jul 2014 01:36:06 +0000
+
+gcl (2.6.10-21) unstable; urgency=high
+
+ * 2.6.11pre test 20
+
+ -- Camm Maguire <camm@debian.org> Mon, 30 Jun 2014 22:43:27 +0000
+
+gcl (2.6.10-20) unstable; urgency=high
+
+ * 2.6.11pre test 19
+
+ -- Camm Maguire <camm@debian.org> Sun, 29 Jun 2014 17:59:59 +0000
+
+gcl (2.6.10-19) unstable; urgency=high
+
+ * 2.6.11pre test 18
+
+ -- Camm Maguire <camm@debian.org> Sun, 29 Jun 2014 16:00:07 +0000
+
+gcl (2.6.10-18) unstable; urgency=high
+
+ * 2.6.11pre test 17
+
+ -- Camm Maguire <camm@debian.org> Sat, 28 Jun 2014 16:57:54 +0000
+
+gcl (2.6.10-17) unstable; urgency=high
+
+ * 2.6.11pre test 16
+
+ -- Camm Maguire <camm@debian.org> Thu, 26 Jun 2014 18:06:42 +0000
+
+gcl (2.6.10-16) unstable; urgency=high
+
+ * 2.6.11pre test 15
+
+ -- Camm Maguire <camm@debian.org> Wed, 18 Jun 2014 17:37:36 +0000
+
+gcl (2.6.10-15) unstable; urgency=high
+
+ * 2.6.11pre test 14
+
+ -- Camm Maguire <camm@debian.org> Tue, 17 Jun 2014 00:39:35 +0000
+
+gcl (2.6.10-14) unstable; urgency=high
+
+ * 2.6.11pre test 13
+
+ -- Camm Maguire <camm@debian.org> Sat, 14 Jun 2014 13:43:57 +0000
+
+gcl (2.6.10-13) unstable; urgency=high
+
+ * 2.6.11pre test 12
+
+ -- Camm Maguire <camm@debian.org> Tue, 20 May 2014 16:00:22 +0000
+
+gcl (2.6.10-12) unstable; urgency=high
+
+ * 2.6.11pre test 11
+
+ -- Camm Maguire <camm@debian.org> Fri, 16 May 2014 17:41:33 +0000
+
+gcl (2.6.10-11) unstable; urgency=high
+
+ * 2.6.11pre test 10
+
+ -- Camm Maguire <camm@debian.org> Fri, 16 May 2014 13:18:07 +0000
+
+gcl (2.6.10-10) unstable; urgency=high
+
+ * 2.6.11pre test 9
+
+ -- Camm Maguire <camm@debian.org> Wed, 07 May 2014 17:10:30 +0000
+
+gcl (2.6.10-9) unstable; urgency=high
+
+ * 2.6.11pre test 8
+
+ -- Camm Maguire <camm@debian.org> Fri, 25 Apr 2014 19:53:10 +0000
+
+gcl (2.6.10-8) unstable; urgency=high
+
+ * 2.6.11pre test 7
+
+ -- Camm Maguire <camm@debian.org> Mon, 21 Apr 2014 14:09:37 +0000
+
+gcl (2.6.10-7) unstable; urgency=high
+
+ * 2.6.11pre test 6
+
+ -- Camm Maguire <camm@debian.org> Sat, 19 Apr 2014 17:52:17 +0000
+
+gcl (2.6.10-6) unstable; urgency=high
+
+ * 2.6.11pre test 5
+
+ -- Camm Maguire <camm@debian.org> Fri, 18 Apr 2014 15:06:09 +0000
+
+gcl (2.6.10-5) unstable; urgency=high
+
+ * 2.6.11pre test 4
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Wed, 09 Apr 2014 13:15:32 +0000
+
+gcl (2.6.10-3) unstable; urgency=high
+
+ * 2.6.11pre test 2
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Mon, 24 Mar 2014 15:47:01 +0000
+
+gcl (2.6.10-1) unstable; urgency=high
+
+ * New upstream release
+
+ -- Camm Maguire <camm@debian.org> Wed, 13 Nov 2013 18:39:19 +0000
+
+gcl (2.6.9-17) unstable; urgency=high
+
+ * 2.6.10pre test 17
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Sat, 09 Nov 2013 13:34:32 +0000
+
+gcl (2.6.9-15) unstable; urgency=high
+
+ * 2.6.10pre test 15
+
+ -- Camm Maguire <camm@debian.org> Sat, 02 Nov 2013 22:21:16 +0000
+
+gcl (2.6.9-14) unstable; urgency=high
+
+ * 2.6.10pre test 14
+
+ -- Camm Maguire <camm@debian.org> Wed, 23 Oct 2013 17:44:14 +0000
+
+gcl (2.6.9-13) unstable; urgency=high
+
+ * environment allocation unrandomize.h
+
+ -- Camm Maguire <camm@debian.org> Mon, 21 Oct 2013 00:20:16 +0000
+
+gcl (2.6.9-12) unstable; urgency=high
+
+ * 2.6.10pre test 13
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Tue, 15 Oct 2013 23:32:09 +0000
+
+gcl (2.6.9-10) unstable; urgency=high
+
+ * fast-fixnums
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> Mon, 30 Sep 2013 19:34:38 +0000
+
+gcl (2.6.9-6) unstable; urgency=high
+
+ * 2.6.10pre test 5
+
+ -- Camm Maguire <camm@debian.org> Tue, 24 Sep 2013 17:03:24 +0000
+
+gcl (2.6.9-5) unstable; urgency=high
+
+ * 2.6.10pre test 4
+
+ -- Camm Maguire <camm@debian.org> Mon, 23 Sep 2013 19:27:36 +0000
+
+gcl (2.6.9-4) unstable; urgency=high
+
+ * 2.6.10pre test 3
+
+ -- Camm Maguire <camm@debian.org> Mon, 23 Sep 2013 16:30:09 +0000
+
+gcl (2.6.9-3) unstable; urgency=high
+
+ * 2.6.10pre test 2
+
+ -- Camm Maguire <camm@debian.org> Sun, 22 Sep 2013 03:27:10 +0000
+
+gcl (2.6.9-2) unstable; urgency=high
+
+ * 2.6.10pre test
+
+ -- Camm Maguire <camm@debian.org> Sat, 21 Sep 2013 04:14:55 +0000
+
+gcl (2.6.9-1) unstable; urgency=high
+
+ * New upstream release
+
+ -- Camm Maguire <camm@debian.org> Wed, 28 Aug 2013 16:49:18 +0000
+
+gcl (2.6.7+dfsga-40) unstable; urgency=high
+
+ * fix allocate functions
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> Fri, 02 Aug 2013 16:25:16 +0000
+
+gcl (2.6.7+dfsga-37) unstable; urgency=high
+
+ * ppc64 gprof fix
+
+ -- Camm Maguire <camm@debian.org> Fri, 26 Jul 2013 23:40:14 +0000
+
+gcl (2.6.7+dfsga-36) unstable; urgency=high
+
+ * min_pagewidth=14 on mips
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> Mon, 15 Jul 2013 16:23:33 +0000
+
+gcl (2.6.7+dfsga-28) unstable; urgency=high
+
+ * install unixport/gcl.script
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> Fri, 12 Jul 2013 00:52:35 +0000
+
+gcl (2.6.7+dfsga-25) unstable; urgency=high
+
+ * alpha, mips, 68k
+
+ -- Camm Maguire <camm@debian.org> Wed, 10 Jul 2013 18:29:37 +0000
+
+gcl (2.6.7+dfsga-24) unstable; urgency=high
+
+ * sgc and reloc fixes
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> Tue, 02 Jul 2013 18:27:54 +0000
+
+gcl (2.6.7+dfsga-21) unstable; urgency=high
+
+ * near out of memory robustification
+
+ -- Camm Maguire <camm@debian.org> Tue, 02 Jul 2013 15:32:58 +0000
+
+gcl (2.6.7+dfsga-20) unstable; urgency=high
+
+ * fix 3GB workaround for gprof
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> Thu, 20 Jun 2013 20:24:29 +0000
+
+gcl (2.6.7+dfsga-17) unstable; urgency=high
+
+ * small optimizations, #= nil fix
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Thu, 13 Jun 2013 15:35:00 +0000
+
+gcl (2.6.7+dfsga-15) unstable; urgency=high
+
+ * ia64 fix
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Wed, 12 Jun 2013 21:42:29 +0000
+
+gcl (2.6.7+dfsga-13) unstable; urgency=low
+
+ * ia64/hurd/s390 and SGC
+
+ -- Camm Maguire <camm@debian.org> Sun, 09 Jun 2013 00:23:51 +0000
+
+gcl (2.6.7+dfsga-12) unstable; urgency=low
+
+ * ia64/hurd/s390
+
+ -- Camm Maguire <camm@debian.org> Sat, 08 Jun 2013 15:24:46 +0000
+
+gcl (2.6.7+dfsga-11) unstable; urgency=high
+
+ * 2.6.9 test
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Sat, 25 May 2013 12:24:35 +0000
+
+gcl (2.6.7+dfsga-9) unstable; urgency=high
+
+ * mips make bug workaround
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Tue, 21 May 2013 14:42:05 +0000
+
+gcl (2.6.7+dfsga-7) unstable; urgency=high
+
+ * export ansi symbols
+
+ -- Camm Maguire <camm@debian.org> Sat, 11 May 2013 21:36:56 +0000
+
+gcl (2.6.7+dfsga-6) unstable; urgency=high
+
+ * fast hash-equal in compiler
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <taffit@debian.org>)
+ * 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 <camm@debian.org> 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 <camm@debian.org> Mon, 08 Oct 2012 18:08:36 +0000
+
+gcl (2.6.7-107) unstable; urgency=high
+
+ * mode 644 on ucf newfile
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> Mon, 01 Oct 2012 15:32:52 +0000
+
+gcl (2.6.7-103) unstable; urgency=high
+
+ * sfaslelf.c: FIX_HIDDEN_SYMBOLS
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> Fri, 20 Apr 2012 02:25:26 +0000
+
+gcl (2.6.7-99) unstable; urgency=low
+
+ * case default error checking
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> Wed, 18 Jan 2012 01:32:43 +0000
+
+gcl (2.6.7-95) unstable; urgency=low
+
+ * clear_cache after mprotect
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> Thu, 28 Oct 2010 13:43:16 +0000
+
+gcl (2.6.7-82) unstable; urgency=low
+
+ * mips64 fixes
+
+ -- Camm Maguire <camm@debian.org> Tue, 26 Oct 2010 18:20:04 +0000
+
+gcl (2.6.7-81) unstable; urgency=low
+
+ * sparc64;mips64
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> Wed, 20 Oct 2010 15:31:59 +0000
+
+gcl (2.6.7-78) unstable; urgency=low
+
+ * mips local got relocs
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> Fri, 01 Oct 2010 19:18:47 +0000
+
+gcl (2.6.7-75) unstable; urgency=low
+
+ * fix alpha bug
+
+ -- Camm Maguire <camm@debian.org> Tue, 28 Sep 2010 20:23:21 +0000
+
+gcl (2.6.7-74) unstable; urgency=low
+
+ * fix alpha relocs for axiom
+
+ -- Camm Maguire <camm@debian.org> Tue, 28 Sep 2010 16:07:38 +0000
+
+gcl (2.6.7-73) unstable; urgency=low
+
+ * sparc reloc updates
+ * fast-link fix
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Wed, 22 Sep 2010 19:32:52 +0000
+
+gcl (2.6.7-71) unstable; urgency=low
+
+ * print sparc64 relocs
+
+ -- Camm Maguire <camm@debian.org> Sat, 28 Aug 2010 14:50:00 +0000
+
+gcl (2.6.7-70) unstable; urgency=low
+
+ * sparc64/m68k
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Thu, 26 Aug 2010 19:08:39 +0000
+
+gcl (2.6.7-68) unstable; urgency=low
+
+ * ppc/mips elf reloc fixes
+
+ -- Camm Maguire <camm@debian.org> Mon, 23 Aug 2010 20:54:30 +0000
+
+gcl (2.6.7-67) unstable; urgency=low
+
+ * Fix compiler::link ansi combo
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> Fri, 20 Aug 2010 01:25:09 +0000
+
+gcl (2.6.7-65) unstable; urgency=low
+
+ * autobuilder fixes
+
+ -- Camm Maguire <camm@debian.org> Sat, 14 Aug 2010 11:30:46 +0000
+
+gcl (2.6.7-64) unstable; urgency=low
+
+ * configure fix
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> Tue, 20 Jul 2010 14:50:19 +0000
+
+gcl (2.6.7-60) unstable; urgency=high
+
+ * fix sh4 support
+
+ -- Camm Maguire <camm@debian.org> Thu, 29 Apr 2010 18:09:04 +0000
+
+gcl (2.6.7-59) unstable; urgency=high
+
+ * fix hurd support
+
+ -- Camm Maguire <camm@debian.org> Fri, 23 Apr 2010 17:12:54 +0000
+
+gcl (2.6.7-58) unstable; urgency=high
+
+ * hurd support
+ * sh4 support
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> Wed, 20 Jan 2010 19:02:28 +0000
+
+gcl (2.6.7-53) unstable; urgency=low
+
+ * revert round ratio to nearest
+
+ -- Camm Maguire <camm@debian.org> Tue, 05 Jan 2010 03:06:59 +0000
+
+gcl (2.6.7-52) unstable; urgency=low
+
+ * SIGINFO for kfreebsd-386
+
+ -- Camm Maguire <camm@debian.org> Mon, 04 Jan 2010 17:49:05 +0000
+
+gcl (2.6.7-51) unstable; urgency=low
+
+ * user_match exscapes once only
+
+ -- Camm Maguire <camm@debian.org> Sun, 03 Jan 2010 05:31:20 +0000
+
+gcl (2.6.7-50) unstable; urgency=low
+
+ * gcc 4.4 warning cleanups
+
+ -- Camm Maguire <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@debian.org> 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 <camm@enhanced.com> 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 <camm@maguirefamily.org> 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 <camm@maguirefamily.org> Wed, 20 Aug 2008 21:18:43 +0000
+
+gcl (2.6.7-42) unstable; urgency=low
+
+ * more div/rem symbols for alpha
+
+ -- Camm Maguire <camm@sacrifice.m.enhanced.com> 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 <camm@sacrifice.m.enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> Fri, 01 Aug 2008 12:53:07 -0400
+
+gcl (2.6.7-38) unstable; urgency=low
+
+ * No infinite unrandomization loops
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> Wed, 16 May 2007 12:45:40 -0400
+
+gcl (2.6.7-32) unstable; urgency=low
+
+ * static function pointers for hppa
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> Fri, 15 Sep 2006 13:48:28 -0400
+
+gcl (2.6.7-21) unstable; urgency=low
+
+ * Fix socket write error
+
+ -- Camm Maguire <camm@enhanced.com> Wed, 6 Sep 2006 09:59:50 -0400
+
+gcl (2.6.7-20) unstable; urgency=low
+
+ * fix ia64 build
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> Fri, 9 Jun 2006 17:52:22 +0000
+
+gcl (2.6.7-14) unstable; urgency=low
+
+ * Add mount declaration to plt.c
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> Thu, 29 Sep 2005 17:50:56 +0000
+
+gcl (2.6.7-6) unstable; urgency=high
+
+ * Build bfd snapshot locally, Closes: #318681
+
+ -- Camm Maguire <camm@enhanced.com> Tue, 20 Sep 2005 17:53:17 +0000
+
+gcl (2.6.7-5) unstable; urgency=high
+
+ * gcc-3.3 for arm
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> Tue, 13 Jul 2004 10:17:02 -0400
+
+gcl (2.6.2-2) unstable; urgency=low
+
+ * New upstream point release
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> Tue, 13 Apr 2004 21:00:22 +0000
+
+gcl (2.6.1-36) unstable; urgency=low
+
+ * Improve optimize-maximum-pages algorithm
+
+ -- Camm Maguire <camm@enhanced.com> Tue, 6 Apr 2004 03:23:40 +0000
+
+gcl (2.6.1-35) unstable; urgency=low
+
+ * Fix sigcontext autodetection on sparc
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> Tue, 27 Jan 2004 20:27:20 +0000
+
+gcl (2.6.1-22) unstable; urgency=low
+
+ * Build depend on emacs21 | emacsen
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> Fri, 16 Jan 2004 16:57:50 +0000
+
+gcl (2.6.1-20) unstable; urgency=low
+
+ * Fix gcl-doc doc-base files
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> Tue, 23 Sep 2003 19:33:27 +0000
+
+gcl (2.6.1-9) unstable; urgency=low
+
+ * Close streams in fasldlsym.c
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> Tue, 9 Sep 2003 15:29:06 +0000
+
+gcl (2.6.1-5) unstable; urgency=low
+
+ * Redefine temporary files in elisp/makefile
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> Thu, 4 Sep 2003 02:20:52 +0000
+
+gcl (2.5.3-2) unstable; urgency=low
+
+ * gcc-3.3 all platforms
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> Sat, 1 Mar 2003 17:33:29 -0500
+
+gcl (2.5.0.cvs20020625-79) unstable; urgency=low
+
+ * Fix Debian package install bug
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> Wed, 26 Feb 2003 21:31:04 -0500
+
+gcl (2.5.0.cvs20020625-75) unstable; urgency=low
+
+ * Export truename for dlopen systems
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@m.enhanced.com> 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 <camm@m.enhanced.com> 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 <camm@m.enhanced.com> 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 <camm@m.enhanced.com> 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 <camm@m.enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> Thu, 12 Sep 2002 18:00:50 -0400
+
+gcl (2.5.0.cvs20020625-51) unstable; urgency=high
+
+ * static gmp for m68k
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> Mon, 12 Aug 2002 23:49:09 -0400
+
+gcl (2.5.0.cvs20020625-41) unstable; urgency=high
+
+ * Minor rules revision for i164
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> Wed, 31 Jul 2002 09:44:20 -0400
+
+gcl (2.5.0.cvs20020625-24) unstable; urgency=high
+
+ * chmod +x gmp3/configure
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> Thu, 25 Jul 2002 15:08:05 -0400
+
+gcl (2.5.0.cvs20020625-20) unstable; urgency=high
+
+ * Cleanups for --disable-bfd option
+
+ -- Camm Maguire <camm@enhanced.com> Wed, 24 Jul 2002 15:05:28 -0400
+
+gcl (2.5.0.cvs20020625-19) unstable; urgency=high
+
+ * 64bit fixes
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> Sat, 20 Jul 2002 18:47:43 -0400
+
+gcl (2.5.0.cvs20020625-13) unstable; urgency=high
+
+ * Proper va_dcl declarations
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> Fri, 12 Jul 2002 19:02:09 -0400
+
+gcl (2.5.0.cvs20020625-9) unstable; urgency=high
+
+ * cvs commits for 64bit support
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> Fri, 12 Jul 2002 14:37:48 -0400
+
+gcl (2.5.0.cvs20020625-7) unstable; urgency=high
+
+ * arm is bigendian
+
+ -- Camm Maguire <camm@enhanced.com> Wed, 10 Jul 2002 18:04:22 -0400
+
+gcl (2.5.0.cvs20020625-6) unstable; urgency=high
+
+ * cvs updates for arm build
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> Wed, 26 Jun 2002 17:27:21 -0400
+
+gcl (2.5.0.cvs20020625-2) unstable; urgency=high
+
+ * s390 support
+
+ -- Camm Maguire <camm@enhanced.com> Tue, 25 Jun 2002 21:25:35 -0400
+
+gcl (2.5.0.cvs20020625-1) unstable; urgency=high
+
+ * CVS updates, new s390 arch
+
+ -- Camm Maguire <camm@enhanced.com> Tue, 25 Jun 2002 19:26:36 -0400
+
+gcl (2.5.0.cvs20020610-2) unstable; urgency=high
+
+ * cvs updates
+
+ -- Camm Maguire <camm@enhanced.com> Thu, 13 Jun 2002 08:42:32 -0400
+
+gcl (2.5.0.cvs20020610-1) unstable; urgency=high
+
+ * cvs updates
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> Fri, 24 May 2002 18:50:22 -0400
+
+gcl (2.5.0.cvs20020523-1) unstable; urgency=high
+
+ * New upstream release
+
+ -- Camm Maguire <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <camm@enhanced.com> 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 <baruch@debian.org> 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 <taral@taral.net> Wed, 30 May 2001 14:34:53 -0500
+
+gcl (2.4.0-1) unstable; urgency=low
+
+ * New upstream release
+
+ -- JP Sugarbroad <taral@taral.net> 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 <taral@taral.net> 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 <taral@taral.net> 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 <taral@taral.net> 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 <dunham@debian.org> Fri, 24 Sep 1999 14:39:15 -0400
+
+gcl (2.2.1-5) unstable; urgency=low
+
+ * Fix m68k build
+
+ -- Steve Dunham <dunham@debian.org> Tue, 6 Jul 1999 09:45:09 -0400
+
+gcl (2.2.1-4) unstable; urgency=low
+
+ * Fix bug #31718
+
+ -- Steve Dunham <dunham@debian.org> Fri, 2 Jul 1999 11:11:12 -0400
+
+gcl (2.2.1-3) unstable; urgency=low
+
+ * Add m68k patches
+
+ -- Steve Dunham <dunham@debian.org> Wed, 16 Dec 1998 14:25:46 -0500
+
+gcl (2.2.1-2) unstable; urgency=low
+
+ * Compile against libc6. New maintainer.
+
+ -- Steve Dunham <dunham@cps.msu.edu> 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 <krs@debian.org> 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 <krs@debian.org> 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
--- /dev/null
+Source: gcl
+Section: lisp
+Priority: optional
+Maintainer: Camm Maguire <camm@debian.org>
+Homepage: http://gnu.org/software/gcl
+Build-Depends: debhelper (>= 13), libreadline-dev, m4, tk8.6-dev, libgmp-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.
--- /dev/null
+Source: gcl
+Section: lisp
+Priority: optional
+Maintainer: Camm Maguire <camm@debian.org>
+Homepage: http://gnu.org/software/gcl
+Build-Depends: debhelper (>= 13), libreadline-dev, m4, tk8.6-dev, libgmp-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.
--- /dev/null
+Source: gclcvs
+Section: lisp
+Priority: optional
+Maintainer: Camm Maguire <camm@debian.org>
+Homepage: http://gnu.org/software/gcl
+Build-Depends: debhelper (>= 13), libreadline-dev, m4, tk8.6-dev, libgmp-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.
--- /dev/null
+This package was debianized by JP Sugarbroad <taral@taral.net> on
+Mon, 30 Apr 2001 19:07:49 -0500.
+
+It was downloaded from http://savannah.gnu.org/projects/gcl
+
+Upstream Author: Bill Schelter <wfs@mail.ma.utexas.edu>
+
+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'.
--- /dev/null
+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
--- /dev/null
+#!/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)"
--- /dev/null
+# 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.
--- /dev/null
+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 <camm@debian.org>, Fri, 9 May 2014 19:08:59 +0000
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+faq
+readme
+readme.xgcl
--- /dev/null
+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
--- /dev/null
+debian/tmp/usr/share/doc/gcl@EXT@-doc
--- /dev/null
+#!/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
--- /dev/null
+ansi-tests/test_results
+RELEASE-2.6.2.html
--- /dev/null
+#! /bin/sh -e
+# /usr/lib/emacsen-common/packages/install/#PACKAGE#
+
+# Written by Jim Van Zandt <jrv@vanzandt.mv.com>, borrowing heavily
+# from the install scripts for gettext by Santiago Vila
+# <sanvila@ctv.es> and octave by Dirk Eddelbuettel <edd@debian.org>.
+
+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
+
--- /dev/null
+#!/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
--- /dev/null
+;; -*-emacs-lisp-*-
+;;
+;; Emacs startup file for the Debian GNU/Linux #PACKAGE# package
+;;
+;; Originally contributed by Nils Naumann <naumann@unileoben.ac.at>
+;; Modified by Dirk Eddelbuettel <edd@debian.org>
+;; Adapted for dh-make by Jim Van Zandt <jrv@vanzandt.mv.com>
+
+;; 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)
--- /dev/null
+debian/tmp/usr/lib
+debian/tmp/usr/bin
+debian/tmp/usr/share/emacs
--- /dev/null
+debian/tmp/usr/share/man/man1/gcl@EXT@.1
--- /dev/null
+#!/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#
+
--- /dev/null
+#!/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#
--- /dev/null
+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
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-2) unstable; urgency=medium
+ .
+ * Version_2_6_13pre1
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/clcs/package.lisp
++++ gcl-2.6.12/clcs/package.lisp
+@@ -20,3 +20,4 @@
+ (defvar *this-package* (find-package :conditions))
+
+
++(import 'si::(clines defentry defcfun object void int double))
+--- gcl-2.6.12.orig/clcs/sys-proclaim.lisp
++++ gcl-2.6.12/clcs/sys-proclaim.lisp
+@@ -1,45 +1,46 @@
+
+-(IN-PACKAGE "CONDITIONS")
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T) T) CONDITION-CLASS-P IS-WARNING CONDITIONP
+- IS-CONDITION ESCAPE-SPECIAL-CASES-REPLACE
+- SIMPLE-CONDITION-CLASS-P INTERNAL-SIMPLE-CONDITION-CLASS-P))
+-(PROCLAIM '(FTYPE (FUNCTION (*) *) CLCS-COMPILE))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T) T) ASSERT-REPORT SYMCAT COERCE-TO-FN
+- SLOT-SYM))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T *) *) CLCS-LOAD CLCS-OPEN CLCS-COMPILE-FILE
+- MAKE-CONDITION))
+-(PROCLAIM '(FTYPE (FUNCTION (T) (*)) SIMPLE-ASSERTION-FAILURE))
+-(PROCLAIM '(FTYPE (FUNCTION (T T T) T) ACCUMULATE-CASES))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T) T)
+- |(PCL::FAST-METHOD PRINT-OBJECT (CONDITION T))|))
+-(PROCLAIM '(FTYPE (FUNCTION (T T) *) ASSERT-PROMPT))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T) *)
+- |(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-WARNING T))|
+- |(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-SLOT T))|
+- |(PCL::FAST-METHOD PRINT-OBJECT (END-OF-FILE T))|
+- |(PCL::FAST-METHOD PRINT-OBJECT (FILE-ERROR T))|
+- |(PCL::FAST-METHOD PRINT-OBJECT (ARITHMETIC-ERROR T))|
+- |(PCL::FAST-METHOD PRINT-OBJECT (SIMPLE-CONDITION T))|
+- |(PCL::FAST-METHOD PRINT-OBJECT (ABORT-FAILURE T))|
+- |(PCL::FAST-METHOD PRINT-OBJECT (CASE-FAILURE T))|
+- |(PCL::FAST-METHOD PRINT-OBJECT (UNDEFINED-FUNCTION T))|
+- |(PCL::FAST-METHOD PRINT-OBJECT (PRINT-NOT-READABLE T))|
+- |(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-ERROR T))|
+- |(PCL::FAST-METHOD PRINT-OBJECT (PACKAGE-ERROR T))|
+- |(PCL::FAST-METHOD PRINT-OBJECT (CELL-ERROR T))|
+- |(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-CONDITION T))|
+- |(PCL::FAST-METHOD PRINT-OBJECT (STREAM-ERROR T))|
+- COERCE-TO-CONDITION
+- |(PCL::FAST-METHOD PRINT-OBJECT (TYPE-ERROR T))|
+- |(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-VARIABLE T))|))
+-(PROCLAIM
+- '(FTYPE (FUNCTION NIL T) REVERT-CLCS-SYMBOLS INSTALL-CLCS-SYMBOLS
+- READ-EVALUATED-FORM))
+-(MAPC (LAMBDA (COMPILER::X)
+- (SETF (GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE) T))
+- '(INSTALL-SYMBOL REVERT-SYMBOL))
+\ No newline at end of file
++(COMMON-LISP::IN-PACKAGE "CONDITIONS")
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T)
++ CONDITIONS::IS-WARNING CONDITIONS::DEFAULT-REPORT
++ CONDITIONS::IS-CONDITION CONDITIONS::CONDITIONP))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T)
++ COMMON-LISP::*)
++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ARITHMETIC-ERROR T))|
++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PACKAGE-ERROR T))|
++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-CONDITION T))|
++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNDEFINED-FUNCTION T))|
++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-SLOT T))|
++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-VARIABLE T))|
++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CASE-FAILURE T))|
++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PRINT-NOT-READABLE T))|
++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (SIMPLE-CONDITION T))|
++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ABORT-FAILURE T))|
++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (TYPE-ERROR T))|
++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CELL-ERROR T))|
++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (FILE-ERROR T))|
++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (END-OF-FILE T))|
++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (STREAM-ERROR T))|))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T)
++ COMMON-LISP::T)
++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CONDITION T))|
++ CONDITIONS::|(PCL::FAST-METHOD MAKE-LOAD-FORM (CONDITION))|))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::T)
++ CONDITIONS::COERCE-TO-FN CONDITIONS::SLOT-SYM))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::*)
++ COMMON-LISP::MAKE-CONDITION))
+\ No newline at end of file
+--- gcl-2.6.12.orig/cmpnew/gcl_cmpbind.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmpbind.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (si:putprop 'bds-bind 'set-bds-bind 'set-loc)
+
+--- gcl-2.6.12.orig/cmpnew/gcl_cmpblock.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmpblock.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (si:putprop 'block 'c1block 'c1special)
+ (si:putprop 'block 'c2block 'c2)
+--- gcl-2.6.12.orig/cmpnew/gcl_cmpcall.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmpcall.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (defvar *ifuncall* nil)
+
+--- gcl-2.6.12.orig/cmpnew/gcl_cmpcatch.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmpcatch.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (si:putprop 'catch 'c1catch 'c1special)
+ (si:putprop 'catch 'c2catch 'c2)
+--- gcl-2.6.12.orig/cmpnew/gcl_cmpenv.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmpenv.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (defvar *safe-compile* nil)
+ (defvar *compiler-check-args* nil)
+@@ -337,7 +337,7 @@
+ readtable sequence short-float simple-array simple-bit-vector
+ simple-string simple-vector single-float standard-char stream string
+ dynamic-extent :dynamic-extent
+- string-char symbol t vector signed-byte unsigned-byte)
++ symbol t vector signed-byte unsigned-byte)
+ (proclaim-var (car decl) (cdr decl)))
+ (otherwise
+ (unless (member (car decl) *alien-declarations*)
+@@ -366,6 +366,12 @@
+ (t
+ (warn "The variable name ~s is not a symbol." var)))))
+
++(defun mexpand-deftype (tp &aux (l (listp tp))(i (when l (cdr tp)))(tp (if l (car tp) tp)))
++ (when (symbolp tp)
++ (let ((fn (get tp 'si::deftype-definition)))
++ (when fn
++ (apply fn i)))))
++
+ (defun c1body (body doc-p &aux (ss nil) (is nil) (ts nil) (others nil)
+ doc form)
+ (loop
+@@ -383,10 +389,8 @@
+ ;;; 20040320 CM
+ (cmpck (not (consp decl))
+ "The declaration ~s is illegal." decl)
+- (let* ((dtype (car decl)))
+-;; Can process user deftypes here in the future -- 20040318 CM
+-;; (dft (and (symbolp dtype) (get dtype 'si::deftype-definition)))
+-;; (dtype (or (and dft (funcall dft)) dtype)))
++ (let* ((dtype (car decl))
++ (dtype (or (mexpand-deftype dtype) dtype)))
+ (if (consp dtype)
+ (let ((stype (car dtype)))
+ (cmpck (or (not (symbolp stype)) (cdddr dtype)) "The declaration ~s is illegal." decl)
+@@ -449,7 +453,7 @@
+ integer keyword list long-float nil null number package pathname
+ random-state ratio rational readtable sequence simple-array
+ simple-bit-vector simple-string simple-base-string simple-vector single-float
+- standard-char stream string string-char symbol t vector
++ standard-char stream string symbol t vector
+ signed-byte unsigned-byte)
+ (let ((type (type-filter stype)))
+ (when type
+@@ -667,7 +671,7 @@
+ readtable sequence short-float simple-array simple-bit-vector
+ simple-string simple-vector single-float standard-char stream string
+ dynamic-extent :dynamic-extent
+- string-char symbol t vector signed-byte unsigned-byte)
++ symbol t vector signed-byte unsigned-byte)
+ (let ((type (type-filter (car decl))))
+ (dolist** (var (cdr decl) t)
+ (if (symbolp var)
+--- gcl-2.6.12.orig/cmpnew/gcl_cmpeval.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmpeval.lsp
+@@ -23,9 +23,9 @@
+
+ (export '(si::define-compiler-macro
+ si::undef-compiler-macro
+- si::define-inline-function) 'system)
++ si::define-inline-function) :system)
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (si:putprop 'progn 'c1progn 'c1special)
+ (si:putprop 'progn 'c2progn 'c2)
+@@ -180,9 +180,8 @@
+
+
+ (defun result-type-from-args(f args &aux tem)
+- (when (and (setq tem (get f 'return-type))
+- (not (eq tem '*))
+- (not (consp tem)))
++ (when (if (setq tem (get f 'return-type))
++ (and (not (eq tem '*)) (not (consp tem))) t)
+ (dolist (v '(inline-always inline-unsafe))
+ (dolist (w (get f v))
+ (fix-opt w)
+@@ -486,19 +485,22 @@
+
+ (defun c1structure-ref1 (form name index &aux (info (make-info)))
+ ;;; Explicitly called from c1expr and c1structure-ref.
+- (declare (special *aet-types*))
+ (cond (*safe-compile* (c1expr `(si::structure-ref ,form ',name ,index)))
+- (t
+- (let* ((sd (get name 'si::s-data))
+- (aet-type (aref (si::s-data-raw sd) index))
+- )
+- (setf (info-type info) (type-filter (aref *aet-types* aet-type)))
+- (list 'structure-ref info
+- (c1expr* form info)
+- (add-symbol name)
+- index sd)
+-
+- ))))
++ ((let* ((sd (get name 'si::s-data))
++ (aet-type (aref (si::s-data-raw sd) index))
++ (sym (find-symbol (si::string-concatenate
++ (or (si::s-data-conc-name sd) "")
++ (car (nth index (si::s-data-slot-descriptions sd))))))
++ (tp (if sym (get-return-type sym) '*))
++ (tp (type-filter (type-and tp (aref *aet-types* aet-type)))))
++
++ (setf (info-type info) (if (and (eq name 'si::s-data) (= index 2));;FIXME -- this belongs somewhere else. CM 20050106
++ '(vector unsigned-char)
++ tp))
++ (list 'structure-ref info
++ (c1expr* form info)
++ (add-symbol name)
++ index sd)))))
+
+ (defun coerce-loc-structure-ref (arg type-wanted &aux (form (cdr arg)))
+ (let* ((sd (fourth form))
+--- gcl-2.6.12.orig/cmpnew/gcl_cmpflet.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmpflet.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (si:putprop 'flet 'c1flet 'c1special)
+ (si:putprop 'flet 'c2flet 'c2)
+--- gcl-2.6.12.orig/cmpnew/gcl_cmpfun.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmpfun.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (si:putprop 'princ 'c1princ 'c1)
+ (si:putprop 'princ 'c2princ 'c2)
+@@ -565,7 +565,7 @@
+ (equal (third type) '(*)))))
+ (setq tem (si::best-array-element-type
+ (second type)))
+- (cond ((eq tem 'string-char) `(stringp ,x))
++ (cond ((eq tem 'character) `(stringp ,x))
+ ((eq tem 'bit) `(bit-vector-p ,x))
+ ((setq tem (position tem *aet-types*))
+ `(the boolean (vector-type ,x ,tem)))))
+@@ -803,7 +803,7 @@
+
+
+ (defvar *aet-types*
+- #(T STRING-CHAR SIGNED-CHAR FIXNUM SHORT-FLOAT LONG-FLOAT
++ #(T CHARACTER SIGNED-CHAR FIXNUM SHORT-FLOAT LONG-FLOAT
+ SIGNED-CHAR
+ UNSIGNED-CHAR SIGNED-SHORT UNSIGNED-SHORT))
+
+@@ -811,7 +811,7 @@
+ (defun aet-c-type (type)
+ (ecase type
+ ((t) "object")
+- ((string-char signed-char) "char")
++ ((character signed-char) "char")
+ (fixnum "fixnum")
+ (unsigned-char "unsigned char")
+ (unsigned-short "unsigned short")
+--- gcl-2.6.12.orig/cmpnew/gcl_cmpif.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmpif.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (si:putprop 'if 'c1if 'c1special)
+ (si:putprop 'if 'c2if 'c2)
+--- gcl-2.6.12.orig/cmpnew/gcl_cmpinline.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmpinline.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ ;;; Pass 1 generates the internal form
+ ;;; ( id info-object . rest )
+--- gcl-2.6.12.orig/cmpnew/gcl_cmplabel.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmplabel.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (defvar *last-label* 0)
+ (defvar *exit*)
+--- gcl-2.6.12.orig/cmpnew/gcl_cmplam.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmplam.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ ;;; During Pass1, a lambda-list
+ ;;;
+--- gcl-2.6.12.orig/cmpnew/gcl_cmplet.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmplet.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+ (eval-when (compile)
+ (or (fboundp 'write-block-open) (load "cmplet.lsp")))
+
+--- gcl-2.6.12.orig/cmpnew/gcl_cmploc.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmploc.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (defvar *value-to-go*)
+
+--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp
+@@ -24,7 +24,7 @@
+ ;;; *****************
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+
+ (export '(*compile-print* *compile-verbose*))
+@@ -49,7 +49,11 @@
+ (defvar *cmpinclude* "\"cmpinclude.h\"")
+ ;;If the following is a string, then it is inserted instead of
+ ;; the include file cmpinclude.h, EXCEPT for system-p calls.
+-(defvar *cmpinclude-string* t)
++(defvar *cmpinclude-string*
++ (si::file-to-string
++ (namestring
++ (make-pathname :directory (append (pathname-directory si::*system-directory*) (list :parent "h"))
++ :name "cmpinclude" :type "h"))))
+
+
+ ;; Let the user write dump c-file etc to /dev/null.
+--- gcl-2.6.12.orig/cmpnew/gcl_cmpmap.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmpmap.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (si:putprop 'mapcar 'c1mapcar 'c1)
+ (si:putprop 'maplist 'c1maplist 'c1)
+--- gcl-2.6.12.orig/cmpnew/gcl_cmpmulti.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmpmulti.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (si:putprop 'multiple-value-call 'c1multiple-value-call 'c1special)
+ (si:putprop 'multiple-value-call 'c2multiple-value-call 'c2)
+--- gcl-2.6.12.orig/cmpnew/gcl_cmpopt.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmpopt.lsp
+@@ -1,4 +1,4 @@
+-(in-package 'compiler)
++(in-package :compiler)
+
+ ;; The optimizers have been redone to allow more flags
+ ;; The old style optimizations correspond to the first 2
+@@ -136,8 +136,11 @@
+ (get 'system:aset 'inline-unsafe))
+ (push '(((array t) fixnum t) t #.(flags set)"(#0)->v.v_self[#1]= (#2)")
+ (get 'system:aset 'inline-unsafe))
+-(push '(((array string-char) fixnum character) character #.(flags rfa set)"(#0)->ust.ust_self[#1]= (#2)")
++(push '(((array character) fixnum character) character #.(flags rfa set)"(#0)->ust.ust_self[#1]= (#2)")
+ (get 'system:aset 'inline-unsafe))
++(push '(((array bit) fixnum fixnum) fixnum #.(flags rfa)
++ "({object _o=(#0);fixnum _i=(#1)+_o->bv.bv_offset;char _c=1<<BIT_ENDIAN(_i&0x7),*_d=_o->bv.bv_self+(_i>>3);bool _b=(#2);if (_b) *_d|=_c; else *_d&=~_c;_b;})")
++ (get 'si::aset 'inline-unsafe))
+ (push '(((array fixnum) fixnum fixnum) fixnum #.(flags set rfa)"(#0)->fixa.fixa_self[#1]= (#2)")
+ (get 'system:aset 'inline-unsafe))
+ (push '(((array signed-short) fixnum fixnum) fixnum #.(flags rfa set)"((short *)(#0)->ust.ust_self)[#1]=(#2)")
+@@ -159,7 +162,7 @@
+ (push '(((array t) fixnum fixnum t) t #.(flags set)
+ "@0;(#0)->a.a_self[(#1)*(#0)->a.a_dims[1]+#2]= (#3)")
+ (get 'system:aset 'inline-unsafe))
+-(push '(((array string-char) fixnum fixnum character) character
++(push '(((array character) fixnum fixnum character) character
+ #.(flags rfa set)
+ "@0;(#0)->ust.ust_self[(#1)*(#0)->a.a_dims[1]+#2]= (#3)")
+ (get 'system:aset 'inline-unsafe))
+@@ -433,7 +436,9 @@
+ (get 'aref 'inline-unsafe))
+ (push '(((array t) fixnum) t #.(flags)"(#0)->v.v_self[#1]")
+ (get 'aref 'inline-unsafe))
+-(push '(((array string-char) fixnum) character #.(flags rfa)"(#0)->ust.ust_self[#1]")
++(push '(((array character) fixnum) character #.(flags rfa)"(#0)->ust.ust_self[#1]")
++ (get 'aref 'inline-unsafe))
++(push '(((array bit) fixnum) fixnum #.(flags rfa)"({object _o=(#0);fixnum _i=(#1)+(_o)->bv.bv_offset;(_o->bv.bv_self[_i>>3]>>BIT_ENDIAN(_i&0x7))&0x1;})")
+ (get 'aref 'inline-unsafe))
+ (push '(((array fixnum) fixnum) fixnum #.(flags rfa)"(#0)->fixa.fixa_self[#1]")
+ (get 'aref 'inline-unsafe))
+@@ -456,7 +461,7 @@
+ (push '(((array t) fixnum fixnum) t #.(flags )
+ "@0;(#0)->a.a_self[(#1)*(#0)->a.a_dims[1]+#2]")
+ (get 'aref 'inline-unsafe))
+-(push '(((array string-char) fixnum fixnum) character #.(flags rfa)
++(push '(((array character) fixnum fixnum) character #.(flags rfa)
+ "@0;(#0)->ust.ust_self[(#1)*(#0)->a.a_dims[1]+#2]")
+ (get 'aref 'inline-unsafe))
+ (push '(((array fixnum) fixnum fixnum) fixnum #.(flags rfa)
+--- gcl-2.6.12.orig/cmpnew/gcl_cmpspecial.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmpspecial.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (si:putprop 'quote 'c1quote 'c1special)
+ (si:putprop 'function 'c1function 'c1special)
+--- gcl-2.6.12.orig/cmpnew/gcl_cmptag.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmptag.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+ (import 'si::switch)
+ (import 'si::switch-finish)
+
+--- gcl-2.6.12.orig/cmpnew/gcl_cmptest.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmptest.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (defun self-compile ()
+ (with-open-file (log "lsplog" :direction :output)
+--- gcl-2.6.12.orig/cmpnew/gcl_cmptop.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmptop.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (defvar *objects* (make-hash-table :test 'eq))
+ ;(defvar *objects* nil)
+@@ -572,7 +572,7 @@
+ (defun make-inline-string (cfun args fname)
+ (if (null args)
+ (format nil "~d()" (c-function-name "LI" cfun fname))
+- (let ((o (make-array 100 :element-type 'string-char :fill-pointer 0
++ (let ((o (make-array 100 :element-type 'character :fill-pointer 0
+ :adjustable t )))
+ (format o "~d(" (c-function-name "LI" cfun fname))
+ (do ((l args (cdr l))
+@@ -696,7 +696,7 @@
+ )))
+
+ (defun si::add-debug (fname x)
+- (si::putprop fname x 'si::debug))
++ (si::putprop fname x 'si::debugger))
+
+ (defun t3init-fun (fname cfun lambda-expr doc)
+
+@@ -1237,10 +1237,10 @@
+ (si::fixnump (cdr (var-ref va))))
+ (setf (nth (cdr (var-ref va)) locals)
+ (var-name va))))
+- (setf (get fname 'si::debug) locals)
+- (let ((locals (get fname 'si::debug)))
++ (setf (get fname 'si::debugger) locals)
++ (let ((locals (get fname 'si::debugger)))
+ (if (and locals (or (cdr locals) (not (null (car locals)))))
+- (add-init `(si::debug ',fname ',locals) )
++ (add-init `(debug ',fname ',locals) )
+ ))
+ ))))
+
+@@ -1406,7 +1406,7 @@
+ ((and (consp form)
+ (symbolp (car form))
+ (or (eq (car form) 'setq)
+- (not (special-form-p (car form))))
++ (not (special-operator-p (car form))))
+ (do ((v (cdr form) (and (consp v) (cdr v)))
+ (i 1 (the fixnum (+ 1 i))))
+ ((or (>= i 1000)
+@@ -1457,7 +1457,7 @@
+ (setf (get 'si::define-structure 't1) 't1define-structure)
+
+ (defun t1define-structure (args)
+- (maybe-eval t `(si::define-structure ,@args ,(not (maybe-eval nil nil))))
++ (maybe-eval t `(si::define-structure ,@(copy-tree args) ,(not (maybe-eval nil nil))));FIXME
+ (t1ordinary (cons 'si::define-structure args)))
+
+
+@@ -1484,7 +1484,7 @@
+ (cond ((stringp s) (push s body))
+ ((consp s)
+ (cond ((symbolp (car s))
+- (cmpck (special-form-p (car s))
++ (cmpck (special-operator-p (car s))
+ "Special form ~s is not allowed in defCfun." (car s))
+ (push (list (cons (car s) (parse-cvspecs (cdr s)))) body))
+ ((and (consp (car s)) (symbolp (caar s))
+@@ -1493,7 +1493,7 @@
+ (not (endp (cddar s)))
+ (endp (cdr s))
+ (not (endp (cddr s))))
+- (special-form-p (caar s)))))
++ (special-operator-p (caar s)))))
+ (push (cons (cons (caar s)
+ (if (eq (caar s) 'quote)
+ (list (add-object (cadar s)))
+--- gcl-2.6.12.orig/cmpnew/gcl_cmptype.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmptype.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ ;;; CL-TYPE is any valid type specification of Common Lisp.
+ ;;;
+@@ -51,7 +51,7 @@
+ (let ((type (type-of thing)))
+ (case type
+ ((fixnum short-float long-float) type)
+- ((string-char standard-char character) 'character)
++ ((standard-char character) 'character)
+ ((string bit-vector) type)
+ (vector (list 'vector (array-element-type thing)))
+ (array (list 'array (array-element-type thing)))
+@@ -82,7 +82,7 @@
+ (and (consp (caddr type))
+ (= (length (caddr type)) 1))))
+ (case element-type
+- (string-char 'string)
++ (character 'string)
+ (bit 'bit-vector)
+ (t (list 'vector element-type))))
+ (t (list 'array element-type))))
+@@ -109,8 +109,8 @@
+ ((subtypep type '(vector long-float))
+ '(vector long-float))
+ ((subtypep type '(array t)) '(array t))
+- ((subtypep type '(array string-char))
+- '(array string-char))
++ ((subtypep type '(array character))
++ '(array character))
+ ((subtypep type '(array bit)) '(array bit))
+ ((subtypep type '(array fixnum)) '(array fixnum))
+ ((subtypep type '(array short-float))
+@@ -142,11 +142,13 @@
+ ((eq type1 t) type2)
+ ((eq type2 'object) type1)
+ ((eq type2 t) type1)
+- ((consp type1)
++ ((subtypep type2 type1) type2)
++ ((subtypep type1 type2) type1)
++ ((consp type1)
+ (case (car type1)
+ (array
+ (case (cadr type1)
+- (string-char (if (eq type2 'string) type2 nil))
++ (character (if (eq type2 'string) type2 nil))
+ (bit (if (eq type2 'bit-vector) type2 nil))
+ (t (if (and (consp type2)
+ (eq (car type2) 'vector)
+@@ -160,7 +162,7 @@
+ (t (case type1
+ (string
+ (if (and (consp type2) (eq (car type2) 'array)
+- (eq (cadr type2) 'string-char))
++ (eq (cadr type2) 'character))
+ type1 nil))
+ (bit-vector
+ (if (and (consp type2) (eq (car type2) 'array)
+--- gcl-2.6.12.orig/cmpnew/gcl_cmputil.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmputil.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (export '(*suppress-compiler-warnings*
+ *suppress-compiler-notes*
+@@ -204,7 +204,7 @@
+ (do-macro-expansion '(macroexpand-1) form)
+ form))
+
+-(defun cmp-expand-macro (fd fname args &aux env (form (cons fname args)))
++(defun cmp-expand-macro (fd fname args &aux (form (cons fname args)))
+ (if (macro-def-p form)
+ (do-macro-expansion `(funcall *macroexpand-hook* ',fd) form)
+ form))
+@@ -214,7 +214,7 @@
+ (defun cmp-toplevel-eval (form)
+ (let* ((si::*ihs-base* si::*ihs-top*)
+ (si::*ihs-top* (1- (si::ihs-top)))
+- (*break-enable* *compiler-break-enable*)
++ (si::*break-enable* *compiler-break-enable*)
+ (si::*break-hidden-packages*
+ (cons (find-package 'compiler)
+ si::*break-hidden-packages*)))
+--- gcl-2.6.12.orig/cmpnew/gcl_cmpvar.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmpvar.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (si:putprop 'var 'c2var 'c2)
+ (si:putprop 'location 'c2location 'c2)
+--- gcl-2.6.12.orig/cmpnew/gcl_cmpvs.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmpvs.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (si:putprop 'vs 'set-vs 'set-loc)
+ (si:putprop 'vs 'wt-vs 'wt-loc)
+--- gcl-2.6.12.orig/cmpnew/gcl_cmpwt.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmpwt.lsp
+@@ -19,7 +19,7 @@
+ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (eval-when (compile eval)
+ (require 'FASDMACROS "../cmpnew/gcl_fasdmacros.lsp")
+--- gcl-2.6.12.orig/cmpnew/gcl_collectfn.lsp
++++ gcl-2.6.12/cmpnew/gcl_collectfn.lsp
+@@ -13,7 +13,7 @@
+ ;; Additionally cross reference information about functions in the system is
+ ;; collected.
+
+-(in-package 'compiler)
++(in-package :compiler)
+ (import 'sloop::sloop)
+
+ (defstruct fn
+--- gcl-2.6.12.orig/cmpnew/gcl_lfun_list.lsp
++++ gcl-2.6.12/cmpnew/gcl_lfun_list.lsp
+@@ -3,7 +3,7 @@
+ ;; and making the arglists correct if they have optional args.
+ ;;
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (DEFSYSFUN 'GENSYM "Lgensym" '(*) 'T NIL NIL)
+ (DEFSYSFUN 'SUBSEQ "Lsubseq" '(T T *) 'T NIL NIL)
+@@ -129,7 +129,7 @@
+ (DEFSYSFUN 'STRING-NOT-GREATERP "Lstring_not_greaterp" '(T T *) 'T NIL NIL)
+ (DEFSYSFUN 'STRING> "Lstring_g" '(T T *) 'T NIL NIL)
+ (DEFSYSFUN 'FINISH-OUTPUT "Lfinish_output" '(*) 'T NIL NIL)
+-(DEFSYSFUN 'SPECIAL-FORM-P "Lspecial_form_p" '(T) 'T NIL T)
++(DEFSYSFUN 'SPECIAL-OPERATOR-P "Lspecial_operator_p" '(T) 'T NIL T)
+ (DEFSYSFUN 'STRINGP "Lstringp" '(T) 'T NIL T)
+ (DEFSYSFUN 'GET-INTERNAL-RUN-TIME "Lget_internal_run_time" 'NIL 'T NIL
+ NIL)
+@@ -303,7 +303,7 @@
+ (DEFSYSFUN '= "Lall_the_same" '(T *) 'T NIL T)
+ (DEFSYSFUN 'GENTEMP "Lgentemp" '(*) 'T NIL NIL)
+ (DEFSYSFUN 'RENAME-PACKAGE "Lrename_package" '(T T *) 'T NIL NIL)
+-(DEFSYSFUN 'COMMONP "Lcommonp" '(T) 'T NIL T)
++(DEFSYSFUN 'COMMONP "siLcommonp" '(T) 'T NIL T)
+ (DEFSYSFUN 'NUMBERP "Lnumberp" '(T) 'T NIL T)
+ (DEFSYSFUN 'COPY-READTABLE "Lcopy_readtable" '(*) 'T NIL NIL)
+ (DEFSYSFUN 'RANDOM-STATE-P "Lrandom_state_p" '(T) 'T NIL T)
+@@ -365,7 +365,7 @@
+ (DEFSYSFUN 'ASSOC-IF "Lassoc_if" '(T T) 'T NIL NIL)
+ (DEFSYSFUN 'GET-PROPERTIES "Lget_properties" '(T T) '* NIL NIL)
+ (DEFSYSFUN 'STRING<= "Lstring_le" '(T T *) 'T NIL NIL)
+-(DEFSYSFUN 'EVALHOOK "Levalhook" '(T T T *) 'T NIL NIL)
++(DEFSYSFUN 'EVALHOOK "siLevalhook" '(T T T *) 'T NIL NIL)
+ (DEFSYSFUN 'FILE-WRITE-DATE "Lfile_write_date" '(T) 'T NIL NIL)
+ (DEFSYSFUN 'LOGCOUNT "Llogcount" '(T) 'T NIL NIL)
+ (DEFSYSFUN 'MERGE-PATHNAMES "Lmerge_pathnames" '(T *) 'T NIL NIL)
+--- gcl-2.6.12.orig/cmpnew/gcl_make_ufun.lsp
++++ gcl-2.6.12/cmpnew/gcl_make_ufun.lsp
+@@ -20,13 +20,13 @@
+
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (defvar gazonk (make-package 'symbol-table :use nil))
+ (defvar eof (cons nil nil))
+ (defvar *Ufun-out*)
+
+-(defvar *str* (make-array 128 :element-type 'string-char :fill-pointer 0))
++(defvar *str* (make-array 128 :element-type 'character :fill-pointer 0))
+
+ (defun make-Ufun (in-files &key (out-file "Ufun_list.lsp"))
+ (with-open-file (*Ufun-out* out-file :direction :output)
+--- gcl-2.6.12.orig/cmpnew/gcl_nocmpinc.lsp
++++ gcl-2.6.12/cmpnew/gcl_nocmpinc.lsp
+@@ -1,6 +1,6 @@
+
+
+-(in-package 'compiler)
++(in-package :compiler)
+
+ (defvar *cmpinclude-string* nil)
+
+@@ -20,4 +20,4 @@
+
+
+
+-
+\ No newline at end of file
++
+--- gcl-2.6.12.orig/cmpnew/sys-proclaim.lisp
++++ gcl-2.6.12/cmpnew/sys-proclaim.lisp
+@@ -1,168 +1,377 @@
+
+-(IN-PACKAGE "COMPILER")
+-(MAPC (LAMBDA (X) (SETF (GET X 'PROCLAIMED-CLOSURE) T))
+- '(CMP-TMP-MACRO COMPILE DISASSEMBLE CMP-ANON))
+-(PROCLAIM '(FTYPE (FUNCTION (STRING *) T) TS))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T) T) VAR-REP-LOC C1FUNOB C1STRUCTURE-REF
+- T1PROGN GET-RETURN-TYPE ADD-REG1 C1VAR C1ECASE
+- C1SHARP-COMMA C1ASH LTVP CTOP-WRITE C2FUNCTION
+- DECLARATION-TYPE C1TERPRI C1FUNCALL VAR-REGISTER C1ASSOC
+- CONS-TO-LISTA WT-LIST C1NTHCDR-CONDITION
+- C1MULTIPLE-VALUE-CALL CHECK-DOWNWARD TYPE-FILTER
+- C2TAGBODY-LOCAL BLK-NAME C1FSET T1DEFENTRY C1MEMBER
+- C1GETHASH C2GO-CCB SCH-LOCAL-FUN C1RPLACD C1RPLACA-NTHCDR
+- INLINE-POSSIBLE C1MAPC C2VAR WT-FUNCALL-C C1ADD-GLOBALS
+- FUN-NAME SAVE-FUNOB FUN-CFUN PROCLAIM TAG-REF-CCB
+- FIXNUM-LOC-P UNWIND-NO-EXIT WT-H1 MAXARGS C1GO INFO-P TAG-P
+- C1AND INLINE-TYPE VAR-REF-CCB C1MULTIPLE-VALUE-BIND C1THE
+- C2DM-RESERVE-VL WT-DOWNWARD-CLOSURE-MACRO VAR-NAME C1THROW
+- INFO-TYPE C1ASH-CONDITION LTVP-EVAL CHARACTER-LOC-P
+- C2DOWNWARD-FUNCTION C1EXPR C1TAGBODY BLK-REF INFO-VOLATILE
+- VAR-REF CONSTANT-FOLD-P WT-DATA-PACKAGE-OPERATION FUN-P
+- VAR-LOC C1PROGN C1NTHCDR VOLATILE TAG-UNWIND-EXIT
+- REPLACE-CONSTANT NAME-TO-SD SET-TOP C1GET PUSH-ARGS
+- FUN-REF-CCB INLINE-BOOLE3-STRING C1SETQ C1LOCAL-CLOSURE
+- CLINK GET-INCLUDED SET-PUSH-CATCH-FRAME FUNCTION-ARG-TYPES
+- T2DECLARE OBJECT-TYPE CHECK-VREF COPY-INFO
+- T1DEFINE-STRUCTURE C1BOOLE3 FUN-LEVEL C1NTH C2GET FIX-OPT
+- C1OR FUNCTION-RETURN-TYPE T1DEFUN T1CLINES FLAGS-POS
+- SAVE-AVMA WT-DOWN C2GO-CLB C1SWITCH WT-SWITCH-CASE
+- C1FUNCTION C2RPLACD C1LABELS C1MULTIPLE-VALUE-SETQ WT-VV
+- C2TAGBODY-CLB WT-CADR C1MAPCAR MACRO-DEF-P T1DEFMACRO
+- SET-RETURN THE-PARAMETER BLK-REF-CCB AET-C-TYPE
+- PUSH-ARGS-LISPCALL WRITE-BLOCK-OPEN SET-UP-VAR-CVS TAG-VAR
+- INFO-SP-CHANGE ADD-LOOP-REGISTERS C1MULTIPLE-VALUE-PROG1
+- WT-VS C2LOCATION C1COMPILER-LET T3CLINES RESULT-TYPE
+- PROCLAMATION C1MAPL C1PRINC TAG-LABEL C2FUNCALL-AUX BLK-VAR
+- TAG-REF-CLB C2TAGBODY-CCB VERIFY-DATA-VECTOR C1MAPCAN
+- BLK-EXIT WT-VS-BASE REGISTER UNDEFINED-VARIABLE
+- SYSTEM:UNDEF-COMPILER-MACRO C1BLOCK C1MAPLIST
+- ARGS-CAUSE-SIDE-EFFECT C2BIND C1LET WT-SYMBOL-FUNCTION
+- CMP-MACRO-FUNCTION WT1 C1MEMQ BLK-REF-CLB ADD-ADDRESS
+- GET-LOCAL-ARG-TYPES C1UNWIND-PROTECT REP-TYPE ADD-CONSTANT
+- C1IF C1QUOTE C1FMLA-CONSTANT WT-DATA1 NAME-SD1 BLK-P
+- C1CATCH CMP-MACROEXPAND SHORT-FLOAT-LOC-P T3ORDINARY
+- C1LENGTH NEED-TO-SET-VS-POINTERS C1DOWNWARD-FUNCTION C1FLET
+- TAG-SWITCH TAG-REF PARSE-CVSPECS TAG-NAME VAR-P VAR-KIND
+- C1VREF C2GETHASH LONG-FLOAT-LOC-P C1MAPCON C1NTH-CONDITION
+- WT-FUNCTION-LINK WT-VAR-DECL C1STACK-LET ADD-SYMBOL T1DEFLA
+- C2EXPR* C1LOAD-TIME-VALUE C1DM-BAD-KEY C1PROGV FSET-FN-NAME
+- C2VALUES FUN-REF C2VAR-KIND C1PSETQ VARARG-P T1ORDINARY
+- C2GO-LOCAL C1LET* C2DM-RESERVE-V PUSH-DATA-INCF
+- C1DEFINE-STRUCTURE DEFAULT-INIT MDELETE-FILE
+- C1BOOLE-CONDITION C2RPLACA C1VALUES GET-ARG-TYPES WT-CAR
+- FUN-INFO C1DECLARE C1STRUCTURE-SET WT-VS* CMP-MACROEXPAND-1
+- SCH-GLOBAL GET-LOCAL-RETURN-TYPE C1EVAL-WHEN C2TAGBODY-BODY
+- C1APPLY C1LOCAL-FUN C1MACROLET ADD-OBJECT C1RETURN-FROM
+- SAFE-SYSTEM RESET-INFO-TYPE T1DEFCFUN C1RPLACA WT-CDR
+- VAR-TYPE T1MACROLET C1LIST-NTH INFO-CHANGED-ARRAY
+- INFO-REFERRED-ARRAY BLK-VALUE-TO-GO ADD-OBJECT2 WT-CCB-VS))
+-(PROCLAIM '(FTYPE (FUNCTION (*) *) INLINE-BOOLE3))
+-(PROCLAIM '(FTYPE (FUNCTION (T) FIXNUM) F-TYPE))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T (VECTOR T) FIXNUM T) FIXNUM) PUSH-ARRAY))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T (VECTOR T) FIXNUM FIXNUM T) FIXNUM)
+- BSEARCHLEQ))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T) *) C2EXPR WT-FIXNUM-LOC WT-LONG-FLOAT-LOC
+- C2OR WT-SHORT-FLOAT-LOC CMP-EVAL C2PROGN WT-TO-STRING
+- SET-LOC CMP-TOPLEVEL-EVAL VV-STR T1EXPR T1EVAL-WHEN WT-LOC
+- C2AND WT-CHARACTER-LOC))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (*) T) FCALLN-INLINE MAKE-BLK MAKE-FUN
+- LIST*-INLINE WT-CLINK COMPILE-FILE C2FSET MAKE-TAG CS-PUSH
+- LIST-INLINE MAKE-VAR COMPILER-COMMAND MAKE-INFO))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (STRING FIXNUM FIXNUM) T) DASH-TO-UNDERSCORE-INT))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T) *) C2COMPILER-LET C2FLET C2LABELS C2IF
+- WT-INLINE))
+-(PROCLAIM '(FTYPE (FUNCTION (T T *) *) T3DEFUN-AUX))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T) *) C1DM-V C2RETURN-FROM C2DM C1DM-VL
+- C2APPLY-OPTIMIZE))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T) T) C2APPLY C2RETURN-CCB C2BIND-INIT
+- PROCLAIM-VAR PRIN1-CMP C2LAMBDA-EXPR-WITH-KEY
+- SYSTEM::ADD-DEBUG C2LAMBDA-EXPR-WITHOUT-KEY C2STACK-LET
+- MULTIPLE-VALUE-CHECK C1DECL-BODY COMPILER-CC C1EXPR*
+- C2MULTIPLE-VALUE-PROG1 CO1VECTOR-PUSH
+- ARGS-INFO-CHANGED-VARS C2DM-BIND-INIT C1PROGN*
+- CO1WRITE-CHAR COERCE-LOC WT-FIXNUM-VALUE IS-REP-REFERRED
+- C2MULTIPLE-VALUE-CALL CO1SPECIAL-FIX-DECL INLINE-PROC
+- WT-CHARACTER-VALUE SET-VS C2PSETQ T3SHARP-COMMA
+- STRUCT-TYPE-OPT WT-MAKE-DCLOSURE C2DM-BIND-VL SET-JUMP-TRUE
+- DO-MACRO-EXPANSION CO1SCHAR C2BLOCK-CLB
+- C2LIST-NTH-IMMEDIATE C2DM-BIND-LOC WT-LONG-FLOAT-VALUE
+- CO1CONS COMPILER-CLEAR-COMPILER-PROPERTIES C2EXPR-TOP
+- ARGS-INFO-REFERRED-VARS C2MEMBER!2 C2MULTIPLE-VALUE-SETQ
+- C2SETQ ADD-DEBUG-INFO GET-INLINE-LOC RESULT-TYPE-FROM-ARGS
+- C2BIND-LOC CO1STRUCTURE-PREDICATE C1ARGS SHIFT<< UNWIND-BDS
+- MAYBE-EVAL C2UNWIND-PROTECT TYPE-AND C2CALL-LOCAL C2THROW
+- CO1TYPEP SET-BDS-BIND C1SETQ1 C2CATCH TYPE>= C1LAMBDA-FUN
+- NEED-TO-PROTECT C2ASSOC!2 CO1READ-BYTE CO1LDB
+- CONVERT-CASE-TO-SWITCH FAST-READ MAKE-USER-INIT
+- CO1CONSTANT-FOLD C1FMLA CHECK-FNAME-ARGS
+- COERCE-LOC-STRUCTURE-REF WT-SHORT-FLOAT-VALUE C2BLOCK-CCB
+- ADD-INFO CAN-BE-REPLACED CO1READ-CHAR C2CALL-LAMBDA
+- CFAST-WRITE PUSH-CHANGED-VARS SHIFT>> JUMPS-TO-P CO1SUBLIS
+- C1CONSTANT-VALUE C2RETURN-CLB WT-VAR CHECK-END C2EXPR-TOP*
+- WT-V*-MACROS SET-JUMP-FALSE CMPFIX-ARGS SET-DBIND
+- CO1WRITE-BYTE CO1EQL COMPILER-DEF-HOOK WT-REQUIREDS))
+-(PROCLAIM '(FTYPE (FUNCTION (T *) *) COMPILE-FILE1))
+-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM FIXNUM) T) MLIN))
+-(PROCLAIM '(FTYPE (FUNCTION (STRING) T) DASH-TO-UNDERSCORE))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T) FIXNUM) PROCLAIMED-ARGD ANALYZE-REGS1
+- ANALYZE-REGS))
+-(PROCLAIM '(FTYPE (FUNCTION (T FIXNUM) T) MEMOIZED-HASH-EQUAL))
+-(PROCLAIM '(FTYPE (FUNCTION ((VECTOR T)) T) COPY-ARRAY))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T) *) C2BLOCK-LOCAL C1SYMBOL-FUN C1BODY
+- C2BLOCK C2DECL-BODY C2RETURN-LOCAL NCONC-FILES
+- WT-INLINE-LOC COMPILER-BUILD))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T *) T) WT-CVAR C1LAMBDA-EXPR UNWIND-EXIT
+- CMPWARN WT-COMMENT WT-INTEGER-LOC CMPERR ADD-INIT
+- FAST-LINK-PROCLAIMED-TYPE-P CMPNOTE C1CASE INIT-NAME))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T) T) T3DEFUN-VARARG C2STRUCTURE-REF
+- C2CALL-UNKNOWN-GLOBAL C1MAKE-VAR C2SWITCH WT-GLOBAL-ENTRY
+- C2CALL-GLOBAL T3INIT-FUN MY-CALL T3DEFUN-NORMAL))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T) T) CJT WT-INLINE-INTEGER CMP-EXPAND-MACRO
+- CHECK-FORM-TYPE SET-VAR C2CASE ADD-FUNCTION-PROCLAMATION
+- INLINE-TYPE-MATCHES T3DEFCFUN C2MAPCAN AND-FORM-TYPE
+- C2PROGV C1DM WT-INLINE-CHARACTER C2MULTIPLE-VALUE-BIND
+- C2FUNCALL-SFUN C2LET MYSUB C-FUNCTION-NAME WT-MAKE-CCLOSURE
+- C2GO WT-INLINE-COND ADD-FAST-LINK C1STRUCTURE-REF1 C2MAPCAR
+- BOOLE3 TOO-FEW-ARGS FIX-DOWN-ARGS COMPILER-PASS2
+- GET-INLINE-INFO C2LET* WT-INLINE-SHORT-FLOAT
+- WT-IF-PROCLAIMED C2PRINC ASSIGN-DOWN-VARS
+- WT-INLINE-LONG-FLOAT C2TAGBODY C1MAP-FUNCTIONS CHECK-VDECL
+- MAKE-INLINE-STRING WT-INLINE-FIXNUM C2MAPC CAN-BE-REPLACED*
+- SUBLIS1-INLINE TOO-MANY-ARGS ADD-FUNCTION-DECLARATION CJF))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T T *) T) T3LOCAL-DCFUN T3LOCAL-FUN))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T T) T) T2DEFUN T3DEFUN C2STRUCTURE-SET
+- C1APPLY-OPTIMIZE T3DEFUN-LOCAL-ENTRY))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T *) T) WT-SIMPLE-CALL GET-OUTPUT-PATHNAME))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T *) T) INLINE-ARGS C2FUNCALL C2LAMBDA-EXPR
+- LINK))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T T T) T) T3DEFMACRO DEFSYSFUN T2DEFENTRY
+- T2DEFMACRO T3DEFENTRY))
+-(PROCLAIM
+- '(FTYPE (FUNCTION NIL T) WT-DATA-BEGIN PRINT-COMPILER-INFO
+- GAZONK-NAME CCB-VS-PUSH INC-INLINE-BLOCKS
+- PRINT-CURRENT-FORM C1NIL WT-DATA-FILE
+- ADD-LOAD-TIME-SHARP-COMMA CVS-PUSH RESET-TOP WT-CVARS
+- BABOON WT-FASD-DATA-FILE WT-DATA-END INIT-ENV
+- TAIL-RECURSION-POSSIBLE WFS-ERROR C1T VS-PUSH
+- WT-NEXT-VAR-ARG WT-FIRST-VAR-ARG WT-C-PUSH
+- CLOSE-INLINE-BLOCKS))
+\ No newline at end of file
++(COMMON-LISP::IN-PACKAGE "COMPILER")
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::STRING COMMON-LISP::*)
++ COMMON-LISP::T)
++ COMPILER::TS))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T)
++ COMPILER::C1MULTIPLE-VALUE-BIND COMPILER::C1VALUES
++ COMPILER::C1RPLACA COMPILER::FUN-P
++ COMPILER::FUNCTION-ARG-TYPES COMPILER::C1STRUCTURE-REF
++ COMPILER::GET-RETURN-TYPE COMPILER::WT-FUNCALL-C
++ COMPILER::MACRO-DEF-P COMPILER::T1DEFUN COMPILER::C1ASSOC
++ COMPILER::SET-UP-VAR-CVS COMPILER::C2FUNCTION
++ COMPILER::C1DM-BAD-KEY COMPILER::ADD-OBJECT
++ COMPILER::WT-SWITCH-CASE COMPILER::VARARG-P
++ COMPILER::C1TAGBODY COMPILER::C2GET COMPILER::VAR-REF
++ COMPILER::SCH-LOCAL-FUN COMPILER::ADD-SYMBOL
++ COMPILER::TAG-UNWIND-EXIT COMPILER::C1MULTIPLE-VALUE-SETQ
++ COMPILER::C1PRINC COMPILER::WT-VAR-DECL COMPILER::C1QUOTE
++ COMPILER::C2RPLACD COMPILER::CHECK-VREF
++ COMPILER::PUSH-ARGS-LISPCALL COMPILER::C1MAPLIST
++ COMPILER::ADD-REG1 COMPILER::C1OR COMPILER::WT-SYMBOL-FUNCTION
++ COMPILER::TAG-P COMPILER::SAFE-SYSTEM COMPILER::C1ECASE
++ COMPILER::LTVP COMPILER::GET-INCLUDED COMPILER::INFO-P
++ COMPILER::FUN-INFO COMPILER::C1LOAD-TIME-VALUE
++ COMPILER::GET-LOCAL-ARG-TYPES COMPILER::BLK-P
++ COMPILER::BLK-EXIT COMPILER::C2VAR-KIND COMPILER::C2LOCATION
++ COMPILER::WT1 COMPILER::WT-CCB-VS
++ COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::BLK-REF-CCB
++ COMPILER::UNDEFINED-VARIABLE COMPILER::C1MULTIPLE-VALUE-CALL
++ COMPILER::VAR-LOC COMPILER::C1SETQ COMPILER::C1NTH-CONDITION
++ COMPILER::C2RPLACA COMPILER::FUN-REF COMPILER::C2VAR
++ COMPILER::WT-CAR COMPILER::WT-LIST COMPILER::WRITE-BLOCK-OPEN
++ COMPILER::INFO-VOLATILE COMPILER::GET-LOCAL-RETURN-TYPE
++ COMPILER::AET-C-TYPE COMPILER::PUSH-ARGS COMPILER::TAG-REF-CLB
++ COMPILER::BLK-REF COMPILER::VAR-P COMPILER::C1ADD-GLOBALS
++ COMPILER::T3ORDINARY COMPILER::ADD-OBJECT2 COMPILER::SET-TOP
++ COMPILER::T1DEFLA COMPILER::C1FUNCTION COMPILER::T3CLINES
++ COMPILER::T1DEFCFUN COMPILER::C1VREF COMPILER::C1ASH
++ COMPILER::BLK-NAME COMPILER::WT-CADR COMPILER::WT-DOWN
++ COMPILER::C1TERPRI COMPILER::C2GETHASH COMPILER::C2GO-CCB
++ COMPILER::SAVE-FUNOB COMPILER::T2DECLARE COMPILER::FUN-REF-CCB
++ COMPILER::C1MAPCAR COMPILER::T1DEFMACRO
++ COMPILER::C2TAGBODY-LOCAL COMPILER::C1STACK-LET
++ COMPILER::INFO-TYPE COMPILER::T1MACROLET COMPILER::C1LET*
++ COMPILER::C1RPLACD COMPILER::DECLARATION-TYPE
++ COMPILER::T1ORDINARY COMPILER::C2EXPR* COMPILER::C1LOCAL-FUN
++ COMPILER::WT-DATA-PACKAGE-OPERATION
++ COMPILER::C1BOOLE-CONDITION SYSTEM::UNDEF-COMPILER-MACRO
++ COMPILER::C2TAGBODY-BODY COMPILER::C1NTHCDR COMPILER::C1VAR
++ COMPILER::C1MULTIPLE-VALUE-PROG1 COMPILER::C1NTHCDR-CONDITION
++ COMPILER::CONSTANT-FOLD-P COMPILER::C1UNWIND-PROTECT
++ COMPILER::PROCLAMATION COMPILER::C1NTH COMPILER::C1RETURN-FROM
++ COMPILER::INFO-SP-CHANGE COMPILER::C1LENGTH
++ COMPILER::CMP-MACRO-FUNCTION COMPILER::BLK-REF-CLB
++ COMPILER::NAME-TO-SD COMPILER::CTOP-WRITE COMPILER::C1MAPCON
++ COMPILER::C1FUNOB COMPILER::FIX-OPT COMPILER::C1RPLACA-NTHCDR
++ COMPILER::C1FLET COMPILER::RESULT-TYPE COMPILER::C1CATCH
++ COMPILER::C2DM-RESERVE-V COMPILER::VAR-NAME
++ COMPILER::CMP-MACROEXPAND COMPILER::VERIFY-DATA-VECTOR
++ COMPILER::T1CLINES COMPILER::C1MAPL COMPILER::T1DEFENTRY
++ COMPILER::TAG-REF-CCB COMPILER::WT-VS
++ COMPILER::LONG-FLOAT-LOC-P COMPILER::C1MAPCAN
++ COMPILER::OBJECT-TYPE COMPILER::ADD-ADDRESS
++ COMPILER::RESET-INFO-TYPE COMPILER::C1BOOLE3 COMPILER::C1MEMQ
++ COMPILER::C1DEFINE-STRUCTURE COMPILER::TYPE-FILTER
++ COMPILER::UNWIND-NO-EXIT COMPILER::C1FMLA-CONSTANT
++ COMPILER::C2DM-RESERVE-VL COMPILER::C1FSET COMPILER::LTVP-EVAL
++ COMPILER::C1GO COMPILER::WT-VV COMPILER::INFO-CHANGED-ARRAY
++ COMPILER::C1FUNCALL COMPILER::C2TAGBODY-CCB
++ COMPILER::TAG-LABEL COMPILER::VAR-KIND COMPILER::WT-VS*
++ COMPILER::VAR-TYPE COMPILER::C2GO-LOCAL COMPILER::REGISTER
++ COMPILER::T1PROGN COMPILER::C1BLOCK COMPILER::TAG-SWITCH
++ COMPILER::VAR-REP-LOC COMPILER::C2BIND
++ COMPILER::SET-PUSH-CATCH-FRAME COMPILER::COPY-INFO
++ COMPILER::C1LIST-NTH COMPILER::CONS-TO-LISTA
++ COMPILER::FUN-LEVEL COMPILER::C1DOWNWARD-FUNCTION
++ COMPILER::THE-PARAMETER COMPILER::C2VALUES COMPILER::C1LABELS
++ COMPILER::MAXARGS COMPILER::VAR-REF-CCB COMPILER::MDELETE-FILE
++ COMPILER::WT-FUNCTION-LINK COMPILER::SAVE-AVMA
++ COMPILER::VOLATILE COMPILER::ADD-CONSTANT COMPILER::C1APPLY
++ COMPILER::C1GETHASH COMPILER::FUN-NAME COMPILER::DEFAULT-INIT
++ COMPILER::CLINK COMPILER::WT-CDR COMPILER::PARSE-CVSPECS
++ COMPILER::REP-TYPE COMPILER::C2GO-CLB
++ COMPILER::ARGS-CAUSE-SIDE-EFFECT COMPILER::PUSH-DATA-INCF
++ COMPILER::SCH-GLOBAL COMPILER::C1STRUCTURE-SET
++ COMPILER::TAG-NAME COMPILER::INFO-REFERRED-ARRAY
++ COMPILER::C1EXPR COMPILER::C1GET COMPILER::BLK-VAR
++ COMPILER::TAG-REF COMPILER::C1MAPC COMPILER::SET-RETURN
++ COMPILER::SHORT-FLOAT-LOC-P COMPILER::C1DECLARE
++ COMPILER::WT-DATA1 COMPILER::FLAGS-POS
++ COMPILER::BLK-VALUE-TO-GO COMPILER::NAME-SD1
++ COMPILER::C2DOWNWARD-FUNCTION COMPILER::C1SHARP-COMMA
++ COMPILER::INLINE-POSSIBLE COMPILER::WT-H1
++ COMPILER::FIXNUM-LOC-P COMPILER::C1LET COMPILER::C1IF
++ COMPILER::C1THE COMPILER::FUNCTION-RETURN-TYPE
++ COMPILER::GET-ARG-TYPES COMPILER::INLINE-TYPE
++ COMPILER::FUN-CFUN COMPILER::TAG-VAR COMPILER::CHARACTER-LOC-P
++ COMPILER::CHECK-DOWNWARD COMPILER::C1PSETQ
++ COMPILER::INLINE-BOOLE3-STRING COMPILER::C1THROW
++ COMPILER::FSET-FN-NAME COMPILER::T1DEFINE-STRUCTURE
++ COMPILER::NEED-TO-SET-VS-POINTERS COMPILER::C1PROGN
++ COMPILER::C2FUNCALL-AUX COMPILER::C1MACROLET COMPILER::C1AND
++ COMPILER::WT-VS-BASE COMPILER::ADD-LOOP-REGISTERS
++ COMPILER::VAR-REGISTER COMPILER::C1PROGV COMPILER::C1SWITCH
++ COMPILER::C1MEMBER COMPILER::C2TAGBODY-CLB
++ COMPILER::CMP-MACROEXPAND-1 COMMON-LISP::PROCLAIM
++ COMPILER::C1ASH-CONDITION COMPILER::C1EVAL-WHEN
++ COMPILER::C1LOCAL-CLOSURE COMPILER::REPLACE-CONSTANT))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*)
++ COMPILER::INLINE-BOOLE3))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T)
++ COMMON-LISP::*)
++ COMPILER::C2DM COMPILER::C1DM-V COMPILER::C1DM-VL
++ COMPILER::C2RETURN-FROM COMPILER::C2APPLY-OPTIMIZE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::*)
++ COMPILER::WT-INLINE COMPILER::C2IF COMPILER::C2LABELS
++ COMPILER::C2FLET))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::*)
++ COMPILER::T3DEFUN-AUX))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM)
++ COMPILER::F-TYPE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::STRING) COMMON-LISP::T)
++ COMPILER::DASH-TO-UNDERSCORE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::T)
++ COMPILER::INIT-NAME COMPILER::ADD-INIT COMPILER::C1LAMBDA-EXPR
++ COMPILER::WT-CVAR COMPILER::C1CASE COMPILER::WT-COMMENT
++ COMPILER::CMPERR COMPILER::WT-INTEGER-LOC COMPILER::CMPNOTE
++ COMPILER::FAST-LINK-PROCLAIMED-TYPE-P COMPILER::UNWIND-EXIT
++ COMPILER::CMPWARN))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::*)
++ COMPILER::C2RETURN-LOCAL COMPILER::C2BLOCK-LOCAL
++ COMPILER::NCONC-FILES COMPILER::C1SYMBOL-FUN COMPILER::C2BLOCK
++ COMPILER::C1BODY COMPILER::COMPILER-BUILD
++ COMPILER::C2DECL-BODY COMPILER::WT-INLINE-LOC))
++(COMMON-LISP::MAPC
++ (COMMON-LISP::LAMBDA (COMPILER::X)
++ (COMMON-LISP::SETF
++ (COMMON-LISP::GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE)
++ COMMON-LISP::T))
++ '(COMPILER::CMP-ANON COMMON-LISP::COMPILE COMPILER::CMP-TMP-MACRO
++ COMMON-LISP::DISASSEMBLE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T (COMMON-LISP::VECTOR COMMON-LISP::T)
++ COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM
++ COMMON-LISP::T)
++ COMMON-LISP::FIXNUM)
++ COMPILER::BSEARCHLEQ))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T (COMMON-LISP::VECTOR COMMON-LISP::T)
++ COMMON-LISP::FIXNUM COMMON-LISP::T)
++ COMMON-LISP::FIXNUM)
++ COMPILER::PUSH-ARRAY))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::T)
++ COMPILER::AND-FORM-TYPE COMPILER::SET-VAR COMPILER::C2LET*
++ COMPILER::COMPILER-PASS2 COMPILER::ADD-FUNCTION-DECLARATION
++ COMPILER::BOOLE3 COMPILER::C1MAP-FUNCTIONS
++ COMPILER::TOO-MANY-ARGS COMPILER::CHECK-FORM-TYPE
++ COMPILER::C2LET COMPILER::C-FUNCTION-NAME
++ COMPILER::WT-INLINE-SHORT-FLOAT COMPILER::FIX-DOWN-ARGS
++ COMPILER::C2PRINC COMPILER::WT-IF-PROCLAIMED
++ COMPILER::ADD-FAST-LINK COMPILER::C2MULTIPLE-VALUE-BIND
++ COMPILER::C2MAPCAN COMPILER::CJT COMPILER::CHECK-VDECL
++ COMPILER::INLINE-TYPE-MATCHES COMPILER::WT-INLINE-LONG-FLOAT
++ COMPILER::C2GO COMPILER::CAN-BE-REPLACED* COMPILER::MYSUB
++ COMPILER::ASSIGN-DOWN-VARS COMPILER::C2MAPC
++ COMPILER::WT-INLINE-INTEGER COMPILER::GET-INLINE-INFO
++ COMPILER::CJF COMPILER::TOO-FEW-ARGS COMPILER::T3DEFCFUN
++ COMPILER::CMP-EXPAND-MACRO COMPILER::WT-MAKE-CCLOSURE
++ COMPILER::C2FUNCALL-SFUN COMPILER::C1DM
++ COMPILER::WT-INLINE-COND COMPILER::C2TAGBODY
++ COMPILER::WT-INLINE-CHARACTER COMPILER::C2PROGV
++ COMPILER::C2MAPCAR COMPILER::C1STRUCTURE-REF1 COMPILER::C2CASE
++ COMPILER::ADD-FUNCTION-PROCLAMATION
++ COMPILER::MAKE-INLINE-STRING COMPILER::SUBLIS1-INLINE
++ COMPILER::WT-INLINE-FIXNUM))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::T)
++ COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL COMPILER::LINK
++ COMPILER::INLINE-ARGS))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T)
++ COMMON-LISP::T)
++ COMPILER::C2STRUCTURE-REF COMPILER::WT-GLOBAL-ENTRY
++ COMPILER::T3DEFUN-VARARG COMPILER::T3DEFUN-NORMAL
++ COMPILER::C2CALL-GLOBAL COMPILER::C1MAKE-VAR
++ COMPILER::C2CALL-UNKNOWN-GLOBAL COMPILER::C2SWITCH
++ COMPILER::T3INIT-FUN COMPILER::MY-CALL))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::T)
++ COMPILER::DEFSYSFUN COMPILER::T2DEFMACRO COMPILER::T2DEFENTRY
++ COMPILER::T3DEFMACRO COMPILER::T3DEFENTRY))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::T)
++ COMPILER::T2DEFUN COMPILER::C1APPLY-OPTIMIZE COMPILER::T3DEFUN
++ COMPILER::C2STRUCTURE-SET COMPILER::T3DEFUN-LOCAL-ENTRY))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::*)
++ COMMON-LISP::T)
++ COMPILER::WT-SIMPLE-CALL COMPILER::GET-OUTPUT-PATHNAME))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::T)
++ COMPILER::T3LOCAL-FUN COMPILER::T3LOCAL-DCFUN))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*)
++ COMPILER::C2PROGN COMPILER::WT-LONG-FLOAT-LOC COMPILER::C2EXPR
++ COMPILER::WT-FIXNUM-LOC COMPILER::WT-CHARACTER-LOC
++ COMPILER::C2AND COMPILER::T1EXPR COMPILER::CMP-TOPLEVEL-EVAL
++ COMPILER::WT-SHORT-FLOAT-LOC COMPILER::C2OR COMPILER::WT-LOC
++ COMPILER::CMP-EVAL COMPILER::T1EVAL-WHEN COMPILER::SET-LOC
++ COMPILER::VV-STR COMPILER::WT-TO-STRING))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T)
++ COMPILER::MAKE-FUN COMPILER::MAKE-BLK
++ COMMON-LISP::COMPILE-FILE COMPILER::FCALLN-INLINE
++ COMPILER::MAKE-INFO COMPILER::CS-PUSH COMPILER::MAKE-VAR
++ COMPILER::LIST-INLINE COMPILER::C2FSET COMPILER::WT-CLINK
++ COMPILER::COMPILER-COMMAND COMPILER::MAKE-TAG
++ COMPILER::LIST*-INLINE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION ((COMMON-LISP::VECTOR COMMON-LISP::T))
++ COMMON-LISP::T)
++ COMPILER::COPY-ARRAY))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::T)
++ COMPILER::C2EXPR-TOP COMPILER::CO1SUBLIS
++ COMPILER::C2CALL-LAMBDA COMPILER::GET-INLINE-LOC
++ COMPILER::CHECK-END COMPILER::C2PSETQ COMPILER::TYPE-AND
++ COMPILER::TYPE>= COMPILER::C2MULTIPLE-VALUE-PROG1
++ COMPILER::CO1SCHAR SYSTEM::ADD-DEBUG COMPILER::C2BLOCK-CCB
++ COMPILER::C2DM-BIND-VL COMPILER::MAKE-USER-INIT
++ COMPILER::NEED-TO-PROTECT COMPILER::FAST-READ
++ COMPILER::RESULT-TYPE-FROM-ARGS COMPILER::C2BIND-INIT
++ COMPILER::JUMPS-TO-P COMPILER::C2MEMBER!2
++ COMPILER::C2CALL-LOCAL COMPILER::C2BLOCK-CLB
++ COMPILER::ARGS-INFO-CHANGED-VARS COMPILER::INLINE-PROC
++ COMPILER::C2THROW COMPILER::C1DECL-BODY
++ COMPILER::WT-MAKE-DCLOSURE COMPILER::CO1WRITE-CHAR
++ COMPILER::C1SETQ1 COMPILER::SET-JUMP-FALSE COMPILER::CO1CONS
++ COMPILER::CO1VECTOR-PUSH COMPILER::SET-VS COMPILER::SHIFT>>
++ COMPILER::COERCE-LOC-STRUCTURE-REF COMPILER::WT-FIXNUM-VALUE
++ COMPILER::C2CATCH COMPILER::C2RETURN-CCB COMPILER::MAYBE-EVAL
++ COMPILER::C2ASSOC!2 COMPILER::C2DM-BIND-INIT
++ COMPILER::C2STACK-LET COMPILER::C2LAMBDA-EXPR-WITH-KEY
++ COMPILER::ARGS-INFO-REFERRED-VARS
++ COMPILER::C2MULTIPLE-VALUE-SETQ COMPILER::C1PROGN*
++ COMPILER::WT-LONG-FLOAT-VALUE COMPILER::C2MULTIPLE-VALUE-CALL
++ COMPILER::WT-SHORT-FLOAT-VALUE COMPILER::CO1CONSTANT-FOLD
++ COMPILER::C1CONSTANT-VALUE COMPILER::C1EXPR*
++ COMPILER::CO1SPECIAL-FIX-DECL COMPILER::C2RETURN-CLB
++ COMPILER::CMPFIX-ARGS COMPILER::PROCLAIM-VAR COMPILER::C2APPLY
++ COMPILER::DO-MACRO-EXPANSION COMPILER::CFAST-WRITE
++ COMPILER::PRIN1-CMP COMPILER::SHIFT<< COMPILER::WT-REQUIREDS
++ COMPILER::C2EXPR-TOP* COMPILER::UNWIND-BDS
++ COMPILER::MULTIPLE-VALUE-CHECK COMPILER::COERCE-LOC
++ COMPILER::STRUCT-TYPE-OPT COMPILER::CO1READ-CHAR
++ COMPILER::ADD-DEBUG-INFO COMPILER::C2LIST-NTH-IMMEDIATE
++ COMPILER::WT-VAR COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY
++ COMPILER::CHECK-FNAME-ARGS COMPILER::CAN-BE-REPLACED
++ COMPILER::WT-CHARACTER-VALUE COMPILER::C2UNWIND-PROTECT
++ COMPILER::SET-DBIND COMPILER::T3SHARP-COMMA
++ COMPILER::IS-REP-REFERRED COMPILER::C1FMLA
++ COMPILER::WT-V*-MACROS COMPILER::C2DM-BIND-LOC
++ COMPILER::C2BIND-LOC
++ COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES
++ COMPILER::ADD-INFO COMPILER::C2SETQ
++ COMPILER::PUSH-CHANGED-VARS COMPILER::CO1STRUCTURE-PREDICATE
++ COMPILER::SET-BDS-BIND COMPILER::SET-JUMP-TRUE
++ COMPILER::CO1READ-BYTE COMPILER::C1LAMBDA-FUN
++ COMPILER::CO1TYPEP COMPILER::CONVERT-CASE-TO-SWITCH
++ COMPILER::COMPILER-DEF-HOOK COMPILER::CO1LDB COMPILER::C1ARGS
++ COMPILER::CO1WRITE-BYTE COMPILER::CO1EQL
++ COMPILER::COMPILER-CC))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM) COMMON-LISP::T)
++ COMPILER::MLIN))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::*)
++ COMPILER::COMPILE-FILE1))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T)
++ COMPILER::WT-DATA-BEGIN COMPILER::WT-C-PUSH COMPILER::WT-CVARS
++ COMPILER::C1T COMPILER::CVS-PUSH COMPILER::WT-DATA-FILE
++ COMPILER::ADD-LOAD-TIME-SHARP-COMMA
++ COMPILER::CLOSE-INLINE-BLOCKS COMPILER::WT-FASD-DATA-FILE
++ COMPILER::GAZONK-NAME COMPILER::WFS-ERROR
++ COMPILER::WT-NEXT-VAR-ARG COMPILER::WT-FIRST-VAR-ARG
++ COMPILER::C1NIL COMPILER::WT-DATA-END COMPILER::RESET-TOP
++ COMPILER::TAIL-RECURSION-POSSIBLE
++ COMPILER::PRINT-COMPILER-INFO COMPILER::CCB-VS-PUSH
++ COMPILER::BABOON COMPILER::INIT-ENV
++ COMPILER::PRINT-CURRENT-FORM COMPILER::VS-PUSH
++ COMPILER::INC-INLINE-BLOCKS))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::FIXNUM)
++ COMMON-LISP::T)
++ COMPILER::MEMOIZED-HASH-EQUAL))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::FIXNUM)
++ COMPILER::PROCLAIMED-ARGD COMPILER::ANALYZE-REGS1
++ COMPILER::ANALYZE-REGS))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::STRING COMMON-LISP::FIXNUM
++ COMMON-LISP::FIXNUM)
++ COMMON-LISP::T)
++ COMPILER::DASH-TO-UNDERSCORE-INT))
+\ No newline at end of file
+--- gcl-2.6.12.orig/configure
++++ gcl-2.6.12/configure
+@@ -7569,9 +7569,6 @@ fi
+
+ if test "$enable_ansi" = "yes" ; then
+ SYSTEM=ansi_gcl
+-
+-$as_echo "#define ANSI_COMMON_LISP 1" >>confdefs.h
+-
+ CLSTANDARD=ANSI
+ else
+ SYSTEM=gcl
+--- gcl-2.6.12.orig/configure.in
++++ gcl-2.6.12/configure.in
+@@ -2112,7 +2112,6 @@ AC_ARG_ENABLE(ansi,[--enable-ansi builds
+
+ if test "$enable_ansi" = "yes" ; then
+ SYSTEM=ansi_gcl
+- AC_DEFINE(ANSI_COMMON_LISP,1,[compile ansi compliant image])
+ CLSTANDARD=ANSI
+ else
+ SYSTEM=gcl
+--- gcl-2.6.12.orig/h/amd64-linux.h
++++ gcl-2.6.12/h/amd64-linux.h
+@@ -21,3 +21,4 @@
+ #define C_GC_OFFSET 4
+
+ #define RELOC_H "elf64_i386_reloc.h"
++#define MAX_CODE_ADDRESS (1L<<31)/*large memory model broken gcc 4.8*/
+--- gcl-2.6.12.orig/h/att_ext.h
++++ gcl-2.6.12/h/att_ext.h
+@@ -145,8 +145,8 @@ object simple_lispcall();
+ object simple_lispcall_no_event();
+ object simple_symlispcall();
+ object simple_symlispcall_no_event();
+-EXTER object Vevalhook;
+-EXTER object Vapplyhook;
++EXTER object siVevalhook;
++EXTER object siVapplyhook;
+ object ieval();
+ object ifuncall(object,int,...);
+ object ifuncall1();
+@@ -301,13 +301,13 @@ EXTER object sLquote;
+
+ EXTER object sLlambda;
+
+-EXTER object sLlambda_block;
+-EXTER object sLlambda_closure;
+-EXTER object sLlambda_block_closure;
++EXTER object sSlambda_block;
++EXTER object sSlambda_closure;
++EXTER object sSlambda_block_closure;
+
+ EXTER object sLfunction;
+-EXTER object sLmacro;
+-EXTER object sLtag;
++EXTER object sSmacro;
++EXTER object sStag;
+ EXTER object sLblock;
+
+
+@@ -359,9 +359,6 @@ object shift_integer();
+ /* package.d */
+ EXTER object lisp_package;
+ EXTER object user_package;
+-#ifdef ANSI_COMMON_LISP
+-EXTER object common_lisp_package;
+-#endif
+ EXTER object keyword_package;
+ EXTER object system_package;
+ EXTER object sLApackageA;
+@@ -565,15 +562,13 @@ EXTER object sSfunction_documentation;
+ /* typespec.c */
+ EXTER object sLcommon,sLnull,sLcons,sLlist,sLsymbol,sLarray,sLvector,sLbit_vector,sLstring;
+ EXTER object sLsequence,sLsimple_array,sLsimple_vector,sLsimple_bit_vector,sLsimple_string;
+-EXTER object sLcompiled_function,sLpathname,sLcharacter,sLnumber,sLrational,sLfloat,sLstring_char;
++EXTER object sLcompiled_function,sLpathname,sLcharacter,sLnumber,sLrational,sLfloat;
+ EXTER object sLinteger,sLreal,sLratio,sLshort_float,sLstandard_char,sLfixnum,sLpositive_fixnum, sLcomplex;
+ EXTER object sLsingle_float,sLpackage,sLbignum,sLrandom_state,sLdouble_float,sLstream,sLbit,sLreadtable;
+ EXTER object sLlong_float,sLhash_table,sLstructure,sLboolean;
+ EXTER object sLdivision_by_zero,sLfloating_point_inexact,sLfloating_point_invalid_operation;
+ EXTER object sLfloating_point_overflow,sLfloating_point_underflow;
+
+-/* #ifdef ANSI_COMMON_LISP */
+-/* new ansi types */
+ EXTER object sLarithmetic_error,sLbase_char,sLbase_string,sLbroadcast_stream,sLbuilt_in_class;
+ EXTER object sLcell_error,sLclass,sLconcatenated_stream,sLcondition,sLcontrol_error;
+ EXTER object sLecho_stream,sLend_of_file,sLerror,sLextended_char,sLfile_error,sLfile_stream;
+@@ -584,7 +579,6 @@ EXTER object sLstandard_generic_function
+ EXTER object sLstream_error,sLstring_stream,sLstructure_class,sLstyle_warning,sLsynonym_stream;
+ EXTER object sLtwo_way_stream,sLtype_error,sLunbound_slot,sLunbound_variable,sLundefined_function,sLwarning;
+ EXTER object sLmethod_combination,sLstructure_object;
+-/* #endif */
+
+ EXTER object sLsatisfies;
+ EXTER object sLmember;
+@@ -595,10 +589,10 @@ EXTER object sLvalues;
+ EXTER object sLmod;
+ EXTER object sLsigned_byte;
+ EXTER object sLunsigned_byte;
+-EXTER object sLsigned_char;
+-EXTER object sLunsigned_char;
+-EXTER object sLsigned_short;
+-EXTER object sLunsigned_short;
++EXTER object sSsigned_char;
++EXTER object sSunsigned_char;
++EXTER object sSsigned_short;
++EXTER object sSunsigned_short;
+ EXTER object sLA;
+ EXTER object sLplusp;
+ EXTER object TSor_symbol_string;
+--- gcl-2.6.12.orig/h/compdefs.h
++++ gcl-2.6.12/h/compdefs.h
+@@ -114,3 +114,4 @@ stp_ordinary
+ SIGNED_CHAR(x)
+ FEerror(x,y...)
+ FEwrong_type_argument(x,y)
++BIT_ENDIAN(x)
+--- gcl-2.6.12.orig/h/elf64_i386_reloc.h
++++ gcl-2.6.12/h/elf64_i386_reloc.h
+@@ -8,5 +8,6 @@
+ add_val(where,~0L,s+a);
+ break;
+ case R_X86_64_PC32:
++ massert(ovchks(s+a-p,~MASK(32)));
+ add_val(where,MASK(32),s+a-p);
+ break;
+--- gcl-2.6.12.orig/h/lu.h
++++ gcl-2.6.12/h/lu.h
+@@ -94,12 +94,12 @@ struct symbol {
+ object s_dbind;
+ void (*s_sfdef) ();
+ char *s_self;
++ short s_stype;
++ short s_mflag;
+ int s_fillp;
+ object s_gfdef;
+ object s_plist;
+ object s_hpack;
+- short s_stype;
+- short s_mflag;
+ SPAD;
+
+ };
+@@ -142,6 +142,7 @@ struct hashtable {
+ int ht_nent;
+ int ht_size;
+ short ht_test;
++ short ht_static;
+ SPAD;
+
+ };
+@@ -152,10 +153,10 @@ struct array {
+ short a_rank;
+ short a_elttype;
+ object *a_self;
+- short a_adjustable;
+- short a_offset;
+ int a_dim;
+ int *a_dims;
++ short a_adjustable;
++ short a_offset;
+ SPAD;
+
+ };
+@@ -168,8 +169,8 @@ struct vector {
+ short v_hasfillp;
+ short v_elttype;
+ object *v_self;
+- int v_fillp;
+ int v_dim;
++ int v_fillp;
+ short v_adjustable;
+ short v_offset;
+ SPAD;
+@@ -181,8 +182,8 @@ struct string {
+ short st_hasfillp;
+ short st_adjustable;
+ char *st_self;
+- int st_fillp;
+ int st_dim;
++ int st_fillp;
+ };
+
+ struct ustring {
+@@ -191,8 +192,8 @@ struct ustring {
+ short ust_hasfillp;
+ short ust_adjustable;
+ unsigned char *ust_self;
+- int ust_fillp;
+ int ust_dim;
++ int ust_fillp;
+ };
+
+ struct bitvector {
+@@ -201,8 +202,8 @@ struct bitvector {
+ short bv_hasfillp;
+ short bv_elttype;
+ char *bv_self;
+- int bv_fillp;
+ int bv_dim;
++ int bv_fillp;
+ short bv_adjustable;
+ short bv_offset;
+ SPAD;
+@@ -214,10 +215,10 @@ struct fixarray {
+ short fixa_rank;
+ short fixa_elttype;
+ fixnum *fixa_self;
+- short fixa_adjustable;
+- short fixa_offset;
+ int fixa_dim;
+ int *fixa_dims;
++ short fixa_adjustable;
++ short fixa_offset;
+ SPAD;
+ };
+
+@@ -227,10 +228,10 @@ struct sfarray {
+ short sfa_rank;
+ short sfa_elttype;
+ shortfloat *sfa_self;
+- short sfa_adjustable;
+- short sfa_offset;
+ int sfa_dim;
+ int *sfa_dims;
++ short sfa_adjustable;
++ short sfa_offset;
+ SPAD;
+ };
+
+@@ -240,10 +241,10 @@ struct lfarray {
+ short lfa_rank;
+ short lfa_elttype;
+ longfloat *lfa_self;
+- short lfa_adjustable;
+- short lfa_offset;
+ int lfa_dim;
+ int *lfa_dims;
++ short lfa_adjustable;
++ short lfa_offset;
+ SPAD;
+ };
+
+--- gcl-2.6.12.orig/h/notcomp.h
++++ gcl-2.6.12/h/notcomp.h
+@@ -22,9 +22,6 @@ void segmentation_catcher();
+ EXTER int gc_enabled, saving_system;
+
+ EXTER object lisp_package,user_package;
+-#ifdef ANSI_COMMON_LISP
+-EXTER object common_lisp_package;
+-#endif
+ EXTER char *core_end;
+ EXTER int catch_fatal;
+ EXTER long real_maxpage;
+@@ -105,6 +102,7 @@ void old(void) \
+ #define make_function(a_,b_) make_function_internal(a_,FFN(b_))
+ #define make_si_function(a_,b_) make_si_function_internal(a_,FFN(b_))
+ #define make_special_form(a_,b_) make_special_form_internal(a_,FFN(b_))
++#define make_si_special_form(a_,b_) make_si_special_form_internal(a_,FFN(b_))
+ #define make_si_sfun(a_,b_,c_) make_si_sfun_internal(a_,FFN(b_),c_)
+ #define STATD static
+ #else
+@@ -114,6 +112,7 @@ void old(void) \
+ #define make_function(a_,b_) make_function_internal(a_,b_)
+ #define make_si_function(a_,b_) make_si_function_internal(a_,b_)
+ #define make_special_form(a_,b_) make_special_form_internal(a_,b_)
++#define make_si_special_form(a_,b_) make_si_special_form_internal(a_,b_)
+ #define make_si_sfun(a_,b_,c_) make_si_sfun_internal(a_,b_,c_)
+ #define STATD
+ #endif
+--- gcl-2.6.12.orig/h/object.h
++++ gcl-2.6.12/h/object.h
+@@ -77,7 +77,7 @@ Foundation, 675 Mass Ave, Cambridge, MA
+ Definition of the type of LISP objects.
+ */
+ typedef union int_object iobject;
+-union int_object {object o; fixnum i;};
++union int_object {object *o; fixnum i;};
+
+ #define SMALL_FIXNUM_LIMIT 1024
+
+@@ -150,6 +150,12 @@ enum aelttype { /* array element type
+ #define SET_BV_OFFSET(x,val) ((type_of(x)==t_bitvector ? x->bv.bv_offset = val : \
+ type_of(x)== t_array ? x->a.a_offset=val : (abort(),0)))
+
++#if !defined(DOUBLE_BIGENDIAN)
++#define BIT_ENDIAN(a_) (7-(a_))
++#else
++#define BIT_ENDIAN(a_) (a_)
++#endif
++
+
+ #define S_DATA(x) ((struct s_data *)((x)->str.str_self))
+ #define SLOT_TYPE(def,i) (((S_DATA(def))->raw->ust.ust_self[i]))
+@@ -304,9 +310,9 @@ EXTER struct typemanager tm_table[ 32 /
+ /*
+ Contiguous block header.
+ */
+-EXTER bool prefer_low_mem_contblock;
++EXTER ufixnum contblock_lim;
+ struct contblock { /* contiguous block header */
+- int cb_size; /* size in bytes */
++ ufixnum cb_size; /* size in bytes */
+ struct contblock
+ *cb_link; /* contiguous block link */
+ };
+@@ -324,7 +330,6 @@ EXTER struct contblock *old_cb_pointer;
+ /*
+ Variables for memory management.
+ */
+-EXTER long ncb; /* number of contblocks */
+ #define ncbpage tm_table[t_contiguous].tm_npage
+ #define maxcbpage tm_table[t_contiguous].tm_maxpage
+ #define cbgbccount tm_table[t_contiguous].tm_gbccount
+@@ -337,15 +342,12 @@ EXTER long holepage; /* hole pages *
+ EXTER long new_holepage,starting_hole_div,starting_relb_heap_mult;
+
+
+-#ifdef SGC
+-EXTER char *old_rb_start; /* read-only relblock start */
+-#endif
+ EXTER char *rb_start; /* relblock start */
+ EXTER char *rb_end; /* relblock end */
+ EXTER char *rb_limit; /* relblock limit */
+ EXTER char *rb_pointer; /* relblock pointer */
+-EXTER char *rb_start1; /* relblock start in copy space */
+-EXTER char *rb_pointer1; /* relblock pointer in copy space */
++/* EXTER char *rb_start1; /\* relblock start in copy space *\/ */
++/* EXTER char *rb_pointer1; /\* relblock pointer in copy space *\/ */
+
+ EXTER char *heap_end; /* heap end */
+ EXTER char *core_end; /* core end */
+--- gcl-2.6.12.orig/h/page.h
++++ gcl-2.6.12/h/page.h
+@@ -21,9 +21,6 @@
+ #define PTR_ALIGN SIZEOF_LONG
+ #endif
+
+-#define ROUND_UP_PTR(n) (((long)(n) + (PTR_ALIGN-1)) & ~(PTR_ALIGN-1))
+-#define ROUND_DOWN_PTR(n) (((long)(n) & ~(PTR_ALIGN-1)))
+-
+ /* minimum size required for contiguous pointers */
+ #if PTR_ALIGN < SIZEOF_CONTBLOCK
+ #define CPTR_SIZE SIZEOF_CONTBLOCK
+@@ -31,9 +28,10 @@
+ #define CPTR_SIZE PTR_ALIGN
+ #endif
+
+-#define ROUND_UP_PTR_CONT(n) (((long)(n) + (CPTR_SIZE-1)) & ~(CPTR_SIZE-1))
+-#define ROUND_DOWN_PTR_CONT(n) (((long)(n) & ~(CPTR_SIZE-1)))
+-
++#define FLR(x,r) (((x))&~(r-1))
++#define CEI(x,r) FLR((x)+(r-1),r)
++#define PFLR(x,r) ((void *)FLR((ufixnum)x,r))
++#define PCEI(x,r) ((void *)CEI((ufixnum)x,r))
+
+ #ifdef SGC
+
+@@ -47,33 +45,25 @@
+
+ #define SGC_WRITABLE (SGC_PERM_WRITABLE | SGC_PAGE_FLAG)
+
+-#define WRITABLE_PAGE_P(p) IS_WRITABLE(p)
+-#define ON_WRITABLE_PAGE(x) WRITABLE_PAGE_P(page(x))
+-
+-#define IF_WRITABLE(x,if_code) ({if (IS_WRITABLE(page(x))) {if_code;}})/*FIXME maxpage*/
+-
+-#define sgc_mark_object(x) IF_WRITABLE(x,if(!is_marked(x)) sgc_mark_object1(x))
+-
+ /* When not 0, the free lists in the type manager are freelists
+ on SGC_PAGE's, for those types supporting sgc.
+ Marking and sweeping is done specially */
+
+ int sgc_on;
+
++#define SGC_WHOLE_PAGE /* disallow old data on sgc pages*/
+
++#ifndef SGC_WHOLE_PAGE
+ /* for the S field of the FIRSTWORD */
+ enum sgc_type { SGC_NORMAL, /* not allocated since the last sgc */
+ SGC_RECENT /* allocated since last sgc */
+ };
+-
++#define SGC_OR_M(x) (!TYPEWORD_TYPE_P(pageinfo(x)->type) ? pageinfo(x)->sgc_flags&SGC_PAGE_FLAG : ((object)x)->d.s)
++#endif
+
+ #define TM_BASE_TYPE_P(i) (tm_table[i].tm_type == i)
+
+-/* check if a relblock address is new relblock */
+-#define SGC_RELBLOCK_P(x) ((char *)(x) >= rb_start)
+-
+ /* is this an sgc cell? encompasses all free cells. Used where cell cannot yet be marked */
+-#define SGC_OR_M(x) (!TYPEWORD_TYPE_P(pageinfo(x)->type) ? pageinfo(x)->sgc_flags&SGC_PAGE_FLAG : ((object)x)->d.s)
+
+ #ifndef SIGPROTV
+ #define SIGPROTV SIGSEGV
+@@ -107,28 +97,26 @@ extern fixnum writable_pages;
+
+ #define CLEAR_WRITABLE(i) set_writable(i,0)
+ #define SET_WRITABLE(i) set_writable(i,1)
+-#define IS_WRITABLE(i) is_writable(i)
++#define WRITABLE_PAGE_P(i) is_writable(i)
++#define CACHED_WRITABLE_PAGE_P(i) is_writable_cached(i)
++#define ON_WRITABLE_PAGE(x) WRITABLE_PAGE_P(page(x))
++#define ON_WRITABLE_PAGE_CACHED(x) CACHED_WRITABLE_PAGE_P(page(x))
++
+
+
+ EXTER long first_data_page,real_maxpage,phys_pages,available_pages;
+-EXTER void *data_start;
++EXTER void *data_start,*initial_sbrk;
+
+ #if !defined(IN_MAIN) && defined(SGC)
+ #include "writable.h"
+ #endif
+
+-#ifdef SGC
+-#define REAL_RB_START (sgc_enabled ? old_rb_start : rb_start)
+-#else
+-#define REAL_RB_START rb_start
+-#endif
+-
+ #define CB_BITS CPTR_SIZE*CHAR_SIZE
+ #define ceil(a_,b_) (((a_)+(b_)-1)/(b_))
+ #define npage(m_) ceil(m_,PAGESIZE)
+ #define cpage(m_) ({ufixnum _m=(m_);ceil(sizeof(struct pageinfo)+_m+2*ceil(_m,(CB_BITS-2)),PAGESIZE);})
+ #define mbytes(p_) ceil((p_)*PAGESIZE-sizeof(struct pageinfo),CB_BITS)
+-#define tpage(tm_,m_) (tm_->tm_type==t_relocatable ? npage(m_-(rb_limit-rb_pointer)) : (tm_->tm_type==t_contiguous ? cpage(m_) : npage(m_)))
++#define tpage(tm_,m_) (tm_->tm_type==t_relocatable ? npage(m_-(rb_limit-rb_pointer)+1) : (tm_->tm_type==t_contiguous ? cpage(m_) : npage(m_)))
+
+ #define CB_DATA_SIZE(z_) ({fixnum _z=(z_);_z*PAGESIZE-2*mbytes(_z)-sizeof(struct pageinfo);})
+ #define CB_MARK_START(pi_) ((void *)(pi_)+sizeof(struct pageinfo))
+--- gcl-2.6.12.orig/h/protoize.h
++++ gcl-2.6.12/h/protoize.h
+@@ -7,7 +7,7 @@
+ /* alloc.c:364:OF */ extern object on_stack_cons (object x, object y); /* (x, y) object x; object y; */
+ /* alloc.c:376:OF */ extern object fSallocated (object typ); /* (typ) object typ; */
+ /* alloc.c:401:OF */ extern object fSreset_number_used (object typ); /* (typ) object typ; */
+-/* alloc.c:480:OF */ extern void insert_contblock (char *p, int s); /* (p, s) char *p; int s; */
++/* alloc.c:480:OF */ extern void insert_contblock (void *p, ufixnum s); /* (p, s) char *p; int s; */
+ /* alloc.c:480:OF */ extern void insert_maybe_sgc_contblock (char *p, int s); /* (p, s) char *p; int s; */
+ /* alloc.c:611:OF */ extern void set_maxpage (void); /* () */
+ /* alloc.c:635:OF */ extern void gcl_init_alloc (void *); /* () */
+@@ -124,6 +124,7 @@ struct key {short n,allow_other_keys;
+ /* cfun.c:299:OF */ extern object make_si_sfun_internal (char *s, object (*f)(), int argd); /* (s, f, argd) char *s; int (*f)(); int argd; */
+ /* cfun.c:322:OF */ extern object make_si_function_internal (char *s, void (*f) ()); /* (s, f) char *s; int (*f)(); */
+ /* cfun.c:341:OF */ extern object make_special_form_internal (char *s, void (*f)()); /* (s, f) char *s; int (*f)(); */
++/* cfun.c:341:OF */ extern object make_si_special_form_internal (char *s, void (*f)()); /* (s, f) char *s; int (*f)(); */
+ /* cfun.c:352:OF */ extern object fScompiled_function_name (object fun); /* (fun) object fun; */
+ /* cfun.c:371:OF */ extern void turbo_closure (object fun); /* (fun) object fun; */
+ /* cfun.c:392:OF */ extern object fSturbo_closure (object funobj); /* (funobj) object funobj; */
+@@ -467,7 +468,7 @@ typedef void (*funcvoid)(void);
+ /* regexp.c:1588:OF */ extern void regerror (char *s); /* (s) char *s; */
+ /* regexpr.c:48:OF */ extern object fSmatch_beginning (fixnum i); /* (i) int i; */
+ /* regexpr.c:57:OF */ extern object fSmatch_end (fixnum i); /* (i) int i; */
+-/* save.c:17:OF */ extern void Lsave (void); /* () */
++/* save.c:17:OF */ extern void siLsave (void); /* () */
+ #include <unistd.h>
+ /* sbrk.c:9:OF */ /* extern void * sbrk (int n); */ /* (n) int n; */
+ /* strcspn.c:3:OF */ /* extern size_t strcspn (const char *s1, const char *s2); */ /* (s1, s2) char *s1; char *s2; */
+@@ -862,9 +863,6 @@ void
+ Lstandard_char_p(void);
+
+ void
+-Lstring_char_p(void);
+-
+-void
+ Lchar_code(void);
+
+ void
+@@ -955,9 +953,6 @@ void
+ Lstandard_char_p(void);
+
+ void
+-Lstring_char_p(void);
+-
+-void
+ Lcharacter(void);
+
+ void
+@@ -1405,7 +1400,6 @@ void Lforce_output(void);
+ void Lnthcdr(void);
+ void Llogior(void);
+ void Lchar_downcase(void);
+-void Lstring_char_p(void);
+ void Lstream_element_type(void);
+ void Lpackage_used_by_list(void);
+ void Ldivide(void);
+@@ -1923,3 +1917,21 @@ rl_stream_p(FILE *f);
+
+ void
+ sigint(void);
++
++void
++allocate_code_block_reserve(void);
++
++inline void
++resize_hole(ufixnum,enum type);
++
++inline void *
++alloc_contblock_no_gc(size_t);
++
++inline void
++reset_contblock_freelist(void);
++
++inline void
++empty_relblock(void);
++
++fixnum
++check_avail_pages(void);
+--- gcl-2.6.12.orig/h/symbol.h
++++ gcl-2.6.12/h/symbol.h
+@@ -23,6 +23,6 @@ object sLquote;
+
+ object sLlambda;
+
+-object sLlambda_block;
+-object sLlambda_closure;
+-object sLlambda_block_closure;
++object sSlambda_block;
++object sSlambda_closure;
++object sSlambda_block_closure;
+--- gcl-2.6.12.orig/h/writable.h
++++ gcl-2.6.12/h/writable.h
+@@ -1,11 +1,16 @@
++EXTER fixnum last_page;
++EXTER int last_result;
++
+ EXTER inline int
+-set_writable(fixnum i,fixnum m) {
++set_writable(fixnum i,bool m) {
+
+ fixnum j;
+ object v;
+
+- if (i<first_data_page || i>=page(core_end))
+- error("out of core in set_writable");
++ last_page=last_result=0;
++
++ if (i<first_data_page || i>=page(heap_end))
++ error("out of heap in set_writable");
+
+ if ((v=sSAwritableA ? sSAwritableA->s.s_dbind : Cnil)==Cnil)
+ error("no wrimap in set_writable");
+@@ -16,13 +21,13 @@ set_writable(fixnum i,fixnum m) {
+ if ((void *)wrimap!=(void *)v->v.v_self)
+ error("set_writable called in gc");
+
++ writable_pages+=m-((wrimap[j/8]>>(j%8))&0x1);
++
+ if (m)
+ wrimap[j/8]|=(1<<(j%8));
+ else
+ wrimap[j/8]&=~(1<<(j%8));
+
+- writable_pages+=m ? 1 : -1;
+-
+ return 0;
+
+ }
+@@ -35,13 +40,24 @@ is_writable(fixnum i) {
+
+ if (i<first_data_page || i>=page(core_end))
+ return 0;
+-
++
+ if ((v=sSAwritableA ? sSAwritableA->s.s_dbind : Cnil)==Cnil)
+ return 1;
+-
++
+ if ((j=i-first_data_page)<0 || j>=v->v.v_dim)
+ return 1;
+-
++
+ return (wrimap[j/8]>>(j%8))&0x1;
++
++}
++
++EXTER inline int
++is_writable_cached(fixnum i) {
++
++ if (last_page==i)
++ return last_result;
++
++ last_page=i;
++ return last_result=is_writable(i);
+
+ }
+--- gcl-2.6.12.orig/info/form.texi
++++ gcl-2.6.12/info/form.texi
+@@ -8,18 +8,6 @@ List of all the lambda-list keywords use
+
+ @end defvr
+
+-@defun GET-SETF-METHOD (form)
+-Package:LISP
+-
+-Returns the five values (or five 'gangs') constituting the SETF method for
+-FORM. See the doc of DEFINE-SETF-METHOD for the meanings of the gangs. It
+-is an error if the third value (i.e., the list of store variables) is not a
+-one-element list. See the doc of GET-SETF-METHOD-MULTIPLE-VALUE for
+-comparison.
+-
+-
+-@end defun
+-
+ @deffn {Special Form} THE
+ Package:LISP
+
+--- gcl-2.6.12.orig/lsp/gcl_arraylib.lsp
++++ gcl-2.6.12/lsp/gcl_arraylib.lsp
+@@ -22,23 +22,7 @@
+ ;;;; array routines
+
+
+-(in-package 'lisp)
+-
+-
+-(export '(make-array array-displacement vector
+- array-element-type array-rank array-dimension
+- array-dimensions
+- array-in-bounds-p array-row-major-index
+- adjustable-array-p
+- bit sbit
+- bit-and bit-ior bit-xor bit-eqv bit-nand bit-nor
+- bit-andc1 bit-andc2 bit-orc1 bit-orc2 bit-not
+- array-has-fill-pointer-p fill-pointer
+- vector-push vector-push-extend vector-pop
+- adjust-array upgraded-array-element-type))
+-
+-(in-package 'system)
+-
++(in-package :si)
+
+ (proclaim '(optimize (safety 2) (space 3)))
+
+@@ -47,7 +31,7 @@
+ (or (gethash type *baet-hash*)
+ (setf (gethash type *baet-hash*)
+ (if type
+- (car (member type '(string-char bit signed-char unsigned-char signed-short unsigned-short
++ (car (member type '(character bit signed-char unsigned-char signed-short unsigned-short
+ fixnum short-float long-float t)
+ :test 'subtypep)) t)))))
+
+--- gcl-2.6.12.orig/lsp/gcl_auto.lsp
++++ gcl-2.6.12/lsp/gcl_auto.lsp
+@@ -1,4 +1,4 @@
+-(in-package 'si)
++(in-package :si)
+ ;;; Autoloaders.
+
+
+--- gcl-2.6.12.orig/lsp/gcl_auto_new.lsp
++++ gcl-2.6.12/lsp/gcl_auto_new.lsp
+@@ -1,4 +1,4 @@
+-(in-package 'si)
++(in-package :si)
+ ;;; Autoloaders.
+
+
+@@ -67,8 +67,7 @@
+ (autoload 'ftruncate '|gcl_numlib|)
+ #-unix (autoload 'get-decoded-time '|gcl_mislib|)
+ #+aosvs (autoload 'get-universal-time '|gcl_mislib|)
+-(autoload 'get-setf-method '|gcl_setf|)
+-(autoload 'get-setf-method-multiple-value '|gcl_setf|)
++(autoload 'get-setf-expansion '|gcl_setf|)
+ (autoload 'inspect '|gcl_describe|)
+ (autoload 'intersection '|gcl_listlib|)
+ (autoload 'isqrt '|gcl_numlib|)
+--- gcl-2.6.12.orig/lsp/gcl_autoload.lsp
++++ gcl-2.6.12/lsp/gcl_autoload.lsp
+@@ -21,8 +21,9 @@
+ ;;;; AUTOLOAD
+
+
+-;;; Go into LISP.
+-(in-package 'lisp)
++(in-package :si)
++
++(export '(clines defentry defcfun object void int double))
+
+ ;(defvar *features*)
+
+@@ -127,13 +128,13 @@
+
+ ;;; Allocator.
+
+-(import 'si::allocate)
+-(export '(allocate
++;(import 'si::allocate)
++;(export '(allocate
+ ;allocated-pages maximum-allocatable-pages
+ ;allocate-contiguous-pages
+ ;allocated-contiguous-pages maximum-contiguous-pages
+ ;allocate-relocatable-pages allocated-relocatable-pages
+- sfun gfun cfun cclosure spice structure))
++; sfun gfun cfun cclosure spice structure))
+
+ ;(defvar type-character-alist
+ ; '((cons . #\.)
+@@ -279,12 +280,12 @@
+ ncbpage maxcbpage (if (zerop cbgbccount) nil cbgbccount) ncb)
+ (format t "~9T~D~35Thole~%" holepage)
+ (format t "~8D/~D~19T~6,1F%~@[~8D~]~35Trelocatable~%~%"
+- nrbpage maxrbpage (/ rbused 0.01 (+ rbused rbfree))
++ nrbpage maxrbpage (if (zerop (+ rbused rbfree)) 0.0 (/ rbused 0.01 (+ rbused rbfree)))
+ (if (zerop rbgbccount) nil rbgbccount))
+ (format t "~10D pages for cells~%~%" npage)
+ (format t "~10D total pages in core~%" (+ npage ncbpage nrbpage))
+ (format t "~10D current core maximum pages~%" (+ maxnpage maxcbpage maxrbpage))
+- (format t "~10D pages reserved for gc~%" maxrbpage)
++ (format t "~10D pages reserved for gc~%" nrbpage)
+ (format t "~10D pages available for adding to core~%" leftpage)
+ (format t "~10D pages reserved for core exhaustion~%~%" (- maxpage (+ maxnpage maxcbpage (ash maxrbpage 1) leftpage)))
+ (format t "~10D maximum pages~%" maxpage)
+@@ -411,8 +412,8 @@ Good luck! The GCL Development Team"
+ (setf (get 'with-output-to-string 'si:pretty-print-format) 1)
+
+
+-(in-package 'si)
++(in-package :si)
+
+ (defvar *lib-directory* (namestring (truename "../")))
+
+-(import '(*lib-directory* *load-path* *system-directory*) 'si::user)
++(import '(*lib-directory* *load-path* *system-directory*) :user)
+--- gcl-2.6.12.orig/lsp/gcl_debug.lsp
++++ gcl-2.6.12/lsp/gcl_debug.lsp
+@@ -1,8 +1,8 @@
+ ;;Copyright William F. Schelter 1990, All Rights Reserved
+
+
+-(In-package "SYSTEM")
+-(import 'sloop::sloop)
++(In-package :si)
++(import '(sloop::sloop))
+
+ (eval-when (compile eval)
+ (proclaim '(optimize (safety 2) (space 3)))
+@@ -98,7 +98,7 @@
+ (cond ((compiled-function-p fun)
+ (setq name (compiled-function-name fun)))
+ (t (setq name fun)))
+- (if (symbolp name)(setq args (get name 'debug)))
++ (if (symbolp name)(setq args (get name 'debugger)))
+ (let ((next (ihs-vs (f + 1 *current-ihs*))))
+ (cond (next
+ (format *debug-io* ">> ~a():" name)
+@@ -583,7 +583,7 @@
+ ;; in other common lisps this should be a string output stream.
+
+ (defvar *display-string*
+- (make-array 100 :element-type 'string-char :fill-pointer 0 :adjustable t))
++ (make-array 100 :element-type 'character :fill-pointer 0 :adjustable t))
+
+ (defun display-env (n env)
+ (do ((v (reverse env) (cdr v)))
+@@ -625,7 +625,7 @@
+ (mv-values nil j))
+ (let
+ ((na (ihs-fname j)))
+- (cond ((special-form-p na))
++ (cond ((special-operator-p na))
+ ((get na 'dbl-invisible))
+ ((fboundp na)(return (mv-values na j)))))))
+
+@@ -677,7 +677,7 @@
+ (vs (1+ k))
+ (vs (+ k 2)))
+ )))))))
+- ((special-form-p na) nil)
++ ((special-operator-p na) nil)
+ ((get na 'dbl-invisible))
+ ((fboundp na)
+ (mv-values i na nil nil
+@@ -717,7 +717,7 @@
+ (end (min (ihs-vs (1+ ihs)) (vs-top))))
+ (format *display-string* "")
+ (do ((i base )
+- (v (get (ihs-fname ihs) 'debug) (cdr v)))
++ (v (get (ihs-fname ihs) 'debugger) (cdr v)))
+ ((or (fb >= i end)(fb > (fill-pointer *display-string*) plength)))
+ (format *display-string* "~a~@[~d~]=~s~@[,~]"
+ (or (car v) 'loc) (if (not (car v)) (f - i base)) (vs i)
+--- gcl-2.6.12.orig/lsp/gcl_defmacro.lsp
++++ gcl-2.6.12/lsp/gcl_defmacro.lsp
+@@ -22,11 +22,7 @@
+ ;;;; defines SI:DEFMACRO*, the defmacro preprocessor
+
+
+-(in-package 'lisp)
+-(export '(&whole &environment &body))
+-
+-
+-(in-package 'system)
++(in-package :si)
+
+
+ (eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+--- gcl-2.6.12.orig/lsp/gcl_defstruct.lsp
++++ gcl-2.6.12/lsp/gcl_defstruct.lsp
+@@ -22,21 +22,13 @@
+ ;;;; The structure routines.
+
+
+-(in-package 'lisp)
+-(export 'defstruct)
+-
+-
+-(in-package 'system)
++(in-package :si)
+
+
+ (proclaim '(optimize (safety 2) (space 3)))
+
+
+
+-;(in-package 'system)
+-
+-
+-
+ (defvar *accessors* (make-array 10 :adjustable t))
+ (defvar *list-accessors* (make-array 2 :adjustable t))
+ (defvar *vector-accessors* (make-array 2 :adjustable t))
+@@ -99,7 +91,10 @@
+ (setq dont-overwrite t)
+ )
+ (t (setf (get access-function 'structure-access)
+- (cons (if type type name) offset)))))))
++ (cons (if type type name) offset))
++ (when slot-type
++ (proclaim `(ftype (function (,name) ,slot-type) ,access-function)))
++ )))))
+ nil))
+
+
+@@ -504,7 +499,7 @@
+ ;bootstrapping code!
+ (setq def (make-s-data-structure
+ (make-array (* leng (size-of t))
+- :element-type 'string-char :static t)
++ :element-type 'character :static t)
+ (make-t-type leng nil slot-descriptions)
+ *standard-slot-positions*
+ slot-descriptions
+@@ -569,9 +564,7 @@
+ (setf (symbol-function predicate)
+ #'(lambda (x)
+ (si::structure-subtype-p x name))))
+- (setf (get predicate 'compiler::co1)
+- 'compiler::co1structure-predicate)
+- (setf (get predicate 'struct-predicate) name)
++ (proclaim `(ftype (function (,name) t) ,predicate));FIXME boolean is unboxed
+ )
+ ) nil)
+
+--- gcl-2.6.12.orig/lsp/gcl_describe.lsp
++++ gcl-2.6.12/lsp/gcl_describe.lsp
+@@ -22,12 +22,7 @@
+ ;;;; DESCRIBE and INSPECT
+
+
+-(in-package 'lisp)
+-
+-(export '(describe inspect))
+-
+-
+-(in-package 'system)
++(in-package :si)
+
+
+ (proclaim '(optimize (safety 2) (space 3)))
+@@ -191,7 +186,6 @@
+ (defun inspect-character (character)
+ (format t
+ (cond ((standard-char-p character) "~S - standard character")
+- ((string-char-p character) "~S - string character")
+ (t "~S - character"))
+ character)
+ (inspect-print "code: #x~X" (char-code character))
+@@ -353,7 +347,7 @@
+ (find-package "SYSTEM")
+ *package*)))
+
+- (cond ((special-form-p symbol)
++ (cond ((special-operator-p symbol)
+ (doc1 (or (documentation symbol 'function) "")
+ (if (macro-function symbol)
+ "[Special form and Macro]"
+--- gcl-2.6.12.orig/lsp/gcl_destructuring_bind.lsp
++++ gcl-2.6.12/lsp/gcl_destructuring_bind.lsp
+@@ -8,9 +8,7 @@
+ ;;; in DEFMACRO are the reason this isn't as easy as it sounds.
+ ;;;
+
+-(in-package 'lisp)
+-
+-(export '(destructuring-bind))
++(in-package :si)
+
+ (defvar *arg-tests* ()
+ "A list of tests that do argument counting at expansion time.")
+--- gcl-2.6.12.orig/lsp/gcl_doc-file.lsp
++++ gcl-2.6.12/lsp/gcl_doc-file.lsp
+@@ -13,7 +13,7 @@
+ for w in-package v
+ when (setq doc (documentation w 'function))
+ do (format st "\1fF~a~%~ain ~a package:~a" w
+- (cond ((special-form-p w) "Special Form ")
++ (cond ((special-operator-p w) "Special Form ")
+ ((functionp w) "Function ")
+ ((macro-function w) "Macro ")
+ (t ""))
+--- gcl-2.6.12.orig/lsp/gcl_evalmacros.lsp
++++ gcl-2.6.12/lsp/gcl_evalmacros.lsp
+@@ -20,11 +20,7 @@
+ ;;;; evalmacros.lsp
+
+
+-(in-package "LISP")
+-
+-(export '(defvar defparameter defconstant))
+-
+-(in-package "SYSTEM")
++(in-package :si)
+
+
+ (eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+--- gcl-2.6.12.orig/lsp/gcl_export.lsp
++++ gcl-2.6.12/lsp/gcl_export.lsp
+@@ -21,313 +21,468 @@
+ ;;;;
+ ;;;; Exporting external symbols of LISP package
+
+-
+-(in-package 'lisp)
+-
++(in-package :common-lisp)
+
+ (export '(
+-
+-&whole
+-&environment
+-&body
+-*
+-**
+-***
+-*break-enable*
+-*break-on-warnings*
+-*features*
+-*modules*
+-+
+-++
+-+++
+--
+-/
+-//
+-///
+-COMMON
+-KYOTO
+-KCL
+-abs
+-acos
+-acosh
+-adjust-array
+-adjustable-array-p
+-apropos
+-apropos-list
+-array-dimension
+-array-dimensions
+-array-element-type
+-array-has-fill-pointer-p
+-array-in-bounds-p
+-array-rank
+-array-row-major-index
+-asin
+-asinh
+-assert
+-atanh
+-bit
+-bit-and
+-bit-andc1
+-bit-andc2
+-bit-eqv
+-bit-ior
+-bit-nand
+-bit-nor
+-bit-not
+-bit-orc1
+-bit-orc2
+-bit-xor
+-break
+-byte
+-byte-position
+-byte-size
+-ccase
+-cerror
+-check-type
+-cis
+-coerce
+-compile
+-compile-file
+-concatenate
+-cosh
+-count
+-count-if
+-count-if-not
+-ctypecase
+-decf
+-declaim
+-decode-universal-time
+-defconstant
+-define-modify-macro
+-define-setf-method
+-defparameter
+-defsetf
+-defstruct
+-deftype
+-defvar
+-delete
+-delete-duplicates
+-delete-if
+-delete-if-not
+-deposit-field
+-describe
+-disassemble
+-do*
+-do-all-symbols
+-do-external-symbols
+-do-symbols
+-documentation
+-dolist
+-dotimes
+-dpb
+-dribble
+-ecase
+-ed
+-eighth
+-encode-universal-time
+-error
+-etypecase
+-eval-when
+-every
+-fceiling
+-ffloor
+-fifth
+-fill
+-fill-pointer
+-find
+-find-all-symbols
+-find-if
+-find-if-not
+-first
+-format
+-fourth
+-fround
+-ftruncate
+-get-decoded-time
+-get-setf-method
+-get-setf-method-multiple-value
+-get-universal-time
+-getf
+-ignore
+-ignorable
+-incf
+-inspect
+-intersection
+-isqrt
+-ldb
+-ldb-test
+-lisp-implementation-type
+-logandc1
+-logandc2
+-lognand
+-lognor
+-lognot
+-logorc1
+-logorc2
+-logtest
+-long-site-name
+-machine-instance
+-machine-type
+-machine-version
+-make-array
+-make-sequence
+-map
+-mask-field
+-merge
+-mismatch
+-mod
+-multiple-value-setq
+-nintersection
+-ninth
+-notany
+-notevery
+-nset-difference
+-nset-exclusive-or
+-nsubstitute
+-nsubstitute-if
+-nsubstitute-if-not
+-nunion
+-phase
+-pop
+-position
+-position-if
+-position-if-not
+-prin1-to-string
+-princ-to-string
+-prog*
+-provide
+-psetf
+-push
+-pushnew
+-rational
+-rationalize
+-real
+-read-from-string
+-reduce
+-rem
+-remf
+-remove
+-remove-duplicates
+-remove-if
+-remove-if-not
+-replace
+-require
+-rotatef
+-room
+-sbit
+-search
+-second
+-set-difference
+-set-exclusive-or
+-setf
+-seventh
+-shiftf
+-short-site-name
+-signum
+-sinh
+-sixth
+-software-type
+-software-version
+-some
+-sort
+-stable-sort
+-step
+-structure
+-subsetp
+-substitute
+-substitute-if
+-substitute-if-not
+-subtypep
+-tanh
+-tenth
+-third
+-time
+-trace
+-type
+-typecase
+-typep
+-union
+-untrace
+-variable
+-vector
+-vector-pop
+-vector-push
+-vector-push-extend
+-warn
+-with-input-from-string
+-with-open-file
+-with-open-stream
+-with-output-to-string
+-write-to-string
+-y-or-n-p
+-yes-or-no-p
+-
+-proclaim
+-proclamation
+-special
+-type
+-ftype
+-function
+-inline
+-notinline
+-ignore
+-optimize
+-speed
+-space
+-safety
+-compilation-speed
+-declaration
+-
+-*eval-when-compile*
+-
+-clines
+-defcfun
+-defentry
+-defla
+-
+-void
+-object
+-char
+-int
+-float
+-double
+-
+-define-compiler-macro
+-compiler-macro
+-compiler-macro-function
+-
+-with-compilation-unit
+-with-standard-io-syntax
+-*print-lines*
+-*print-miser-width*
+-*print-pprint-dispatch*
+-*print-right-margin*
+-
+-*read-eval*
+-
+-dynamic-extent
+-
+-loop
+-check-type assert typecase etypecase ctypecase case ecase ccase
+-
+-restart-bind restart-case with-condition-restarts muffle-warning continue abort
+- store-value use-value
+- restart restart-name restart-function restart-report-function
+- restart-interactive-function restart-test-function
+- compute-restarts find-restart invoke-restart invoke-restart-interactively
+- with-simple-restart signal
+-
+-simple-condition simple-error simple-warning invoke-debugger *debugger-hook* *break-on-signals*
+-
+-handler-case handler-bind ignore-errors define-condition make-condition
+- condition warning serious-condition simple-condition-format-control simple-condition-format-arguments
+- storage-condition stack-overflow storage-exhausted type-error
+- type-error-datum type-error-expected-type simple-type-error
+- program-error control-error stream-error stream-error-stream
+- end-of-file file-error file-error-pathname cell-error cell-error-name
+- unbound-variable undefined-function arithmetic-error
+- arithmetic-error-operation arithmetic-error-operands
+- package-error package-error-package
+- division-by-zero floating-point-overflow floating-point-underflow
+-
+-))
++ &allow-other-keys *print-miser-width*
++ &aux *print-pprint-dispatch*
++ &body *print-pretty*
++ &environment *print-radix*
++ &key *print-readably*
++ &optional *print-right-margin*
++ &rest *query-io*
++ &whole *random-state*
++ * *read-base*
++ ** *read-default-float-format*
++ *** *read-eval*
++ *break-on-signals* *read-suppress*
++ *compile-file-pathname* *readtable*
++ *compile-file-truename* *standard-input*
++ *compile-print* *standard-output*
++ *compile-verbose* *terminal-io*
++ *debug-io* *trace-output*
++ *debugger-hook* +
++ *default-pathname-defaults* ++
++ *error-output* +++
++ *features* -
++ *gensym-counter* /
++ *load-pathname* //
++ *load-print* ///
++ *load-truename* /=
++ *load-verbose* 1+
++ *macroexpand-hook* 1-
++ *modules* <
++ *package* <=
++ *print-array* =
++ *print-base* >
++ *print-case* >=
++ *print-circle* abort
++ *print-escape* abs
++ *print-gensym* acons
++ *print-length* acos
++ *print-level* acosh
++ *print-lines* add-method
++
++ adjoin atom boundp
++ adjust-array base-char break
++ adjustable-array-p base-string broadcast-stream
++ allocate-instance bignum broadcast-stream-streams
++ alpha-char-p bit built-in-class
++ alphanumericp bit-and butlast
++ and bit-andc1 byte
++ append bit-andc2 byte-position
++ apply bit-eqv byte-size
++ apropos bit-ior caaaar
++ apropos-list bit-nand caaadr
++ aref bit-nor caaar
++ arithmetic-error bit-not caadar
++ arithmetic-error-operands bit-orc1 caaddr
++ arithmetic-error-operation bit-orc2 caadr
++ array bit-vector caar
++ array-dimension bit-vector-p cadaar
++ array-dimension-limit bit-xor cadadr
++ array-dimensions block cadar
++ array-displacement boole caddar
++ array-element-type boole-1 cadddr
++ array-has-fill-pointer-p boole-2 caddr
++ array-in-bounds-p boole-and cadr
++ array-rank boole-andc1 call-arguments-limit
++ array-rank-limit boole-andc2 call-method
++ array-row-major-index boole-c1 call-next-method
++ array-total-size boole-c2 car
++ array-total-size-limit boole-clr case
++ arrayp boole-eqv catch
++ ash boole-ior ccase
++ asin boole-nand cdaaar
++ asinh boole-nor cdaadr
++ assert boole-orc1 cdaar
++ assoc boole-orc2 cdadar
++ assoc-if boole-set cdaddr
++ assoc-if-not boole-xor cdadr
++ atan boolean cdar
++ atanh both-case-p cddaar
++
++ cddadr clear-input copy-tree
++ cddar clear-output cos
++ cdddar close cosh
++ cddddr clrhash count
++ cdddr code-char count-if
++ cddr coerce count-if-not
++ cdr compilation-speed ctypecase
++ ceiling compile debug
++ cell-error compile-file decf
++ cell-error-name compile-file-pathname declaim
++ cerror compiled-function declaration
++ change-class compiled-function-p declare
++ char compiler-macro decode-float
++ char-code compiler-macro-function decode-universal-time
++ char-code-limit complement defclass
++ char-downcase complex defconstant
++ char-equal complexp defgeneric
++ char-greaterp compute-applicable-methods define-compiler-macro
++ char-int compute-restarts define-condition
++ char-lessp concatenate define-method-combination
++ char-name concatenated-stream define-modify-macro
++ char-not-equal concatenated-stream-streams define-setf-expander
++ char-not-greaterp cond define-symbol-macro
++ char-not-lessp condition defmacro
++ char-upcase conjugate defmethod
++ char/= cons defpackage
++ char< consp defparameter
++ char<= constantly defsetf
++ char= constantp defstruct
++ char> continue deftype
++ char>= control-error defun
++ character copy-alist defvar
++ characterp copy-list delete
++ check-type copy-pprint-dispatch delete-duplicates
++ cis copy-readtable delete-file
++ class copy-seq delete-if
++ class-name copy-structure delete-if-not
++ class-of copy-symbol delete-package
++
++ denominator eq
++ deposit-field eql
++ describe equal
++ describe-object equalp
++ destructuring-bind error
++ digit-char etypecase
++ digit-char-p eval
++ directory eval-when
++ directory-namestring evenp
++ disassemble every
++ division-by-zero exp
++ do export
++ do* expt
++ do-all-symbols extended-char
++ do-external-symbols fboundp
++ do-symbols fceiling
++ documentation fdefinition
++ dolist ffloor
++ dotimes fifth
++ double-float file-author
++ double-float-epsilon file-error
++ double-float-negative-epsilon file-error-pathname
++ dpb file-length
++ dribble file-namestring
++ dynamic-extent file-position
++ ecase file-stream
++ echo-stream file-string-length
++ echo-stream-input-stream file-write-date
++ echo-stream-output-stream fill
++ ed fill-pointer
++ eighth find
++ elt find-all-symbols
++ encode-universal-time find-class
++ end-of-file find-if
++ endp find-if-not
++ enough-namestring find-method
++ ensure-directories-exist find-package
++ ensure-generic-function find-restart
++
++ find-symbol get-internal-run-time
++ finish-output get-macro-character
++ first get-output-stream-string
++ fixnum get-properties
++ flet get-setf-expansion
++ float get-universal-time
++ float-digits getf
++ float-precision gethash
++ float-radix go
++ float-sign graphic-char-p
++ floating-point-inexact handler-bind
++ floating-point-invalid-operation handler-case
++ floating-point-overflow hash-table
++ floating-point-underflow hash-table-count
++ floatp hash-table-p
++ floor hash-table-rehash-size
++ fmakunbound hash-table-rehash-threshold
++ force-output hash-table-size
++ format hash-table-test
++ formatter host-namestring
++ fourth identity
++ fresh-line if
++ fround ignorable
++ ftruncate ignore
++ ftype ignore-errors
++ funcall imagpart
++ function import
++ function-keywords in-package
++ function-lambda-expression incf
++ functionp initialize-instance
++ gcd inline
++ generic-function input-stream-p
++ gensym inspect
++ gentemp integer
++ get integer-decode-float
++ get-decoded-time integer-length
++ get-dispatch-macro-character integerp
++ get-internal-real-time interactive-stream-p
++
++ intern lisp-implementation-type
++ internal-time-units-per-second lisp-implementation-version
++ intersection list
++ invalid-method-error list*
++ invoke-debugger list-all-packages
++ invoke-restart list-length
++ invoke-restart-interactively listen
++ isqrt listp
++ keyword load
++ keywordp load-logical-pathname-translations
++ labels load-time-value
++ lambda locally
++ lambda-list-keywords log
++ lambda-parameters-limit logand
++ last logandc1
++ lcm logandc2
++ ldb logbitp
++ ldb-test logcount
++ ldiff logeqv
++ least-negative-double-float logical-pathname
++ least-negative-long-float logical-pathname-translations
++ least-negative-normalized-double-float logior
++ least-negative-normalized-long-float lognand
++ least-negative-normalized-short-float lognor
++ least-negative-normalized-single-float lognot
++ least-negative-short-float logorc1
++ least-negative-single-float logorc2
++ least-positive-double-float logtest
++ least-positive-long-float logxor
++ least-positive-normalized-double-float long-float
++ least-positive-normalized-long-float long-float-epsilon
++ least-positive-normalized-short-float long-float-negative-epsilon
++ least-positive-normalized-single-float long-site-name
++ least-positive-short-float loop
++ least-positive-single-float loop-finish
++ length lower-case-p
++ let machine-instance
++ let* machine-type
++
++ machine-version mask-field
++ macro-function max
++ macroexpand member
++ macroexpand-1 member-if
++ macrolet member-if-not
++ make-array merge
++ make-broadcast-stream merge-pathnames
++ make-concatenated-stream method
++ make-condition method-combination
++ make-dispatch-macro-character method-combination-error
++ make-echo-stream method-qualifiers
++ make-hash-table min
++ make-instance minusp
++ make-instances-obsolete mismatch
++ make-list mod
++ make-load-form most-negative-double-float
++ make-load-form-saving-slots most-negative-fixnum
++ make-method most-negative-long-float
++ make-package most-negative-short-float
++ make-pathname most-negative-single-float
++ make-random-state most-positive-double-float
++ make-sequence most-positive-fixnum
++ make-string most-positive-long-float
++ make-string-input-stream most-positive-short-float
++ make-string-output-stream most-positive-single-float
++ make-symbol muffle-warning
++ make-synonym-stream multiple-value-bind
++ make-two-way-stream multiple-value-call
++ makunbound multiple-value-list
++ map multiple-value-prog1
++ map-into multiple-value-setq
++ mapc multiple-values-limit
++ mapcan name-char
++ mapcar namestring
++ mapcon nbutlast
++ maphash nconc
++ mapl next-method-p
++ maplist nil
++
++ nintersection package-error
++ ninth package-error-package
++ no-applicable-method package-name
++ no-next-method package-nicknames
++ not package-shadowing-symbols
++ notany package-use-list
++ notevery package-used-by-list
++ notinline packagep
++ nreconc pairlis
++ nreverse parse-error
++ nset-difference parse-integer
++ nset-exclusive-or parse-namestring
++ nstring-capitalize pathname
++ nstring-downcase pathname-device
++ nstring-upcase pathname-directory
++ nsublis pathname-host
++ nsubst pathname-match-p
++ nsubst-if pathname-name
++ nsubst-if-not pathname-type
++ nsubstitute pathname-version
++ nsubstitute-if pathnamep
++ nsubstitute-if-not peek-char
++ nth phase
++ nth-value pi
++ nthcdr plusp
++ null pop
++ number position
++ numberp position-if
++ numerator position-if-not
++ nunion pprint
++ oddp pprint-dispatch
++ open pprint-exit-if-list-exhausted
++ open-stream-p pprint-fill
++ optimize pprint-indent
++ or pprint-linear
++ otherwise pprint-logical-block
++ output-stream-p pprint-newline
++ package pprint-pop
++
++ pprint-tab read-char
++ pprint-tabular read-char-no-hang
++ prin1 read-delimited-list
++ prin1-to-string read-from-string
++ princ read-line
++ princ-to-string read-preserving-whitespace
++ print read-sequence
++ print-not-readable reader-error
++ print-not-readable-object readtable
++ print-object readtable-case
++ print-unreadable-object readtablep
++ probe-file real
++ proclaim realp
++ prog realpart
++ prog* reduce
++ prog1 reinitialize-instance
++ prog2 rem
++ progn remf
++ program-error remhash
++ progv remove
++ provide remove-duplicates
++ psetf remove-if
++ psetq remove-if-not
++ push remove-method
++ pushnew remprop
++ quote rename-file
++ random rename-package
++ random-state replace
++ random-state-p require
++ rassoc rest
++ rassoc-if restart
++ rassoc-if-not restart-bind
++ ratio restart-case
++ rational restart-name
++ rationalize return
++ rationalp return-from
++ read revappend
++ read-byte reverse
++
++ room simple-bit-vector
++ rotatef simple-bit-vector-p
++ round simple-condition
++ row-major-aref simple-condition-format-arguments
++ rplaca simple-condition-format-control
++ rplacd simple-error
++ safety simple-string
++ satisfies simple-string-p
++ sbit simple-type-error
++ scale-float simple-vector
++ schar simple-vector-p
++ search simple-warning
++ second sin
++ sequence single-float
++ serious-condition single-float-epsilon
++ set single-float-negative-epsilon
++ set-difference sinh
++ set-dispatch-macro-character sixth
++ set-exclusive-or sleep
++ set-macro-character slot-boundp
++ set-pprint-dispatch slot-exists-p
++ set-syntax-from-char slot-makunbound
++ setf slot-missing
++ setq slot-unbound
++ seventh slot-value
++ shadow software-type
++ shadowing-import software-version
++ shared-initialize some
++ shiftf sort
++ short-float space
++ short-float-epsilon special
++ short-float-negative-epsilon special-operator-p
++ short-site-name speed
++ signal sqrt
++ signed-byte stable-sort
++ signum standard
++ simple-array standard-char
++ simple-base-string standard-char-p
++
++ standard-class sublis
++ standard-generic-function subseq
++ standard-method subsetp
++ standard-object subst
++ step subst-if
++ storage-condition subst-if-not
++ store-value substitute
++ stream substitute-if
++ stream-element-type substitute-if-not
++ stream-error subtypep
++ stream-error-stream svref
++ stream-external-format sxhash
++ streamp symbol
++ string symbol-function
++ string-capitalize symbol-macrolet
++ string-downcase symbol-name
++ string-equal symbol-package
++ string-greaterp symbol-plist
++ string-left-trim symbol-value
++ string-lessp symbolp
++ string-not-equal synonym-stream
++ string-not-greaterp synonym-stream-symbol
++ string-not-lessp t
++ string-right-trim tagbody
++ string-stream tailp
++ string-trim tan
++ string-upcase tanh
++ string/= tenth
++ string< terpri
++ string<= the
++ string= third
++ string> throw
++ string>= time
++ stringp trace
++ structure translate-logical-pathname
++ structure-class translate-pathname
++ structure-object tree-equal
++ style-warning truename
++
++ truncate values-list
++ two-way-stream variable
++ two-way-stream-input-stream vector
++ two-way-stream-output-stream vector-pop
++ type vector-push
++ type-error vector-push-extend
++ type-error-datum vectorp
++ type-error-expected-type warn
++ type-of warning
++ typecase when
++ typep wild-pathname-p
++ unbound-slot with-accessors
++ unbound-slot-instance with-compilation-unit
++ unbound-variable with-condition-restarts
++ undefined-function with-hash-table-iterator
++ unexport with-input-from-string
++ unintern with-open-file
++ union with-open-stream
++ unless with-output-to-string
++ unread-char with-package-iterator
++ unsigned-byte with-simple-restart
++ untrace with-slots
++ unuse-package with-standard-io-syntax
++ unwind-protect write
++ update-instance-for-different-class write-byte
++ update-instance-for-redefined-class write-char
++ upgraded-array-element-type write-line
++ upgraded-complex-part-type write-sequence
++ upper-case-p write-string
++ use-package write-to-string
++ use-value y-or-n-p
++ user-homedir-pathname yes-or-no-p
++ values zerop))
+--- gcl-2.6.12.orig/lsp/gcl_fpe.lsp
++++ gcl-2.6.12/lsp/gcl_fpe.lsp
+@@ -1,8 +1,8 @@
+-(in-package :fpe :use '(:lisp))
++(in-package :fpe)
+
+ (import 'si::(disassemble-instruction feenableexcept fedisableexcept fld *fixnum *float *double
+ +fe-list+ +mc-context-offsets+ floating-point-error
+- function-by-address))
++ function-by-address clines defentry))
+ (export '(break-on-floating-point-exceptions read-instruction))
+
+ (eval-when
+--- gcl-2.6.12.orig/lsp/gcl_info.lsp
++++ gcl-2.6.12/lsp/gcl_info.lsp
+@@ -1,4 +1,4 @@
+-(in-package "SI" )
++(in-package :si)
+
+ (eval-when (compile eval)
+ (defmacro while (test &body body)
+@@ -11,7 +11,7 @@
+ (eval-when (compile eval load)
+ (defun sharp-u-reader (stream subchar arg)
+ subchar arg
+- (let ((tem (make-array 10 :element-type 'string-char :fill-pointer 0)))
++ (let ((tem (make-array 10 :element-type 'character :fill-pointer 0)))
+ (or (eql (read-char stream) #\")
+ (error "sharp-u-reader reader needs a \" right after it"))
+ (loop
+@@ -44,7 +44,7 @@
+ (or (and (<= 0 start ) (<= start len))
+ (error "illegal file start ~a" start))
+ (let ((tem (make-array (- len start)
+- :element-type 'string-char)))
++ :element-type 'character)))
+ (if (> start 0) (file-position st start))
+ (si::fread tem 0 (length tem) st) tem)))
+
+@@ -105,7 +105,7 @@
+ ((> extra 0)
+ (setq tem
+ (make-array (f + (length x) extra)
+- :element-type 'string-char :fill-pointer 0))
++ :element-type 'character :fill-pointer 0))
+ (setq i 0)
+ (go AGAIN))
+ (t (setq tem x)))
+--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp
++++ gcl-2.6.12/lsp/gcl_iolib.lsp
+@@ -22,21 +22,7 @@
+ ;;;; The IO library.
+
+
+-(in-package 'lisp)
+-
+-
+-(export '(with-open-stream with-input-from-string with-output-to-string
+- ensure-directories-exist wild-pathname-p
+- read-byte write-byte read-sequence write-sequence))
+-(export '(read-from-string))
+-(export '(write-to-string prin1-to-string princ-to-string))
+-(export 'with-open-file)
+-(export '(y-or-n-p yes-or-no-p))
+-(export 'dribble)
+-
+-
+-(in-package 'system)
+-
++(in-package :si)
+
+ (proclaim '(optimize (safety 2) (space 3)))
+
+--- gcl-2.6.12.orig/lsp/gcl_listlib.lsp
++++ gcl-2.6.12/lsp/gcl_listlib.lsp
+@@ -25,13 +25,7 @@
+ ; rather than recursion, as needed for large data sets.
+
+
+-(in-package 'lisp)
+-
+-(export '(union nunion intersection nintersection
+- set-difference nset-difference set-exclusive-or nset-exclusive-or
+- subsetp nth nth-value nthcdr first second third fourth fifth sixth seventh eighth ninth tenth))
+-
+-(in-package 'system)
++(in-package :si)
+
+ (eval-when (compile)
+ (proclaim '(optimize (safety 0) (space 3)))
+--- gcl-2.6.12.orig/lsp/gcl_mislib.lsp
++++ gcl-2.6.12/lsp/gcl_mislib.lsp
+@@ -20,15 +20,7 @@
+ ;;;; This file is IMPLEMENTATION-DEPENDENT.
+
+
+-(in-package 'lisp)
+-
+-
+-(export 'time)
+-(export '(reset-sys-paths decode-universal-time encode-universal-time compile-file-pathname complement constantly))
+-
+-
+-(in-package 'system)
+-
++(in-package :si)
+
+ (proclaim '(optimize (safety 2) (space 3)))
+
+@@ -37,13 +29,13 @@
+ (let ((real-start (gensym)) (real-end (gensym)) (gbc-time-start (gensym))
+ (gbc-time (gensym)) (x (gensym)) (run-start (gensym)) (run-end (gensym))
+ (child-run-start (gensym)) (child-run-end (gensym)))
+- `(let (,real-start ,real-end (,gbc-time-start (si::gbc-time)) ,gbc-time ,x)
++ `(let (,real-start ,real-end (,gbc-time-start (gbc-time)) ,gbc-time ,x)
+ (setq ,real-start (get-internal-real-time))
+ (multiple-value-bind (,run-start ,child-run-start) (get-internal-run-time)
+- (si::gbc-time 0)
++ (gbc-time 0)
+ (setq ,x (multiple-value-list ,form))
+- (setq ,gbc-time (si::gbc-time))
+- (si::gbc-time (+ ,gbc-time-start ,gbc-time))
++ (setq ,gbc-time (gbc-time))
++ (gbc-time (+ ,gbc-time-start ,gbc-time))
+ (multiple-value-bind (,run-end ,child-run-end) (get-internal-run-time)
+ (setq ,real-end (get-internal-real-time))
+ (fresh-line *trace-output*)
+@@ -139,7 +131,7 @@ x))
+ *gcl-major-version* *gcl-minor-version* *gcl-extra-version*
+ (if (member :ansi-cl *features*) "ANSI" "CLtL1")
+ (if (member :gprof *features*) "profiling" "")
+- (si::gcl-compile-time)
++ (gcl-compile-time)
+ "Source License: LGPL(gcl,gmp), GPL(unexec,bfd,xgcl)"
+ "Binary License: "
+ (if gpled-modules (format nil "GPL due to GPL'ed components: ~a" gpled-modules)
+@@ -150,13 +142,13 @@ x))
+
+ (defun lisp-implementation-version nil
+ (format nil "GCL ~a.~a.~a"
+- si::*gcl-major-version*
+- si::*gcl-minor-version*
+- si::*gcl-extra-version*))
++ *gcl-major-version*
++ *gcl-minor-version*
++ *gcl-extra-version*))
+
+ (defun objlt (x y)
+ (declare (object x y))
+- (let ((x (si::address x)) (y (si::address y)))
++ (let ((x (address x)) (y (address y)))
+ (declare (fixnum x y))
+ (if (< y 0)
+ (if (< x 0) (< x y) t)
+@@ -164,10 +156,10 @@ x))
+
+ (defun reset-sys-paths (s)
+ (declare (string s))
+- (setq si::*lib-directory* s)
+- (setq si::*system-directory* (si::string-concatenate s "unixport/"))
++ (setq *lib-directory* s)
++ (setq *system-directory* (string-concatenate s "unixport/"))
+ (let (nl)
+ (dolist (l '("cmpnew/" "gcl-tk/" "lsp/" "xgcl-2/"))
+- (push (si::string-concatenate s l) nl))
+- (setq si::*load-path* nl))
++ (push (string-concatenate s l) nl))
++ (setq *load-path* nl))
+ nil)
+--- gcl-2.6.12.orig/lsp/gcl_module.lsp
++++ gcl-2.6.12/lsp/gcl_module.lsp
+@@ -22,13 +22,7 @@
+ ;;;; module routines
+
+
+-(in-package 'lisp)
+-
+-(export '(*modules* provide require))
+-(export 'documentation)
+-(export '(variable function structure type setf))
+-
+-(in-package 'system)
++(in-package :si)
+
+
+ (eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+--- gcl-2.6.12.orig/lsp/gcl_numlib.lsp
++++ gcl-2.6.12/lsp/gcl_numlib.lsp
+@@ -22,20 +22,7 @@
+ ;;;; number routines
+
+
+-(in-package 'lisp)
+-(export
+- '(isqrt abs phase signum cis asin acos sinh cosh tanh
+- asinh acosh atanh
+- rational rationalize
+- ffloor fround ftruncate fceiling
+- lognand lognor logandc1 logandc2 logorc1 logorc2
+- lognot logtest
+- byte byte-size byte-position
+- ldb ldb-test mask-field dpb deposit-field
+- ))
+-
+-
+-(in-package 'system)
++(in-package :si)
+
+
+ (proclaim '(optimize (safety 2) (space 3)))
+--- gcl-2.6.12.orig/lsp/gcl_packlib.lsp
++++ gcl-2.6.12/lsp/gcl_packlib.lsp
+@@ -22,14 +22,7 @@
+ ;;;; package routines
+
+
+-(in-package 'lisp)
+-
+-
+-(export '(find-all-symbols do-symbols do-external-symbols do-all-symbols with-package-iterator))
+-(export '(apropos apropos-list))
+-
+-
+-(in-package 'system)
++(in-package :si)
+
+
+ (proclaim '(optimize (safety 2) (space 3)))
+@@ -121,7 +114,7 @@
+ (defun print-symbol-apropos (symbol)
+ (prin1 symbol)
+ (when (fboundp symbol)
+- (if (special-form-p symbol)
++ (if (special-operator-p symbol)
+ (princ " Special form")
+ (if (macro-function symbol)
+ (princ " Macro")
+--- gcl-2.6.12.orig/lsp/gcl_predlib.lsp
++++ gcl-2.6.12/lsp/gcl_predlib.lsp
+@@ -22,9 +22,7 @@
+ ;;;; predicate routines
+
+
+-(in-package 'system)
+-
+-(export '(lisp::deftype lisp::typep lisp::subtypep lisp::coerce) 'lisp)
++(in-package :si)
+
+ (eval-when (compile)
+ (proclaim '(optimize (safety 2) (space 3)))
+@@ -87,7 +85,7 @@
+ (deftype vector (&optional element-type size)
+ `(array ,element-type (,size)))
+ (deftype string (&optional size)
+- `(vector string-char ,size))
++ `(vector character ,size))
+ (deftype base-string (&optional size)
+ `(vector base-char ,size))
+ (deftype bit-vector (&optional size)
+@@ -96,7 +94,7 @@
+ (deftype simple-vector (&optional size)
+ `(simple-array t (,size)))
+ (deftype simple-string (&optional size)
+- `(simple-array string-char (,size)))
++ `(simple-array character (,size)))
+ (deftype simple-base-string (&optional size)
+ `(simple-array base-char (,size)))
+ (deftype simple-bit-vector (&optional size)
+@@ -206,8 +204,8 @@
+ (ratio (eq (type-of object) 'ratio))
+ (standard-char
+ (and (characterp object) (standard-char-p object)))
+- ((base-char string-char)
+- (and (characterp object) (string-char-p object)))
++ ((base-char character)
++ (characterp object))
+ (integer
+ (and (integerp object) (in-interval-p object i)))
+ (rational
+@@ -309,7 +307,7 @@
+ signed-char unsigned-char signed-short unsigned-short
+ number integer bignum rational ratio float method-combination
+ short-float single-float double-float long-float complex
+- character standard-char string-char real
++ character standard-char character real
+ package stream pathname readtable hash-table random-state
+ structure array simple-array function compiled-function
+ arithmetic-error base-char base-string broadcast-stream
+@@ -583,23 +581,23 @@
+ (if (sub-interval-p '(* *) i2) (values t t) (values nil t)))
+ (t (values nil ntp2))))
+ (standard-char
+- (if (member t2 '(base-char string-char character))
++ (if (member t2 '(base-char character character))
+ (values t t)
+ (values nil ntp2)))
+ (base-char
+- (if (member t2 '(character string-char))
++ (if (member t2 '(character character))
+ (values t t)
+ (values nil ntp2)))
+ (extended-char
+- (if (member t2 '(character string-char))
++ (if (member t2 '(character character))
+ (values t t)
+ (values nil ntp2)))
+- (string-char
++ (character
+ (if (eq t2 'character)
+ (values t t)
+ (values nil ntp2)))
+ (character
+- (if (eq t2 'string-char)
++ (if (eq t2 'character)
+ (values t t)
+ (values nil ntp2)))
+ (integer
+@@ -635,7 +633,7 @@
+ (unless (or (equal (car i1) (car i2))
+ ; FIXME
+ (and (eq (car i1) 'base-char)
+- (eq (car i2) 'string-char)))
++ (eq (car i2) 'character)))
+ ;; Unless the element type matches,
+ ;; return NIL T.
+ ;; Is this too strict?
+@@ -658,7 +656,7 @@
+ (unless (or (equal (car i1) (car i2))
+ ; FIXME
+ (and (eq (car i1) 'base-char)
+- (eq (car i2) 'string-char)))
++ (eq (car i2) 'character)))
+ (return-from subtypep
+ (values nil t)))))
+ (when (or (endp (cdr i1)) (eq (cadr i1) '*))
+--- gcl-2.6.12.orig/lsp/gcl_profile.lsp
++++ gcl-2.6.12/lsp/gcl_profile.lsp
+@@ -1,5 +1,5 @@
+
+-(in-package 'si)
++(in-package :si)
+ (use-package "SLOOP")
+
+ ;; Sample Usage:
+--- gcl-2.6.12.orig/lsp/gcl_seq.lsp
++++ gcl-2.6.12/lsp/gcl_seq.lsp
+@@ -22,11 +22,7 @@
+ ;;;; sequence routines
+
+
+-(in-package 'lisp)
+-
+-(export '(make-sequence concatenate map some every notany notevery))
+-
+-(in-package 'system)
++(in-package :si)
+
+
+ (proclaim '(optimize (safety 2) (space 3)))
+@@ -40,7 +36,7 @@
+ (if iesp
+ (make-list size :initial-element initial-element)
+ (make-list size))))
+- ((or (eq type 'simple-string) (eq type 'string)) 'string-char)
++ ((or (eq type 'simple-string) (eq type 'string)) 'character)
+ ((or (eq type 'simple-bit-vector) (eq type 'bit-vector)) 'bit)
+ ((or (eq type 'simple-vector) (eq type 'vector)) t)
+ (t
+--- gcl-2.6.12.orig/lsp/gcl_seqlib.lsp
++++ gcl-2.6.12/lsp/gcl_seqlib.lsp
+@@ -22,24 +22,7 @@
+ ;;;; sequence routines
+
+
+-(in-package 'lisp)
+-
+-
+-(export '(reduce fill replace
+- remove remove-if remove-if-not
+- delete delete-if delete-if-not
+- count count-if count-if-not
+- substitute substitute-if substitute-if-not
+- nsubstitute nsubstitute-if nsubstitute-if-not
+- find find-if find-if-not
+- position position-if position-if-not
+- remove-duplicates delete-duplicates
+- mismatch search
+- with-hash-table-iterator
+- sort stable-sort merge map-into))
+-
+-
+-(in-package 'system)
++(in-package :si)
+
+
+ (proclaim '(optimize (safety 2) (space 3)))
+--- gcl-2.6.12.orig/lsp/gcl_serror.lsp
++++ gcl-2.6.12/lsp/gcl_serror.lsp
+@@ -100,6 +100,8 @@
+ args))))
+ ("unknown error")))
+
++(defvar *break-on-warnings* nil)
++
+ (defun warn (datum &rest arguments)
+ (declare (optimize (safety 2)))
+ (let ((c (process-error datum arguments 'simple-warning)))
+--- gcl-2.6.12.orig/lsp/gcl_setf.lsp
++++ gcl-2.6.12/lsp/gcl_setf.lsp
+@@ -22,16 +22,7 @@
+ ;;;; setf routines
+
+
+-(in-package 'lisp)
+-
+-
+-(export '(setf psetf shiftf rotatef
+- define-modify-macro defsetf
+- getf remf incf decf push pushnew pop
+- define-setf-method get-setf-method get-setf-method-multiple-value))
+-
+-
+-(in-package 'system)
++(in-package :si)
+
+
+ (eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
+@@ -86,10 +77,10 @@
+ ',access-fn))
+
+
+-;;; GET-SETF-METHOD.
++;;; GET-SETF-EXPANSION.
+ ;;; It just calls GET-SETF-METHOD-MULTIPLE-VALUE
+ ;;; and checks the number of the store variable.
+-(defun get-setf-method (form &optional env)
++(defun get-setf-expansion (form &optional env)
+ (multiple-value-bind (vars vals stores store-form access-form)
+ (get-setf-method-multiple-value form env)
+ (unless (= (list-length stores) 1)
+@@ -218,7 +209,7 @@
+
+ (define-setf-method getf (&environment env place indicator &optional default)
+ (multiple-value-bind (vars vals stores store-form access-form)
+- (get-setf-method place env)
++ (get-setf-expansion place env)
+ (let ((itemp (gensym)) (store (gensym)))
+ (values `(,@vars ,itemp)
+ `(,@vals ,indicator)
+@@ -234,7 +225,7 @@
+
+ (define-setf-method the (&environment env type form)
+ (multiple-value-bind (vars vals stores store-form access-form)
+- (get-setf-method form env)
++ (get-setf-expansion form env)
+ (let ((store (gensym)))
+ (values vars vals (list store)
+ `(let ((,(car stores) (the ,type ,store))) ,store-form)
+@@ -246,7 +237,7 @@
+ (null (cddr fn)))
+ (error "Can't get the setf-method of ~S." fn))
+ (multiple-value-bind (vars vals stores store-form access-form)
+- (get-setf-method (cons (cadr fn) rest) env)
++ (get-setf-expansion (cons (cadr fn) rest) env)
+ (unless (eq (car (last store-form)) (car (last vars)))
+ (error "Can't get the setf-method of ~S." fn))
+ (values vars vals stores
+@@ -261,7 +252,7 @@
+ (null (cddr fn)))
+ (error "Can't get the setf-method of ~S." fn))
+ (multiple-value-bind (vars vals stores store-form access-form)
+- (get-setf-method (cons (cadr fn) rest) env)
++ (get-setf-expansion (cons (cadr fn) rest) env)
+ (cond ((eq (car (last store-form)) (car (last vars)))
+ (values vars vals stores
+ `(apply #',(car store-form) ,@(cdr store-form))
+@@ -277,7 +268,7 @@
+
+ (define-setf-method char-bit (&environment env char name)
+ (multiple-value-bind (temps vals stores store-form access-form)
+- (get-setf-method char env)
++ (get-setf-expansion char env)
+ (let ((ntemp (gensym))
+ (store (gensym))
+ (stemp (first stores)))
+@@ -290,7 +281,7 @@
+
+ (define-setf-method ldb (&environment env bytespec int)
+ (multiple-value-bind (temps vals stores store-form access-form)
+- (get-setf-method int env)
++ (get-setf-expansion int env)
+ (let ((btemp (gensym))
+ (store (gensym))
+ (stemp (first stores)))
+@@ -303,7 +294,7 @@
+
+ (define-setf-method mask-field (&environment env bytespec int)
+ (multiple-value-bind (temps vals stores store-form access-form)
+- (get-setf-method int env)
++ (get-setf-expansion int env)
+ (let ((btemp (gensym))
+ (store (gensym))
+ (stemp (first stores)))
+@@ -346,7 +337,7 @@
+ (setf-structure-access (cadr place) (car g) (cdr g) newvalue))))
+
+ (multiple-value-bind (vars vals stores store-form access-form)
+- (get-setf-method place env)
++ (get-setf-expansion place env)
+ (declare (ignore access-form))
+ `(let* ,(mapcar #'list
+ (append vars stores)
+@@ -397,7 +388,7 @@
+ nil))
+ (when (endp (cdr r)) (error "~S is an illegal PSETF form." rest))
+ (multiple-value-bind (vars vals stores store-form access-form)
+- (get-setf-method (car r) env)
++ (get-setf-expansion (car r) env)
+ (declare (ignore access-form))
+ (setq store-forms (cons store-form store-forms))
+ (setq pairs
+@@ -426,7 +417,7 @@
+ ,@store-forms
+ ,g))
+ (multiple-value-bind (vars vals stores1 store-form access-form)
+- (get-setf-method (car r) env)
++ (get-setf-expansion (car r) env)
+ (setq pairs (nconc pairs (mapcar #'list vars vals)))
+ (setq stores (cons (car stores1) stores))
+ (setq store-forms (cons store-form store-forms))
+@@ -451,7 +442,7 @@
+ nil
+ ))
+ (multiple-value-bind (vars vals stores1 store-form access-form)
+- (get-setf-method (car r) env)
++ (get-setf-expansion (car r) env)
+ (setq pairs (nconc pairs (mapcar #'list vars vals)))
+ (setq stores (cons (car stores1) stores))
+ (setq store-forms (cons store-form store-forms))
+@@ -480,7 +471,7 @@
+ (let ((access-form reference))
+ (list 'setq reference ,update-form))))
+ (multiple-value-bind (vars vals stores store-form access-form)
+- (get-setf-method reference env)
++ (get-setf-expansion reference env)
+ (list 'let*
+ (mapcar #'list
+ (append vars stores)
+@@ -492,7 +483,7 @@
+
+ (defmacro remf (&environment env place indicator)
+ (multiple-value-bind (vars vals stores store-form access-form)
+- (get-setf-method place env)
++ (get-setf-expansion place env)
+ `(let* ,(mapcar #'list vars vals)
+ (multiple-value-bind (,(car stores) flag)
+ (si:rem-f ,access-form ,indicator)
+@@ -508,7 +499,7 @@
+ (return-from push `(let* ((,myitem ,item))
+ (setq ,place (cons ,myitem ,place)))))
+ (multiple-value-bind (vars vals stores store-form access-form)
+- (get-setf-method place env)
++ (get-setf-expansion place env)
+ `(let* ,(mapcar #'list
+ (append (list myitem) vars stores)
+ (append (list item) vals (list (list 'cons myitem access-form))))
+@@ -520,7 +511,7 @@
+ (return-from pushnew `(let* ((,myitem ,item))
+ (setq ,place (adjoin ,myitem ,place ,@rest))))))
+ (multiple-value-bind (vars vals stores store-form access-form)
+- (get-setf-method place env)
++ (get-setf-expansion place env)
+ `(let* ,(mapcar #'list
+ (append (list myitem) vars stores)
+ (append (list item) vals
+@@ -535,7 +526,7 @@
+ (setq ,place (cdr ,place))
+ ,temp))))
+ (multiple-value-bind (vars vals stores store-form access-form)
+- (get-setf-method place env)
++ (get-setf-expansion place env)
+ `(let* ,(mapcar #'list
+ (append vars stores)
+ (append vals (list (list 'cdr access-form))))
+--- gcl-2.6.12.orig/lsp/gcl_sloop.lsp
++++ gcl-2.6.12/lsp/gcl_sloop.lsp
+@@ -71,7 +71,7 @@
+ ;;; some other package.
+
+
+-(in-package "SLOOP" :use '(LISP))
++(in-package "SLOOP" :use '(:LISP))
+ (eval-when (compile eval load)
+
+ (export '(loop-return sloop def-loop-collect def-loop-map
+--- gcl-2.6.12.orig/lsp/gcl_stack-problem.lsp
++++ gcl-2.6.12/lsp/gcl_stack-problem.lsp
+@@ -1,4 +1,4 @@
+-(in-package 'si)
++(in-package :si)
+
+ (defvar *old-handler* #'si::universal-error-handler)
+
+--- gcl-2.6.12.orig/lsp/gcl_top.lsp
++++ gcl-2.6.12/lsp/gcl_top.lsp
+@@ -24,24 +24,14 @@
+ ;;;; Revised on July 11, by Carl Hoffman.
+
+
+-(in-package "LISP")
+-;(export 'lisp)
+-(export '(+ ++ +++ - * ** *** / // ///))
+-(export '(break warn))
+-(export '*break-on-warnings*)
+-(export '*break-enable*)
+-
+-(in-package 'system)
++(in-package :si)
+
+ (export '*break-readtable*)
+ (export '(loc *debug-print-level*))
+
+ (export '(vs ihs-vs ihs-fun frs-vs frs-bds frs-ihs bds-var bds-val super-go))
+
+-(eval-when
+- (compile)
+- (proclaim '(optimize (safety 2) (space 3)))
+- (defvar *command-args* nil))
++(defvar *command-args* nil)
+
+ (defvar +)
+ (defvar ++)
+@@ -75,8 +65,6 @@
+ (defvar *break-enable* t)
+ (defvar *break-message* "")
+
+-(defvar *break-on-warnings* nil)
+-
+ (defvar *break-readtable* nil)
+
+ (defvar *top-level-hook* nil)
+@@ -330,7 +318,7 @@
+ (lambda-block-closure (cddddr fun))
+ (t (cond
+ ((and (symbolp (car fun))
+- (or (special-form-p(car fun))
++ (or (special-operator-p(car fun))
+ (fboundp (car fun))))
+ (car fun))
+ (t '(:zombi))))))
+@@ -384,7 +372,7 @@
+ (lambda-block-closure (nth 4 fun))
+ (lambda-closure 'lambda-closure)
+ (t (if (and (symbolp (car fun))
+- (or (special-form-p (car fun))
++ (or (special-operator-p (car fun))
+ (fboundp (car fun))))
+ (car fun) :zombi)
+ )))
+--- gcl-2.6.12.orig/lsp/gcl_trace.lsp
++++ gcl-2.6.12/lsp/gcl_trace.lsp
+@@ -27,13 +27,7 @@
+ ;; If you are working in another package you should (import 'si::arglist)
+ ;; to avoid typing the si::
+
+-(in-package 'lisp)
+-
+-(export '(trace untrace))
+-(export 'step)
+-
+-
+-(in-package 'system)
++(in-package :si)
+
+ ;;(proclaim '(optimize (safety 2) (space 3)))
+
+@@ -169,7 +163,7 @@
+ (when (null (fboundp fname))
+ (format *trace-output* "The function ~S is not defined.~%" fname)
+ (return-from trace-one nil))
+- (when (special-form-p fname)
++ (when (special-operator-p fname)
+ (format *trace-output* "~S is a special form.~%" fname)
+ (return-from trace-one nil))
+ (when (macro-function fname)
+--- gcl-2.6.12.orig/lsp/sys-proclaim.lisp
++++ gcl-2.6.12/lsp/sys-proclaim.lisp
+@@ -1,294 +1,522 @@
+
+-(IN-PACKAGE "SYSTEM")
+-(MAPC (LAMBDA (COMPILER::X)
+- (SETF (GET COMPILER::X 'PROCLAIMED-CLOSURE) T))
+- '(SI-CLASS-PRECEDENCE-LIST BREAK-ON-FLOATING-POINT-EXCEPTIONS
+- SI-FIND-CLASS AUTOLOAD SI-CLASS-NAME TRACE-ONE SI-CLASSP
+- SIMPLE-CONDITION-CLASS-P CONDITIONP MAKE-ACCESS-FUNCTION
+- UNTRACE-ONE WARNINGP DEFINE-STRUCTURE CONDITION-CLASS-P
+- SI-CLASS-OF AUTOLOAD-MACRO))
+-(PROCLAIM '(FTYPE (FUNCTION (T) (VALUES T T)) LISP::MAKE-KEYWORD))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T) T) S-DATA-HAS-HOLES CONSTANTLY
+- COMPUTING-ARGS-P ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS
+- ANSI-LOOP::LOOP-COLLECTOR-NAME FIRST INSPECT-SYMBOL
+- CONTEXT-P ANSI-LOOP::LOOP-MAKE-PSETQ TENTH
+- COMPILER-MACRO-FUNCTION ANSI-LOOP::LOOP-COLLECTOR-DATA
+- ARRAY-DIMENSIONS ASINH FPE::XMM-LOOKUP KNOWN-TYPE-P
+- CONTEXT-VEC CONTEXT-HASH SHOW-ENVIRONMENT
+- CHECK-DECLARATIONS BKPT-FILE-LINE PROVIDE
+- ANSI-LOOP::LOOP-PATH-P DWIM RESTART-P FPE::LOOKUP ACOSH
+- PRINT-SYMBOL-APROPOS SIGNUM ANSI-LOOP::LOOP-UNIVERSE-ANSI
+- IHS-NOT-INTERPRETED-ENV BYTE-SIZE THIRD RESTART-FUNCTION
+- ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS DO-F
+- ANSI-LOOP::LOOP-EMIT-BODY COSH S-DATA-CONC-NAME
+- INSTREAM-STREAM-NAME PATCH-SHARP INSPECT-STRING
+- S-DATA-INCLUDES SHOW-BREAK-POINT FPE::GREF
+- FIND-KCL-TOP-RESTART RESTART-REPORT-FUNCTION S-DATA-NAMED
+- S-DATA-CONSTRUCTORS S-DATA-P SLOOP::PARSE-LOOP
+- INSPECT-STRUCTURE BKPT-FORM PHASE SETUP-INFO
+- ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS
+- RESET-TRACE-DECLARATIONS SLOOP::SLOOP-SLOOP-MACRO EIGHTH
+- SECOND SLOOP::TRANSLATE-NAME
+- ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE NINTH
+- ANSI-LOOP::LOOP-COLLECTOR-P MAKE-KCL-TOP-RESTART
+- SEARCH-STACK ANSI-LOOP::LOOP-COLLECTOR-DTYPE ACOS
+- ANSI-LOOP::LOOP-MAXMIN-COLLECTION MAKE-DEFPACKAGE-FORM
+- INSPECT-NUMBER SINH ANSI-LOOP::LOOP-HACK-ITERATION
+- INSTREAM-STREAM WALK-THROUGH PRINT-IHS SIXTH S-DATA-FROZEN
+- INSPECT-CHARACTER SLOOP::RETURN-SLOOP-MACRO
+- FREEZE-DEFSTRUCT NEXT-STACK-FRAME
+- SLOOP::LOOP-COLLECT-KEYWORD-P DM-BAD-KEY
+- COMPILE-FILE-PATHNAME SEVENTH
+- ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD
+- SLOOP::PARSE-LOOP-INITIALLY TERMINAL-INTERRUPT
+- ANSI-LOOP::LOOP-EMIT-FINAL-VALUE FRS-KIND CHECK-TRACE-SPEC
+- CONTEXT-SPICE ANSI-LOOP::DESTRUCTURING-SIZE
+- ANSI-LOOP::LOOP-MINIMAX-OPERATIONS INSPECT-VECTOR ATANH
+- ANSI-LOOP::LOOP-PATH-NAMES S-DATA-OFFSET
+- SLOOP::REPEAT-SLOOP-MACRO FIND-ALL-SYMBOLS
+- ANSI-LOOP::LOOP-PATH-FUNCTION REWRITE-RESTART-CASE-CLAUSE
+- ANSI-LOOP::LOOP-COLLECTOR-CLASS
+- RESTART-INTERACTIVE-FUNCTION DM-KEY-NOT-ALLOWED
+- INSPECT-PACKAGE S-DATA-PRINT-FUNCTION NODE-OFFSET
+- RESTART-NAME RATIONAL NORMALIZE-TYPE
+- SLOOP::SUBSTITUTE-SLOOP-BODY FIFTH INFO-GET-TAGS S-DATA-RAW
+- RE-QUOTE-STRING SHORT-NAME LOGNOT INSPECT-ARRAY
+- TRACE-ONE-PREPROCESS SIMPLE-ARRAY-P FIND-DOCUMENTATION
+- BKPT-FUNCTION ANSI-LOOP::LOOP-PATH-USER-DATA EVAL-FEATURE
+- ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA ABS S-DATA-STATICP
+- ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE INSERT-BREAK-POINT
+- S-DATA-DOCUMENTATION PRINT-FRS IHS-VISIBLE GET-INSTREAM
+- INFO-GET-FILE GET-NEXT-VISIBLE-FUN DBL-EVAL FOURTH
+- ANSI-LOOP::LOOP-COLLECTOR-HISTORY BYTE-POSITION
+- ANSI-LOOP::LOOP-TYPED-INIT ASIN
+- ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS FIX-LOAD-PATH BKPT-FILE
+- VECTOR-POP IDESCRIBE UNIQUE-ID
+- ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS
+- ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED
+- SLOOP::POINTER-FOR-COLLECT FPE::ST-LOOKUP
+- ANSI-LOOP::LOOP-CONSTANTP ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS
+- ADD-TO-HOTLIST ANSI-LOOP::LOOP-DO-THEREIS
+- ANSI-LOOP::LOOP-LIST-COLLECTION S-DATA-TYPE
+- SLOOP::LOOP-LET-BINDINGS
+- ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED
+- BREAK-FORWARD-SEARCH-STACK ISQRT S-DATA-SLOT-POSITION
+- BREAK-BACKWARD-SEARCH-STACK
+- ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE RESTART-TEST-FUNCTION
+- INVOKE-DEBUGGER SLOOP::PARSE-NO-BODY
+- ANSI-LOOP::LOOP-MAKE-DESETQ
+- ANSI-LOOP::LOOP-CONSTRUCT-RETURN COMPLEMENT
+- ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS TANH INSTREAM-P
+- NODES-FROM-INDEX ANSI-LOOP::LOOP-PSEUDO-BODY
+- S-DATA-INCLUDED ANSI-LOOP::LOOP-MINIMAX-TYPE
+- NUMBER-OF-DAYS-FROM-1900 INFO-NODE-FROM-POSITION
+- ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE
+- ANSI-LOOP::LOOP-MINIMAX-P BEST-ARRAY-ELEMENT-TYPE
+- S-DATA-NAME SLOOP::AVERAGING-SLOOP-MACRO
+- ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS CIS SEQTYPE
+- LEAP-YEAR-P GET-BYTE-STREAM-NCHARS IHS-FNAME
+- ANSI-LOOP::LOOP-UNIVERSE-P INSPECT-CONS
+- S-DATA-SLOT-DESCRIPTIONS))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (*) *) INFO-ERROR BREAK-PREVIOUS BREAK-NEXT
+- CONTINUE BREAK-LOCAL SHOW-BREAK-VARIABLES BREAK-BDS
+- MUFFLE-WARNING DBL-BACKTRACE ANSI-LOOP::LOOP-OPTIONAL-TYPE
+- IHS-BACKTRACE BREAK-QUIT BREAK-VS))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (FIXNUM) FIXNUM) FPE::FE-ENABLE DBL-WHAT-FRAME))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T) FIXNUM) INSTREAM-LINE FPE::REG-LOOKUP
+- S-DATA-SIZE S-DATA-LENGTH THE-START))
+-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM) T) PUSH-CONTEXT GET-CONTEXT))
+-(PROCLAIM '(FTYPE (FUNCTION (STRING FIXNUM) FIXNUM) ATOI))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (*) T) ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE
+- MAYBE-CLEAR-INPUT ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL
+- DRIBBLE ANSI-LOOP::MAKE-LOOP-COLLECTOR
+- ANSI-LOOP::MAKE-LOOP-UNIVERSE Y-OR-N-P COMPUTE-RESTARTS
+- DESCRIBE-ENVIRONMENT TRANSFORM-KEYWORDS
+- SLOOP::PARSE-LOOP-DECLARE MAKE-RESTART MAKE-INSTREAM
+- ANSI-LOOP::LOOP-GENTEMP DBL-READ LOC CURRENT-STEP-FUN
+- VECTOR YES-OR-NO-P BREAK
+- ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL STEP-INTO MAKE-CONTEXT
+- ANSI-LOOP::MAKE-LOOP-PATH MAKE-S-DATA BREAK-LOCALS ABORT
+- SLOOP::PARSE-LOOP-WITH STEP-NEXT))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T) *) PRINC-TO-STRING GET-&ENVIRONMENT DESCRIBE
+- INSPECT ANSI-LOOP::NAMED-VARIABLE WAITING
+- ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES PRIN1-TO-STRING
+- BREAK-LEVEL-INVOKE-RESTART END-WAITING
+- ANSI-LOOP::LOOP-LIST-STEP ALOAD INSTREAM-NAME
+- INVOKE-RESTART-INTERACTIVELY FIND-DECLARATIONS BREAK-GO
+- INSPECT-OBJECT INFO-SUBFILE))
+-(PROCLAIM '(FTYPE (FUNCTION (T FIXNUM T T) T) BIGNTHCDR))
+-(PROCLAIM '(FTYPE (FUNCTION (T FIXNUM FIXNUM T T) T) QUICK-SORT))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T) *) SHARP-S-READER SHARP---READER
+- ANSI-LOOP::LOOP-GET-COLLECTION-INFO SHARP-+-READER
+- LIST-MERGE-SORT LISP::VERIFY-KEYWORDS READ-INSPECT-COMMAND
+- RESTART-PRINT))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T *) *) REDUCE SUBTYPEP SORT
+- SLOOP::FIND-IN-ORDERED-LIST STABLE-SORT LISP::PARSE-BODY))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T T *) *) LISP::PARSE-DEFMACRO-LAMBDA-LIST
+- LISP::PARSE-DEFMACRO))
+-(PROCLAIM '(FTYPE (FUNCTION (T T T *) *) MASET))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T T T T T) *) LISP::PUSH-OPTIONAL-BINDING))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T *) *) DECODE-UNIVERSAL-TIME STEPPER USE-VALUE
+- FROUND INFO SHOW-INFO INVOKE-RESTART FCEILING
+- PARSE-BODY-HEADER ENSURE-DIRECTORIES-EXIST PRINT-DOC
+- APROPOS-DOC WRITE-TO-STRING FFLOOR NLOAD BREAK-FUNCTION
+- REQUIRE APROPOS GET-SETF-METHOD APROPOS-LIST
+- ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE STORE-VALUE
+- GET-SETF-METHOD-MULTIPLE-VALUE READ-FROM-STRING
+- WILD-PATHNAME-P FTRUNCATE))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T) T) QUOTATION-READER
+- SLOOP::IN-PACKAGE-SLOOP-MAP SLOOP::NEVER-SLOOP-COLLECT
+- MATCH-DIMENSIONS OBJLT ANSI-LOOP::LOOP-TEQUAL DBL-UP
+- GET-INFO-CHOICES NTHCDR ANSI-LOOP::LOOP-DECLARE-VARIABLE
+- ANSI-LOOP::MAKE-LOOP-MINIMAX LDB
+- OVERWRITE-SLOT-DESCRIPTIONS GET-LINE-OF-FORM DOCUMENTATION
+- DM-NTH ANSI-LOOP::LOOP-LOOKUP-KEYWORD DM-NTH-CDR
+- SLOOP::=-SLOOP-FOR LIST-DELQ SET-DIR LOGANDC2
+- SLOOP::IN-FRINGE-SLOOP-MAP DISPLAY-COMPILED-ENV SET-BACK
+- SLOOP::LOGXOR-SLOOP-COLLECT LEFT-PARENTHESIS-READER
+- ANSI-LOOP::LOOP-DO-IF FPE::%-READER LDB-TEST
+- COMPILER::COMPILER-DEF-HOOK BYTE
+- SLOOP::IN-CAREFULLY-SLOOP-FOR INCREMENT-CURSOR
+- IN-INTERVAL-P LISP::LOOKUP-KEYWORD SUPER-GO WRITE-BYTE
+- ANSI-LOOP::LOOP-DO-WHILE READ-INSTRUCTION LOGANDC1
+- SLOOP::THEREIS-SLOOP-COLLECT COERCE-TO-STRING LOGORC2
+- SEQUENCE-CURSOR LOGNOR FPE::READ-OPERANDS
+- SLOOP::MAXIMIZE-SLOOP-COLLECT ALL-MATCHES
+- SLOOP::IN-TABLE-SLOOP-MAP SLOOP::COLLATE-SLOOP-COLLECT
+- CHECK-SEQ-START-END BREAK-STEP-NEXT FPE::RF
+- SLOOP::PARSE-LOOP-MAP VECTOR-PUSH FPE::PAREN-READER
+- FPE::0-READER ANSI-LOOP::LOOP-TASSOC SETF-HELPER
+- SETF-EXPAND SLOOP::MINIMIZE-SLOOP-COLLECT ADD-FILE LOGORC1
+- SLOOP::COUNT-SLOOP-COLLECT SLOOP::MAKE-VALUE
+- PARSE-SLOT-DESCRIPTION SLOOP::DESETQ1
+- ANSI-LOOP::LOOP-DO-ALWAYS SLOOP::L-EQUAL GET-MATCH
+- SLOOP::SUM-SLOOP-COLLECT DM-V BREAK-STEP-INTO LOGNAND NTH
+- SUBSTRINGP INFO-AUX SUB-INTERVAL-P *BREAK-POINTS* SAFE-EVAL
+- ANSI-LOOP::HIDE-VARIABLE-REFERENCES COERCE
+- ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION CONDITION-PASS
+- GET-NODES ANSI-LOOP::LOOP-TMEMBER
+- SLOOP::ALWAYS-SLOOP-COLLECT DISPLAY-ENV SLOOP::THE-TYPE
+- ANSI-LOOP::LOOP-MAYBE-BIND-FORM ITERATE-OVER-BKPTS LOGTEST
+- LISP::KEYWORD-SUPPLIED-P))
+-(PROCLAIM '(FTYPE (FUNCTION (T T T T T T T) *) TRACE-CALL))
+-(PROCLAIM
+- '(FTYPE (FUNCTION NIL *) GCL-TOP-LEVEL SIMPLE-BACKTRACE
+- BREAK-CURRENT BREAK-MESSAGE ANSI-LOOP::LOOP-DO-FOR
+- BREAK-HELP))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (STRING) T) RESET-SYS-PATHS
+- COERCE-SLASH-TERMINATED))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T) FIXNUM) RELATIVE-LINE GET-NODE-INDEX
+- ANSI-LOOP::DUPLICATABLE-CODE-P THE-END))
+-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM T) T) SMALLNTHCDR))
+-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM FIXNUM) FIXNUM) ROUND-UP))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T *) T)
+- ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES SBIT
+- INFO-SEARCH PROCESS-ARGS LIST-MATCHES ARRAY-ROW-MAJOR-INDEX
+- FIND-RESTART SLOOP::LOOP-ADD-TEMPS ANSI-LOOP::LOOP-WARN
+- ANSI-LOOP::LOOP-ERROR BAD-SEQ-LIMIT ARRAY-IN-BOUNDS-P
+- MAKE-ARRAY SIGNAL BIT PROCESS-SOME-ARGS CONCATENATE ERROR
+- REMOVE-DUPLICATES SLOOP::ADD-FROM-DATA READ-BYTE
+- FILE-SEARCH FILE-TO-STRING UPGRADED-ARRAY-ELEMENT-TYPE WARN
+- BREAK-LEVEL BIT-NOT NTH-STACK-FRAME DELETE-DUPLICATES))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T) *) ANSI-LOOP::ESTIMATE-CODE-SIZE-1 NEWLINE
+- FIND-DOC RESTART-REPORT ANSI-LOOP::ESTIMATE-CODE-SIZE
+- NEW-SEMI-COLON-READER))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T *) T) NOTANY BIT-ORC1
+- ANSI-LOOP::LOOP-CHECK-DATA-TYPE REMOVE BIT-ANDC1
+- INTERNAL-COUNT-IF-NOT READ-SEQUENCE SUBSETP
+- VECTOR-PUSH-EXTEND TYPEP CERROR REPLACE COUNT-IF
+- NSET-DIFFERENCE DELETE REMOVE-IF NSET-EXCLUSIVE-OR
+- PROCESS-ERROR INTERNAL-COUNT SLOOP::IN-ARRAY-SLOOP-FOR
+- SEARCH MAKE-SEQUENCE ADJUST-ARRAY BIT-NAND FIND-IF
+- NINTERSECTION FILL BIT-ORC2 BIT-XOR UNION DELETE-IF-NOT
+- SLOOP::PARSE-LOOP-MACRO WRITE-SEQUENCE SOME COUNT-IF-NOT
+- MAP-INTO FIND FIND-IF-NOT BIT-NOR BIT-ANDC2 POSITION-IF
+- NOTEVERY NUNION SET-DIFFERENCE INTERSECTION POSITION-IF-NOT
+- EVERY POSITION FIND-IHS BIT-EQV REMOVE-IF-NOT MISMATCH
+- BIT-AND INTERNAL-COUNT-IF DELETE-IF COUNT BREAK-CALL
+- SET-EXCLUSIVE-OR SLOOP::LOOP-ADD-BINDING BIT-IOR))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T) T) ANSI-LOOP::LOOP-FOR-IN
+- FLOATING-POINT-ERROR CHECK-TRACE-ARGS
+- ANSI-LOOP::HIDE-VARIABLE-REFERENCE SETF-EXPAND-1
+- MAKE-BREAK-POINT FPE::REF SHARP-A-READER SHARP-U-READER DPB
+- DM-VL CHECK-S-DATA ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE
+- APPLY-DISPLAY-FUN ANSI-LOOP::LOOP-STANDARD-EXPANSION
+- ANSI-LOOP::LOOP-TRANSLATE DEPOSIT-FIELD
+- ANSI-LOOP::LOOP-ANSI-FOR-EQUALS
+- SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS
+- ANSI-LOOP::LOOP-FOR-ON GET-SLOT-POS
+- ANSI-LOOP::PRINT-LOOP-UNIVERSE DEFMACRO* WARN-VERSION
+- RESTART-CASE-EXPRESSION-CONDITION MAKE-T-TYPE
+- ANSI-LOOP::LOOP-SUM-COLLECTION ANSI-LOOP::LOOP-FOR-BEING
+- ANSI-LOOP::LOOP-FOR-ACROSS))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T *) T) CHECK-TYPE-SYMBOL
+- ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH NSUBSTITUTE-IF
+- SUBSTITUTE-IF
+- ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH NSUBSTITUTE
+- ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH
+- LISP::PUSH-LET-BINDING ANSI-LOOP::ADD-LOOP-PATH
+- SUBSTITUTE-IF-NOT MAP SLOOP::LOOP-DECLARE-BINDING
+- SUBSTITUTE ANSI-LOOP::LOOP-MAKE-VARIABLE NSUBSTITUTE-IF-NOT
+- COMPLETE-PROP))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T T T) T) LISP::DO-ARG-COUNT-ERROR
+- LISP::PUSH-SUB-LIST-BINDING))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T T) T) MAKE-CONSTRUCTOR MAKE-PREDICATE
+- DO-BREAK-LEVEL))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T *) T) PRINT-STACK-FRAME MERGE
+- SLOOP::DEF-LOOP-INTERNAL))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T FIXNUM) T) SHARP-EQ-READER
+- SHARP-SHARP-READER))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T) T) CALL-TEST COERCE-TO-CONDITION
+- FIND-LINE-IN-FUN ANSI-LOOP::LOOP-FOR-ARITHMETIC MAYBE-BREAK
+- SLOOP::FIRST-USE-SLOOP-FOR SLOOP::FIRST-SLOOP-FOR
+- SETF-STRUCTURE-ACCESS))
+-(PROCLAIM '(FTYPE (FUNCTION (T T T T T T *) T) ENCODE-UNIVERSAL-TIME))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T T T T T T T) T)
+- ANSI-LOOP::LOOP-SEQUENCER))
+-(PROCLAIM '(FTYPE (FUNCTION (T T T T T *) T) UNIVERSAL-ERROR-HANDLER))
+-(PROCLAIM
+- '(FTYPE (FUNCTION NIL T) ANSI-LOOP::LOOP-DO-NAMED
+- SLOOP::LOOP-UN-POP ANSI-LOOP::LOOP-DO-INITIALLY
+- SLOOP::PARSE-LOOP-WHEN SLOOP::LOOP-POP SLOOP::LOOP-PEEK
+- SLOOP::PARSE-LOOP-DO SET-ENV ANSI-LOOP::LOOP-DO-REPEAT
+- READ-EVALUATED-FORM ANSI-LOOP::LOOP-DO-RETURN
+- ANSI-LOOP::LOOP-GET-FORM ANSI-LOOP::LOOP-DO-FINALLY
+- SET-CURRENT DEFAULT-SYSTEM-BANNER DM-TOO-FEW-ARGUMENTS
+- ANSI-LOOP::LOOP-DO-DO SLOOP::PARSE-ONE-WHEN-CLAUSE
+- DEFAULT-INFO-HOTLIST KCL-TOP-RESTARTS TYPE-ERROR
+- SET-UP-TOP-LEVEL INSPECT-INDENT GET-INDEX-NODE
+- ALL-TRACE-DECLARATIONS DBL ANSI-LOOP::LOOP-GET-PROGN
+- INIT-BREAK-POINTS STEP-READ-LINE
+- ANSI-LOOP::LOOP-ITERATION-DRIVER GET-SIG-FN-NAME
+- SETUP-LINEINFO CLEANUP ANSI-LOOP::LOOP-WHEN-IT-VARIABLE
+- ANSI-LOOP::LOOP-DO-WITH SHOW-RESTARTS
+- SLOOP::PARSE-LOOP-COLLECT INSPECT-READ-LINE
+- DM-TOO-MANY-ARGUMENTS INSPECT-INDENT-1
+- ANSI-LOOP::LOOP-POP-SOURCE TEST-ERROR SLOOP::PARSE-LOOP1
+- ANSI-LOOP::LOOP-CONTEXT ANSI-LOOP::LOOP-BIND-BLOCK
+- WINE-TMP-REDIRECT ILLEGAL-BOA SLOOP::PARSE-LOOP-FOR
+- TOP-LEVEL LISP-IMPLEMENTATION-VERSION GET-TEMP-DIR))
+\ No newline at end of file
++(COMMON-LISP::IN-PACKAGE "SYSTEM")
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T)
++ ANSI-LOOP::LOOP-EMIT-FINAL-VALUE SYSTEM::INSPECT-CHARACTER
++ SYSTEM::INSPECT-STRUCTURE SYSTEM::PRINT-IHS
++ SYSTEM::RESTART-FUNCTION COMMON-LISP::TANH COMMON-LISP::FIFTH
++ SLOOP::PARSE-LOOP-INITIALLY SYSTEM::NEXT-STACK-FRAME
++ SYSTEM::IDESCRIBE SYSTEM::PROCESS-ARGS SYSTEM::LEAP-YEAR-P
++ SLOOP::AVERAGING-SLOOP-MACRO SYSTEM::FIX-LOAD-PATH
++ SLOOP::SUBSTITUTE-SLOOP-BODY SYSTEM::RESTART-REPORT-FUNCTION
++ COMMON-LISP::NINTH SLOOP::SLOOP-SLOOP-MACRO
++ SYSTEM::S-DATA-CONSTRUCTORS SYSTEM::FREEZE-DEFSTRUCT
++ COMMON-LISP::EIGHTH SYSTEM::FIND-DOCUMENTATION
++ ANSI-LOOP::LOOP-PSEUDO-BODY COMMON-LISP::RATIONAL
++ ANSI-LOOP::LOOP-EMIT-BODY COMMON-LISP::ASIN
++ COMMON-LISP::COMPILE-FILE-PATHNAME SYSTEM::S-DATA-P
++ SYSTEM::BKPT-FUNCTION SYSTEM::TRACE-ONE-PREPROCESS
++ COMMON-LISP::LOGNOT SYSTEM::SIMPLE-ARRAY-P SYSTEM::BKPT-FILE
++ SYSTEM::S-DATA-STATICP COMMON-LISP::ISQRT SYSTEM::INSTREAM-P
++ COMMON-LISP::SEVENTH SYSTEM::S-DATA-NAMED
++ ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS SYSTEM::INSPECT-NUMBER
++ COMMON-LISP::ATANH SYSTEM::RESTART-TEST-FUNCTION
++ SYSTEM::S-DATA-INCLUDES SYSTEM::S-DATA-HAS-HOLES
++ SYSTEM::CONTEXT-VEC FPE::XMM-LOOKUP SYSTEM::S-DATA-RAW
++ ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS
++ SYSTEM::RESTART-INTERACTIVE-FUNCTION
++ ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS
++ ANSI-LOOP::LOOP-COLLECTOR-NAME ANSI-LOOP::LOOP-PATH-NAMES
++ ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE
++ SYSTEM::S-DATA-INCLUDED SYSTEM::S-DATA-SLOT-DESCRIPTIONS
++ SYSTEM::S-DATA-OFFSET SLOOP::REPEAT-SLOOP-MACRO
++ SYSTEM::S-DATA-PRINT-FUNCTION ANSI-LOOP::LOOP-PATH-USER-DATA
++ COMMON-LISP::FIND-ALL-SYMBOLS COMMON-LISP::FIRST
++ SYSTEM::GET-BYTE-STREAM-NCHARS SYSTEM::BKPT-FORM
++ SYSTEM::NODES-FROM-INDEX SYSTEM::INSPECT-SYMBOL
++ SYSTEM::KNOWN-TYPE-P ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE
++ SYSTEM::MAKE-DEFPACKAGE-FORM COMMON-LISP::ARRAY-DIMENSIONS
++ SYSTEM::INSERT-BREAK-POINT SLOOP::PARSE-LOOP
++ ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED
++ ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS SYSTEM::SHORT-NAME
++ SYSTEM::CHECK-TRACE-SPEC ANSI-LOOP::DESTRUCTURING-SIZE
++ SYSTEM::BEST-ARRAY-ELEMENT-TYPE SYSTEM::CONTEXT-HASH
++ COMMON-LISP::SIXTH SYSTEM::IHS-VISIBLE SYSTEM::INSPECT-ARRAY
++ COMMON-LISP::BYTE-SIZE ANSI-LOOP::LOOP-COLLECTOR-CLASS
++ ANSI-LOOP::LOOP-HACK-ITERATION
++ ANSI-LOOP::LOOP-CONSTRUCT-RETURN SYSTEM::S-DATA-SLOT-POSITION
++ ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE SYSTEM::INSPECT-STRING
++ COMMON-LISP::PROVIDE COMMON-LISP::CIS
++ ANSI-LOOP::LOOP-MINIMAX-OPERATIONS
++ SYSTEM::BREAK-BACKWARD-SEARCH-STACK
++ ANSI-LOOP::LOOP-COLLECTOR-DTYPE
++ SYSTEM::IHS-NOT-INTERPRETED-ENV SYSTEM::SEARCH-STACK
++ COMMON-LISP::TENTH ANSI-LOOP::LOOP-DO-THEREIS
++ ANSI-LOOP::LOOP-MAXMIN-COLLECTION
++ ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA
++ ANSI-LOOP::LOOP-MAKE-PSETQ SYSTEM::ADD-TO-HOTLIST
++ SYSTEM::INSPECT-CONS ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS
++ SYSTEM::INSPECT-VECTOR COMMON-LISP::CONSTANTLY
++ SYSTEM::REWRITE-RESTART-CASE-CLAUSE SYSTEM::DM-BAD-KEY
++ SYSTEM::PRINT-SYMBOL-APROPOS SYSTEM::FRS-KIND FPE::ST-LOOKUP
++ COMMON-LISP::FOURTH SYSTEM::TERMINAL-INTERRUPT
++ SYSTEM::DM-KEY-NOT-ALLOWED SYSTEM::UNIQUE-ID
++ SYSTEM::S-DATA-FROZEN SLOOP::POINTER-FOR-COLLECT
++ SYSTEM::INSPECT-PACKAGE SYSTEM::DBL-EVAL
++ ANSI-LOOP::LOOP-MINIMAX-TYPE ANSI-LOOP::LOOP-UNIVERSE-ANSI
++ ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS SYSTEM::DWIM
++ SYSTEM::INSTREAM-STREAM-NAME SLOOP::RETURN-SLOOP-MACRO
++ SYSTEM::PATCH-SHARP SYSTEM::CONTEXT-P SYSTEM::INFO-GET-FILE
++ SYSTEM::RESTART-P COMMON-LISP::COSH COMMON-LISP::SINH
++ SYSTEM::GET-NEXT-VISIBLE-FUN SYSTEM::CHECK-DECLARATIONS
++ SYSTEM::GET-INSTREAM
++ ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD SYSTEM::S-DATA-NAME
++ ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS
++ SYSTEM::S-DATA-DOCUMENTATION SYSTEM::SHOW-BREAK-POINT
++ COMMON-LISP::ACOS COMMON-LISP::INVOKE-DEBUGGER
++ SYSTEM::BKPT-FILE-LINE ANSI-LOOP::LOOP-COLLECTOR-DATA
++ COMMON-LISP::THIRD SYSTEM::S-DATA-CONC-NAME
++ COMMON-LISP::SIGNUM
++ ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED
++ SYSTEM::NORMALIZE-TYPE ANSI-LOOP::LOOP-TYPED-INIT
++ ANSI-LOOP::LOOP-PATH-FUNCTION SYSTEM::INFO-NODE-FROM-POSITION
++ COMMON-LISP::ASINH SYSTEM::RE-QUOTE-STRING
++ SLOOP::LOOP-COLLECT-KEYWORD-P SYSTEM::PRINT-FRS
++ SYSTEM::EVAL-FEATURE ANSI-LOOP::LOOP-COLLECTOR-P
++ ANSI-LOOP::LOOP-COLLECTOR-HISTORY
++ ANSI-LOOP::LOOP-LIST-COLLECTION
++ SYSTEM::BREAK-FORWARD-SEARCH-STACK COMMON-LISP::RESTART-NAME
++ SLOOP::PARSE-NO-BODY ANSI-LOOP::LOOP-UNIVERSE-P
++ SYSTEM::NUMBER-OF-DAYS-FROM-1900 SYSTEM::NODE-OFFSET
++ ANSI-LOOP::LOOP-MINIMAX-P SYSTEM::IHS-FNAME FPE::LOOKUP
++ SLOOP::LOOP-LET-BINDINGS FPE::GREF COMMON-LISP::PHASE
++ COMMON-LISP::BYTE-POSITION SYSTEM::INSTREAM-STREAM
++ ANSI-LOOP::LOOP-PATH-P SYSTEM::SEQTYPE COMMON-LISP::ACOSH
++ COMMON-LISP::ABS COMMON-LISP::COMPLEMENT
++ ANSI-LOOP::LOOP-CONSTANTP SYSTEM::WALK-THROUGH
++ SYSTEM::SETUP-INFO SYSTEM::COMPUTING-ARGS-P
++ SYSTEM::CONTEXT-SPICE SYSTEM::MAKE-KCL-TOP-RESTART
++ COMMON-LISP::COMPILER-MACRO-FUNCTION
++ ANSI-LOOP::LOOP-MAKE-DESETQ SYSTEM::SHOW-ENVIRONMENT
++ SLOOP::TRANSLATE-NAME SYSTEM::INFO-GET-TAGS
++ COMMON-LISP::SECOND SYSTEM::RESET-TRACE-DECLARATIONS
++ SYSTEM::S-DATA-TYPE SYSTEM::FIND-KCL-TOP-RESTART
++ ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE SYSTEM::DO-F
++ ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS COMMON-LISP::VECTOR-POP))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*)
++ SYSTEM::IHS-BACKTRACE SYSTEM::BREAK-NEXT SYSTEM::BREAK-QUIT
++ SYSTEM::SHOW-BREAK-VARIABLES SYSTEM::BREAK-BDS
++ COMMON-LISP::MUFFLE-WARNING SYSTEM::BREAK-PREVIOUS
++ SYSTEM::INFO-ERROR ANSI-LOOP::LOOP-OPTIONAL-TYPE
++ SYSTEM::DBL-BACKTRACE SYSTEM::BREAK-LOCAL SYSTEM::BREAK-VS
++ COMMON-LISP::CONTINUE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM)
++ COMMON-LISP::FIXNUM)
++ SYSTEM::DBL-WHAT-FRAME FPE::FE-ENABLE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::*)
++ COMMON-LISP::SUBTYPEP COMMON-LISP::REDUCE SYSTEM::PARSE-BODY
++ COMMON-LISP::STABLE-SORT COMMON-LISP::SORT
++ SLOOP::FIND-IN-ORDERED-LIST))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::*)
++ SYSTEM::VERIFY-KEYWORDS SYSTEM::RESTART-PRINT
++ ANSI-LOOP::LOOP-GET-COLLECTION-INFO SYSTEM::LIST-MERGE-SORT
++ SYSTEM::READ-INSPECT-COMMAND SYSTEM::SHARP---READER
++ SYSTEM::SHARP-+-READER SYSTEM::SHARP-S-READER))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::*)
++ SYSTEM::PUSH-OPTIONAL-BINDING))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::*)
++ SYSTEM::PARSE-DEFMACRO-LAMBDA-LIST SYSTEM::PARSE-DEFMACRO))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T)
++ COMMON-LISP::*)
++ SYSTEM::TRACE-CALL))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::*)
++ COMMON-LISP::*)
++ SYSTEM::MASET))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM)
++ FPE::REG-LOOKUP SYSTEM::INSTREAM-LINE SYSTEM::THE-START
++ SYSTEM::S-DATA-LENGTH SYSTEM::S-DATA-SIZE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T)
++ SYSTEM::PUSH-CONTEXT SYSTEM::GET-CONTEXT))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*)
++ SYSTEM::BREAK-CURRENT SYSTEM::GCL-TOP-LEVEL
++ SYSTEM::BREAK-MESSAGE SYSTEM::BREAK-RESUME
++ ANSI-LOOP::LOOP-DO-FOR SYSTEM::SIMPLE-BACKTRACE
++ SYSTEM::BREAK-HELP))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::STRING) COMMON-LISP::T)
++ SYSTEM::COERCE-SLASH-TERMINATED SYSTEM::RESET-SYS-PATHS))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::T)
++ COMMON-LISP::BIT COMMON-LISP::READ-BYTE
++ COMMON-LISP::CONCATENATE SYSTEM::INFO-SEARCH
++ COMMON-LISP::ARRAY-IN-BOUNDS-P ANSI-LOOP::LOOP-ERROR
++ ANSI-LOOP::LOOP-WARN COMMON-LISP::REMOVE-DUPLICATES
++ SYSTEM::BAD-SEQ-LIMIT SYSTEM::PROCESS-SOME-ARGS
++ ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES
++ SLOOP::LOOP-ADD-TEMPS COMMON-LISP::BIT-NOT COMMON-LISP::SIGNAL
++ SYSTEM::NTH-STACK-FRAME COMMON-LISP::ARRAY-ROW-MAJOR-INDEX
++ COMMON-LISP::MAKE-ARRAY SYSTEM::FILE-SEARCH
++ SYSTEM::LIST-MATCHES COMMON-LISP::FIND-RESTART
++ SYSTEM::BREAK-LEVEL COMMON-LISP::DELETE-DUPLICATES
++ SLOOP::ADD-FROM-DATA COMMON-LISP::ERROR COMMON-LISP::WARN
++ SYSTEM::FILE-TO-STRING
++ COMMON-LISP::UPGRADED-ARRAY-ELEMENT-TYPE COMMON-LISP::SBIT))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::*)
++ SYSTEM::FIND-DOC SYSTEM::RESTART-REPORT
++ ANSI-LOOP::ESTIMATE-CODE-SIZE-1 SYSTEM::NEWLINE
++ ANSI-LOOP::ESTIMATE-CODE-SIZE SYSTEM::NEW-SEMI-COLON-READER))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T)
++ (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T))
++ SYSTEM::MAKE-KEYWORD))
++(COMMON-LISP::MAPC
++ (COMMON-LISP::LAMBDA (COMPILER::X)
++ (COMMON-LISP::SETF
++ (COMMON-LISP::GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE)
++ COMMON-LISP::T))
++ '(SYSTEM::SI-CLASS-PRECEDENCE-LIST SYSTEM::SI-CLASSP
++ SYSTEM::SIMPLE-CONDITION-CLASS-P SYSTEM::UNTRACE-ONE
++ SYSTEM::CONDITIONP SYSTEM::CONDITION-CLASS-P
++ SYSTEM::MAKE-ACCESS-FUNCTION SYSTEM::SI-CLASS-NAME
++ SYSTEM::AUTOLOAD-MACRO SYSTEM::AUTOLOAD SYSTEM::SI-CLASS-OF
++ SYSTEM::WARNINGP SYSTEM::DEFINE-STRUCTURE
++ FPE::BREAK-ON-FLOATING-POINT-EXCEPTIONS SYSTEM::SI-FIND-CLASS
++ SYSTEM::TRACE-ONE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM
++ COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::T)
++ SYSTEM::QUICK-SORT))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::T
++ COMMON-LISP::T)
++ COMMON-LISP::T)
++ SYSTEM::BIGNTHCDR))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::T)
++ ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE ANSI-LOOP::LOOP-FOR-IN
++ SYSTEM::DEFMACRO* SYSTEM::APPLY-DISPLAY-FUN
++ SYSTEM::WARN-VERSION ANSI-LOOP::HIDE-VARIABLE-REFERENCE
++ SYSTEM::SHARP-U-READER ANSI-LOOP::LOOP-FOR-ACROSS
++ SYSTEM::DM-VL SYSTEM::GET-SLOT-POS
++ SYSTEM::RESTART-CASE-EXPRESSION-CONDITION
++ SYSTEM::CHECK-TRACE-ARGS ANSI-LOOP::LOOP-FOR-ON FPE::REF
++ ANSI-LOOP::PRINT-LOOP-UNIVERSE ANSI-LOOP::LOOP-ANSI-FOR-EQUALS
++ SYSTEM::SETF-EXPAND-1 ANSI-LOOP::LOOP-SUM-COLLECTION
++ ANSI-LOOP::LOOP-STANDARD-EXPANSION SYSTEM::MAKE-T-TYPE
++ COMMON-LISP::DEPOSIT-FIELD SYSTEM::MAKE-BREAK-POINT
++ ANSI-LOOP::LOOP-FOR-BEING ANSI-LOOP::LOOP-TRANSLATE
++ SYSTEM::SHARP-A-READER COMMON-LISP::DPB
++ SYSTEM::FLOATING-POINT-ERROR SYSTEM::CHECK-S-DATA
++ SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T)
++ COMMON-LISP::T)
++ SLOOP::FIRST-USE-SLOOP-FOR SYSTEM::COERCE-TO-CONDITION
++ SLOOP::FIRST-SLOOP-FOR ANSI-LOOP::LOOP-FOR-ARITHMETIC
++ SYSTEM::MAYBE-BREAK SYSTEM::SETF-STRUCTURE-ACCESS
++ SYSTEM::CALL-TEST SYSTEM::FIND-LINE-IN-FUN))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::T)
++ COMMON-LISP::COUNT-IF COMMON-LISP::BIT-ANDC2
++ COMMON-LISP::REMOVE SYSTEM::INTERNAL-COUNT-IF
++ SLOOP::LOOP-ADD-BINDING COMMON-LISP::MAP-INTO
++ COMMON-LISP::FIND-IF COMMON-LISP::NSET-DIFFERENCE
++ COMMON-LISP::UNION COMMON-LISP::NUNION
++ COMMON-LISP::MAKE-SEQUENCE COMMON-LISP::NOTANY
++ COMMON-LISP::POSITION COMMON-LISP::DELETE-IF
++ COMMON-LISP::BIT-ORC2 COMMON-LISP::REPLACE COMMON-LISP::DELETE
++ SYSTEM::BREAK-CALL COMMON-LISP::NINTERSECTION
++ COMMON-LISP::POSITION-IF SYSTEM::FIND-IHS COMMON-LISP::BIT-AND
++ COMMON-LISP::DELETE-IF-NOT ANSI-LOOP::LOOP-CHECK-DATA-TYPE
++ COMMON-LISP::REMOVE-IF COMMON-LISP::READ-SEQUENCE
++ SLOOP::PARSE-LOOP-MACRO COMMON-LISP::BIT-NAND
++ SYSTEM::INTERNAL-COUNT-IF-NOT COMMON-LISP::SUBSETP
++ COMMON-LISP::VECTOR-PUSH-EXTEND COMMON-LISP::EVERY
++ COMMON-LISP::SOME COMMON-LISP::WRITE-SEQUENCE
++ COMMON-LISP::MISMATCH COMMON-LISP::SET-EXCLUSIVE-OR
++ COMMON-LISP::REMOVE-IF-NOT COMMON-LISP::BIT-NOR
++ COMMON-LISP::BIT-XOR COMMON-LISP::BIT-EQV COMMON-LISP::SEARCH
++ COMMON-LISP::SET-DIFFERENCE COMMON-LISP::FILL
++ COMMON-LISP::CERROR COMMON-LISP::ADJUST-ARRAY
++ COMMON-LISP::BIT-ORC1 SYSTEM::INTERNAL-COUNT
++ COMMON-LISP::TYPEP SYSTEM::PROCESS-ERROR
++ COMMON-LISP::COUNT-IF-NOT COMMON-LISP::INTERSECTION
++ SLOOP::IN-ARRAY-SLOOP-FOR COMMON-LISP::FIND-IF-NOT
++ COMMON-LISP::BIT-ANDC1 COMMON-LISP::POSITION-IF-NOT
++ COMMON-LISP::NOTEVERY COMMON-LISP::NSET-EXCLUSIVE-OR
++ COMMON-LISP::FIND COMMON-LISP::COUNT COMMON-LISP::BIT-IOR))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::T)
++ SYSTEM::PUSH-SUB-LIST-BINDING SYSTEM::DO-ARG-COUNT-ERROR))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::*)
++ COMMON-LISP::T)
++ ANSI-LOOP::ADD-LOOP-PATH COMMON-LISP::MAP
++ ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH
++ ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH
++ COMMON-LISP::SUBSTITUTE COMMON-LISP::NSUBSTITUTE
++ COMMON-LISP::NSUBSTITUTE-IF-NOT ANSI-LOOP::LOOP-MAKE-VARIABLE
++ COMMON-LISP::SUBSTITUTE-IF-NOT
++ ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH
++ SYSTEM::PUSH-LET-BINDING COMMON-LISP::SUBSTITUTE-IF
++ SYSTEM::CHECK-TYPE-SYMBOL SLOOP::LOOP-DECLARE-BINDING
++ SYSTEM::COMPLETE-PROP COMMON-LISP::NSUBSTITUTE-IF))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::T)
++ SYSTEM::MAKE-PREDICATE SYSTEM::DO-BREAK-LEVEL
++ SYSTEM::MAKE-CONSTRUCTOR))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::T)
++ SYSTEM::UNIVERSAL-ERROR-HANDLER))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::FIXNUM)
++ COMMON-LISP::T)
++ SYSTEM::SHARP-SHARP-READER SYSTEM::SHARP-EQ-READER))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::T)
++ SLOOP::DEF-LOOP-INTERNAL SYSTEM::PRINT-STACK-FRAME
++ COMMON-LISP::MERGE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::*)
++ COMMON-LISP::T)
++ COMMON-LISP::ENCODE-UNIVERSAL-TIME))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T)
++ COMMON-LISP::T)
++ ANSI-LOOP::LOOP-SEQUENCER))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::STRING COMMON-LISP::FIXNUM)
++ COMMON-LISP::FIXNUM)
++ SYSTEM::ATOI))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T)
++ SYSTEM::DESCRIBE-ENVIRONMENT SYSTEM::STEP-NEXT
++ COMMON-LISP::BREAK COMMON-LISP::ABORT SYSTEM::MAKE-S-DATA
++ ANSI-LOOP::MAKE-LOOP-COLLECTOR SLOOP::PARSE-LOOP-DECLARE
++ ANSI-LOOP::LOOP-GENTEMP SYSTEM::MAKE-INSTREAM
++ SYSTEM::MAYBE-CLEAR-INPUT
++ ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL COMMON-LISP::Y-OR-N-P
++ SYSTEM::CURRENT-STEP-FUN ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL
++ COMMON-LISP::DRIBBLE SYSTEM::MAKE-RESTART
++ SLOOP::PARSE-LOOP-WITH SYSTEM::LOC COMMON-LISP::YES-OR-NO-P
++ SYSTEM::TRANSFORM-KEYWORDS SYSTEM::MAKE-CONTEXT
++ COMMON-LISP::COMPUTE-RESTARTS SYSTEM::DBL-READ
++ SYSTEM::STEP-INTO ANSI-LOOP::MAKE-LOOP-UNIVERSE
++ SYSTEM::BREAK-LOCALS ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE
++ COMMON-LISP::VECTOR ANSI-LOOP::MAKE-LOOP-PATH))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*)
++ ANSI-LOOP::LOOP-LIST-STEP SYSTEM::INSPECT-OBJECT
++ COMMON-LISP::DESCRIBE ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES
++ SYSTEM::BREAK-GO SYSTEM::GET-&ENVIRONMENT
++ COMMON-LISP::PRINC-TO-STRING SYSTEM::WAITING
++ SYSTEM::INSTREAM-NAME ANSI-LOOP::NAMED-VARIABLE
++ COMMON-LISP::PRIN1-TO-STRING SYSTEM::INFO-SUBFILE
++ COMMON-LISP::INSPECT SYSTEM::END-WAITING
++ SYSTEM::FIND-DECLARATIONS
++ COMMON-LISP::INVOKE-RESTART-INTERACTIVELY
++ SYSTEM::BREAK-LEVEL-INVOKE-RESTART SYSTEM::ALOAD))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::T)
++ ANSI-LOOP::MAKE-LOOP-MINIMAX COMMON-LISP::LDB
++ SYSTEM::LIST-DELQ FPE::RF SLOOP::L-EQUAL
++ ANSI-LOOP::LOOP-DECLARE-VARIABLE SYSTEM::DISPLAY-COMPILED-ENV
++ SYSTEM::SET-BACK ANSI-LOOP::HIDE-VARIABLE-REFERENCES
++ SYSTEM::GET-LINE-OF-FORM SYSTEM::BREAK-STEP-INTO
++ SLOOP::THE-TYPE SLOOP::COUNT-SLOOP-COLLECT
++ SYSTEM::KEYWORD-SUPPLIED-P COMMON-LISP::LOGANDC2
++ ANSI-LOOP::LOOP-MAYBE-BIND-FORM SYSTEM::SET-DIR
++ SYSTEM::COERCE-TO-STRING COMMON-LISP::VECTOR-PUSH
++ SYSTEM::DM-NTH-CDR SLOOP::IN-FRINGE-SLOOP-MAP
++ SLOOP::MAXIMIZE-SLOOP-COLLECT SYSTEM::ADD-FILE
++ SYSTEM::ALL-MATCHES SYSTEM::DM-NTH
++ SLOOP::IN-CAREFULLY-SLOOP-FOR SYSTEM::PARSE-SLOT-DESCRIPTION
++ ANSI-LOOP::LOOP-LOOKUP-KEYWORD FPE::0-READER
++ ANSI-LOOP::LOOP-TMEMBER COMPILER::COMPILER-DEF-HOOK
++ SYSTEM::INFO-AUX COMMON-LISP::NTH SYSTEM::QUOTATION-READER
++ SYSTEM::CHECK-SEQ-START-END COMMON-LISP::LOGNAND
++ SYSTEM::SUBSTRINGP COMMON-LISP::LOGORC2
++ ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION SYSTEM::SAFE-EVAL
++ ANSI-LOOP::LOOP-DO-IF SLOOP::THEREIS-SLOOP-COLLECT
++ SYSTEM::MATCH-DIMENSIONS SYSTEM::GET-MATCH
++ SYSTEM::SUB-INTERVAL-P FPE::PAREN-READER
++ SLOOP::IN-TABLE-SLOOP-MAP COMMON-LISP::LOGTEST
++ SLOOP::LOGXOR-SLOOP-COLLECT SYSTEM::DM-V
++ SYSTEM::GET-INFO-CHOICES SLOOP::COLLATE-SLOOP-COLLECT
++ SYSTEM::BREAK-STEP-NEXT ANSI-LOOP::LOOP-TEQUAL
++ COMMON-LISP::WRITE-BYTE COMMON-LISP::NTHCDR
++ SYSTEM::SETF-HELPER SLOOP::NEVER-SLOOP-COLLECT SLOOP::DESETQ1
++ ANSI-LOOP::LOOP-DO-WHILE COMMON-LISP::DOCUMENTATION
++ FPE::%-READER SYSTEM::IN-INTERVAL-P SLOOP::SUM-SLOOP-COLLECT
++ SYSTEM::OBJLT COMMON-LISP::LDB-TEST SLOOP::PARSE-LOOP-MAP
++ SYSTEM::GET-NODES SLOOP::MAKE-VALUE SYSTEM::CONDITION-PASS
++ SLOOP::IN-PACKAGE-SLOOP-MAP SYSTEM::INCREMENT-CURSOR
++ ANSI-LOOP::LOOP-DO-ALWAYS SYSTEM::DISPLAY-ENV SYSTEM::SUPER-GO
++ SLOOP::MINIMIZE-SLOOP-COLLECT COMMON-LISP::LOGNOR
++ COMMON-LISP::LOGANDC1 COMMON-LISP::BYTE SYSTEM::DBL-UP
++ SYSTEM::ITERATE-OVER-BKPTS COMMON-LISP::LOGORC1
++ FPE::READ-OPERANDS SLOOP::ALWAYS-SLOOP-COLLECT
++ SYSTEM::SETF-EXPAND SYSTEM::OVERWRITE-SLOT-DESCRIPTIONS
++ SYSTEM::*BREAK-POINTS* SYSTEM::LOOKUP-KEYWORD
++ ANSI-LOOP::LOOP-TASSOC SYSTEM::LEFT-PARENTHESIS-READER
++ SLOOP::=-SLOOP-FOR FPE::READ-INSTRUCTION COMMON-LISP::COERCE
++ SYSTEM::SEQUENCE-CURSOR))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::*)
++ COMMON-LISP::FFLOOR SYSTEM::BREAK-FUNCTION
++ COMMON-LISP::APROPOS-LIST COMMON-LISP::DECODE-UNIVERSAL-TIME
++ SYSTEM::STEPPER COMMON-LISP::REQUIRE SYSTEM::APROPOS-DOC
++ SYSTEM::PRINT-DOC SYSTEM::INFO COMMON-LISP::USE-VALUE
++ COMMON-LISP::WRITE-TO-STRING COMMON-LISP::FCEILING
++ SYSTEM::GET-SETF-METHOD
++ ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE SYSTEM::NLOAD
++ COMMON-LISP::ENSURE-DIRECTORIES-EXIST
++ COMMON-LISP::WILD-PATHNAME-P COMMON-LISP::FTRUNCATE
++ COMMON-LISP::FROUND SYSTEM::PARSE-BODY-HEADER
++ COMMON-LISP::INVOKE-RESTART SYSTEM::SHOW-INFO
++ COMMON-LISP::READ-FROM-STRING
++ SYSTEM::GET-SETF-METHOD-MULTIPLE-VALUE COMMON-LISP::APROPOS
++ COMMON-LISP::STORE-VALUE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T)
++ ANSI-LOOP::LOOP-DO-WITH SYSTEM::WINE-TMP-REDIRECT
++ SLOOP::PARSE-ONE-WHEN-CLAUSE COMMON-LISP::TYPE-ERROR
++ SYSTEM::INSPECT-INDENT SYSTEM::SET-CURRENT SYSTEM::TEST-ERROR
++ SLOOP::LOOP-POP ANSI-LOOP::LOOP-DO-REPEAT
++ ANSI-LOOP::LOOP-GET-PROGN SYSTEM::DM-TOO-FEW-ARGUMENTS
++ ANSI-LOOP::LOOP-CONTEXT SYSTEM::READ-EVALUATED-FORM
++ SYSTEM::ALL-TRACE-DECLARATIONS
++ COMMON-LISP::LISP-IMPLEMENTATION-VERSION
++ SYSTEM::DEFAULT-SYSTEM-BANNER ANSI-LOOP::LOOP-DO-RETURN
++ SYSTEM::INSPECT-INDENT-1 SYSTEM::STEP-READ-LINE
++ SYSTEM::SET-ENV SYSTEM::DM-TOO-MANY-ARGUMENTS
++ ANSI-LOOP::LOOP-BIND-BLOCK SLOOP::PARSE-LOOP1
++ ANSI-LOOP::LOOP-DO-NAMED SLOOP::PARSE-LOOP-COLLECT
++ SYSTEM::KCL-TOP-RESTARTS SYSTEM::INSPECT-READ-LINE
++ SYSTEM::SET-UP-TOP-LEVEL SYSTEM::SHOW-RESTARTS SYSTEM::DBL
++ SLOOP::PARSE-LOOP-FOR ANSI-LOOP::LOOP-ITERATION-DRIVER
++ ANSI-LOOP::LOOP-WHEN-IT-VARIABLE ANSI-LOOP::LOOP-DO-DO
++ SYSTEM::DEFAULT-INFO-HOTLIST SYSTEM::GET-TEMP-DIR
++ ANSI-LOOP::LOOP-POP-SOURCE SLOOP::LOOP-UN-POP
++ SYSTEM::TOP-LEVEL ANSI-LOOP::LOOP-DO-FINALLY
++ ANSI-LOOP::LOOP-DO-INITIALLY SYSTEM::GET-INDEX-NODE
++ SYSTEM::SETUP-LINEINFO SLOOP::PARSE-LOOP-WHEN SYSTEM::CLEANUP
++ ANSI-LOOP::LOOP-GET-FORM SLOOP::PARSE-LOOP-DO
++ SYSTEM::INIT-BREAK-POINTS SLOOP::LOOP-PEEK
++ SYSTEM::GET-SIG-FN-NAME SYSTEM::ILLEGAL-BOA))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM COMMON-LISP::T)
++ COMMON-LISP::T)
++ SYSTEM::SMALLNTHCDR))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::FIXNUM)
++ SYSTEM::THE-END ANSI-LOOP::DUPLICATABLE-CODE-P
++ SYSTEM::RELATIVE-LINE SYSTEM::GET-NODE-INDEX))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM)
++ COMMON-LISP::FIXNUM)
++ SYSTEM::ROUND-UP))
+\ No newline at end of file
+--- gcl-2.6.12.orig/o/alloc.c
++++ gcl-2.6.12/o/alloc.c
+@@ -68,7 +68,7 @@ sbrk1(n)
+ long starting_hole_div=10;
+ long starting_relb_heap_mult=2;
+ long new_holepage;
+-long resv_pages=40;
++long resv_pages=0;
+
+ #ifdef BSD
+ #include <sys/time.h>
+@@ -186,14 +186,45 @@ int reserve_pages_for_signal_handler=30;
+ If not in_signal_handler then try to keep a minimum of
+ reserve_pages_for_signal_handler pages on hand in the hole
+ */
++
++inline void
++empty_relblock(void) {
++
++ object o=sSAleaf_collection_thresholdA->s.s_dbind;
++
++ sSAleaf_collection_thresholdA->s.s_dbind=make_fixnum(0);
++ for (;rb_pointer!=rb_start&&rb_pointer!=rb_end;)
++ GBC(t_relocatable);
++ sSAleaf_collection_thresholdA->s.s_dbind=o;
++
++}
++
++inline void
++resize_hole(ufixnum hp,enum type tp) {
++
++ char *new_start=heap_end+hp*PAGESIZE;
++ char *start=rb_pointer<rb_end ? rb_start : rb_end;
++ ufixnum size=rb_pointer-start;
++
++ if ((new_start<start && new_start+size>=start) || (new_start<start+size && new_start+size>=start+size)) {
++ fprintf(stderr,"Toggling relblock when resizing hole to %lu\n",hp);
++ fflush(stderr);
++ tm_table[t_relocatable].tm_adjgbccnt--;
++ GBC(t_relocatable);
++ return resize_hole(hp,tp);
++ }
++
++ holepage=hp;
++ tm_of(tp)->tm_adjgbccnt--;
++ GBC(tp);
++
++}
++
+ inline void *
+ alloc_page(long n) {
+
+- void *e=heap_end;
+ fixnum d,m;
+-#ifdef SGC
+- int in_sgc=sgc_enabled;
+-#endif
++
+ if (n>=0) {
+
+ if (n>(holepage - (in_signal_handler? 0 :
+@@ -215,25 +246,8 @@ eg to add 20 more do (si::set-hole-size
+ d=d<0 ? 0 : d;
+ d=new_holepage<d ? new_holepage : d;
+
+- holepage = d + n;
++ resize_hole(d+n,t_relocatable);
+
+-#ifdef SGC
+- if (in_sgc) sgc_quit();
+-#endif
+-
+- GBC(t_relocatable);
+- tm_table[t_relocatable].tm_adjgbccnt--;/* hole overrun is not a call for more relocatable */
+-
+-
+-#ifdef SGC
+- /* starting sgc can use up some pages
+- and may move heap end, so start over
+- */
+- if (in_sgc) {
+- sgc_start();
+- return alloc_page(n);
+- }
+-#endif
+ }
+
+ holepage -= n;
+@@ -244,9 +258,12 @@ eg to add 20 more do (si::set-hole-size
+ core_end+=PAGESIZE*n;
+ }
+
+- heap_end+=PAGESIZE*n;
++ {
++ void *e=heap_end;
++ heap_end+=PAGESIZE*n;
+
+- return(e);
++ return(e);
++ }
+
+ }
+
+@@ -256,13 +273,13 @@ eg to add 20 more do (si::set-hole-size
+ m=(core_end-heap_end)/PAGESIZE;
+
+ if (n<=m)
+- return(e);
++ return(heap_end);
+
+ IF_ALLOCATE_ERR error("Can't allocate. Good-bye!");
+
+ core_end+=PAGESIZE*(n-m);
+
+- return(e);
++ return(heap_end);
+
+ }
+
+@@ -272,16 +289,37 @@ eg to add 20 more do (si::set-hole-size
+
+ struct pageinfo *cell_list_head=NULL,*cell_list_tail=NULL;;
+
++inline ufixnum
++sum_maxpages(void) {
++
++ ufixnum i,j;
++
++ for (i=t_start,j=0;i<t_other;i++)
++ j+=tm_table[i].tm_maxpage;
++
++ return j+tm_table[t_relocatable].tm_maxpage;
++
++}
++
++fixnum
++check_avail_pages(void) {
++
++ return real_maxpage-page(data_start ? data_start : sbrk(0))-available_pages-resv_pages-sum_maxpages();
++
++}
++
++
+ inline fixnum
+ set_tm_maxpage(struct typemanager *tm,fixnum n) {
+
+ fixnum r=tm->tm_type==t_relocatable,j=tm->tm_maxpage,z=(n-j)*(r ? 2 : 1);
+ if (z>available_pages) return 0;
+- if (r && 2*n+page(REAL_RB_START)>real_maxpage) return 0;
++ if (r && 2*n+page(rb_start)>real_maxpage) return 0;
+ available_pages-=z;
+- tm->tm_adjgbccnt*=((double)j)/n;
++ tm->tm_adjgbccnt*=((double)j+1)/(n+1);
+ tm->tm_maxpage=n;
+- return n;
++ /* massert(!check_avail_pages()); */
++ return 1;
+ }
+
+
+@@ -317,8 +355,11 @@ add_page_to_freelist(char *p, struct typ
+
+ if (sgc_enabled && tm->tm_sgc)
+ pp->sgc_flags=SGC_PAGE_FLAG;
++
++#ifndef SGC_WHOLE_PAGE
+ if (TYPEWORD_TYPE_P(pp->type))
+ x->d.s=(sgc_enabled && tm->tm_sgc) ? SGC_RECENT : SGC_NORMAL;
++#endif
+
+ /* array headers must be always writable, since a write to the
+ body does not touch the header. It may be desirable if there
+@@ -410,17 +451,61 @@ grow_linear(fixnum old, fixnum fract, fi
+ DEFVAR("*OPTIMIZE-MAXIMUM-PAGES*",sSAoptimize_maximum_pagesA,SI,sLnil,"");
+ #define OPTIMIZE_MAX_PAGES (sSAoptimize_maximum_pagesA ==0 || sSAoptimize_maximum_pagesA->s.s_dbind !=sLnil)
+ DEFVAR("*NOTIFY-OPTIMIZE-MAXIMUM-PAGES*",sSAnotify_optimize_maximum_pagesA,SI,sLnil,"");
+-#define MMAX_PG(a_) (a_)->tm_maxpage
++#define MMAX_PG(a_) (a_)->tm_maxpage-(a_)->tm_alt_npage
++
++static int
++rebalance_maxpages(struct typemanager *my_tm,fixnum z) {
++
++ fixnum d;
++ ufixnum i,j;
++
++
++ d=(z-my_tm->tm_maxpage)*(my_tm->tm_type==t_relocatable ? 2 : 1);
++ j=sum_maxpages();
++
++ if (j+d>phys_pages) {
++
++ ufixnum k=0;
++
++ for (i=t_start;i<t_other;i++)
++ if (tm_table+i!=my_tm)
++ k+=(tm_table[i].tm_maxpage-tm_table[i].tm_npage)*(i==t_relocatable ? 2 : 1);
++
++ d=d>k+phys_pages-j ? k+phys_pages-j : d;
++ if (d<=0)
++ return 0;
++
++ for (i=t_start;i<t_other;i++)
++ if (tm_table[i].tm_npage) {
++ if (tm_table+i==my_tm) {
++ massert(set_tm_maxpage(tm_table+i,z));
++ } else {
++ massert(set_tm_maxpage(tm_table+i,tm_table[i].tm_npage+(1.0-(double)(j+d-phys_pages)/k)*(tm_table[i].tm_maxpage-tm_table[i].tm_npage)));
++ }
++ }
++
++ /* for (i=t_start;i<t_other;i++) */
++ /* if (tm_table[i].tm_npage && tm_table[i].tm_npage>((double)phys_pages/(j+d))*(tm_table+i==my_tm ? z : tm_table[i].tm_maxpage)) */
++ /* return 0; */
++ /* for (i=t_start;i<t_other;i++) */
++ /* if (tm_table[i].tm_npage) */
++ /* massert(set_tm_maxpage(tm_table+i,((double)phys_pages/(j+d))*(tm_table+i==my_tm ? z : tm_table[i].tm_maxpage))); */
++
++ return 1;
++
++ } else
++
++ return set_tm_maxpage(my_tm,z);
++
++}
++
+ inline long
+ opt_maxpage(struct typemanager *my_tm) {
+
+ double x=0.0,y=0.0,z,r;
+ long mmax_page;
+ struct typemanager *tm,*tme;
+- long mro=0,tro=0;
+-
+- if (phys_pages>0 && page(heap_end)-first_data_page+nrbpage>=phys_pages)
+- return 0;
++ long mro=0,tro=0,j;
+
+ if (page(core_end)>0.8*real_maxpage)
+ return 0;
+@@ -437,22 +522,27 @@ opt_maxpage(struct typemanager *my_tm) {
+ }
+ #endif
+
+- z=my_tm->tm_adjgbccnt-1;
++ z=my_tm->tm_adjgbccnt/* -1 */;
+ z/=(1+x-0.9*my_tm->tm_adjgbccnt);
+ z*=(y-mmax_page)*mmax_page;
+ z=sqrt(z);
+ z=z-mmax_page>available_pages ? mmax_page+available_pages : z;
+- my_tm->tm_opt_maxpage=(long)z>my_tm->tm_opt_maxpage ? (long)z : my_tm->tm_opt_maxpage;
++ my_tm->tm_opt_maxpage=(long)(z+my_tm->tm_alt_npage)>my_tm->tm_opt_maxpage ? (long)(z+my_tm->tm_alt_npage) : my_tm->tm_opt_maxpage;
+
+ if (z<=mmax_page)
+ return 0;
+
+ r=((x-my_tm->tm_adjgbccnt)+ my_tm->tm_adjgbccnt*mmax_page/z)*(y-mmax_page+z);
+ r/=x*y;
++
++ j=r<=0.95 && rebalance_maxpages(my_tm,z+mro+my_tm->tm_alt_npage);
++
+ if (sSAnotify_optimize_maximum_pagesA->s.s_dbind!=sLnil)
+- printf("[type %u max %lu(%lu) opt %lu y %lu(%lu) gbcrat %f sav %f]\n",
+- my_tm->tm_type,mmax_page,mro,(long)z,(long)y,tro,(my_tm->tm_adjgbccnt-1)/(1+x-0.9*my_tm->tm_adjgbccnt),r);
+- return r<=0.95 && set_tm_maxpage(my_tm,z+mro) ? 1 : 0;
++ printf("[type %u max %lu(%lu) opt %lu y %lu(%lu) gbcrat %f sav %f new %lu sum %lu phys %lu]\n",
++ my_tm->tm_type,mmax_page,mro,(long)z,(long)y,tro,(my_tm->tm_adjgbccnt/* -1 */)/(1+x-0.9*my_tm->tm_adjgbccnt),r,
++ my_tm->tm_maxpage,sum_maxpages(),phys_pages);
++
++ return j ? 1 : 0;
+
+ }
+
+@@ -483,41 +573,200 @@ Use ALLOCATE to expand the space.",
+ #else
+ #define TOTAL_THIS_TYPE(tm) (tm->tm_nppage * tm->tm_npage)
+ #endif
+-bool prefer_low_mem_contblock=FALSE;
++
++static object cbv=Cnil;
++#define cbsrch1 ((struct contblock ***)cbv->v.v_self)
++#define cbsrche (cbsrch1+cbv->v.v_fillp)
++
++static inline void
++expand_contblock_index_space(void) {
++
++ if (cbv==Cnil) {
++ cbv=(VFUN_NARGS=4,fSmake_vector1(make_fixnum(16),make_fixnum(aet_fix),Cnil,make_fixnum(0)));
++ cbv->v.v_self[0]=(object)&cb_pointer;
++ enter_mark_origin(&cbv);
++ }
++
++ if (cbv->v.v_fillp+1==cbv->v.v_dim) {
++
++ void *v=alloc_relblock(2*cbv->v.v_dim*sizeof(fixnum));
++
++ memcpy(v,cbv->v.v_self,cbv->v.v_dim*sizeof(fixnum));
++ cbv->v.v_self=v;
++ cbv->v.v_dim*=2;
++
++ }
++
++}
++
++static inline void *
++expand_contblock_index(struct contblock ***cbppp) {
++
++ ufixnum i=cbppp-cbsrch1;
++
++ expand_contblock_index_space();
++
++ cbppp=cbsrch1+i;
++ memmove(cbppp+1,cbppp,(cbsrche-cbppp+1)*sizeof(*cbppp));
++ cbv->v.v_fillp++;
++
++ return cbppp;
++
++}
++
++static inline void
++contract_contblock_index(struct contblock ***cbppp) {
++
++ memmove(cbppp+1,cbppp+2,(cbsrche-cbppp-1)*sizeof(*cbppp));
++ cbv->v.v_fillp--;
++
++}
++
++static inline int
++cbcomp(const void *v1,const void *v2) {
++
++ ufixnum u1=(**(struct contblock ** const *)v1)->cb_size;
++ ufixnum u2=(**(struct contblock ** const *)v2)->cb_size;
++
++ return u1<u2 ? -1 : (u1==u2 ? 0 : 1);
++
++}
++
++static inline void *
++bsearchleq(void *i,void *v1,size_t n,size_t s,int (*c)(const void *,const void *)) {
++
++ ufixnum nn=n>>1;
++ void *v=v1+nn*s;
++ int j=c(i,v);
++
++ if (nn)
++ return !j ? v : (j>0 ? bsearchleq(i,v,n-nn,s,c) : bsearchleq(i,v1,nn,s,c));
++ else
++ return j<=0 ? v : v+s;
++
++}
++
++
++static inline struct contblock ***
++find_cbppp(struct contblock *cbp) {
++
++ struct contblock **cbpp=&cbp;
++
++ return cbsrche==cbsrch1 ? cbsrch1 : bsearchleq(&cbpp,cbsrch1,cbsrche-cbsrch1,sizeof(*cbsrch1),cbcomp);
++
++}
++
++static inline struct contblock ***
++find_cbppp_by_n(ufixnum n) {
++
++ struct contblock cb={n,NULL};
++
++ return find_cbppp(&cb);
++
++}
++
++static inline struct contblock **
++find_cbpp(struct contblock ***cbppp,ufixnum n) {
++
++ return *cbppp;
++
++}
++
++
++static inline struct contblock **
++find_contblock(ufixnum n,void **p) {
++
++ *p=find_cbppp_by_n(n);
++ return find_cbpp(*p,n);
++}
++
++inline void
++print_cb(int print) {
++
++ struct contblock *cbp,***cbppp,**cbpp=&cb_pointer;
++ ufixnum k;
++
++ for (cbp=cb_pointer,cbppp=cbsrch1;cbp;cbppp++) {
++ massert(cbppp<cbsrche);
++ massert(*cbppp);
++ massert(**cbppp==cbp);
++ for (k=0;cbp && cbp->cb_size==(**cbppp)->cb_size;cbpp=&cbp->cb_link,cbp=cbp->cb_link,k++);
++ if (print)
++ fprintf(stderr,"%lu %p %p %lu %lu\n",cbppp-cbsrch1,*cbppp,**cbppp,(**cbppp)->cb_size,k);
++ }
++ massert(cbppp==cbsrche);
++ massert(*cbppp==cbpp);
++ massert(!**cbppp);
++
++ fflush(stderr);
++
++}
++
++inline void
++insert_contblock(void *p,ufixnum s) {
++
++ struct contblock *cbp=p,**cbpp,***cbppp;
++
++ cbpp=find_contblock(s,(void **)&cbppp);
++
++ cbp->cb_size=s;
++ cbp->cb_link=*cbpp;
++ *cbpp=cbp;
++
++ if ((!cbp->cb_link || cbp->cb_link->cb_size!=s)) {
++ cbppp=expand_contblock_index(cbppp);
++ cbppp[1]=&cbp->cb_link;
++ }
++
++}
++
++static inline void
++delete_contblock(void *p,struct contblock **cbpp) {
++
++ struct contblock ***cbppp=p;
++ ufixnum s=(*cbpp)->cb_size;
++
++ (*cbpp)=(*cbpp)->cb_link;
++
++ if ((!(*cbpp) || (*cbpp)->cb_size!=s))
++ contract_contblock_index(cbppp);
++
++}
++
++inline void
++reset_contblock_freelist(void) {
++
++ cb_pointer=NULL;
++ cbv->v.v_fillp=0;
++
++}
+
+ inline void *
+ alloc_from_freelist(struct typemanager *tm,fixnum n) {
+
+- void *p,*v,*vp;
+- struct contblock **cbpp;
+- fixnum i;
++ void *p;
+
+ switch (tm->tm_type) {
+
+ case t_contiguous:
+- for (cbpp= &cb_pointer,v=(void *)-1,vp=NULL; (*cbpp)!=NULL; cbpp= &(*cbpp)->cb_link)
+- if ((*cbpp)->cb_size >= n) {
+- if (!prefer_low_mem_contblock) {
+- vp=cbpp;
+- break;
+- } else if ((void *)(*cbpp)<v) {
+- v=*cbpp;
+- vp=cbpp;
+- }
++ {
++ void *pp;
++ struct contblock **cbpp=find_contblock(n,&pp);
++
++ if ((p=*cbpp)) {
++ ufixnum s=(*cbpp)->cb_size;
++ delete_contblock(pp,cbpp);
++ if (n<s)
++ insert_contblock(p+n,s-n);
+ }
+- if (vp) {
+- cbpp=vp;
+- p=(void *)(*cbpp);
+- i=(*cbpp)->cb_size-n;
+- *cbpp=(*cbpp)->cb_link;
+- --ncb;
+- insert_contblock(p+n,i);
+- return(p);
++ return p;
+ }
+ break;
+
+ case t_relocatable:
+- if (rb_limit-rb_pointer>=n)
++ if (rb_pointer>rb_end && rb_pointer+n>rb_limit && rb_pointer+n<rb_end+nrbpage*PAGESIZE)
++ rb_limit=rb_pointer+n;
++ if (rb_limit-rb_pointer>n)
+ return ((rb_pointer+=n)-n);
+ break;
+
+@@ -554,7 +803,7 @@ too_full_p(struct typemanager *tm) {
+
+ switch (tm->tm_type) {
+ case t_relocatable:
+- return 100*(rb_limit-rb_pointer)<pf*(rb_limit-rb_start);
++ return 100*(rb_limit-rb_pointer)<pf*(rb_end-rb_start);
+ break;
+ case t_contiguous:
+ for (cbp=cb_pointer,k=0;cbp;cbp=cbp->cb_link) k+=cbp->cb_size;
+@@ -575,7 +824,7 @@ too_full_p(struct typemanager *tm) {
+ inline void *
+ alloc_after_gc(struct typemanager *tm,fixnum n) {
+
+- if (tm->tm_npage+tpage(tm,n)>=tm->tm_maxpage && GBC_enable) {
++ if (tm->tm_npage+tpage(tm,n)>tm->tm_maxpage && GBC_enable) {
+
+ switch (jmp_gmp) {
+ case 0: /* not in gmp call*/
+@@ -618,11 +867,16 @@ add_pages(struct typemanager *tm,fixnum
+
+ case t_relocatable:
+
++ if (rb_pointer>rb_end) {
++ fprintf(stderr,"Moving relblock low before expanding relblock pages\n");
++ fflush(stderr);
++ GBC(t_relocatable);
++ }
+ nrbpage+=m;
+- rb_end=heap_end+(holepage+nrbpage)*PAGESIZE;
+- rb_limit=rb_end-2*RB_GETA;
++ rb_end+=m*PAGESIZE;
++ rb_limit+=m*PAGESIZE;
+
+- alloc_page(-(nrbpage+holepage));
++ alloc_page(-(2*nrbpage+holepage));
+
+ break;
+
+@@ -656,7 +910,7 @@ alloc_after_adding_pages(struct typemana
+
+ }
+
+- m=tm->tm_maxpage-tm->tm_npage;
++ /* m=tm->tm_maxpage-tm->tm_npage; */
+ add_pages(tm,m);
+
+ return alloc_from_freelist(tm,n);
+@@ -670,15 +924,15 @@ alloc_after_reclaiming_pages(struct type
+
+ if (tm->tm_type>=t_end) return NULL;
+
+- reloc_min=npage(rb_pointer-REAL_RB_START);
++ reloc_min=npage(rb_pointer-rb_start);
+
+ if (m<2*(nrbpage-reloc_min)) {
+
+ set_tm_maxpage(tm_table+t_relocatable,reloc_min);
+ nrbpage=reloc_min;
+
+- GBC(t_relocatable);
+ tm_table[t_relocatable].tm_adjgbccnt--;
++ GBC(t_relocatable);
+
+ return alloc_after_adding_pages(tm,n);
+
+@@ -742,13 +996,31 @@ alloc_object(enum type t) {
+
+ inline void *
+ alloc_contblock(size_t n) {
+- return alloc_mem(tm_of(t_contiguous),ROUND_UP_PTR_CONT(n));
++ return alloc_mem(tm_of(t_contiguous),CEI(n,CPTR_SIZE));
++}
++
++inline void *
++alloc_contblock_no_gc(size_t n) {
++
++ struct typemanager *tm=tm_of(t_contiguous);
++ void *p;
++
++ n=CEI(n,CPTR_SIZE);
++
++ if ((p=alloc_from_freelist(tm,n)))
++ return p;
++
++ if (tpage(tm,n)<(rb_start-heap_end)>>PAGEWIDTH && (p=alloc_after_adding_pages(tm,n)))
++ return p;
++
++ return NULL;
++
+ }
+
+ inline void *
+ alloc_relblock(size_t n) {
+
+- return alloc_mem(tm_of(t_relocatable),ROUND_UP_PTR(n));
++ return alloc_mem(tm_of(t_relocatable),CEI(n,PTR_ALIGN));
+
+ }
+
+@@ -789,7 +1061,7 @@ DEFUNM_NEW("ALLOCATED",object,fSallocate
+ tm = & tm_table[tm->tm_type];
+ if (tm->tm_type == t_relocatable)
+ { tm->tm_npage = (rb_end-rb_start)/PAGESIZE;
+- tm->tm_nfree = rb_end -rb_pointer;
++ tm->tm_nfree = rb_limit -rb_pointer;
+ }
+ else if (tm->tm_type == t_contiguous)
+ { int cbfree =0;
+@@ -808,45 +1080,6 @@ DEFUNM_NEW("ALLOCATED",object,fSallocate
+ ));
+ }
+
+-/* DEFUN_NEW("RESET-NUMBER-USED",object,fSreset_number_used,SI,0,1,NONE,OO,OO,OO,OO,(object typ),"") */
+-/* {int i; */
+-/* if (VFUN_NARGS == 1) */
+-/* { tm_table[t_from_type(typ)].tm_nused = 0;} */
+-/* else */
+-/* for (i=0; i <= t_relocatable ; i++) */
+-/* { tm_table[i].tm_nused = 0;} */
+-/* RETURN1(sLnil); */
+-/* } */
+-
+-#define IN_CONTBLOCK_P(p,pi) ((void *)p>=(void *)pi && (void *)p<(void *)pi+pi->in_use*PAGESIZE)
+-
+-/* SGC cont pages: explicit free calls can come at any time, and we
+- must make sure to add the newly deallocated block to the right
+- list. CM 20030827*/
+-#ifdef SGC
+-void
+-insert_maybe_sgc_contblock(char *p,int s) {
+-
+- struct contblock *tmp_cb_pointer;
+- struct pageinfo *pi;
+-
+- for (pi=contblock_list_head;pi && !IN_CONTBLOCK_P(p,pi);pi=pi->next);
+- massert(pi);
+-
+- if (sgc_enabled && ! (pi->sgc_flags&SGC_PAGE_FLAG)) {
+- tmp_cb_pointer=cb_pointer;
+- cb_pointer=old_cb_pointer;
+- sgc_enabled=0;
+- insert_contblock(p,s);
+- sgc_enabled=1;
+- old_cb_pointer=cb_pointer;
+- cb_pointer=tmp_cb_pointer;
+- } else
+- insert_contblock(p,s);
+-
+-}
+-#endif
+-
+ #ifdef SGC_CONT_DEBUG
+ extern void overlap_check(struct contblock *,struct contblock *);
+ #endif
+@@ -856,78 +1089,17 @@ DEFUN_NEW("PRINT-FREE-CONTBLOCK-LIST",ob
+ struct contblock *cbp,*cbp1;
+
+ for (cbp=cb_pointer;cbp;cbp=cbp->cb_link) {
+- printf("%p %d\n",cbp,cbp->cb_size);
++ printf("%p %lu\n",cbp,cbp->cb_size);
+ for (cbp1=cbp;cbp1;cbp1=cbp1->cb_link)
+ if ((void *)cbp+cbp->cb_size==(void *)cbp1 ||
+ (void *)cbp1+cbp1->cb_size==(void *)cbp)
+- printf(" adjacent to %p %d\n",cbp1,cbp1->cb_size);
++ printf(" adjacent to %p %lu\n",cbp1,cbp1->cb_size);
+ }
+
+ return Cnil;
+
+ }
+
+-void
+-insert_contblock(char *p, int s) {
+-
+- struct contblock **cbpp, *cbp;
+-
+- /* SGC cont pages: This used to return when s<CBMINSIZE, but we need
+- to be able to sweep small (e.g. bignum) contblocks. FIXME:
+- should never be called with s<=0 to begin with. CM 20030827*/
+- if (s<=0)
+- return;
+- ncb++;
+- cbp = (struct contblock *)p;
+- /* SGC cont pages: allocated sizes may not be zero mod CPTR_SIZE,
+- e.g. string fillp, but alloc_contblock rounded up the allocation
+- like this, which we follow here. CM 20030827 */
+- cbp->cb_size = ROUND_UP_PTR_CONT(s);
+-
+- for (cbpp=&cb_pointer;*cbpp;) {
+- if ((void *)(*cbpp)+(*cbpp)->cb_size==(void *)cbp) {
+- /* printf("Merge contblock %p %d %p %d\n",cbp,cbp->cb_size,*cbpp,(*cbpp)->cb_size); */
+- /* fflush(stdout); */
+- (*cbpp)->cb_size+=cbp->cb_size;
+- cbp=*cbpp;
+- *cbpp=(*cbpp)->cb_link;
+- } else if ((void *)(*cbpp)==(void *)cbp+cbp->cb_size) {
+- /* printf("Merge contblock %p %d %p %d\n",cbp,cbp->cb_size,*cbpp,(*cbpp)->cb_size); */
+- /* fflush(stdout); */
+- cbp->cb_size+=(*cbpp)->cb_size;
+- *cbpp=(*cbpp)->cb_link;
+- } else
+- cbpp=&(*cbpp)->cb_link;
+- }
+- s=cbp->cb_size;
+-
+- for (cbpp = &cb_pointer; *cbpp; cbpp = &((*cbpp)->cb_link))
+- if ((*cbpp)->cb_size >= s) {
+-#ifdef SGC_CONT_DEBUG
+- if (*cbpp==cbp) {
+- fprintf(stderr,"Trying to install a circle at %p\n",cbp);
+- exit(1);
+- }
+- if (sgc_enabled)
+- overlap_check(old_cb_pointer,cb_pointer);
+-#endif
+- cbp->cb_link = *cbpp;
+- *cbpp = cbp;
+-#ifdef SGC_CONT_DEBUG
+- if (sgc_enabled)
+- overlap_check(old_cb_pointer,cb_pointer);
+-#endif
+- return;
+- }
+- cbp->cb_link = NULL;
+- *cbpp = cbp;
+-#ifdef SGC_CONT_DEBUG
+- if (sgc_enabled)
+- overlap_check(old_cb_pointer,cb_pointer);
+-#endif
+-
+-}
+-
+ /* Add a tm_distinct field to prevent page type sharing if desired.
+ Not used now, as its never desirable from an efficiency point of
+ view, and as the only known place one must separate is cons and
+@@ -961,7 +1133,7 @@ init_tm(enum type t, char *name, int els
+ return;
+ }
+ tm_table[(int)t].tm_type = t;
+- tm_table[(int)t].tm_size = elsize ? ROUND_UP_PTR(elsize) : 1;
++ tm_table[(int)t].tm_size = elsize ? CEI(elsize,PTR_ALIGN) : 1;
+ tm_table[(int)t].tm_nppage = (PAGESIZE-sizeof(struct pageinfo))/tm_table[(int)t].tm_size;
+ tm_table[(int)t].tm_free = OBJNULL;
+ tm_table[(int)t].tm_nfree = 0;
+@@ -1096,13 +1268,19 @@ gcl_init_alloc(void *cs_start) {
+
+ update_real_maxpage();
+
+- if (gcl_alloc_initialized) return;
++ if (gcl_alloc_initialized) {
++ massert(rb_start==heap_end &&rb_end==heap_end && rb_limit==heap_end && rb_pointer==heap_end);
++ holepage=new_holepage;
++ alloc_page(-holepage);
++ rb_start=rb_end=rb_limit=rb_pointer=heap_end+(holepage<<PAGEWIDTH);
++ return;
++ }
+
+ #ifdef INIT_ALLOC
+ INIT_ALLOC;
+ #endif
+
+- data_start=heap_end;
++ initial_sbrk=data_start=heap_end;
+ first_data_page=page(data_start);
+
+ holepage=new_holepage;
+@@ -1118,40 +1296,39 @@ gcl_init_alloc(void *cs_start) {
+ Gave each page type at least some sgc pages by default. Of
+ course changeable by allocate-sgc. CM 20030827 */
+
+- init_tm(t_cons, ".CONS", sizeof(struct cons), 65536 ,50,0 );
+- init_tm(t_fixnum, "NFIXNUM",sizeof(struct fixnum_struct), 8192,20,0);
+- init_tm(t_structure, "SSTRUCTURE", sizeof(struct structure), 5461,1,0 );
+- init_tm(t_cfun, "fCFUN", sizeof(struct cfun), 4096,1,0 );
+- init_tm(t_sfun, "gSFUN", sizeof(struct sfun),409,1,0 );
+- init_tm(t_string, "\"STRING", sizeof(struct string), 5461,1,0 );
+- init_tm(t_array, "aARRAY", sizeof(struct array), 4681,1,0 );
+- init_tm(t_symbol, "|SYMBOL", sizeof(struct symbol), 3640,1,0 );
+- init_tm(t_bignum, "BBIGNUM", sizeof(struct bignum), 2730,1,0 );
+- init_tm(t_ratio, "RRATIONAL", sizeof(struct ratio), 170,1,0 );
+- init_tm(t_shortfloat, "FSHORT-FLOAT",sizeof(struct shortfloat_struct), 256 ,1,0);
+- init_tm(t_longfloat, "LLONG-FLOAT",sizeof(struct longfloat_struct), 170 ,1,0);
+- init_tm(t_complex, "CCOMPLEX", sizeof(struct ocomplex), 170 ,1,0);
+- init_tm(t_character,"#CHARACTER",sizeof(struct character), 256 ,1,0);
+- init_tm(t_package, ":PACKAGE", sizeof(struct package), 2*PAGESIZE / sizeof(struct package),1,0);
+- init_tm(t_hashtable, "hHASH-TABLE", sizeof(struct hashtable), 78,1,0 );
+- init_tm(t_vector, "vVECTOR", sizeof(struct vector), 146 ,1,0);
+- init_tm(t_bitvector, "bBIT-VECTOR", sizeof(struct bitvector), 73 ,1,0);
+- init_tm(t_stream, "sSTREAM", sizeof(struct stream), 78 ,1,0);
+- init_tm(t_random, "$RANDOM-STATE", sizeof(struct random), 256 ,1,0);
+- init_tm(t_readtable, "rREADTABLE", sizeof(struct readtable), 256 ,1,0);
+- init_tm(t_pathname, "pPATHNAME", sizeof(struct pathname), 73 ,1,0);
+- init_tm(t_cclosure, "cCCLOSURE", sizeof(struct cclosure), 85 ,1,0);
+- init_tm(t_closure, "cCLOSURE", sizeof(struct cclosure), 85 ,1,0);
+- init_tm(t_vfun, "VVFUN", sizeof(struct vfun), 102 ,1,0);
++ init_tm(t_cons, ".CONS", sizeof(struct cons), 0 ,50,0 );
++ init_tm(t_fixnum, "NFIXNUM",sizeof(struct fixnum_struct), 0,20,0);
++ init_tm(t_structure, "SSTRUCTURE", sizeof(struct structure),0,1,0 );
++ init_tm(t_cfun, "fCFUN", sizeof(struct cfun),0,1,0 );
++ init_tm(t_sfun, "gSFUN", sizeof(struct sfun),0,1,0 );
++ init_tm(t_string, "\"STRING", sizeof(struct string),0,1,0 );
++ init_tm(t_array, "aARRAY", sizeof(struct array),0,1,0 );
++ init_tm(t_symbol, "|SYMBOL", sizeof(struct symbol),0,1,0 );
++ init_tm(t_bignum, "BBIGNUM", sizeof(struct bignum),0,1,0 );
++ init_tm(t_ratio, "RRATIONAL", sizeof(struct ratio),0,1,0 );
++ init_tm(t_shortfloat, "FSHORT-FLOAT",sizeof(struct shortfloat_struct),0 ,1,0);
++ init_tm(t_longfloat, "LLONG-FLOAT",sizeof(struct longfloat_struct),0 ,1,0);
++ init_tm(t_complex, "CCOMPLEX", sizeof(struct ocomplex),0 ,1,0);
++ init_tm(t_character,"#CHARACTER",sizeof(struct character),0 ,1,0);
++ init_tm(t_package, ":PACKAGE", sizeof(struct package),0,1,0);
++ init_tm(t_hashtable, "hHASH-TABLE", sizeof(struct hashtable),0,1,0 );
++ init_tm(t_vector, "vVECTOR", sizeof(struct vector),0 ,1,0);
++ init_tm(t_bitvector, "bBIT-VECTOR", sizeof(struct bitvector),0 ,1,0);
++ init_tm(t_stream, "sSTREAM", sizeof(struct stream),0 ,1,0);
++ init_tm(t_random, "$RANDOM-STATE", sizeof(struct random),0 ,1,0);
++ init_tm(t_readtable, "rREADTABLE", sizeof(struct readtable),0 ,1,0);
++ init_tm(t_pathname, "pPATHNAME", sizeof(struct pathname),0 ,1,0);
++ init_tm(t_cclosure, "cCCLOSURE", sizeof(struct cclosure),0 ,1,0);
++ init_tm(t_closure, "cCLOSURE", sizeof(struct closure),0 ,1,0);
++ init_tm(t_vfun, "VVFUN", sizeof(struct vfun),0 ,1,0);
+ init_tm(t_gfun, "gGFUN", sizeof(struct sfun), 0 ,1,0);
+ init_tm(t_afun, "AAFUN", sizeof(struct sfun), 0 ,1,0);
+- init_tm(t_cfdata, "cCFDATA", sizeof(struct cfdata), 102 ,1,0);
+- init_tm(t_spice, "!SPICE", sizeof(struct spice), 4096 ,1,0);
++ init_tm(t_cfdata, "cCFDATA", sizeof(struct cfdata),0 ,1,0);
++ init_tm(t_spice, "!SPICE", sizeof(struct spice),0 ,1,0);
+ init_tm(t_relocatable, "%RELOCATABLE-BLOCKS", 0,0,20,1);
+ init_tm(t_contiguous, "_CONTIGUOUS-BLOCKS", 0,0,20,1);
+
+
+- ncb = 0;
+ ncbpage = 0;
+ set_tm_maxpage(tm_table+t_contiguous,1);
+ #ifdef GCL_GPROF
+@@ -1162,7 +1339,7 @@ gcl_init_alloc(void *cs_start) {
+ set_tm_maxpage(tm_table+t_relocatable,1);
+ nrbpage=0;
+
+- alloc_page(-(holepage + nrbpage));
++ alloc_page(-(holepage + 2*nrbpage));
+
+ rb_start = rb_pointer = heap_end + PAGESIZE*holepage;
+ rb_end = rb_start + PAGESIZE*nrbpage;
+@@ -1171,6 +1348,8 @@ gcl_init_alloc(void *cs_start) {
+ tm_table[(int)t_relocatable].tm_sgc = 50;
+ #endif
+
++ expand_contblock_index_space();
++
+ gcl_alloc_initialized=1;
+
+ }
+@@ -1554,7 +1733,7 @@ static char *baby_malloc(n)
+ {
+ char *res= last_baby;
+ int m;
+- n = ROUND_UP_PTR(n);
++ n = CEI(n,PTR_ALIGN);
+ m = n+ sizeof(int);
+ if ((res +m-baby_malloc_data) > sizeof(baby_malloc_data))
+ {
+@@ -1642,11 +1821,11 @@ free(void *ptr) {
+ for (p = &malloc_list,pp=*p; pp && !endp(pp); p = &((pp)->c.c_cdr),pp=pp->c.c_cdr)
+ if ((pp)->c.c_car->st.st_self == ptr) {
+ /* SGC contblock pages: Its possible this is on an old page CM 20030827 */
+-#ifdef SGC
+- insert_maybe_sgc_contblock((pp)->c.c_car->st.st_self,(pp)->c.c_car->st.st_dim);
+-#else
+- insert_contblock((pp)->c.c_car->st.st_self,(pp)->c.c_car->st.st_dim);
+-#endif
++/* #ifdef SGC */
++/* insert_maybe_sgc_contblock((pp)->c.c_car->st.st_self,(pp)->c.c_car->st.st_dim); */
++/* #else */
++/* insert_contblock((pp)->c.c_car->st.st_self,(pp)->c.c_car->st.st_dim); */
++/* #endif */
+ (pp)->c.c_car->st.st_self = NULL;
+ *p = pp->c.c_cdr;
+ #ifdef GCL_GPROF
+@@ -1707,11 +1886,11 @@ realloc(void *ptr, size_t size) {
+ for (i = 0; i < size; i++)
+ x->st.st_self[i] = ((char *)ptr)[i];
+ /* SGC contblock pages: Its possible this is on an old page CM 20030827 */
+-#ifdef SGC
+- insert_maybe_sgc_contblock(ptr, j);
+-#else
+- insert_contblock(ptr, j);
+-#endif
++/* #ifdef SGC */
++/* insert_maybe_sgc_contblock(ptr, j); */
++/* #else */
++/* insert_contblock(ptr, j); */
++/* #endif */
+ return(x->st.st_self);
+ }
+ }
+--- gcl-2.6.12.orig/o/array.c
++++ gcl-2.6.12/o/array.c
+@@ -457,15 +457,15 @@ static longfloat DFLT_aet_lf = 0.0;
+ static object Iname_t = sLt;
+ static struct { char * dflt; object *namep;} aet_types[] =
+ { {(char *) &DFLT_aet_object, &Iname_t,}, /* t */
+- {(char *) &DFLT_aet_ch, &sLstring_char,},/* string-char */
++ {(char *) &DFLT_aet_ch, &sLcharacter,},/* character */
+ {(char *) &DFLT_aet_fix, &sLbit,}, /* bit */
+ {(char *) &DFLT_aet_fix, &sLfixnum,}, /* fixnum */
+ {(char *) &DFLT_aet_sf, &sLshort_float,}, /* short-float */
+ {(char *) &DFLT_aet_lf, &sLlong_float,}, /* long-float */
+- {(char *) &DFLT_aet_char,&sLsigned_char,}, /* signed char */
+- {(char *) &DFLT_aet_char,&sLunsigned_char,}, /* unsigned char */
+- {(char *) &DFLT_aet_short,&sLsigned_short,}, /* signed short */
+- {(char *) &DFLT_aet_short, &sLunsigned_short}, /* unsigned short */
++ {(char *) &DFLT_aet_char,&sSsigned_char,}, /* signed char */
++ {(char *) &DFLT_aet_char,&sSunsigned_char,}, /* unsigned char */
++ {(char *) &DFLT_aet_short,&sSsigned_short,}, /* signed short */
++ {(char *) &DFLT_aet_short, &sSunsigned_short}, /* unsigned short */
+ };
+
+ DEFUN_NEW("GET-AELTTYPE",object,fSget_aelttype,SI,1,1,NONE,OO,OO,OO,OO,(object x),"")
+--- gcl-2.6.12.orig/o/assignment.c
++++ gcl-2.6.12/o/assignment.c
+@@ -172,7 +172,7 @@ DEFUNO_NEW("FSET",object,fSfset,SI
+ sym->s.s_mflag = FALSE;
+ } else if (car(function) == sLspecial)
+ FEerror("Cannot define a special form.", 0);
+- else if (function->c.c_car == sLmacro) {
++ else if (function->c.c_car == sSmacro) {
+ sym->s.s_gfdef = function->c.c_cdr;
+ sym->s.s_mflag = TRUE;
+ } else {
+--- gcl-2.6.12.orig/o/bind.c
++++ gcl-2.6.12/o/bind.c
+@@ -918,8 +918,8 @@ parse_key_new_new(int n, object *base, s
+ /* from here down identical to parse_key_rest */
+ new = new + n ;
+ {int j=keys->n;
+- object *p= (object *)(keys->defaults);
+- while (--j >=0) base[j]=p[j];
++ object **p= (object **)(keys->defaults);
++ while (--j >=0) base[j]=*(p[j]);
+ }
+ {if (n==0){ return 0;}
+ {int allow = keys->allow_other_keys;
+@@ -939,7 +939,7 @@ parse_key_new_new(int n, object *base, s
+ new = new -2;
+ k = *new;
+ while(--i >= 0)
+- {if ((*(ke++)).o == k)
++ {if (*(*(ke++)).o == k)
+ {base[i]= new[1];
+ n=n-2;
+ goto top;
+@@ -1026,8 +1026,7 @@ parse_key_rest_new(object rest, int n, o
+
+ new = new + n ;
+ {int j=keys->n;
+- object *p= (object *)(keys->defaults);
+- while (--j >=0) base[j]=p[j];
++ while (--j >=0) base[j]=*keys->defaults[j].o;
+ }
+ {if (n==0){ return 0;}
+ {int allow = keys->allow_other_keys;
+@@ -1047,7 +1046,7 @@ parse_key_rest_new(object rest, int n, o
+ new = new -2;
+ k = *new;
+ while(--i >= 0)
+- {if ((*(ke++)).o == k)
++ {if (*(*(ke++)).o == k)
+ {base[i]= new[1];
+ n=n-2;
+ goto top;
+@@ -1066,18 +1065,19 @@ parse_key_rest_new(object rest, int n, o
+ return -1;
+ }}}
+
++static object foo[2]={Cnil,OBJNULL};
+
+ void
+ set_key_struct(struct key *ks, object data)
+ {int i=ks->n;
+ while (--i >=0)
+- {ks->keys[i].o = data->cfd.cfd_self[ ks->keys[i].i ];
++ {ks->keys[i].o = data->cfd.cfd_self+ks->keys[i].i;
+ if (ks->defaults != (void *)Cstd_key_defaults)
+ {fixnum m=ks->defaults[i].i;
+ ks->defaults[i].o=
+- (m==-2 ? Cnil :
+- m==-1 ? OBJNULL :
+- data->cfd.cfd_self[m]);}
++ (m==-2 ? foo :
++ m==-1 ? foo+1 :
++ data->cfd.cfd_self+m);}
+ }}
+
+ #undef AUX
+--- gcl-2.6.12.orig/o/cfun.c
++++ gcl-2.6.12/o/cfun.c
+@@ -306,6 +306,15 @@ make_special_form_internal(char *s, void
+ return(x);
+ }
+
++object
++make_si_special_form_internal(char *s, void (*f)())
++{
++ object x;
++ x = make_si_ordinary(s);
++ x->s.s_sfdef = f;
++ return(x);
++}
++
+ DEFUN_NEW("COMPILED-FUNCTION-NAME",object,fScompiled_function_name,SI
+ ,1,1,NONE,OO,OO,OO,OO,(object fun),"")
+
+--- gcl-2.6.12.orig/o/character.d
++++ gcl-2.6.12/o/character.d
+@@ -50,14 +50,6 @@ Foundation, 675 Mass Ave, Cambridge, MA
+ @(return Cnil)
+ @)
+
+-@(defun string_char_p (c)
+-@
+- check_type_character(&c);
+- if (char_font(c) != 0 || char_bits(c) != 0)
+- @(return Cnil)
+- @(return Ct)
+-@)
+-
+ @(defun alpha_char_p (c)
+ int i;
+ @
+@@ -358,18 +350,6 @@ BEGIN:
+ @(return `make_fixnum(char_code(c))`)
+ @)
+
+-@(defun char_bits (c)
+-@
+- check_type_character(&c);
+- @(return `small_fixnum(char_bits(c))`)
+-@)
+-
+-@(defun char_font (c)
+-@
+- check_type_character(&c);
+- @(return `small_fixnum(char_font(c))`)
+-@)
+-
+ @(defun code_char (c &o (b `make_fixnum(0)`) (f `make_fixnum(0)`))
+ object x;
+ @
+@@ -393,29 +373,6 @@ BEGIN:
+ @(return x)
+ @)
+
+-@(defun make_char (c &o (b `make_fixnum(0)`) (f `make_fixnum(0)`))
+- object x;
+- int code;
+-@
+- check_type_character(&c);
+- code = char_code(c);
+- check_type_non_negative_integer(&b);
+- check_type_non_negative_integer(&f);
+- if (type_of(b) == t_bignum)
+- @(return Cnil)
+- if (type_of(f) == t_bignum)
+- @(return Cnil)
+- if (fix(b)>=CHBITSLIM || fix(f)>=CHFONTLIM)
+- @(return Cnil)
+- if (fix(b) == 0 && fix(f) == 0)
+- @(return `code_char(code)`)
+- x = alloc_object(t_character);
+- char_code(x) = code;
+- char_bits(x) = fix(b);
+- char_font(x) = fix(f);
+- @(return x)
+-@)
+-
+ @(defun char_upcase (c)
+ @
+ check_type_character(&c);
+@@ -489,30 +446,6 @@ int w, r;
+ @(return `make_fixnum(i)`)
+ @)
+
+-@(defun int_char (x)
+- int i, c, b, f;
+-@
+- check_type_non_negative_integer(&x);
+- if (type_of(x) == t_bignum)
+- @(return Cnil)
+- i = fix(x);
+- c = i % CHCODELIM;
+- i /= CHCODELIM;
+- b = i % CHBITSLIM;
+- i /= CHBITSLIM;
+- f = i % CHFONTLIM;
+- i /= CHFONTLIM;
+- if (i > 0)
+- @(return Cnil)
+- if (b == 0 && f == 0)
+- @(return `code_char(c)`)
+- x = alloc_object(t_character);
+- char_code(x) = c;
+- char_bits(x) = b;
+- char_font(x) = f;
+- @(return x)
+-@)
+-
+ @(defun char_name (c)
+ @
+ check_type_character(&c);
+@@ -563,18 +496,6 @@ int w, r;
+ @(return Cnil)
+ @)
+
+-@(defun char_bit (c n)
+-@
+- check_type_character(&c);
+- FEerror("Cannot get char-bit of ~S.", 1, c);
+-@)
+-
+-@(defun set_char_bit (c n v)
+-@
+- check_type_character(&c);
+- FEerror("Cannot set char-bit of ~S.", 1, c);
+-@)
+-
+ void
+ gcl_init_character()
+ {
+@@ -599,8 +520,8 @@ gcl_init_character()
+ #endif
+
+ make_constant("CHAR-CODE-LIMIT", make_fixnum(CHCODELIM));
+- make_constant("CHAR-FONT-LIMIT", make_fixnum(CHFONTLIM));
+- make_constant("CHAR-BITS-LIMIT", make_fixnum(CHBITSLIM));
++ make_si_constant("CHAR-FONT-LIMIT", make_fixnum(CHFONTLIM));
++ make_si_constant("CHAR-BITS-LIMIT", make_fixnum(CHBITSLIM));
+
+ STreturn = make_simple_string("Return");
+ enter_mark_origin(&STreturn);
+@@ -620,18 +541,97 @@ gcl_init_character()
+ STnewline = make_simple_string("Newline");
+ enter_mark_origin(&STnewline);
+
+- make_constant("CHAR-CONTROL-BIT", make_fixnum(0));
+- make_constant("CHAR-META-BIT", make_fixnum(0));
+- make_constant("CHAR-SUPER-BIT", make_fixnum(0));
+- make_constant("CHAR-HYPER-BIT", make_fixnum(0));
++ make_si_constant("CHAR-CONTROL-BIT", make_fixnum(0));
++ make_si_constant("CHAR-META-BIT", make_fixnum(0));
++ make_si_constant("CHAR-SUPER-BIT", make_fixnum(0));
++ make_si_constant("CHAR-HYPER-BIT", make_fixnum(0));
++
+ }
+
++@(defun make_char (c &o (b `make_fixnum(0)`) (f `make_fixnum(0)`))
++ object x;
++ int code;
++@
++ check_type_character(&c);
++ code = char_code(c);
++ check_type_non_negative_integer(&b);
++ check_type_non_negative_integer(&f);
++ if (type_of(b) == t_bignum)
++ @(return Cnil)
++ if (type_of(f) == t_bignum)
++ @(return Cnil)
++ if (fix(b)>=CHBITSLIM || fix(f)>=CHFONTLIM)
++ @(return Cnil)
++ if (fix(b) == 0 && fix(f) == 0)
++ @(return `code_char(code)`)
++ x = alloc_object(t_character);
++ char_code(x) = code;
++ char_bits(x) = fix(b);
++ char_font(x) = fix(f);
++ @(return x)
++@)
++
++@(defun char_bits (c)
++@
++ check_type_character(&c);
++ @(return `small_fixnum(char_bits(c))`)
++@)
++
++@(defun char_font (c)
++@
++ check_type_character(&c);
++ @(return `small_fixnum(char_font(c))`)
++@)
++
++@(defun char_bit (c n)
++@
++ check_type_character(&c);
++ FEerror("Cannot get char-bit of ~S.", 1, c);
++@)
++
++@(defun set_char_bit (c n v)
++@
++ check_type_character(&c);
++ FEerror("Cannot set char-bit of ~S.", 1, c);
++@)
++
++@(defun string_char_p (c)
++@
++ check_type_character(&c);
++ if (char_font(c) != 0 || char_bits(c) != 0)
++ @(return Cnil)
++ @(return Ct)
++@)
++
++@(defun int_char (x)
++ int i, c, b, f;
++@
++ check_type_non_negative_integer(&x);
++ if (type_of(x) == t_bignum)
++ @(return Cnil)
++ i = fix(x);
++ c = i % CHCODELIM;
++ i /= CHCODELIM;
++ b = i % CHBITSLIM;
++ i /= CHBITSLIM;
++ f = i % CHFONTLIM;
++ i /= CHFONTLIM;
++ if (i > 0)
++ @(return Cnil)
++ if (b == 0 && f == 0)
++ @(return `code_char(c)`)
++ x = alloc_object(t_character);
++ char_code(x) = c;
++ char_bits(x) = b;
++ char_font(x) = f;
++ @(return x)
++@)
++
+ void
+ gcl_init_character_function()
+ {
+ make_function("STANDARD-CHAR-P", Lstandard_char_p);
+ make_function("GRAPHIC-CHAR-P", Lgraphic_char_p);
+- make_function("STRING-CHAR-P", Lstring_char_p);
+ make_function("ALPHA-CHAR-P", Lalpha_char_p);
+ make_function("UPPER-CASE-P", Lupper_case_p);
+ make_function("LOWER-CASE-P", Llower_case_p);
+@@ -652,17 +652,18 @@ gcl_init_character_function()
+ make_function("CHAR-NOT-LESSP", Lchar_not_lessp);
+ make_function("CHARACTER", Lcharacter);
+ make_function("CHAR-CODE", Lchar_code);
+- make_function("CHAR-BITS", Lchar_bits);
+- make_function("CHAR-FONT", Lchar_font);
+ make_function("CODE-CHAR", Lcode_char);
+- make_function("MAKE-CHAR", Lmake_char);
+ make_function("CHAR-UPCASE", Lchar_upcase);
+ make_function("CHAR-DOWNCASE", Lchar_downcase);
+ make_function("DIGIT-CHAR", Ldigit_char);
+ make_function("CHAR-INT", Lchar_int);
+- make_function("INT-CHAR", Lint_char);
+ make_function("CHAR-NAME", Lchar_name);
+ make_function("NAME-CHAR", Lname_char);
+- make_function("CHAR-BIT", Lchar_bit);
+- make_function("SET-CHAR-BIT", Lset_char_bit);
++ make_si_function("INT-CHAR", Lint_char);
++ make_si_function("MAKE-CHAR", Lmake_char);
++ make_si_function("CHAR-BITS", Lchar_bits);
++ make_si_function("CHAR-FONT", Lchar_font);
++ make_si_function("CHAR-BIT", Lchar_bit);
++ make_si_function("SET-CHAR-BIT", Lset_char_bit);
++ make_si_function("STRING-CHAR-P", Lstring_char_p);
+ }
+--- gcl-2.6.12.orig/o/cmpaux.c
++++ gcl-2.6.12/o/cmpaux.c
+@@ -48,7 +48,7 @@ DEFUNO_NEW("SPECIALP",object,fSspecialp,
+ RETURN1(sym);
+ }
+
+-DEF_ORDINARY("DEBUG",sSdebug,SI,"");
++DEF_ORDINARY("DEBUGGER",sSdebugger,SI,"");
+
+ DEFUN_NEW("DEFVAR1",object,fSdefvar1,SI
+ ,2,3,NONE,OO,OO,OO,OO,(object sym,object val,...),"")
+@@ -71,10 +71,10 @@ DEFUN_NEW("DEFVAR1",object,fSdefvar1,SI
+ }
+
+
+-DEFUN_NEW("DEBUG",object,fSdebug,SI
++DEFUN_NEW("DEBUG",object,fLdebug,LISP
+ ,2,2,NONE,OO,OO,OO,OO,(object sym,object val),"")
+ { /* 2 args */
+- putprop(sym,val,sSdebug);
++ putprop(sym,val,sSdebugger);
+ RETURN1(sym);
+ }
+
+--- gcl-2.6.12.orig/o/error.c
++++ gcl-2.6.12/o/error.c
+@@ -67,27 +67,27 @@ ihs_function_name(object x)
+ y = x->c.c_car;
+ if (y == sLlambda)
+ return(sLlambda);
+- if (y == sLlambda_closure)
+- return(sLlambda_closure);
+- if (y == sLlambda_block || y == sSlambda_block_expanded) {
++ if (y == sSlambda_closure)
++ return(sSlambda_closure);
++ if (y == sSlambda_block || y == sSlambda_block_expanded) {
+ x = x->c.c_cdr;
+ if (type_of(x) != t_cons)
+- return(sLlambda_block);
++ return(sSlambda_block);
+ return(x->c.c_car);
+ }
+- if (y == sLlambda_block_closure) {
++ if (y == sSlambda_block_closure) {
+ x = x->c.c_cdr;
+ if (type_of(x) != t_cons)
+- return(sLlambda_block_closure);
++ return(sSlambda_block_closure);
+ x = x->c.c_cdr;
+ if (type_of(x) != t_cons)
+- return(sLlambda_block_closure);
++ return(sSlambda_block_closure);
+ x = x->c.c_cdr;
+ if (type_of(x) != t_cons)
+- return(sLlambda_block_closure);
++ return(sSlambda_block_closure);
+ x = x->c.c_cdr;
+ if (type_of(x) != t_cons)
+- return(sLlambda_block_closure);
++ return(sSlambda_block_closure);
+ return(x->c.c_car);
+ }
+ /* a general special form */
+--- gcl-2.6.12.orig/o/eval.c
++++ gcl-2.6.12/o/eval.c
+@@ -227,7 +227,7 @@ funcall(object fun)
+ c = FALSE;
+ fun = fun->c.c_cdr;
+
+- }else if (x == sLlambda_block) {
++ }else if (x == sSlambda_block) {
+ b = TRUE;
+ c = FALSE;
+ if(sSlambda_block_expanded->s.s_dbind!=OBJNULL)
+@@ -237,14 +237,14 @@ funcall(object fun)
+
+
+
+- } else if (x == sLlambda_closure) {
++ } else if (x == sSlambda_closure) {
+ b = FALSE;
+ c = TRUE;
+ fun = fun->c.c_cdr;
+ } else if (x == sLlambda) {
+ b = c = FALSE;
+ fun = fun->c.c_cdr;
+- } else if (x == sLlambda_block_closure) {
++ } else if (x == sSlambda_block_closure) {
+ b = c = TRUE;
+ fun = fun->c.c_cdr;
+ } else
+@@ -644,13 +644,13 @@ EVAL:
+
+ vs_check;
+
+- if (Vevalhook->s.s_dbind != Cnil && eval1 == 0)
++ if (siVevalhook->s.s_dbind != Cnil && eval1 == 0)
+ {
+ bds_ptr old_bds_top = bds_top;
+- object hookfun = symbol_value(Vevalhook);
++ object hookfun = symbol_value(siVevalhook);
+ /* check if Vevalhook is unbound */
+
+- bds_bind(Vevalhook, Cnil);
++ bds_bind(siVevalhook, Cnil);
+ form = Ifuncall_n(hookfun,2,form,list(3,lex_env[0],lex_env[1],lex_env[2]));
+ bds_unwind(old_bds_top);
+ return form;
+@@ -721,7 +721,7 @@ APPLICATION:
+ for (x = lex_env[1]; type_of(x) == t_cons; x = x->c.c_cdr)
+ if (x->c.c_car->c.c_car == fun) {
+ x = x->c.c_car;
+- if (MMcadr(x) == sLmacro) {
++ if (MMcadr(x) == sSmacro) {
+ x = MMcaddr(x);
+ goto EVAL_MACRO;
+ }
+@@ -755,10 +755,10 @@ EVAL_ARGS:
+ vs_top = ++top;
+ form = MMcdr(form);}
+ n =top - base; /* number of args */
+- if (Vapplyhook->s.s_dbind != Cnil) {
++ if (siVapplyhook->s.s_dbind != Cnil) {
+ base[0]= (object)n;
+ base[0] = c_apply_n(list,n+1,base);
+- x = Ifuncall_n(Vapplyhook->s.s_dbind,3,
++ x = Ifuncall_n(siVapplyhook->s.s_dbind,3,
+ x, /* the function */
+ base[0], /* the arg list */
+ list(3,lex_env[0],lex_env[1],lex_env[2]));
+@@ -775,7 +775,7 @@ EVAL_ARGS:
+
+ LAMBDA:
+ if (type_of(fun) == t_cons && MMcar(fun) == sLlambda) {
+- x = listA(4,sLlambda_closure,lex_env[0],lex_env[1],lex_env[2],Mcdr(fun));
++ x = listA(4,sSlambda_closure,lex_env[0],lex_env[1],lex_env[2],Mcdr(fun));
+ goto EVAL_ARGS;
+ }
+ FEinvalid_function(fun);
+@@ -805,13 +805,13 @@ EVAL:
+
+ vs_check;
+
+- if (Vevalhook->s.s_dbind != Cnil && eval1 == 0)
++ if (siVevalhook->s.s_dbind != Cnil && eval1 == 0)
+ {
+ bds_ptr old_bds_top = bds_top;
+- object hookfun = symbol_value(Vevalhook);
+- /* check if Vevalhook is unbound */
++ object hookfun = symbol_value(siVevalhook);
++ /* check if siVevalhook is unbound */
+
+- bds_bind(Vevalhook, Cnil);
++ bds_bind(siVevalhook, Cnil);
+ vs_base = vs_top;
+ vs_push(form);
+ vs_push(lex_env[0]);
+@@ -903,7 +903,7 @@ APPLICATION:
+ for (x = lex_env[1]; type_of(x) == t_cons; x = x->c.c_cdr)
+ if (x->c.c_car->c.c_car == fun) {
+ x = x->c.c_car;
+- if (MMcadr(x) == sLmacro) {
++ if (MMcadr(x) == sSmacro) {
+ x = MMcaddr(x);
+ goto EVAL_MACRO;
+ }
+@@ -940,7 +940,7 @@ EVAL_ARGS:
+ form = MMcdr(form);
+ }
+ vs_base = base;
+- if (Vapplyhook->s.s_dbind != Cnil) {
++ if (siVapplyhook->s.s_dbind != Cnil) {
+ call_applyhook(fun);
+ return;
+ }
+@@ -959,7 +959,7 @@ LAMBDA:
+ temporary = make_cons(lex_env[2], fun->c.c_cdr);
+ temporary = make_cons(lex_env[1], temporary);
+ temporary = make_cons(lex_env[0], temporary);
+- x = make_cons(sLlambda_closure, temporary);
++ x = make_cons(sSlambda_closure, temporary);
+ vs_push(x);
+ goto EVAL_ARGS;
+ }
+@@ -972,7 +972,7 @@ call_applyhook(object fun)
+ object ah;
+ object *v;
+
+- ah = symbol_value(Vapplyhook);
++ ah = symbol_value(siVapplyhook);
+ v = vs_base + 1;
+ vs_push(Cnil);
+ while (vs_top > v)
+@@ -1040,7 +1040,7 @@ DEFUNOM_NEW("EVAL",object,fLeval,LISP
+ return Ivs_values();
+ }
+
+-LFD(Levalhook)(void)
++LFD(siLevalhook)(void)
+ {
+ object env;
+ bds_ptr old_bds_top = bds_top;
+@@ -1062,15 +1062,15 @@ LFD(Levalhook)(void)
+ vs_push(car(env));
+ } else
+ too_many_arguments();
+- bds_bind(Vevalhook, vs_base[1]);
+- bds_bind(Vapplyhook, vs_base[2]);
++ bds_bind(siVevalhook, vs_base[1]);
++ bds_bind(siVapplyhook, vs_base[2]);
+ eval1 = 1;
+ eval(vs_base[0]);
+ lex_env = lex;
+ bds_unwind(old_bds_top);
+ }
+
+-LFD(Lapplyhook)(void)
++LFD(siLapplyhook)(void)
+ {
+
+ object env;
+@@ -1094,8 +1094,8 @@ LFD(Lapplyhook)(void)
+ vs_push(car(env));
+ } else
+ too_many_arguments();
+- bds_bind(Vevalhook, vs_base[2]);
+- bds_bind(Vapplyhook, vs_base[3]);
++ bds_bind(siVevalhook, vs_base[2]);
++ bds_bind(siVapplyhook, vs_base[3]);
+ z = vs_top;
+ for (l = vs_base[1]; !endp(l); l = l->c.c_cdr)
+ vs_push(l->c.c_car);
+@@ -1392,15 +1392,15 @@ gcl_init_eval(void)
+ make_constant("CALL-ARGUMENTS-LIMIT", make_fixnum(64));
+
+
+- Vevalhook = make_special("*EVALHOOK*", Cnil);
+- Vapplyhook = make_special("*APPLYHOOK*", Cnil);
++ siVevalhook = make_si_special("*EVALHOOK*", Cnil);
++ siVapplyhook = make_si_special("*APPLYHOOK*", Cnil);
+
+
+ three_nils.nil3_self[0] = Cnil;
+ three_nils.nil3_self[1] = Cnil;
+ three_nils.nil3_self[2] = Cnil;
+
+- make_function("EVALHOOK", Levalhook);
+- make_function("APPLYHOOK", Lapplyhook);
++ make_si_function("EVALHOOK", siLevalhook);
++ make_si_function("APPLYHOOK", siLapplyhook);
+
+ }
+--- gcl-2.6.12.orig/o/fasdump.c
++++ gcl-2.6.12/o/fasdump.c
+@@ -345,14 +345,14 @@ getd(str)
+ #define READ_BYTE1() getc(fas_stream)
+
+ #define GET8(varx ) \
+- do{unsigned long var=(unsigned long)READ_BYTE1(); \
+- var |= ((unsigned long)READ_BYTE1() << SIZE_BYTE); \
+- var |= ((unsigned long)READ_BYTE1() << (2*SIZE_BYTE)); \
+- var |= ((unsigned long)READ_BYTE1() << (3*SIZE_BYTE)); \
+- var |= ((unsigned long)READ_BYTE1() << (4*SIZE_BYTE)); \
+- var |= ((unsigned long)READ_BYTE1() << (5*SIZE_BYTE)); \
+- var |= ((unsigned long)READ_BYTE1() << (6*SIZE_BYTE)); \
+- var |= ((unsigned long)READ_BYTE1() << (7*SIZE_BYTE)); \
++ do{unsigned long long var=READ_BYTE1(); \
++ var |= ((unsigned long long)READ_BYTE1() << SIZE_BYTE); \
++ var |= ((unsigned long long)READ_BYTE1() << (2*SIZE_BYTE)); \
++ var |= ((unsigned long long)READ_BYTE1() << (3*SIZE_BYTE)); \
++ var |= ((unsigned long long)READ_BYTE1() << (4*SIZE_BYTE)); \
++ var |= ((unsigned long long)READ_BYTE1() << (5*SIZE_BYTE)); \
++ var |= ((unsigned long long)READ_BYTE1() << (6*SIZE_BYTE)); \
++ var |= ((unsigned long long)READ_BYTE1() << (7*SIZE_BYTE)); \
+ DPRINTF("{8byte:varx= %ld}", var); \
+ varx=var;} while (0)
+
+@@ -386,7 +386,7 @@ getd(str)
+ #define GETFIX(v_) Join(GET,SIZEOF_LONG)(v_)
+
+ #define PUT8(varx ) \
+- do{unsigned long var= varx ; \
++ do{unsigned long long var= varx ; \
+ DPRINTF("{8byte:varx= %ld}", var); \
+ WRITE_BYTEI(var,0); \
+ WRITE_BYTEI(var,1); \
+@@ -808,7 +808,7 @@ write_fasd(object obj)
+ {int l = MP(obj)->_mp_size;
+ int m = (l >= 0 ? l : -l);
+
+- unsigned long *u = (unsigned long *) MP(obj)->_mp_d;
++ mp_limb_t *u = MP(obj)->_mp_d;
+ /* fix this */
+ /* if (sizeof(mp_limb_t) != 4) { FEerror("fix for gmp",0);} */
+ PUT4(l);
+@@ -1279,7 +1279,7 @@ read_fasd1(int i, object *loc)
+ case DP( d_bignum:)
+ {int j,m;
+ object tem;
+- unsigned long *u;
++ mp_limb_t *u;
+ GET4(j);
+ #ifdef GMP
+ tem = new_bignum();
+@@ -1287,7 +1287,7 @@ read_fasd1(int i, object *loc)
+ _mpz_realloc(MP(tem),m);
+ MP(tem)->_mp_size = j;
+ j = m;
+- u = (unsigned long *) MP(tem)->_mp_d;
++ u = MP(tem)->_mp_d;
+ #else
+ { BEGIN_NO_INTERRUPT;
+ tem = alloc_object(t_bignum);
+--- gcl-2.6.12.orig/o/file.d
++++ gcl-2.6.12/o/file.d
+@@ -268,7 +268,7 @@ BEGIN:
+ return(strm->sm.sm_object0);
+
+ case smm_socket:
+- return (sLstring_char);
++ return (sLcharacter);
+
+ case smm_synonym:
+ strm = symbol_value(strm->sm.sm_object0);
+@@ -295,10 +295,10 @@ BEGIN:
+ return(stream_element_type(STREAM_INPUT_STREAM(strm)));
+
+ case smm_string_input:
+- return(sLstring_char);
++ return(sLcharacter);
+
+ case smm_string_output:
+- return(sLstring_char);
++ return(sLcharacter);
+
+ default:
+ error("illegal stream mode");
+@@ -512,7 +512,7 @@ object if_exists, if_does_not_exist;
+ x->sm.sm_fp = fp;
+
+ x->sm.sm_buffer = 0;
+- x->sm.sm_object0 = (unzipped ? make_cons(sSAallow_gzipped_fileA,unzipped) : sLstring_char);
++ x->sm.sm_object0 = (unzipped ? make_cons(sSAallow_gzipped_fileA,unzipped) : sLcharacter);
+ x->sm.sm_object1 = fn;
+ x->sm.sm_int0 = x->sm.sm_int1 = 0;
+ vs_push(x);
+@@ -1715,7 +1715,7 @@ LFD(Lstream_element_type)()
+
+ @(static defun open (filename
+ &key (direction sKinput)
+- (element_type sLstring_char)
++ (element_type sLcharacter)
+ (if_exists Cnil iesp)
+ (if_does_not_exist Cnil idnesp)
+ &aux strm)
+@@ -1800,7 +1800,7 @@ LFD(Lfile_length)()
+ vs_base[0] = make_fixnum(i);
+ }
+
+-object sSAload_pathnameA;
++object sLAload_pathnameA;
+ DEFVAR("*COLLECT-BINARY-MODULES*",sSAcollect_binary_modulesA,SI,sLnil,"");
+ DEFVAR("*BINARY-MODULES*",sSAbinary_modulesA,SI,Cnil,"");
+
+@@ -1861,7 +1861,7 @@ DEFVAR("*BINARY-MODULES*",sSAbinary_modu
+ }
+ package = symbol_value(sLApackageA);
+ bds_bind(sLApackageA, package);
+- bds_bind(sSAload_pathnameA,fasl_filename);
++ bds_bind(sLAload_pathnameA,fasl_filename);
+ if (sSAcollect_binary_modulesA->s.s_dbind==Ct) {
+ object _x=sSAbinary_modulesA->s.s_dbind;
+ object _y=Cnil;
+@@ -1920,7 +1920,7 @@ DEFVAR("*BINARY-MODULES*",sSAbinary_modu
+ flush_stream(PRINTstream);
+ }
+ package = symbol_value(sLApackageA);
+- bds_bind(sSAload_pathnameA,pathname);
++ bds_bind(sLAload_pathnameA,pathname);
+ bds_bind(sLApackageA, package);
+ bds_bind(sLAstandard_inputA, strm);
+ frs_push(FRS_PROTECT, Cnil);
+@@ -2534,7 +2534,7 @@ gcl_init_file(void)
+ standard_input->sm.sm_mode = (short)smm_input;
+ standard_input->sm.sm_fp = stdin;
+ standard_input->sm.sm_buffer = 0;
+- standard_input->sm.sm_object0 = sLstring_char;
++ standard_input->sm.sm_object0 = sLcharacter;
+ standard_input->sm.sm_object1
+ #ifdef UNIX
+ = make_simple_string("stdin");
+@@ -2546,7 +2546,7 @@ gcl_init_file(void)
+ standard_output->sm.sm_mode = (short)smm_output;
+ standard_output->sm.sm_fp = stdout;
+ standard_output->sm.sm_buffer = 0;
+- standard_output->sm.sm_object0 = sLstring_char;
++ standard_output->sm.sm_object0 = sLcharacter;
+ standard_output->sm.sm_object1
+ #ifdef UNIX
+ = make_simple_string("stdout");
+@@ -2571,7 +2571,7 @@ gcl_init_file(void)
+ }
+
+ DEFVAR("*IGNORE-EOF-ON-TERMINAL-IO*",sSAignore_eof_on_terminal_ioA,SI,Cnil,"");
+-DEFVAR("*LOAD-PATHNAME*",sSAload_pathnameA,SI,Cnil,"");
++DEFVAR("*LOAD-PATHNAME*",sLAload_pathnameA,LISP,Cnil,"");
+ DEFVAR("*LOAD-VERBOSE*",sLAload_verboseA,LISP,Ct,"");
+
+ DEF_ORDINARY("ABORT",sKabort,KEYWORD,"");
+--- gcl-2.6.12.orig/o/funlink.c
++++ gcl-2.6.12/o/funlink.c
+@@ -19,7 +19,7 @@ typedef object (*object_func)();
+ static int
+ vpush_extend(void *,object);
+
+-object sLAlink_arrayA;
++object sSAlink_arrayA;
+ int Rset = 0;
+
+ DEFVAR("*LINK-LIST*",sSAlink_listA,SI,0,"");
+@@ -67,8 +67,8 @@ call_or_link(object sym, void **link) {
+ if (Rset==0)
+ funcall(fun);
+ else if (type_of(fun) == t_cfun) {
+- (void) vpush_extend( link,sLAlink_arrayA->s.s_dbind);
+- (void) vpush_extend( *link,sLAlink_arrayA->s.s_dbind);
++ (void) vpush_extend( link,sSAlink_arrayA->s.s_dbind);
++ (void) vpush_extend( *link,sSAlink_arrayA->s.s_dbind);
+ *link = (void *) (fun->cf.cf_self);
+ (*(void (*)())(fun->cf.cf_self))();
+ } else {
+@@ -89,8 +89,8 @@ call_or_link_closure(object sym, void **
+ }
+ if (type_of(fun) == t_cclosure && (fun->cc.cc_turbo)) {
+ if (Rset) {
+- (void) vpush_extend( link,sLAlink_arrayA->s.s_dbind);
+- (void) vpush_extend( *link,sLAlink_arrayA->s.s_dbind);
++ (void) vpush_extend( link,sSAlink_arrayA->s.s_dbind);
++ (void) vpush_extend( *link,sSAlink_arrayA->s.s_dbind);
+ *ptr = (void *)fun;
+ *link = (void *) (fun->cf.cf_self);
+ MMccall(fun);
+@@ -105,8 +105,8 @@ call_or_link_closure(object sym, void **
+ /* can't do this if invoking foo(a) is illegal when foo is not defined
+ to take any arguments. In the majority of C's this is legal */
+ else if (type_of(fun) == t_cfun) {
+- (void) vpush_extend(link,sLAlink_arrayA->s.s_dbind);
+- (void) vpush_extend(*link,sLAlink_arrayA->s.s_dbind);
++ (void) vpush_extend(link,sSAlink_arrayA->s.s_dbind);
++ (void) vpush_extend(*link,sSAlink_arrayA->s.s_dbind);
+ *link = (void *)fun->cf.cf_self;
+ (*(void (*)())fun->cf.cf_self)();
+ } else {
+@@ -129,7 +129,7 @@ vpush_extend(void *item, object ar)
+ return(ar->v.v_fillp = ind);}
+ else
+ {
+- int newdim= ROUND_UP_PTR((2 + (int) (1.3 * ind)));
++ int newdim= CEI((2 + (int) (1.3 * ind)),PTR_ALIGN);
+ unsigned char *newself;
+ newself = (void *)alloc_relblock(newdim);
+ bcopy(ar->ust.ust_self,newself,ind);
+@@ -180,8 +180,8 @@ is supplied and FLAG is nil, then this f
+ LDEFAULT2: sym = Cnil ;
+ LEND_VARARG: va_end(ap);}
+
+- if (sLAlink_arrayA ==0) RETURN1(Cnil);
+- link_ar = sLAlink_arrayA->s.s_dbind;
++ if (sSAlink_arrayA ==0) RETURN1(Cnil);
++ link_ar = sSAlink_arrayA->s.s_dbind;
+ if (link_ar==Cnil && flag==Cnil) RETURN1(Cnil);
+ check_type_array(&link_ar);
+ if (type_of(link_ar) != t_string)
+@@ -339,8 +339,8 @@ call_proc(object sym, void **link, int a
+
+ }
+
+- (void) vpush_extend(link,sLAlink_arrayA->s.s_dbind);
+- (void) vpush_extend(*link,sLAlink_arrayA->s.s_dbind);
++ (void) vpush_extend(link,sSAlink_arrayA->s.s_dbind);
++ (void) vpush_extend(*link,sSAlink_arrayA->s.s_dbind);
+ *link = (void *)fn;
+
+ AFTER_LINK:
+@@ -443,8 +443,8 @@ call_proc_new(object sym, void **link, i
+
+ }
+
+- (void) vpush_extend(link,sLAlink_arrayA->s.s_dbind);
+- (void) vpush_extend(*link,sLAlink_arrayA->s.s_dbind);
++ (void) vpush_extend(link,sSAlink_arrayA->s.s_dbind);
++ (void) vpush_extend(*link,sSAlink_arrayA->s.s_dbind);
+ *link = (void *)fn;
+
+ AFTER_LINK:
+@@ -607,7 +607,7 @@ FFN(mv_ref)(unsigned int i)
+ #include "xdrfuns.c"
+
+ DEF_ORDINARY("CDEFN",sScdefn,SI,"");
+-DEFVAR("*LINK-ARRAY*",sLAlink_arrayA,LISP,Cnil,"");
++DEFVAR("*LINK-ARRAY*",sSAlink_arrayA,SI,Cnil,"");
+
+ void
+ gcl_init_links(void)
+--- gcl-2.6.12.orig/o/gbc.c
++++ gcl-2.6.12/o/gbc.c
+@@ -24,7 +24,7 @@
+ IMPLEMENTATION-DEPENDENT
+ */
+
+-#define DEBUG
++/* #define DEBUG */
+
+ #define IN_GBC
+ #define NEED_MP_H
+@@ -45,7 +45,7 @@ static void
+ sgc_mark_phase(void);
+
+ static fixnum
+-sgc_count_writable(void);
++sgc_count_read_only(void);
+
+ #endif
+
+@@ -55,10 +55,6 @@ mark_c_stack(jmp_buf, int, void (*)(void
+ static void
+ mark_contblock(void *, int);
+
+-static void
+-mark_object(object);
+-
+-
+ /* the following in line definitions seem to be twice as fast (at
+ least on mc68020) as going to the assembly function calls in bitop.c so
+ since this is more portable and faster lets use them --W. Schelter
+@@ -75,6 +71,31 @@ mark_object(object);
+ #error Do not recognize CPTR_SIZE
+ #endif
+
++void *
++cb_in(void *p) {
++ struct contblock **cbpp;
++ int i;
++
++ for (cbpp=&cb_pointer,i=0;*cbpp;cbpp=&((*cbpp)->cb_link),i++) {
++ if ((void *)*cbpp<=p && ((void *)(*cbpp)+(*cbpp)->cb_size) >p)
++ return *cbpp;
++ }
++ return NULL;
++}
++
++int
++cb_print(void) {
++ struct contblock **cbpp;
++ int i;
++
++ for (cbpp=&cb_pointer,i=0;*cbpp;cbpp=&((*cbpp)->cb_link),i++) {
++ fprintf(stderr,"%lu at %p\n",(*cbpp)->cb_size,*cbpp);
++ fflush(stderr);
++ }
++ fprintf(stderr,"%u blocks\n",i);
++ return 0;
++}
++
+ #ifdef CONTBLOCK_MARK_DEBUG
+ int
+ cb_check(void) {
+@@ -121,13 +142,48 @@ off_check(void *v,void *ve,fixnum i,stru
+ }
+ #endif
+
++void **contblock_stack_list=NULL;
++
++static inline bool
++pageinfo_p(void *v) {
++
++ struct pageinfo *pi=v;
++
++ return pi->magic==PAGE_MAGIC && pi->type<=t_contiguous &&
++ (!pi->next || (void *)pi->next>=v+(pi->type==t_contiguous ? pi->in_use : 1)*PAGESIZE);
++
++}
++
++static inline bool
++in_contblock_stack_list(void *p,void ***ap) {
++ void **a;
++ for (a=*ap;a && a[0]>p;a=a[1]);
++ *ap=a;
++ /* if (a && a[0]==p) fprintf(stderr,"Skipping %p\n",p); */
++ return a && a[0]==p;
++}
+
+ inline struct pageinfo *
+ get_pageinfo(void *x) {
+- struct pageinfo *v=contblock_list_head;void *vv;
+- for (;(vv=v) && (vv>=x || vv+v->in_use*PAGESIZE<=x);v=v->next);
+- return v;
++
++ void *p=pageinfo(x),**a=contblock_stack_list;
++ struct pageinfo *v;
++
++ for (;!pageinfo_p(p) || in_contblock_stack_list(p,&a);p-=PAGESIZE);
++
++ v=p;
++ massert(v->type==t_contiguous && p+v->in_use*PAGESIZE>x);
++
++ return p;
++
+ }
++
++/* inline struct pageinfo * */
++/* get_pageinfo(void *x) { */
++/* struct pageinfo *v=contblock_list_head;void *vv; */
++/* for (;(vv=v) && (vv>=x || vv+v->in_use*PAGESIZE<=x);v=v->next); */
++/* return v; */
++/* } */
+
+ inline char
+ get_bit(char *v,struct pageinfo *pi,void *x) {
+@@ -300,21 +356,6 @@ enter_mark_origin(object *p) {
+
+ }
+
+-inline void
+-mark_cons(object x) {
+-
+- do {
+- object d=x->c.c_cdr;
+- mark(x);
+- mark_object(x->c.c_car);
+- x=d;
+- if (NULL_OR_ON_C_STACK(x) || is_marked_or_free(x))/*catches Cnil*/
+- return;
+- } while (cdr_listp(x));
+- mark_object(x);
+-
+-}
+-
+ /* Whenever two arrays are linked together by displacement,
+ if one is live, the other will be made live */
+ #define mark_displaced_field(ar) mark_object(ar->a.a_displaced)
+@@ -336,27 +377,17 @@ mark_link_array(void *v,void *ve) {
+ if (NULL_OR_ON_C_STACK(v))
+ return;
+
+- if (sLAlink_arrayA->s.s_dbind==Cnil)
++ if (sSAlink_arrayA->s.s_dbind==Cnil)
+ return;
+
+- p=(void *)sLAlink_arrayA->s.s_dbind->v.v_self;
+- pe=(void *)p+sLAlink_arrayA->s.s_dbind->v.v_fillp;
+-
+- if (is_marked(sLAlink_arrayA->s.s_dbind) && COLLECT_RELBLOCK_P
+-#ifdef SGC
+- && (!sgc_enabled || SGC_RELBLOCK_P(sLAlink_arrayA->s.s_dbind->v.v_self))
+-#endif
+- ) {
+- fixnum j=rb_pointer1-rb_pointer;
+- p=(void *)p+j;
+- pe=(void *)pe+j;
+- }
++ p=(void *)sSAlink_arrayA->s.s_dbind->v.v_self;
++ pe=(void *)p+sSAlink_arrayA->s.s_dbind->v.v_fillp;
+
+ for (;p<pe;p+=2)
+ if (*p>=v && *p<ve) {
+ massert(!LINK_ARRAY_MARKED(p));
+ #ifdef SGC
+- if(!sgc_enabled || IS_WRITABLE(page(p)))
++ if(!sgc_enabled || WRITABLE_PAGE_P(page(p)))
+ #endif
+ MARK_LINK_ARRAY(p);
+ }
+@@ -368,11 +399,11 @@ prune_link_array(void) {
+
+ void **p,**pe,**n,**ne;
+
+- if (sLAlink_arrayA->s.s_dbind==Cnil)
++ if (sSAlink_arrayA->s.s_dbind==Cnil)
+ return;
+
+- ne=n=p=(void *)sLAlink_arrayA->s.s_dbind->v.v_self;
+- pe=(void *)p+sLAlink_arrayA->s.s_dbind->v.v_fillp;
++ ne=n=p=(void *)sSAlink_arrayA->s.s_dbind->v.v_self;
++ pe=(void *)p+sSAlink_arrayA->s.s_dbind->v.v_fillp;
+
+ while (p<pe) {
+ if (*p) {
+@@ -382,7 +413,7 @@ prune_link_array(void) {
+ p+=2;
+ }
+
+- sLAlink_arrayA->s.s_dbind->v.v_fillp=(ne-n)*sizeof(*n);
++ sSAlink_arrayA->s.s_dbind->v.v_fillp=(ne-n)*sizeof(*n);
+
+ }
+
+@@ -392,11 +423,11 @@ sweep_link_array(void) {
+
+ void ***p,***pe;
+
+- if (sLAlink_arrayA->s.s_dbind==Cnil)
++ if (sSAlink_arrayA->s.s_dbind==Cnil)
+ return;
+
+- p=(void *)sLAlink_arrayA->s.s_dbind->v.v_self;
+- pe=(void *)p+sLAlink_arrayA->s.s_dbind->v.v_fillp;
++ p=(void *)sSAlink_arrayA->s.s_dbind->v.v_self;
++ pe=(void *)p+sSAlink_arrayA->s.s_dbind->v.v_fillp;
+ for (;p<pe;p+=2)
+ if (*p) {
+ if (LINK_ARRAY_MARKED(p))
+@@ -411,42 +442,120 @@ sweep_link_array(void) {
+
+ }
+
+-static void
+-mark_object(object x) {
+-
+- fixnum i,j;
+- object *p;
+- char *cp;
+- enum type tp;
+-
+- BEGIN:
+- /* if the body of x is in the c stack, its elements
+- are marked anyway by the c stack mark carefully, and
+- if this x is somehow hanging around in a cons that
+- should be dead, we dont want to mark it. -wfs
+- */
++DEFVAR("*LEAF-COLLECTION-THRESHOLD*",sSAleaf_collection_thresholdA,SI,make_fixnum(0),"");
++
++#define MARK_LEAF_DATA_ALIGNED(a_,b_,c_,d_) mark_leaf_data(a_,(void **)&b_,c_,d_)
++#define MARK_LEAF_DATA(a_,b_,c_) MARK_LEAF_DATA_ALIGNED(a_,b_,c_,1)
++
++static inline bool
++marking(void *p) {
++ return (sgc_enabled ? ON_WRITABLE_PAGE_CACHED(p) : !NULL_OR_ON_C_STACK(p));
++}
++
++static inline bool
++collecting(void *p) {
++ return (p<(void *)heap_end ? what_to_collect==t_contiguous : COLLECT_RELBLOCK_P);
++}
++
++static ufixnum ngc_thresh;
++static union {struct dummy d;ufixnum f;} rst={.f=-1};
++/* static object lcv=Cnil; */
++
++static inline void
++mark_leaf_data(object x,void **pp,ufixnum s,ufixnum r) {
++
++ void *p=*pp,*dp/* ,*dpe */;
+
+- if (NULL_OR_ON_C_STACK(x) || is_marked_or_free(x))
++ if (!marking(p)||!collecting(p))
+ return;
+
+- tp=type_of(x);
++ /* if (lcv!=Cnil && !collecting(lcv->st.st_self) && */
++ /* (dp=PCEI(lcv->st.st_self,r)) && dp+s<=(dpe=lcv->st.st_self+lcv->st.st_dim) */
++ /* && x && x->d.st>=ngc_thresh) { */
++
++ if (what_to_collect!=t_contiguous &&
++ x && x->d.st>=ngc_thresh &&
++ (dp=alloc_contblock_no_gc(s))) {
++
++ /* fprintf(stderr,"Promoting %p,%lu to %p\n",p,s,dp); */
++ /* fflush(stderr); */
++
++ *pp=memcpy(dp,p,s);
++ /* lcv->st.st_fillp=lcv->st.st_dim=(dpe-(void *)(lcv->st.st_self=dp+s)); */
++ x->d.st=0;
+
+- if (tp==t_cons) {
+- mark_cons(x);
+ return;
++
++ }
++
++ if (x && x->d.st<rst.d.st) x->d.st++;
++
++ if (p>=(void *)heap_end)
++ *pp=(void *)copy_relblock(p,s);
++ else
++ mark_contblock(p,s);
++
++}
++
++static void mark_object1(object);
++#define mark_object(x) if (marking(x)) mark_object1(x)
++
++static inline void
++mark_object_address(object *o,int f) {
++
++ static ufixnum lp;
++ static ufixnum lr;
++
++ ufixnum p=page(o);
++
++ if (lp!=p || !f) {
++ lp=p;
++ lr=sgc_enabled ? WRITABLE_PAGE_P(lp) : 1;
+ }
+
++ if (lr)
++ mark_object(*o);
++
++}
++
++static inline void
++mark_object_array(object *o,object *oe) {
++ int f=0;
++
++ if (o)
++ for (;o<oe;o++,f=1)
++ mark_object_address(o,f);
++
++}
++
++
++static void
++mark_object1(object x) {
++
++ fixnum i,j=0;/*FIXME*/
++
++ if (is_marked_or_free(x))
++ return;
++
+ mark(x);
+
+- switch (tp) {
++ switch (type_of(x)) {
++
++ case t_cons:
++ mark_object(x->c.c_car);
++ mark_object(Scdr(x));/*FIXME*/
++ break;
+
+ case t_fixnum:
+ break;
+
++ case t_bignum:
++ MARK_LEAF_DATA(x,MP_SELF(x),MP_ALLOCATED(x)*MP_LIMB_SIZE);
++ break;
++
+ case t_ratio:
+ mark_object(x->rat.rat_num);
+- x = x->rat.rat_den;
+- goto BEGIN;
++ mark_object(x->rat.rat_den);
+
+ case t_shortfloat:
+ break;
+@@ -456,8 +565,7 @@ mark_object(object x) {
+
+ case t_complex:
+ mark_object(x->cmp.cmp_imag);
+- x = x->cmp.cmp_real;
+- goto BEGIN;
++ mark_object(x->cmp.cmp_real);
+
+ case t_character:
+ break;
+@@ -466,13 +574,7 @@ mark_object(object x) {
+ mark_object(x->s.s_plist);
+ mark_object(x->s.s_gfdef);
+ mark_object(x->s.s_dbind);
+- if (x->s.s_self == NULL)
+- break;
+- if (inheap(x->s.s_self)) {
+- if (what_to_collect == t_contiguous)
+- mark_contblock(x->s.s_self,x->s.s_fillp);
+- } else if (COLLECT_RELBLOCK_P)
+- x->s.s_self = copy_relblock(x->s.s_self, x->s.s_fillp);
++ MARK_LEAF_DATA(x,x->s.s_self,x->s.s_fillp);
+ break;
+
+ case t_package:
+@@ -481,197 +583,88 @@ mark_object(object x) {
+ mark_object(x->p.p_shadowings);
+ mark_object(x->p.p_uselist);
+ mark_object(x->p.p_usedbylist);
+- if (what_to_collect != t_contiguous)
+- break;
+- if (x->p.p_internal != NULL)
+- mark_contblock((char *)(x->p.p_internal),
+- x->p.p_internal_size*sizeof(object));
+- if (x->p.p_external != NULL)
+- mark_contblock((char *)(x->p.p_external),
+- x->p.p_external_size*sizeof(object));
++ mark_object_array(x->p.p_internal,x->p.p_internal+x->p.p_internal_size);
++ MARK_LEAF_DATA(x,x->p.p_internal,x->p.p_internal_size*sizeof(object));
++ mark_object_array(x->p.p_external,x->p.p_external+x->p.p_external_size);
++ MARK_LEAF_DATA(x,x->p.p_external,x->p.p_external_size*sizeof(object));
+ break;
+
+ case t_hashtable:
+ mark_object(x->ht.ht_rhsize);
+ mark_object(x->ht.ht_rhthresh);
+- if (x->ht.ht_self == NULL)
+- break;
+- for (i = 0, j = x->ht.ht_size; i < j; i++) {
+- mark_object(x->ht.ht_self[i].hte_key);
+- mark_object(x->ht.ht_self[i].hte_value);
+- }
+- if (inheap(x->ht.ht_self)) {
+- if (what_to_collect == t_contiguous)
+- mark_contblock((char *)x->ht.ht_self,j*sizeof(struct htent));
+- } else if (COLLECT_RELBLOCK_P)
+- x->ht.ht_self=(void *)copy_relblock((char *)x->ht.ht_self,j*sizeof(struct htent));;
++ if (x->ht.ht_self)
++ for (i=0;i<x->ht.ht_size;i++)
++ if (x->ht.ht_self[i].hte_key!=OBJNULL) {
++ mark_object_address(&x->ht.ht_self[i].hte_key,i);
++ mark_object_address(&x->ht.ht_self[i].hte_value,i+1);
++ }
++ MARK_LEAF_DATA(x,x->ht.ht_self,x->ht.ht_size*sizeof(*x->ht.ht_self));
+ break;
+
+ case t_array:
+- if ((x->a.a_displaced) != Cnil)
+- mark_displaced_field(x);
+- if (x->a.a_dims != NULL) {
+- if (inheap(x->a.a_dims)) {
+- if (what_to_collect == t_contiguous)
+- mark_contblock((char *)(x->a.a_dims),sizeof(int)*x->a.a_rank);
+- } else if (COLLECT_RELBLOCK_P)
+- x->a.a_dims = (int *) copy_relblock((char *)(x->a.a_dims),sizeof(int)*x->a.a_rank);
+- }
+- if ((enum aelttype)x->a.a_elttype == aet_ch)
+- goto CASE_STRING;
+- if ((enum aelttype)x->a.a_elttype == aet_bit)
+- goto CASE_BITVECTOR;
+- if ((enum aelttype)x->a.a_elttype == aet_object)
+- goto CASE_GENERAL;
+-
+- CASE_SPECIAL:
+- cp = (char *)(x->fixa.fixa_self);
+- if (cp == NULL)
+- break;
+- /* set j to the size in char of the body of the array */
+-
+- switch((enum aelttype)x->a.a_elttype){
+-#define ROUND_RB_POINTERS_DOUBLE \
+-{int tem = ((long)rb_pointer1) & (sizeof(double)-1); \
+- if (tem) \
+- { rb_pointer += (sizeof(double) - tem); \
+- rb_pointer1 += (sizeof(double) - tem); \
+- }}
++ MARK_LEAF_DATA(x,x->a.a_dims,sizeof(int)*x->a.a_rank);
++
++ case t_vector:
++ case t_bitvector:
++
++ switch(j ? j : (enum aelttype)x->v.v_elttype) {
++
+ case aet_lf:
+- j= sizeof(longfloat)*x->lfa.lfa_dim;
+- if ((COLLECT_RELBLOCK_P) && !(inheap(cp)))
+- ROUND_RB_POINTERS_DOUBLE;/*FIXME gc space violation*/
++ j= sizeof(longfloat)*x->v.v_dim;
++ if ((COLLECT_RELBLOCK_P) && (void *)x->v.v_self>=(void *)heap_end)
++ rb_pointer=PCEI(rb_pointer,sizeof(double)); /*FIXME GC space violation*/
+ break;
++
++ case aet_bit:
++#define W_SIZE (8*sizeof(fixnum))
++ j= sizeof(fixnum)*((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE);
++ break;
++
+ case aet_char:
+ case aet_uchar:
+- j=sizeof(char)*x->a.a_dim;
++ j=sizeof(char)*x->v.v_dim;
+ break;
++
+ case aet_short:
+ case aet_ushort:
+- j=sizeof(short)*x->a.a_dim;
++ j=sizeof(short)*x->v.v_dim;
+ break;
++
++ case aet_object:
++ if (x->v.v_displaced->c.c_car==Cnil)
++ mark_object_array(x->v.v_self,x->v.v_self+x->v.v_dim);
++
+ default:
+- j=sizeof(fixnum)*x->fixa.fixa_dim;}
+-
+- goto COPY;
+-
+- CASE_GENERAL:
+- p = x->a.a_self;
+- if (p == NULL
+-#ifdef HAVE_ALLOCA
+- || (char *)p >= core_end
+-#endif
+- )
+- break;
+- j=0;
+- if (x->a.a_displaced->c.c_car == Cnil)
+- for (i = 0, j = x->a.a_dim; i < j; i++)
+- mark_object(p[i]);
+- cp = (char *)p;
+- j *= sizeof(object);
+- COPY:
+- if (inheap(cp)) {
+- if (what_to_collect == t_contiguous)
+- mark_contblock(cp, j);
+- } else if (COLLECT_RELBLOCK_P) {
+- if (x->a.a_displaced == Cnil) {
+-#ifdef HAVE_ALLOCA
+- if (!NULL_OR_ON_C_STACK(cp)) /* only if body of array not on C stack */
+-#endif
+- x->a.a_self = (object *)copy_relblock(cp, j);
+- } else if (x->a.a_displaced->c.c_car == Cnil) {
+- i = (long)(object *)copy_relblock(cp, j) - (long)(x->a.a_self);
+- adjust_displaced(x, i);
+- }
++ j=sizeof(fixnum)*x->v.v_dim;
++
+ }
+- break;
+-
+- case t_vector:
+- if ((x->v.v_displaced) != Cnil)
+- mark_displaced_field(x);
+- if ((enum aelttype)x->v.v_elttype == aet_object)
+- goto CASE_GENERAL;
+- else
+- goto CASE_SPECIAL;
+-
+- case t_bignum:
+-#ifndef GMP_USE_MALLOC
+- if ((int)what_to_collect >= (int)t_contiguous) {
+- j = MP_ALLOCATED(x);
+- cp = (char *)MP_SELF(x);
+- if (cp == 0)
+- break;
+-#ifdef PARI
+- if (j != lg(MP(x)) &&
+- /* we don't bother to zero this register,
+- and its contents may get over written */
+- ! (x == big_register_1 &&
+- (int)(cp) <= top &&
+- (int) cp >= bot))
+- printf("bad length 0x%x ",x);
+-#endif
+- j = j * MP_LIMB_SIZE;
+- if (inheap(cp)) {
+- if (what_to_collect == t_contiguous)
+- mark_contblock(cp, j);
+- } else if (COLLECT_RELBLOCK_P) {
+- MP_SELF(x) = (void *) copy_relblock(cp, j);}}
+-#endif /* not GMP_USE_MALLOC */
+- break;
+-
+- CASE_STRING:
+- case t_string:
+- if ((x->st.st_displaced) != Cnil)
+- mark_displaced_field(x);
+- j = x->st.st_dim;
+- cp = x->st.st_self;
+- if (cp == NULL)
+- break;
+- COPY_STRING:
+- if (inheap(cp)) {
+- if (what_to_collect == t_contiguous)
+- mark_contblock(cp, j);
+- } else if (COLLECT_RELBLOCK_P) {
+- if (x->st.st_displaced == Cnil)
+- x->st.st_self = copy_relblock(cp, j);
+- else if (x->st.st_displaced->c.c_car == Cnil) {
+- i = copy_relblock(cp, j) - cp;
+- adjust_displaced(x, i);
++
++ case t_string:/*FIXME*/
++ j=j ? j : x->st.st_dim;
++
++ if (x->v.v_displaced->c.c_car==Cnil) {
++ void *p=x->v.v_self;
++ MARK_LEAF_DATA(x,x->v.v_self,j);
++ if (x->v.v_displaced!=Cnil) {
++ j=(void *)x->v.v_self-p;
++ x->v.v_self=p;
++ adjust_displaced(x,j);
+ }
+- }
++ }
++ mark_object(x->v.v_displaced);
+ break;
+
+- CASE_BITVECTOR:
+- case t_bitvector:
+- if ((x->bv.bv_displaced) != Cnil)
+- mark_displaced_field(x);
+- /* We make bitvectors multiple of sizeof(int) in size allocated
+- Assume 8 = number of bits in char */
+-
+-#define W_SIZE (8*sizeof(fixnum))
+- j= sizeof(fixnum) *
+- ((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE);
+- cp = x->bv.bv_self;
+- if (cp == NULL)
+- break;
+- goto COPY_STRING;
+-
+ case t_structure:
+- mark_object(x->str.str_def);
+- p = x->str.str_self;
+- if (p == NULL)
+- break;
+ {
+ object def=x->str.str_def;
+- unsigned char * s_type = &SLOT_TYPE(def,0);
+- unsigned short *s_pos= & SLOT_POS(def,0);
+- for (i = 0, j = S_DATA(def)->length; i < j; i++)
+- if (s_type[i]==0) mark_object(STREF(object,x,s_pos[i]));
+- if (inheap(x->str.str_self)) {
+- if (what_to_collect == t_contiguous)
+- mark_contblock((char *)p,S_DATA(def)->size);
+- } else if (COLLECT_RELBLOCK_P)
+- x->str.str_self = (object *)copy_relblock((char *)p, S_DATA(def)->size);
++ unsigned char *s_type= &SLOT_TYPE(def,0);
++ unsigned short *s_pos= &SLOT_POS(def,0);
++ mark_object(x->str.str_def);
++ if (x->str.str_self)
++ for (i=0,j=S_DATA(def)->length;i<j;i++)
++ if (s_type[i]==0)
++ mark_object_address(&STREF(object,x,s_pos[i]),i);
++ MARK_LEAF_DATA(x,x->str.str_self,S_DATA(def)->size);
+ }
+ break;
+
+@@ -684,12 +677,11 @@ mark_object(object x) {
+ case smm_probe:
+ mark_object(x->sm.sm_object0);
+ mark_object(x->sm.sm_object1);
+- if (what_to_collect == t_contiguous &&
+- x->sm.sm_fp &&
+- x->sm.sm_buffer)
+- mark_contblock(x->sm.sm_buffer, BUFSIZ);
++ if (x->sm.sm_fp) {
++ MARK_LEAF_DATA(x,x->sm.sm_buffer,BUFSIZ);
++ }
+ break;
+-
++
+ case smm_synonym:
+ mark_object(x->sm.sm_object0);
+ break;
+@@ -720,44 +712,20 @@ mark_object(object x) {
+ }
+ break;
+
+-#define MARK_CP(a_,b_) {fixnum _t=(b_);if (inheap(a_)) {\
+- if (what_to_collect == t_contiguous) mark_contblock((void *)(a_),_t); \
+- } else if (COLLECT_RELBLOCK_P) (a_)=(void *)copy_relblock((void *)(a_),_t);}
+-
+-#define MARK_MP(a_) {if ((a_)->_mp_d) \
+- MARK_CP((a_)->_mp_d,(a_)->_mp_alloc*MP_LIMB_SIZE);}
+-
+ case t_random:
+- if ((int)what_to_collect >= (int)t_contiguous) {
+- MARK_MP(x->rnd.rnd_state._mp_seed);
+-#if __GNU_MP_VERSION < 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR < 2)
+- if (x->rnd.rnd_state._mp_algdata._mp_lc) {
+- MARK_MP(x->rnd.rnd_state._mp_algdata._mp_lc->_mp_a);
+- if (!x->rnd.rnd_state._mp_algdata._mp_lc->_mp_m2exp) MARK_MP(x->rnd.rnd_state._mp_algdata._mp_lc->_mp_m);
+- MARK_CP(x->rnd.rnd_state._mp_algdata._mp_lc,sizeof(*x->rnd.rnd_state._mp_algdata._mp_lc));
+- }
+-#endif
+- }
++ MARK_LEAF_DATA_ALIGNED(x,x->rnd.rnd_state._mp_seed->_mp_d,x->rnd.rnd_state._mp_seed->_mp_alloc*MP_LIMB_SIZE,MP_LIMB_SIZE);
+ break;
+
+ case t_readtable:
+- if (x->rt.rt_self == NULL)
+- break;
+- if (what_to_collect == t_contiguous)
+- mark_contblock((char *)(x->rt.rt_self),
+- RTABSIZE*sizeof(struct rtent));
+- for (i = 0; i < RTABSIZE; i++) {
+- mark_object(x->rt.rt_self[i].rte_macro);
+- if (x->rt.rt_self[i].rte_dtab != NULL) {
+- /**/
+- if (what_to_collect == t_contiguous)
+- mark_contblock((char *)(x->rt.rt_self[i].rte_dtab),
+- RTABSIZE*sizeof(object));
+- for (j = 0; j < RTABSIZE; j++)
+- mark_object(x->rt.rt_self[i].rte_dtab[j]);
+- /**/
++ if (x->rt.rt_self) {
++ for (i=0;i<RTABSIZE;i++)
++ mark_object_address(&x->rt.rt_self[i].rte_macro,i);
++ for (i=0;i<RTABSIZE;i++) {
++ mark_object_array(x->rt.rt_self[i].rte_dtab,x->rt.rt_self[i].rte_dtab+RTABSIZE);
++ MARK_LEAF_DATA(x,x->rt.rt_self[i].rte_dtab,RTABSIZE*sizeof(object));
+ }
+ }
++ MARK_LEAF_DATA(x,x->rt.rt_self,RTABSIZE*sizeof(struct rtent));
+ break;
+
+ case t_pathname:
+@@ -770,13 +738,8 @@ mark_object(object x) {
+ break;
+
+ case t_closure:
+- {
+- int i ;
+- for (i= 0 ; i < x->cl.cl_envdim ; i++)
+- mark_object(x->cl.cl_env[i]);
+- if (COLLECT_RELBLOCK_P)
+- x->cl.cl_env=(void *)copy_relblock((void *)x->cl.cl_env,x->cl.cl_envdim*sizeof(object));
+- }
++ mark_object_array(x->cl.cl_env,x->cl.cl_env+x->cl.cl_envdim);
++ MARK_LEAF_DATA(x,x->cl.cl_env,x->cl.cl_envdim*sizeof(object));
+
+ case t_cfun:
+ case t_sfun:
+@@ -789,48 +752,40 @@ mark_object(object x) {
+
+ case t_cfdata:
+
+- if (x->cfd.cfd_self != NULL)
+- {int i=x->cfd.cfd_fillp;
+- while(i-- > 0)
+- mark_object(x->cfd.cfd_self[i]);}
+- if (what_to_collect == t_contiguous) {
+- mark_contblock(x->cfd.cfd_start, x->cfd.cfd_size);
++ mark_object_array(x->cfd.cfd_self,x->cfd.cfd_self+x->cfd.cfd_fillp);
++ if (what_to_collect == t_contiguous)
+ mark_link_array(x->cfd.cfd_start,x->cfd.cfd_start+x->cfd.cfd_size);
+- }
++ MARK_LEAF_DATA(NULL,x->cfd.cfd_start,x->cfd.cfd_size);/*Code cannot move*/
+ break;
+- case t_cclosure:
++
++ case t_cclosure:
+ mark_object(x->cc.cc_name);
+ mark_object(x->cc.cc_env);
+ mark_object(x->cc.cc_data);
+- if (x->cc.cc_turbo!=NULL) {
+- mark_object(*(x->cc.cc_turbo-1));
+- if (COLLECT_RELBLOCK_P)
+- x->cc.cc_turbo=(void *)copy_relblock((char *)(x->cc.cc_turbo-1),(1+fix(*(x->cc.cc_turbo-1)))*sizeof(object))+sizeof(object);
++ if (x->cc.cc_turbo) {
++ x->cc.cc_turbo--;
++ mark_object_array(x->cc.cc_turbo,x->cc.cc_turbo+fix(x->cc.cc_turbo[0]));
++ MARK_LEAF_DATA(x,x->cc.cc_turbo,(1+fix(x->cc.cc_turbo[0]))*sizeof(*x->cc.cc_turbo));
++ x->cc.cc_turbo++;
+ }
+ break;
+
+ case t_spice:
+ break;
+- default:
++
++ default:
+ #ifdef DEBUG
+ if (debug)
+ printf("\ttype = %d\n", type_of(x));
+ #endif
+ error("mark botch");
++
+ }
++
+ }
+
+ static long *c_stack_where;
+
+-void **contblock_stack_list=NULL;
+-
+-#define PAGEINFO_P(pi) (pi->magic==PAGE_MAGIC && pi->type<=t_contiguous)
+-
+-#ifdef SGC
+-static void
+-sgc_mark_object1(object);
+-#endif
+-
+ static void
+ mark_stack_carefully(void *topv, void *bottomv, int offset) {
+
+@@ -865,10 +820,9 @@ mark_stack_carefully(void *topv, void *b
+
+ pageoffset=v-(void *)pagetochar(p);
+ pi=pagetoinfo(p);
+- if (!PAGEINFO_P(pi)) continue;
++ if (!pageinfo_p(pi)) continue;
+
+- for (a=contblock_stack_list;a && a[0]!=pi;a=a[1]);
+- if (a) continue;
++ if ((a=contblock_stack_list) && in_contblock_stack_list(pi,&a)) continue;
+
+ tm=tm_of(pi->type);
+ if (tm->tm_type>=t_end) continue;
+@@ -879,13 +833,10 @@ mark_stack_carefully(void *topv, void *b
+
+ if (is_marked_or_free(x)) continue;
+
+-#ifdef SGC
+- if (sgc_enabled)
+- sgc_mark_object(x);
+- else
+-#endif
+- mark_object(x);
++ mark_object(x);
++
+ }
++
+ }
+
+
+@@ -930,10 +881,6 @@ mark_phase(void) {
+
+ for (pp = pack_pointer; pp != NULL; pp = pp->p_link)
+ mark_object((object)pp);
+-#ifdef KCLOVM
+- if (ovm_process_created)
+- mark_all_stacks();
+-#endif
+
+ #ifdef DEBUG
+ if (debug) {
+@@ -947,18 +894,18 @@ mark_phase(void) {
+ (int)what_to_collect < (int)t_contiguous) {
+ */
+
+- {int size;
++ /* {int size; */
+
+- for (pp = pack_pointer; pp != NULL; pp = pp->p_link) {
+- size = pp->p_internal_size;
+- if (pp->p_internal != NULL)
+- for (i = 0; i < size; i++)
+- mark_object(pp->p_internal[i]);
+- size = pp->p_external_size;
+- if (pp->p_external != NULL)
+- for (i = 0; i < size; i++)
+- mark_object(pp->p_external[i]);
+- }}
++ /* for (pp = pack_pointer; pp != NULL; pp = pp->p_link) { */
++ /* size = pp->p_internal_size; */
++ /* if (pp->p_internal != NULL) */
++ /* for (i = 0; i < size; i++) */
++ /* mark_object(pp->p_internal[i]); */
++ /* size = pp->p_external_size; */
++ /* if (pp->p_external != NULL) */
++ /* for (i = 0; i < size; i++) */
++ /* mark_object(pp->p_external[i]); */
++ /* }} */
+
+ /* mark the c stack */
+ #ifndef N_RECURSION_REQD
+@@ -1055,42 +1002,27 @@ mark_c_stack(jmp_buf env1, int n, void (
+ #ifndef C_GC_OFFSET
+ #define C_GC_OFFSET 0
+ #endif
+- {
+- struct pageinfo *v,*tv;void **a;
+- fixnum i;
+- for (v=contblock_list_head,contblock_stack_list=NULL;v;v=v->next)
+- for (i=1;i<v->in_use;i++) {
+- tv=pagetoinfo(page(v)+i);
+- if (PAGEINFO_P(tv)) {
+- a=contblock_stack_list;
+- /* printf("%p\n",tv); */
+- contblock_stack_list=alloca(2*sizeof(a));
+- contblock_stack_list[0]=tv;
+- contblock_stack_list[1]=a;
+- }}
+-
+- if (&where > cs_org)
+- (*fn)(0,cs_org,C_GC_OFFSET);
+- else
+- (*fn)(cs_org,0,C_GC_OFFSET);
++ if (&where > cs_org)
++ (*fn)(0,cs_org,C_GC_OFFSET);
++ else
++ (*fn)(cs_org,0,C_GC_OFFSET);
+
+- contblock_stack_list=NULL;
+- }}
++ }
+
+ #if defined(__ia64__)
+- {
+- extern void * __libc_ia64_register_backing_store_base;
+- void * bst=GC_save_regs_in_stack();
+- void * bsb=__libc_ia64_register_backing_store_base;
+-
+- if (bsb>bst)
+- (*fn)(bsb,bst,C_GC_OFFSET);
+- else
+- (*fn)(bst,bsb,C_GC_OFFSET);
+-
+- }
++ {
++ extern void * __libc_ia64_register_backing_store_base;
++ void * bst=GC_save_regs_in_stack();
++ void * bsb=__libc_ia64_register_backing_store_base;
++
++ if (bsb>bst)
++ (*fn)(bsb,bst,C_GC_OFFSET);
++ else
++ (*fn)(bst,bsb,C_GC_OFFSET);
++
++ }
+ #endif
+-
++
+ }
+
+ static void
+@@ -1136,12 +1068,10 @@ static void
+ contblock_sweep_phase(void) {
+
+ STATIC char *s, *e, *p, *q;
+- STATIC struct contblock *cbp;
+ STATIC struct pageinfo *v;
++
++ reset_contblock_freelist();
+
+- cb_pointer = NULL;
+- ncb = 0;
+-
+ for (v=contblock_list_head;v;v=v->next) {
+ bool z;
+
+@@ -1163,7 +1093,7 @@ contblock_sweep_phase(void) {
+ #ifdef DEBUG
+ if (debug) {
+ for (cbp = cb_pointer; cbp != NULL; cbp = cbp->cb_link)
+- printf("%d-byte contblock\n", cbp->cb_size);
++ printf("%lud-byte contblock\n", cbp->cb_size);
+ fflush(stdout);
+ }
+ #endif
+@@ -1175,7 +1105,6 @@ contblock_sweep_phase(void) {
+
+ int (*GBC_enter_hook)() = NULL;
+ int (*GBC_exit_hook)() = NULL;
+-char *old_rb_start;
+
+ /* void */
+ /* ttss(void) { */
+@@ -1201,10 +1130,6 @@ fixnum fault_pages=0;
+ void
+ GBC(enum type t) {
+
+- long i,j;
+-#ifdef SGC
+- int in_sgc = sgc_enabled;
+-#endif
+ #ifdef DEBUG
+ int tm=0;
+ #endif
+@@ -1216,6 +1141,26 @@ GBC(enum type t) {
+ t=t_contiguous;
+ }
+
++ ngc_thresh=fix(sSAleaf_collection_thresholdA->s.s_dbind);
++
++ { /*FIXME try to get this below the setjmp in mark_c_stack*/
++ struct pageinfo *v,*tv;
++ ufixnum i;
++ void *a;
++
++ for (v=contblock_list_head,contblock_stack_list=NULL;v;v=v->next)
++ for (i=1;i<v->in_use;i++) {
++ tv=pagetoinfo(page(v)+i);
++ if (pageinfo_p(tv)) {
++ a=contblock_stack_list;
++ /* fprintf(stderr,"pushing %p\n",tv); */
++ contblock_stack_list=alloca(2*sizeof(a));
++ contblock_stack_list[0]=tv;
++ contblock_stack_list[1]=a;
++ }
++ }
++ }
++
+ if (in_signal_handler && t == t_relocatable)
+ error("cant gc relocatable in signal handler");
+
+@@ -1241,10 +1186,8 @@ GBC(enum type t) {
+ close_stream(o);
+ }
+
+- t = t_relocatable; gc_time = -1;
+-#ifdef SGC
+- if(sgc_enabled) sgc_quit();
+-#endif
++ /* t = t_relocatable; */
++ gc_time = -1;
+ }
+
+
+@@ -1257,10 +1200,15 @@ GBC(enum type t) {
+ tm_table[(int)t].tm_gbccount++;
+ tm_table[(int)t].tm_adjgbccnt++;
+
++ if (sSAnotify_gbcA->s.s_dbind != Cnil
+ #ifdef DEBUG
+- if (debug || (sSAnotify_gbcA->s.s_dbind != Cnil)) {
+-
+- if (gc_time < 0) gc_time=0;
++ || debug
++#endif
++ ) {
++
++ if (gc_time < 0)
++ gc_time=0;
++
+ #ifdef SGC
+ printf("[%s for %ld %s pages..",
+ (sgc_enabled ? "SGC" : "GC"),
+@@ -1272,48 +1220,33 @@ GBC(enum type t) {
+ (tm_of(t)->tm_npage),
+ (tm_table[(int)t].tm_name)+1);
+ #endif
++
+ #ifdef SGC
+ if(sgc_enabled)
+- printf("(%ld faulted pages, %ld writable, %ld read only)..",fault_pages,sgc_count_writable(),
+- (page(core_end)-first_data_page)-(page(old_rb_start)-page(heap_end))-sgc_count_writable());
++ printf("(%ld faulted pages, %ld writable, %ld read only)..",
++ fault_pages,(page(core_end)-first_data_page)-(page(rb_start)-page(heap_end))-sgc_count_read_only(),
++ sgc_count_read_only());
+ #endif
++
+ fflush(stdout);
++
+ }
+-#endif
++
+ if (gc_time >=0 && !gc_recursive++) {gc_start=runtime();}
+
+- /* maxpage = page(heap_end); */
+-
+ if (COLLECT_RELBLOCK_P) {
+
+- i=rb_pointer-REAL_RB_START+PAGESIZE;/*FIXME*/
+-
+-#ifdef SGC
+- if (sgc_enabled==0)
+-#endif
+- rb_start = heap_end + PAGESIZE*holepage;
++ char *new_start=heap_end+holepage*PAGESIZE,*new_end=new_start+nrbpage*PAGESIZE;
+
+- rb_end = heap_end + (holepage + nrbpage) *PAGESIZE;
+-
+- if (rb_start < rb_pointer)
+- rb_start1 = (char *)
+- ((long)(rb_pointer + PAGESIZE-1) & -(unsigned long)PAGESIZE);
+- else
+- rb_start1 = rb_start;
+-
+- /* as we walk through marking data, we replace the
+- relocatable pointers
+- in objects by the rb_pointer, advance that
+- by the size, and copy the actual
+- data there to rb_pointer1, and advance it by the size
+- at the end [rb_start1,rb_pointer1] is copied
+- to [rb_start,rb_pointer]
+- */
+- rb_pointer = rb_start; /* where the new relblock will start */
+- rb_pointer1 = rb_start1;/* where we will copy it to during gc*/
+-
+- i = (rb_end < (rb_start1 + i) ? (rb_start1 + i) : rb_end) - heap_end;
+- alloc_page(-(i + PAGESIZE - 1)/PAGESIZE);
++ if (new_start!=rb_start) {
++ rb_pointer=new_start;
++ rb_limit=new_end;
++ } else {
++ rb_pointer=(rb_pointer<rb_end) ? rb_end : rb_start;
++ rb_limit=rb_pointer+(new_end-new_start);
++ }
++
++ alloc_page(-(holepage+2*nrbpage));
+
+ }
+
+@@ -1326,14 +1259,7 @@ GBC(enum type t) {
+ #endif
+ #ifdef SGC
+ if(sgc_enabled)
+- { if (t < t_end && tm_of(t)->tm_sgc == 0)
+- {sgc_quit();
+- if (sSAnotify_gbcA->s.s_dbind != Cnil)
+- {fprintf(stdout, " (doing full gc)");
+- fflush(stdout);}
+- mark_phase();}
+- else
+- sgc_mark_phase();}
++ sgc_mark_phase();
+ else
+ #endif
+ mark_phase();
+@@ -1365,27 +1291,16 @@ GBC(enum type t) {
+ #endif
+
+ if (COLLECT_RELBLOCK_P) {
++
++ rb_start = heap_end + PAGESIZE*holepage;
++ rb_end = heap_end + (holepage + nrbpage) *PAGESIZE;
+
+- if (rb_start < rb_start1) {
+- j = (rb_pointer-rb_start + PAGESIZE - 1)/PAGESIZE;
+- memmove(rb_start,rb_start1,j*PAGESIZE);
+- }
+-
++
+ #ifdef SGC
+ if (sgc_enabled)
+ wrimap=(void *)sSAwritableA->s.s_dbind->v.v_self;
+ #endif
+
+-#ifdef SGC
+- /* we don't know which pages have relblock on them */
+- if(sgc_enabled) {
+- fixnum i;
+- for (i=page(rb_start);i<page(rb_pointer+PAGESIZE-1);i++)
+- massert(IS_WRITABLE(i));
+- }
+-#endif
+- rb_limit = rb_end - 2*RB_GETA;
+-
+ }
+
+ if (t == t_contiguous) {
+@@ -1410,6 +1325,54 @@ GBC(enum type t) {
+ #endif
+ }
+
++
++/* { */
++/* static int promoting; */
++/* if (!promoting && promotion_pointer>promotion_pointer1) { */
++/* object *p,st; */
++/* promoting=1; */
++/* st=alloc_simple_string(""); */
++/* for (p=promotion_pointer1;p<promotion_pointer;p++) { */
++/* fixnum j; */
++/* object x=*p; */
++
++/* if (type_of(x)==t_string) */
++
++/* j=x->st.st_dim; */
++
++/* else switch (x->v.v_elttype) { */
++
++/* case aet_lf: */
++/* j=sizeof(longfloat)*x->v.v_dim; */
++/* break; */
++/* case aet_bit: */
++/* #define W_SIZE (8*sizeof(fixnum)) */
++/* j=sizeof(fixnum)*((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE); */
++/* break; */
++/* case aet_char: */
++/* case aet_uchar: */
++/* j=sizeof(char)*x->v.v_dim; */
++/* break; */
++/* case aet_short: */
++/* case aet_ushort: */
++/* j=sizeof(short)*x->v.v_dim; */
++/* break; */
++/* default: */
++/* j=sizeof(fixnum)*x->v.v_dim; */
++/* } */
++
++/* st->st.st_dim=j; */
++/* st->st.st_self=alloc_contblock(st->st.st_dim); */
++/* fprintf(stderr,"Promoting vector leaf bytes %lu at %p, %p -> %p\n",j,x,x->v.v_self,st->st.st_self); */
++/* fflush(stderr); */
++/* memcpy(st->st.st_self,x->v.v_self,st->st.st_dim); */
++/* x->v.v_self=(void *)st->st.st_self; */
++/* } */
++/* promoting=0; */
++/* } */
++/* } */
++
++
+ #ifdef DEBUG
+ if (debug) {
+ for (i = 0, j = 0; i < (int)t_end; i++) {
+@@ -1437,11 +1400,6 @@ GBC(enum type t) {
+
+ interrupt_enable = TRUE;
+
+-#ifdef SGC
+- if (in_sgc && sgc_enabled==0)
+- sgc_start();
+-#endif
+-
+ if (GBC_exit_hook != NULL)
+ (*GBC_exit_hook)();
+
+@@ -1468,6 +1426,23 @@ GBC(enum type t) {
+
+ }
+
++ /* {static int mv; */
++ /* if (!mv && COLLECT_RELBLOCK_P) { */
++ /* mv=1; */
++ /* if (relb_copied) { */
++ /* sSAstatic_promotion_areaA->s.s_dbind=(VFUN_NARGS=4,fSmake_vector1(make_fixnum(relb_copied),make_fixnum(aet_char),Ct,make_fixnum(0))); */
++ /* fprintf(stderr,"Making static promotion area %lu bytes\n",relb_copied); */
++ /* fflush(stderr); */
++ /* relb_copied=0; */
++ /* } else { */
++ /* fprintf(stderr,"Releasing static promotion area\n"); */
++ /* fflush(stderr); */
++ /* sSAstatic_promotion_areaA->s.s_dbind=Cnil; */
++ /* } */
++ /* mv=0; */
++ /* } */
++ /* } */
++
+ collect_both=0;
+
+ END_NO_INTERRUPT;
+@@ -1524,11 +1499,16 @@ FFN(siLroom_report)(void) {
+ vs_push(make_fixnum(available_pages));
+ vs_push(make_fixnum(ncbpage));
+ vs_push(make_fixnum(maxcbpage));
+- vs_push(make_fixnum(ncb));
++ {
++ ufixnum ncb;
++ struct contblock *cbp;
++ for (ncb=0,cbp=cb_pointer;cbp;cbp=cbp->cb_link,ncb++);
++ vs_push(make_fixnum(ncb));
++ }
+ vs_push(make_fixnum(cbgbccount));
+ vs_push(make_fixnum(holepage));
+- vs_push(make_fixnum(rb_pointer - rb_start));
+- vs_push(make_fixnum(rb_end - rb_pointer));
++ vs_push(make_fixnum(rb_pointer - (rb_pointer<rb_end ? rb_start : rb_end)));
++ vs_push(make_fixnum((rb_pointer<rb_end ? rb_end : (rb_end+(rb_end-rb_start))) - rb_pointer));
+ vs_push(make_fixnum(nrbpage));
+ vs_push(make_fixnum(maxrbpage));
+ vs_push(make_fixnum(rbgbccount));
+@@ -1567,18 +1547,15 @@ FFN(siLreset_gbc_count)(void) {
+ */
+
+ static char *
+-copy_relblock(char *p, int s)
+-{ char *res = rb_pointer;
+- char *q = rb_pointer1;
+- s = ROUND_UP_PTR(s);
++copy_relblock(char *p, int s) {
++ char *q = rb_pointer;
++
++ s = CEI(s,PTR_ALIGN);
+ rb_pointer += s;
+- rb_pointer1 += s;
+-
+- memmove(q,p,s);
+- /* while (--s >= 0) */
+- /* { *q++ = *p++;} */
+-
+- return res;
++ memmove(q,p,s);/*FIXME memcpy*/
++
++ return q;
++
+ }
+
+
+@@ -1595,18 +1572,124 @@ mark_contblock(void *p, int s) {
+ q = p + s;
+ /* SGC cont pages: contblock pages must be no smaller than
+ sizeof(struct contblock). CM 20030827 */
+- x = (char *)ROUND_DOWN_PTR_CONT(p);
+- y = (char *)ROUND_UP_PTR_CONT(q);
++ x = (char *)PFLR(p,CPTR_SIZE);
++ y = (char *)PCEI(q,CPTR_SIZE);
+ v=get_pageinfo(x);
+ #ifdef SGC
+ if (!sgc_enabled || (v->sgc_flags&SGC_PAGE_FLAG))
+ #endif
+- set_mark_bits(v,x,y);
++ set_mark_bits(v,x,y);
++ }
++
++DEFUN_NEW("CONTIGUOUS-REPORT",object,fScontiguous_report,SI,1,1,NONE,OO,OO,OO,OO,(void),"") {
++
++ struct contblock **cbpp;
++ struct pageinfo *v;
++ ufixnum i,j,k,s;
++ struct typemanager *tm=tm_of(t_cfdata);
++ void *p;
++
++ for (i=j=0,cbpp=&cb_pointer;(*cbpp);) {
++ for (k=0,s=(*cbpp)->cb_size,p=*cbpp;*cbpp && (*cbpp)->cb_size==s;i+=(*cbpp)->cb_size,j++,k++,cbpp=&(*cbpp)->cb_link);
++ fprintf(stderr,"%lu %lu starting at %p\n",k,s,p);
++ }
++ fprintf(stderr,"\nTotal free %lu in %lu pieces\n\n",i,j);
++
++ for (i=j=0,v=contblock_list_head;v;i+=v->in_use,j++,v=v->next)
++ fprintf(stderr,"%lu pages at %p\n",(unsigned long)v->in_use,v);
++ fprintf(stderr,"\nTotal pages %lu in %lu pieces\n\n",i,j);
++
++ for (i=j=0,v=cell_list_head;v;v=v->next)
++ if (tm->tm_type==v->type) {
++ void *p;
++ ufixnum k;
++ for (p=pagetochar(page(v)),k=0;k<tm->tm_nppage;k++,p+=tm->tm_size) {
++ object o=p;
++ if (!is_free(o) && type_of(o)==t_cfdata && (void *)o->cfd.cfd_start>=data_start) {
++ fprintf(stderr,"%lu code bytes at %p\n",(unsigned long)o->cfd.cfd_size,o->cfd.cfd_start);
++ i+=o->cfd.cfd_size;
++ j++;
++ }
++ }
++ }
++ fprintf(stderr,"\nTotal code bytes %lu in %lu pieces\n",i,j);
++
++ for (i=j=0,v=cell_list_head;v;v=v->next) {
++ struct typemanager *tm=tm_of(v->type);
++ void *p;
++ ufixnum k;
++ for (p=pagetochar(page(v)),k=0;k<tm->tm_nppage;k++,p+=tm->tm_size) {
++ object o=p;
++ void *d=NULL;
++ ufixnum s=0;
++ if (!is_free(o)) {
++ switch (type_of(o)) {
++ case t_array:
++ case t_vector:
++ d=o->a.a_self;
++ s=o->a.a_dim*sizeof(object);
++ break;
++ case t_hashtable:
++ d=o->ht.ht_self;
++ s=o->ht.ht_size*sizeof(object)*2;
++ break;
++ case t_symbol:
++ d=o->s.s_self;
++ s=o->s.s_fillp;
++ break;
++ case t_string:
++ case t_bitvector:
++ d=o->a.a_self;
++ s=o->a.a_dim;
++ break;
++ case t_package:
++ d=o->p.p_external;
++ s=(o->p.p_external_size+o->p.p_internal_size)*sizeof(object);
++ break;
++ case t_bignum:
++ d=o->big.big_mpz_t._mp_d;
++ s=o->big.big_mpz_t._mp_alloc*MP_LIMB_SIZE;
++ break;
++ case t_structure:
++ d=o->str.str_self;
++ s=S_DATA(o->str.str_def)->length*sizeof(object);
++ break;
++ case t_random:
++ d=o->rnd.rnd_state._mp_seed->_mp_d;
++ s=o->rnd.rnd_state._mp_seed->_mp_alloc*MP_LIMB_SIZE;
++ break;
++ case t_cclosure:
++ d=o->cc.cc_turbo;
++ s=fix(o->cc.cc_turbo[-1]);
++ break;
++ case t_cfdata:
++ d=o->cfd.cfd_start;
++ s=o->cfd.cfd_size;
++ break;
++ case t_readtable:
++ d=o->rt.rt_self;
++ s=RTABSIZE*(sizeof(struct rtent));/*FIXME*/
++ break;
++ default:
++ break;
++ }
++ if (d>=data_start && d<(void *)heap_end && s) {
++ fprintf(stderr,"%lu %s bytes at %p\n",s,tm_table[type_of(o)].tm_name,d);
++ i+=s;
++ j++;
++ }
++ }
++ }
++ }
++ fprintf(stderr,"\nTotal leaf bytes %lu in %lu pieces\n",i,j);
++
++ return Cnil;
++
+ }
+
+-DEFUN_NEW("GBC",object,fLgbc,LISP,1,1,NONE,OO,OO,OO,OO,(object x0),"") {
++DEFUN_NEW("GBC",object,fSgbc,SI,1,1,NONE,OO,OO,OO,OO,(object x0),"") {
+
+- /* 1 args */
++ /* 1 args */
+
+ if (x0 == Ct)
+ GBC(t_other);
+@@ -1650,5 +1733,5 @@ gcl_init_GBC(void) {
+ #ifdef SGC
+ make_si_function("SGC-ON",siLsgc_on);
+ #endif
+-
++
+ }
+--- gcl-2.6.12.orig/o/gmp.c
++++ gcl-2.6.12/o/gmp.c
+@@ -18,12 +18,12 @@ static void *gcl_gmp_realloc(void *oldme
+ MP_SELF(big_gcprotect)=0;
+ bcopy(old,new,oldsize);
+ /* SGC contblock pages: Its possible this is on an old page CM 20030827 */
+- if (inheap(oldmem))
+-#ifdef SGC
+- insert_maybe_sgc_contblock(oldmem,oldsize);
+-#else
+- insert_contblock(oldmem,oldsize);
+-#endif
++/* if (inheap(oldmem)) */
++/* #ifdef SGC */
++/* insert_maybe_sgc_contblock(oldmem,oldsize); */
++/* #else */
++/* insert_contblock(oldmem,oldsize); */
++/* #endif */
+
+ return new;
+ }
+--- gcl-2.6.12.orig/o/hash.d
++++ gcl-2.6.12/o/hash.d
+@@ -30,6 +30,7 @@ object sLequal;
+ object sKsize;
+ object sKrehash_size;
+ object sKrehash_threshold;
++object sKstatic;
+
+ #define MHSH(a_) ((a_) & ~(1UL<<(sizeof(a_)*CHAR_SIZE-1)))
+
+@@ -295,8 +296,9 @@ object hashtable;
+ hashtable->ht.ht_rhthresh =
+ make_fixnum(fix(hashtable->ht.ht_rhthresh) +
+ (new_size - old->ht.ht_size));
+- hashtable->ht.ht_self =
+- (struct htent *)alloc_relblock(new_size * sizeof(struct htent));
++ hashtable->ht.ht_self = hashtable->ht.ht_static ?
++ (struct htent *)alloc_contblock(new_size * sizeof(struct htent)) :
++ (struct htent *)alloc_relblock(new_size * sizeof(struct htent));
+ for (i = 0; i < new_size; i++) {
+ hashtable->ht.ht_self[i].hte_key = OBJNULL;
+ hashtable->ht.ht_self[i].hte_value = OBJNULL;
+@@ -322,6 +324,7 @@ DEFVAR("*DEFAULT-HASH-TABLE-REHASH-THRES
+ `sSAdefault_hash_table_rehash_sizeA->s.s_dbind`)
+ (rehash_threshold
+ `sSAdefault_hash_table_rehash_thresholdA->s.s_dbind`)
++ (static `Cnil`)
+ &aux h)
+ enum httest htt=0;
+ int i;
+@@ -363,9 +366,11 @@ DEFVAR("*DEFAULT-HASH-TABLE-REHASH-THRES
+ h->ht.ht_rhsize = rehash_size;
+ h->ht.ht_rhthresh = rehash_threshold;
+ h->ht.ht_nent = 0;
++ h->ht.ht_static = static!=Cnil ? 1 : 0;
+ h->ht.ht_self = NULL;
+- h->ht.ht_self = (struct htent *)
+- alloc_relblock(fix(size) * sizeof(struct htent));
++ h->ht.ht_self = h->ht.ht_static ?
++ (struct htent *)alloc_contblock(fix(size) * sizeof(struct htent)) :
++ (struct htent *)alloc_relblock(fix(size) * sizeof(struct htent));
+ for(i = 0; i < fix(size); i++) {
+ h->ht.ht_self[i].hte_key = OBJNULL;
+ h->ht.ht_self[i].hte_value = OBJNULL;
+@@ -547,6 +552,7 @@ gcl_init_hash()
+ sKtest = make_keyword("TEST");
+ sKrehash_size = make_keyword("REHASH-SIZE");
+ sKrehash_threshold = make_keyword("REHASH-THRESHOLD");
++ sKstatic = make_keyword("STATIC");
+
+ make_function("MAKE-HASH-TABLE", Lmake_hash_table);
+ make_function("HASH-TABLE-P", Lhash_table_p);
+--- gcl-2.6.12.orig/o/let.c
++++ gcl-2.6.12/o/let.c
+@@ -226,7 +226,7 @@ is an illegal function definition in FLE
+ top[0] = MMcons(lex[2], def);
+ top[0] = MMcons(lex[1], top[0]);
+ top[0] = MMcons(lex[0], top[0]);
+- top[0] = MMcons(sLlambda_block_closure, top[0]);
++ top[0] = MMcons(sSlambda_block_closure, top[0]);
+ lex_fun_bind(MMcar(def), top[0]);
+ def_list = MMcdr(def_list);
+ }
+@@ -262,7 +262,7 @@ is an illegal function definition in LAB
+ top[0] = MMcons(Cnil, top[0]);
+ top[1] = MMcons(top[0], top[1]);
+ top[0] = MMcons(lex[0], top[0]);
+- top[0] = MMcons(sLlambda_block_closure, top[0]);
++ top[0] = MMcons(sSlambda_block_closure, top[0]);
+ lex_fun_bind(MMcar(def), top[0]);
+ def_list = MMcdr(def_list);
+ }
+@@ -315,8 +315,8 @@ gcl_init_let(void)
+ make_special_form("LET", Flet);
+ make_special_form("LET*", FletA);
+ make_special_form("MULTIPLE-VALUE-BIND", Fmultiple_value_bind);
+- make_special_form("COMPILER-LET", Fcompiler_let);
+ make_special_form("FLET",Fflet);
+ make_special_form("LABELS",Flabels);
+ make_special_form("MACROLET",Fmacrolet);
++ make_si_special_form("COMPILER-LET", Fcompiler_let);
+ }
+--- gcl-2.6.12.orig/o/lex.c
++++ gcl-2.6.12/o/lex.c
+@@ -58,7 +58,7 @@ lex_macro_bind(object name, object exp_f
+ {
+ object *top = vs_top;
+ vs_push(make_cons(exp_fun, Cnil));
+- top[0] = make_cons(sLmacro, top[0]);
++ top[0] = make_cons(sSmacro, top[0]);
+ top[0] = make_cons(name, top[0]);
+ lex_env[1]=make_cons(top[0], lex_env[1]);
+ vs_top = top;
+@@ -70,7 +70,7 @@ lex_tag_bind(object tag, object id)
+ object *top = vs_top;
+
+ vs_push(make_cons(id, Cnil));
+- top[0] = make_cons(sLtag, top[0]);
++ top[0] = make_cons(sStag, top[0]);
+ top[0] = make_cons(tag, top[0]);
+ lex_env[2] =make_cons(top[0], lex_env[2]);
+ vs_top = top;
+@@ -95,7 +95,7 @@ lex_tag_sch(object tag)
+ object alist = lex_env[2];
+
+ while (!endp(alist)) {
+- if (eql(MMcaar(alist), tag) && MMcadar(alist) == sLtag)
++ if (eql(MMcaar(alist), tag) && MMcadar(alist) == sStag)
+ return(MMcar(alist));
+ alist = MMcdr(alist);
+ }
+@@ -120,10 +120,10 @@ gcl_init_lex(void)
+ {
+ /* sLfunction = make_ordinary("FUNCTION"); */
+ /* enter_mark_origin(&sLfunction); */
+- sLmacro = make_ordinary("MACRO");
+- enter_mark_origin(&sLmacro);
+- sLtag = make_ordinary("TAG");
+- enter_mark_origin(&sLtag);
++ sSmacro = make_si_ordinary("MACRO");
++ enter_mark_origin(&sSmacro);
++ sStag = make_si_ordinary("TAG");
++ enter_mark_origin(&sStag);
+ sLblock = make_ordinary("BLOCK");
+ enter_mark_origin(&sLblock);
+ }
+--- gcl-2.6.12.orig/o/macros.c
++++ gcl-2.6.12/o/macros.c
+@@ -161,7 +161,7 @@ macro_def(object form)
+ return(head->s.s_gfdef);
+ else
+ return(Cnil);
+- else if (MMcadr(fd) == sLmacro)
++ else if (MMcadr(fd) == sSmacro)
+ return(MMcaddr(fd));
+ else
+ return(Cnil);
+@@ -279,7 +279,7 @@ macro_expand(object form)
+ exp_fun = head->s.s_gfdef;
+ else
+ return(form);
+- else if (MMcadr(fd) == sLmacro)
++ else if (MMcadr(fd) == sSmacro)
+ exp_fun = MMcaddr(fd);
+ else
+ return(form);
+@@ -316,7 +316,7 @@ LOOP:
+ exp_fun = head->s.s_gfdef;
+ else
+ goto END;
+- else if (MMcadr(fd) == sLmacro)
++ else if (MMcadr(fd) == sSmacro)
+ exp_fun = MMcaddr(fd);
+ else
+ goto END;
+--- gcl-2.6.12.orig/o/main.c
++++ gcl-2.6.12/o/main.c
+@@ -182,30 +182,41 @@ get_phys_pages_no_malloc(void) {
+ #else
+
+ ufixnum
+-get_phys_pages_no_malloc(void) {
+- int l;
++get_proc_meminfo_value_in_pages(const char *k) {
++ int l,m;
+ char b[PAGESIZE],*c;
+- const char *k="MemTotal:",*f="/proc/meminfo";
+- ufixnum res=0,n;
++ ufixnum n;
+
+- if ((l=open(f,O_RDONLY))!=-1) {
+- if ((n=read(l,b,sizeof(b)))<sizeof(b) &&
+- !(b[n]=0) &&
+- (c=strstr(b,k)) &&
+- sscanf(c+strlen(k),"%lu",&n)==1)
+- res=n;
+- close(l);
+- }
+- return res>>(PAGEWIDTH-10);
++ massert((l=open("/proc/meminfo",O_RDONLY))!=-1);
++ massert((n=read(l,b,sizeof(b)))<sizeof(b));
++ b[n]=0;
++ massert(!close(l));
++ massert((c=strstr(b,k)));
++ c+=strlen(k);
++ massert(sscanf(c,"%lu%n",&n,&m)==1);
++ massert(!strncmp(c+m," kB\n",4));
++ return n>>(PAGEWIDTH-10);
++}
++
++ufixnum
++get_phys_pages_no_malloc(char freep) {
++ return freep ?
++ get_proc_meminfo_value_in_pages("MemFree:")+
++ get_proc_meminfo_value_in_pages("Buffers:")+
++ get_proc_meminfo_value_in_pages("Cached:") :
++ get_proc_meminfo_value_in_pages("MemTotal:");
+ }
+
+ #endif
+
++void *initial_sbrk=NULL;
++
+ int
+ update_real_maxpage(void) {
+
+ ufixnum i,j,k;
+ void *end,*cur,*beg;
++ ufixnum free_phys_pages=get_phys_pages_no_malloc(1),maxpages;
+ #ifdef __MINGW32__
+ static fixnum n;
+
+@@ -215,6 +226,8 @@ update_real_maxpage(void) {
+ }
+ #endif
+
++ phys_pages=get_phys_pages_no_malloc(1);
++
+ massert(cur=sbrk(0));
+ beg=data_start ? data_start : cur;
+ for (i=0,j=(1L<<log_maxpage_bound);j>PAGESIZE;j>>=1)
+@@ -225,30 +238,46 @@ update_real_maxpage(void) {
+ }
+ massert(!mbrk(cur));
+
+- phys_pages=get_phys_pages_no_malloc();
++/* phys_pages=get_phys_pages_no_malloc(0); */
+
+-#ifdef BRK_DOES_NOT_GUARANTEE_ALLOCATION
+- if (phys_pages>0 && real_maxpage>phys_pages+page(beg)) real_maxpage=phys_pages+page(beg);
+-#endif
++/* #ifdef BRK_DOES_NOT_GUARANTEE_ALLOCATION */
++/* if (phys_pages>0 && real_maxpage>phys_pages+page(beg)) real_maxpage=phys_pages+page(beg); */
++/* #endif */
++
++ maxpages=real_maxpage-page(beg);
+
+- available_pages=real_maxpage-page(beg);
++ free_phys_pages=free_phys_pages>maxpages ? maxpages : free_phys_pages;
++
++ resv_pages=available_pages=0;
++ available_pages=check_avail_pages();
++
+ for (i=t_start,j=0;i<t_other;i++) {
+- k=tm_table[i].tm_maxpage;
+- if (tm_table[i].tm_type==t_relocatable)
+- k*=2;
+- else
+- j+=k;
+- available_pages-=k;
++ massert(set_tm_maxpage(tm_table+i,tm_table[i].tm_npage));
++ j+=tm_table[i].tm_maxpage;
+ }
+ resv_pages=40<available_pages ? 40 : available_pages;
+ available_pages-=resv_pages;
++
++ if (sSAoptimize_maximum_pagesA && sSAoptimize_maximum_pagesA->s.s_dbind!=Cnil) {
+
+- new_holepage=available_pages/starting_hole_div;
+- k=available_pages/20;
+- j*=starting_relb_heap_mult;
+- j=j<k ? j : k;
+- if (maxrbpage<j)
+- set_tm_maxpage(tm_table+t_relocatable,j);
++ for (i=t_start,j=0;i<t_relocatable;i++)
++ j+=tm_table[i].tm_maxpage;
++
++ if (j<free_phys_pages) {
++ for (i=t_start,k=0;i<t_relocatable;i++)
++ if (tm_table[i].tm_maxpage) {
++ massert(set_tm_maxpage(tm_table+i,((double)0.7*free_phys_pages/j)*tm_table[i].tm_maxpage));
++ k+=tm_table[i].tm_maxpage;
++ }
++ set_tm_maxpage(tm_table+t_relocatable,(free_phys_pages-k)>>1);
++ }
++
++ new_holepage=0;
++ for (i=t_start;i<t_relocatable;i++)
++ new_holepage+=tm_table[i].tm_maxpage-tm_table[i].tm_npage;
++
++ } else
++ new_holepage=available_pages/starting_hole_div;
+
+ return 0;
+
+@@ -257,25 +286,13 @@ update_real_maxpage(void) {
+ static int
+ minimize_image(void) {
+
+-#ifdef SGC
+- int in_sgc=sgc_enabled;
+-#else
+- int in_sgc=0;
+-#endif
+ extern long new_holepage;
+- fixnum old_holepage=new_holepage,i;
+- void *new;
+-
+- if (in_sgc) sgc_quit();
+- holepage=new_holepage=1;
+- GBC(t_relocatable);
+- if (in_sgc) sgc_start();
+- new = (void *)(((((ufixnum)rb_pointer)+ PAGESIZE-1)/PAGESIZE)*PAGESIZE);
+- core_end = new;
+- rb_end=rb_limit=new;
+- set_tm_maxpage(tm_table+t_relocatable,(nrbpage=((char *)new-REAL_RB_START)/PAGESIZE));
+- new_holepage=old_holepage;
++ fixnum i;
+
++ empty_relblock();
++ holepage=nrbpage=0;
++ core_end=rb_start=rb_end=rb_limit=rb_pointer=heap_end;
++
+ #ifdef GCL_GPROF
+ gprof_cleanup();
+ #endif
+@@ -301,7 +318,7 @@ DEFUN_NEW("SET-LOG-MAXPAGE-BOUND",object
+ l=l<def ? l : def;
+ end=data_start+(1L<<l)-PAGESIZE;
+ GBC(t_relocatable);
+- dend=heap_end+PAGESIZE+(((rb_pointer-REAL_RB_START)+PAGESIZE-1)&(-PAGESIZE));
++ dend=heap_end+PAGESIZE+CEI(rb_pointer-(rb_pointer<rb_end ? rb_start : rb_end),PAGESIZE);
+ if (end >= dend) {
+ minimize_image();
+ log_maxpage_bound=l;
+@@ -352,6 +369,8 @@ gcl_mprotect(void *v,unsigned long l,int
+ }
+ #endif
+
++DEFVAR("*CODE-BLOCK-RESERVE*",sSAcode_block_reserveA,SI,Cnil,"");
++
+ int
+ main(int argc, char **argv, char **envp) {
+
+@@ -430,9 +449,10 @@ main(int argc, char **argv, char **envp)
+ gcl_init_readline_function();
+ #endif
+ #ifdef NEED_STACK_CHK_GUARD
+- __stack_chk_guard=random_ulong();/*Cannot be safely set inside a function which returns*/
++ __stack_chk_guard=random_ulong();/*Cannot be safely set inside a function which returns*/
+ #endif
+-
++ allocate_code_block_reserve();
++
+ }
+
+ #ifdef _WIN32
+@@ -549,22 +569,10 @@ initlisp(void) {
+ import(Ct, lisp_package);
+ export(Ct, lisp_package);
+
+-#ifdef ANSI_COMMON_LISP
+-/* Cnil->s.s_hpack = common_lisp_package; */
+- import(Cnil, common_lisp_package);
+- export(Cnil, common_lisp_package);
+-
+-/* Ct->s.s_hpack = common_lisp_package; */
+- import(Ct, common_lisp_package);
+- export(Ct, common_lisp_package);
+-#endif
+-
+-/* sLquote = make_ordinary("QUOTE"); */
+-/* sLfunction = make_ordinary("FUNCTION"); */
+ sLlambda = make_ordinary("LAMBDA");
+- sLlambda_block = make_ordinary("LAMBDA-BLOCK");
+- sLlambda_closure = make_ordinary("LAMBDA-CLOSURE");
+- sLlambda_block_closure = make_ordinary("LAMBDA-BLOCK-CLOSURE");
++ sSlambda_block = make_si_ordinary("LAMBDA-BLOCK");
++ sSlambda_closure = make_si_ordinary("LAMBDA-CLOSURE");
++ sSlambda_block_closure = make_si_ordinary("LAMBDA-BLOCK-CLOSURE");
+ sLspecial = make_ordinary("SPECIAL");
+
+
+@@ -702,7 +710,7 @@ segmentation_catcher(int i) {
+ /* error("end of file"); */
+ /* } */
+
+-DEFUNO_NEW("BYE",object,fLbye,LISP
++DEFUNO_NEW("BYE",object,fSbye,SI
+ ,0,1,NONE,OO,OO,OO,OO,void,Lby,(object exitc),"")
+ { int n=VFUN_NARGS;
+ int exit_code;
+@@ -714,9 +722,9 @@ DEFUNO_NEW("BYE",object,fLbye,LISP
+ }
+
+
+-DEFUN_NEW("QUIT",object,fLquit,LISP
++DEFUN_NEW("QUIT",object,fSquit,SI
+ ,0,1,NONE,OO,OO,OO,OO,(object exitc),"")
+-{ return FFN(fLbye)(exitc); }
++{ return FFN(fSbye)(exitc); }
+
+ /* DEFUN_NEW("EXIT",object,fLexit,LISP */
+ /* ,0,1,NONE,OI,OO,OO,OO,(fixnum exitc),"") */
+@@ -976,8 +984,8 @@ FFN(siLsave_system)(void) {
+
+ saving_system = FALSE;
+
+- Lsave();
+- alloc_page(-(holepage+nrbpage));
++ siLsave();
++ alloc_page(-(holepage+2*nrbpage));
+
+ }
+
+@@ -990,7 +998,7 @@ DEFVAR("*COMMAND-ARGS*",sSAcommand_argsA
+ static void
+ init_main(void) {
+
+- make_function("BY", Lby);
++ make_si_function("BY", Lby);
+ make_si_function("ARGC", siLargc);
+ make_si_function("ARGV", siLargv);
+
+--- gcl-2.6.12.orig/o/package.d
++++ gcl-2.6.12/o/package.d
+@@ -1159,17 +1159,12 @@ gcl_init_package()
+ {
+
+ lisp_package
+- = make_package(make_simple_string("LISP"),
+- Cnil, Cnil,47,509);
++ = make_package(make_simple_string("COMMON-LISP"),
++ list(2,make_simple_string("CL"),make_simple_string("LISP")),Cnil,47,509);
+ user_package
+- = make_package(make_simple_string("USER"),
+- Cnil,
++ = make_package(make_simple_string("COMMON-LISP-USER"),
++ list(2,make_simple_string("CL-USER"),make_simple_string("USER")),
+ make_cons(lisp_package, Cnil),509,97);
+-#ifdef ANSI_COMMON_LISP
+- common_lisp_package
+- = make_package(make_simple_string("COMMON-LISP"),
+- Cnil, Cnil,47,509);
+-#endif
+ keyword_package
+ = make_package(make_simple_string("KEYWORD"),
+ Cnil, Cnil,11,509);
+--- gcl-2.6.12.orig/o/predicate.c
++++ gcl-2.6.12/o/predicate.c
+@@ -341,9 +341,9 @@ DEFUNO_NEW("FUNCTIONP",object,fLfunction
+ x0 = Cnil; }
+ else if (t == t_cons) {
+ x = x0->c.c_car;
+- if (x == sLlambda || x == sLlambda_block ||
++ if (x == sLlambda || x == sSlambda_block ||
+ x == sSlambda_block_expanded ||
+- x == sLlambda_closure || x == sLlambda_block_closure)
++ x == sSlambda_closure || x == sSlambda_block_closure)
+ x0 = Ct;
+ else
+ x0 = Cnil;
+@@ -358,6 +358,14 @@ fLfunctionp(object x) {
+ #endif
+
+
++DEFUNO_NEW("COMMONP",object,fScommonp,SI,1,1,NONE,OO,OO,OO,OO,void,siLcommonp,(object x0),"") {
++ if (type_of(x0) != t_spice)
++ x0 = Ct;
++ else
++ x0 = Cnil;
++ RETURN1(x0);
++}
++
+ DEFUNO_NEW("COMPILED-FUNCTION-P",object,fLcompiled_function_p,LISP
+ ,1,1,NONE,OO,OO,OO,OO,void,Lcompiled_function_p,(object x0),"")
+
+@@ -377,18 +385,6 @@ DEFUNO_NEW("COMPILED-FUNCTION-P",object,
+ x0 = Ct;
+ else
+ x0 = Cnil;
+-RETURN1(x0);}
+-
+-DEFUNO_NEW("COMMONP",object,fLcommonp,LISP
+- ,1,1,NONE,OO,OO,OO,OO,void,Lcommonp,(object x0),"")
+-
+-{
+- /* 1 args */;
+-
+- if (type_of(x0) != t_spice)
+- x0 = Ct;
+- else
+- x0 = Cnil;
+ RETURN1(x0);}
+
+ DEFUN_NEW("EQ",object,fLeq,LISP,2,2,NONE,OO,OO,OO,OO,(object x0,object x1),"") {
+--- gcl-2.6.12.orig/o/read.d
++++ gcl-2.6.12/o/read.d
+@@ -2152,7 +2152,8 @@ LFD(Lreadtablep)()
+ rdtbl->rt.rt_self[c].rte_chattrib
+ = cat_terminating;
+ rdtbl->rt.rt_self[c].rte_macro = fnc;
+- @(return Ct)
++ SGC_TOUCH(rdtbl);
++ @(return Ct)
+ @)
+
+ @(defun get_macro_character (chr &optional (rdtbl `current_readtable()`))
+--- gcl-2.6.12.orig/o/reference.c
++++ gcl-2.6.12/o/reference.c
+@@ -82,7 +82,7 @@ LFD(Lsymbol_function)(void)
+ FEundefined_function(sym);
+ if (sym->s.s_mflag) {
+ vs_push(sym->s.s_gfdef);
+- vs_base[0] = sLmacro;
++ vs_base[0] = sSmacro;
+ stack_cons();
+ return;
+ }
+@@ -131,7 +131,7 @@ FFN(Ffunction)(object form)
+ vs_base[0] = MMcons(lex_env[2], vs_base[0]);
+ vs_base[0] = MMcons(lex_env[1], vs_base[0]);
+ vs_base[0] = MMcons(lex_env[0], vs_base[0]);
+- vs_base[0] = MMcons(sLlambda_closure, vs_base[0]);
++ vs_base[0] = MMcons(sSlambda_closure, vs_base[0]);
+ } else
+ FEinvalid_function(fun);
+ }
+@@ -173,7 +173,7 @@ LFD(Lmacro_function)(void)
+ vs_base[0] = Cnil;
+ }
+
+-LFD(Lspecial_form_p)(void)
++LFD(Lspecial_operator_p)(void)
+ {
+ check_arg(1);
+ if (type_of(vs_base[0]) != t_symbol)
+@@ -194,7 +194,6 @@ gcl_init_reference(void)
+ make_function("SYMBOL-VALUE", Lsymbol_value);
+ make_function("BOUNDP", Lboundp);
+ make_function("MACRO-FUNCTION", Lmacro_function);
+- make_function("SPECIAL-FORM-P", Lspecial_form_p);
+- make_function("SPECIAL-OPERATOR-P", Lspecial_form_p);
++ make_function("SPECIAL-OPERATOR-P", Lspecial_operator_p);
+ }
+
+--- gcl-2.6.12.orig/o/run_process.c
++++ gcl-2.6.12/o/run_process.c
+@@ -432,7 +432,7 @@ enum smmode smm;
+ stream->sm.sm_fp = fp;
+ stream->sm.sm_buffer = 0;
+
+- stream->sm.sm_object0 = sLstring_char;
++ stream->sm.sm_object0 = sLcharacter;
+ stream->sm.sm_object1 = host_l;
+ stream->sm.sm_int0 = stream->sm.sm_int1 = 0;
+ vs_push(stream);
+--- gcl-2.6.12.orig/o/save.c
++++ gcl-2.6.12/o/save.c
+@@ -16,11 +16,12 @@ memory_save(char *original_file, char *s
+ extern void _cleanup();
+ #endif
+
+-LFD(Lsave)(void) {
++LFD(siLsave)(void) {
+
+ char filename[256];
+ extern char *kcl_self;
+-
++ extern void *initial_sbrk;
++
+ check_arg(1);
+ check_type_or_pathname_string_symbol_stream(&vs_base[0]);
+ coerce_to_filename(vs_base[0], filename);
+@@ -33,7 +34,8 @@ LFD(Lsave)(void) {
+
+ raw_image=FALSE;
+ cs_org=0;
+-
++ initial_sbrk=core_end;
++
+ #ifdef MEMORY_SAVE
+ MEMORY_SAVE(kcl_self,filename);
+ #else
+--- gcl-2.6.12.orig/o/sfaslbfd.c
++++ gcl-2.6.12/o/sfaslbfd.c
+@@ -212,7 +212,7 @@ fasload(object faslfile) {
+
+ set_type_of(&dum,t_stream);
+ dum.sm.sm_mode=smm_input;
+- dum.sm.sm_object0=sLstring_char;
++ dum.sm.sm_object0=sLcharacter;
+
+ link_callbacks.add_archive_element=madd_archive_element;
+ link_callbacks.multiple_definition=mmultiple_definition;
+--- gcl-2.6.12.orig/o/sfaslelf.c
++++ gcl-2.6.12/o/sfaslelf.c
+@@ -58,7 +58,7 @@ License for more details.
+ #define LOAD_SYM(sym) ({ul _b=ELF_ST_BIND(sym->st_info),_t=ELF_ST_TYPE(sym->st_info); \
+ sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK || (_t>=STT_LOPROC && _t<=STT_HIPROC));})
+
+-#define MASK(n) (~(~0L << (n)))
++#define MASK(n) (~(~0ULL << (n)))
+
+
+
+@@ -242,6 +242,46 @@ relocate_symbols(Sym *sym,Sym *syme,Shdr
+
+ }
+
++#ifndef MAX_CODE_ADDRESS
++#define MAX_CODE_ADDRESS -1UL
++#endif
++
++static void *
++alloc_memory(ul sz) {
++
++ void *v;
++
++ if (sSAcode_block_reserveA &&
++ sSAcode_block_reserveA->s.s_dbind!=Cnil && sSAcode_block_reserveA->s.s_dbind->st.st_dim>=sz) {
++
++ v=sSAcode_block_reserveA->s.s_dbind->st.st_self;
++ sSAcode_block_reserveA->s.s_dbind->st.st_self+=sz;
++ sSAcode_block_reserveA->s.s_dbind->st.st_dim-=sz;
++ sSAcode_block_reserveA->s.s_dbind->st.st_fillp=sSAcode_block_reserveA->s.s_dbind->st.st_dim;
++
++ } else
++ v=alloc_contblock(sz);
++
++ massert(v && (ul)(v+sz)<MAX_CODE_ADDRESS);
++
++ return v;
++
++}
++
++void
++allocate_code_block_reserve(void) {
++
++ const char *s=getenv("GCL_CODESPACE");
++ ul n;
++
++ if (!s || sscanf(s,"%lu",&n)!=1)
++ return;
++
++ sSAcode_block_reserveA->s.s_dbind=alloc_simple_string(n);
++ sSAcode_block_reserveA->s.s_dbind->st.st_self=alloc_memory(n);
++
++}
++
+ static object
+ load_memory(Shdr *sec1,Shdr *sece,void *v1,ul **got,ul **gote) {
+
+@@ -275,9 +315,7 @@ load_memory(Shdr *sec1,Shdr *sece,void *
+ memory->cfd.cfd_size=sz;
+ memory->cfd.cfd_self=0;
+ memory->cfd.cfd_start=0;
+- prefer_low_mem_contblock=TRUE;
+- memory->cfd.cfd_start=alloc_contblock(sz);
+- prefer_low_mem_contblock=FALSE;
++ memory->cfd.cfd_start=alloc_memory(sz);
+
+ a=(ul)memory->cfd.cfd_start;
+ a=(a+ma)&~ma;
+--- gcl-2.6.12.orig/o/sgbc.c
++++ gcl-2.6.12/o/sgbc.c
+@@ -7,9 +7,6 @@
+
+ */
+
+-static void
+-sgc_mark_object1(object);
+-
+ #ifdef BSD
+ /* ulong may have been defined in mp.h but the define is no longer needed */
+ #undef ulong
+@@ -51,81 +48,12 @@ int gclmprotect ( void *addr, size_t len
+
+ #include <signal.h>
+
+-/* void segmentation_catcher(void); */
+-
+-
+-#define sgc_mark_pack_list(u) \
+-do {register object xtmp = u; \
+- while (xtmp != Cnil) \
+- {if (ON_WRITABLE_PAGE(xtmp)) {mark(xtmp);} \
+- sgc_mark_object(xtmp->c.c_car); \
+- xtmp=Scdr(xtmp);}}while(0)
+-
+-
+ #ifdef SDEBUG
+ object sdebug;
+ joe1(){;}
+ joe() {;}
+ #endif
+
+-/* static void */
+-/* sgc_mark_cons(object x) { */
+-
+-/* cs_check(x); */
+-
+-/* /\* x is already marked. *\/ */
+-
+-/* BEGIN: */
+-/* #ifdef SDEBUG */
+-/* if(x==sdebug) joe1(); */
+-/* #endif */
+-/* sgc_mark_object(x->c.c_car); */
+-/* #ifdef OLD */
+-/* IF_WRITABLE(x->c.c_car, goto MARK_CAR;); */
+-/* goto MARK_CDR; */
+-
+-/* MARK_CAR: */
+-/* if (!is_marked_or_free(x->c.c_car)) { */
+-/* if (consp(x->c.c_car)) { */
+-/* mark(x->c.c_car); */
+-/* sgc_mark_cons(x->c.c_car); */
+-/* } else */
+-/* sgc_mark_object1(x->c.c_car);} */
+-/* MARK_CDR: */
+-/* #endif */
+-/* /\* if (is_imm_fixnum(x->c.c_cdr)) return; *\/ */
+-/* x = Scdr(x); */
+-/* IF_WRITABLE(x, goto WRITABLE_CDR;); */
+-/* return; */
+-/* WRITABLE_CDR: */
+-/* if (is_marked_or_free(x)) return; */
+-/* if (consp(x)) { */
+-/* mark(x); */
+-/* goto BEGIN; */
+-/* } */
+-/* sgc_mark_object1(x); */
+-/* } */
+-
+-inline void
+-sgc_mark_cons(object x) {
+-
+- do {
+- object d=x->c.c_cdr;
+- mark(x);
+- sgc_mark_object(x->c.c_car);
+- x=d;
+- if (!IS_WRITABLE(page(x)) || is_marked_or_free(x))/*catches Cnil*/
+- return;
+- } while (cdr_listp(x));
+- sgc_mark_object(x);
+-
+-}
+-
+-/* Whenever two arrays are linked together by displacement,
+- if one is live, the other will be made live */
+-#define sgc_mark_displaced_field(ar) sgc_mark_object(ar->a.a_displaced)
+-
+-
+ /* structures and arrays of type t, need to be marked if their
+ bodies are not write protected even if the headers are.
+ So we should keep these on pages particular to them.
+@@ -134,415 +62,6 @@ sgc_mark_cons(object x) {
+ This takes only 1.47 as opposed to 1.33 microseconds per set.
+ */
+ static void
+-sgc_mark_object1(object x) {
+-
+- fixnum i,j;
+- object *p;
+- char *cp;
+- enum type tp;
+-
+- cs_check(x);
+- BEGIN:
+-#ifdef SDEBUG
+- if (x == OBJNULL || !ON_WRITABLE_PAGE(x))
+- return;
+- IF_WRITABLE(x,goto OK);
+- joe();
+- OK:
+-#endif
+- if (is_marked_or_free(x))
+- return;
+-#ifdef SDEBUG
+- if(x==sdebug) joe1();
+-#endif
+-
+- tp=type_of(x);
+-
+- if (tp==t_cons) {
+- sgc_mark_cons(x);
+- return;
+- }
+-
+- mark(x);
+-
+- switch (tp) {
+-
+- case t_fixnum:
+- break;
+-
+- case t_ratio:
+- sgc_mark_object(x->rat.rat_num);
+- x = x->rat.rat_den;
+- IF_WRITABLE(x,if(!is_marked_or_free(x)) goto BEGIN);
+-
+- case t_shortfloat:
+- break;
+-
+- case t_longfloat:
+- break;
+-
+- case t_complex:
+- sgc_mark_object(x->cmp.cmp_imag);
+- x = x->cmp.cmp_real;
+- IF_WRITABLE(x,if(!is_marked_or_free(x)) goto BEGIN);
+-
+- case t_character:
+- break;
+-
+- case t_symbol:
+- IF_WRITABLE(x->s.s_plist,if(!is_marked_or_free(x->s.s_plist))
+- {/* mark(x->s.s_plist); */
+- sgc_mark_cons(x->s.s_plist);});
+- sgc_mark_object(x->s.s_gfdef);
+- sgc_mark_object(x->s.s_dbind);
+- if (x->s.s_self == NULL)
+- break;
+- /* to do */
+- if (inheap(x->s.s_self)) {
+- if (what_to_collect == t_contiguous)
+- mark_contblock(x->s.s_self,x->s.s_fillp);
+- } else if (SGC_RELBLOCK_P(x->s.s_self) && COLLECT_RELBLOCK_P)
+- x->s.s_self = copy_relblock(x->s.s_self, x->s.s_fillp);
+- break;
+-
+- case t_package:
+- sgc_mark_object(x->p.p_name);
+- sgc_mark_object(x->p.p_nicknames);
+- sgc_mark_object(x->p.p_shadowings);
+- sgc_mark_object(x->p.p_uselist);
+- sgc_mark_object(x->p.p_usedbylist);
+- if (what_to_collect == t_contiguous) {
+- if (x->p.p_internal != NULL)
+- mark_contblock((char *)(x->p.p_internal),
+- x->p.p_internal_size*sizeof(object));
+- if (x->p.p_external != NULL)
+- mark_contblock((char *)(x->p.p_external),
+- x->p.p_external_size*sizeof(object));
+- }
+- break;
+-
+- case t_hashtable:
+- sgc_mark_object(x->ht.ht_rhsize);
+- sgc_mark_object(x->ht.ht_rhthresh);
+- if (x->ht.ht_self == NULL)
+- break;
+- for (i = 0, j = x->ht.ht_size; i < j; i++) {
+- if (ON_WRITABLE_PAGE(&x->ht.ht_self[i])) {
+- sgc_mark_object(x->ht.ht_self[i].hte_key);
+- sgc_mark_object(x->ht.ht_self[i].hte_value);
+- }
+- }
+- if (inheap(x->ht.ht_self)) {
+- if (what_to_collect == t_contiguous)
+- mark_contblock((char *)(x->ht.ht_self),j * sizeof(struct htent));
+- } else if (SGC_RELBLOCK_P(x->ht.ht_self) && COLLECT_RELBLOCK_P)
+- x->ht.ht_self=(void *)copy_relblock((char *)x->ht.ht_self,j*sizeof(struct htent));;
+- break;
+-
+- case t_array:
+- if ((x->a.a_displaced) != Cnil)
+- sgc_mark_displaced_field(x);
+- if (x->a.a_dims != NULL) {
+- if (inheap(x->a.a_dims)) {
+- if (what_to_collect == t_contiguous)
+- mark_contblock((char *)(x->a.a_dims),sizeof(int)*x->a.a_rank);
+- } else if (SGC_RELBLOCK_P(x->a.a_dims) && COLLECT_RELBLOCK_P)
+- x->a.a_dims = (int *) copy_relblock((char *)(x->a.a_dims),sizeof(int)*x->a.a_rank);
+- }
+- if ((enum aelttype)x->a.a_elttype == aet_ch)
+- goto CASE_STRING;
+- if ((enum aelttype)x->a.a_elttype == aet_bit)
+- goto CASE_BITVECTOR;
+- if ((enum aelttype)x->a.a_elttype == aet_object)
+- goto CASE_GENERAL;
+-
+- CASE_SPECIAL:
+- cp = (char *)(x->fixa.fixa_self);
+- if (cp == NULL)
+- break;
+- /* set j to the size in char of the body of the array */
+-
+- switch((enum aelttype)x->a.a_elttype){
+- case aet_lf:
+- j= sizeof(longfloat)*x->lfa.lfa_dim;
+- if ((COLLECT_RELBLOCK_P) && !(inheap(cp)) && SGC_RELBLOCK_P(x->a.a_self))
+- ROUND_RB_POINTERS_DOUBLE;/*FIXME gc space violation*/
+- break;
+- case aet_char:
+- case aet_uchar:
+- j=sizeof(char)*x->a.a_dim;
+- break;
+- case aet_short:
+- case aet_ushort:
+- j=sizeof(short)*x->a.a_dim;
+- break;
+- default:
+- j=sizeof(fixnum)*x->fixa.fixa_dim;}
+-
+- goto COPY;
+-
+- CASE_GENERAL:
+- p = x->a.a_self;
+- if (p == NULL
+-#ifdef HAVE_ALLOCA
+- || (char *)p >= core_end
+-#endif
+-
+- )
+- break;
+- j=0;
+- if (x->a.a_displaced->c.c_car == Cnil)
+- for (i = 0, j = x->a.a_dim; i < j; i++)
+- if (ON_WRITABLE_PAGE(&p[i]))
+- sgc_mark_object(p[i]);
+- cp = (char *)p;
+- j *= sizeof(object);
+- COPY:
+- if (inheap(cp)) {
+- if (what_to_collect == t_contiguous)
+- mark_contblock(cp, j);
+- } else if (SGC_RELBLOCK_P(cp) && COLLECT_RELBLOCK_P) {
+- if (x->a.a_displaced == Cnil) {
+-#ifdef HAVE_ALLOCA
+- if (!NULL_OR_ON_C_STACK(cp)) /* only if body of array not on C stack */
+-#endif
+- x->a.a_self = (object *)copy_relblock(cp, j);
+- } else if (x->a.a_displaced->c.c_car == Cnil) {
+- i = (long)(object *)copy_relblock(cp, j) - (long)(x->a.a_self);
+- adjust_displaced(x, i);
+- }
+- }
+- break;
+-
+- case t_vector:
+- if ((x->v.v_displaced) != Cnil)
+- sgc_mark_displaced_field(x);
+- if ((enum aelttype)x->v.v_elttype == aet_object)
+- goto CASE_GENERAL;
+- else
+- goto CASE_SPECIAL;
+-
+- case t_bignum:
+-#ifdef SDEBUG
+- if (TYPE_MAP(page(x->big.big_self)) < t_contiguous)
+- printf("bad body for %x (%x)\n",x,cp);
+-#endif
+-#ifndef GMP_USE_MALLOC
+- j = MP_ALLOCATED(x);
+- cp = (char *)MP_SELF(x);
+- if (cp == 0)
+- break;
+- j = j * MP_LIMB_SIZE;
+- if (inheap(cp)) {
+- if (what_to_collect == t_contiguous)
+- mark_contblock(cp, j);
+- } else if (SGC_RELBLOCK_P(cp) && COLLECT_RELBLOCK_P)
+- MP_SELF(x) = (void *) copy_relblock(cp, j);
+-#endif /* not GMP_USE_MALLOC */
+- break;
+-
+-
+- CASE_STRING:
+- case t_string:
+- if ((x->st.st_displaced) != Cnil)
+- sgc_mark_displaced_field(x);
+- j = x->st.st_dim;
+- cp = x->st.st_self;
+- if (cp == NULL)
+- break;
+-
+- COPY_STRING:
+- if (inheap(cp)) {
+- if (what_to_collect == t_contiguous)
+- mark_contblock(cp, j);
+- } else if (SGC_RELBLOCK_P(cp) && COLLECT_RELBLOCK_P) {
+- if (x->st.st_displaced == Cnil)
+- x->st.st_self = copy_relblock(cp, j);
+- else if (x->st.st_displaced->c.c_car == Cnil) {
+- i = copy_relblock(cp, j) - cp;
+- adjust_displaced(x, i);
+- }
+- }
+- break;
+-
+- CASE_BITVECTOR:
+- case t_bitvector:
+- if ((x->bv.bv_displaced) != Cnil)
+- sgc_mark_displaced_field(x);
+- /* We make bitvectors multiple of sizeof(int) in size allocated
+- Assume 8 = number of bits in char */
+-
+-#define W_SIZE (8*sizeof(fixnum))
+- j= sizeof(fixnum) *
+- ((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE);
+- cp = x->bv.bv_self;
+- if (cp == NULL)
+- break;
+- goto COPY_STRING;
+-
+- case t_structure:
+- sgc_mark_object(x->str.str_def);
+- p = x->str.str_self;
+- if (p == NULL)
+- break;
+- {
+- object def=x->str.str_def;
+- unsigned char *s_type = &SLOT_TYPE(def,0);
+- unsigned short *s_pos = &SLOT_POS (def,0);
+- for (i = 0, j = S_DATA(def)->length; i < j; i++)
+- if (s_type[i]==0 && ON_WRITABLE_PAGE(&STREF(object,x,s_pos[i])))
+- sgc_mark_object(STREF(object,x,s_pos[i]));
+- if (inheap(x->str.str_self)) {
+- if (what_to_collect == t_contiguous)
+- mark_contblock((char *)p,S_DATA(def)->size);
+- } else if (SGC_RELBLOCK_P(p) && (COLLECT_RELBLOCK_P))
+- x->str.str_self = (object *) copy_relblock((char *)p, S_DATA(def)->size);
+- }
+- break;
+-
+- case t_stream:
+- switch (x->sm.sm_mode) {
+- case smm_input:
+- case smm_output:
+- case smm_io:
+- case smm_socket:
+- case smm_probe:
+- sgc_mark_object(x->sm.sm_object0);
+- sgc_mark_object(x->sm.sm_object1);
+- if (what_to_collect == t_contiguous &&
+- x->sm.sm_fp &&
+- x->sm.sm_buffer)
+- mark_contblock(x->sm.sm_buffer, BUFSIZ);
+- break;
+-
+- case smm_synonym:
+- sgc_mark_object(x->sm.sm_object0);
+- break;
+-
+- case smm_broadcast:
+- case smm_concatenated:
+- sgc_mark_object(x->sm.sm_object0);
+- break;
+-
+- case smm_two_way:
+- case smm_echo:
+- sgc_mark_object(x->sm.sm_object0);
+- sgc_mark_object(x->sm.sm_object1);
+- break;
+-
+- case smm_string_input:
+- case smm_string_output:
+- sgc_mark_object(x->sm.sm_object0);
+- break;
+-#ifdef USER_DEFINED_STREAMS
+- case smm_user_defined:
+- sgc_mark_object(x->sm.sm_object0);
+- sgc_mark_object(x->sm.sm_object1);
+- break;
+-#endif
+- default:
+- error("mark stream botch");
+- }
+- break;
+-
+-#define SGC_MARK_CP(a_,b_) {fixnum _t=(b_);if (inheap((a_))) {\
+- if (what_to_collect == t_contiguous) mark_contblock((void *)(a_),_t); \
+- } else if (SGC_RELBLOCK_P((a_)) && COLLECT_RELBLOCK_P) (a_)=(void *)copy_relblock((void *)(a_),_t);}
+-
+-#define SGC_MARK_MP(a_) {if ((a_)->_mp_d) SGC_MARK_CP((a_)->_mp_d,(a_)->_mp_alloc*MP_LIMB_SIZE);}
+-
+- case t_random:
+- SGC_MARK_MP(x->rnd.rnd_state._mp_seed);
+-#if __GNU_MP_VERSION < 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR < 2)
+- if (x->rnd.rnd_state._mp_algdata._mp_lc) {
+- SGC_MARK_MP(x->rnd.rnd_state._mp_algdata._mp_lc->_mp_a);
+- if (!x->rnd.rnd_state._mp_algdata._mp_lc->_mp_m2exp) SGC_MARK_MP(x->rnd.rnd_state._mp_algdata._mp_lc->_mp_m);
+- SGC_MARK_CP(x->rnd.rnd_state._mp_algdata._mp_lc,sizeof(*x->rnd.rnd_state._mp_algdata._mp_lc));
+- }
+-#endif
+- break;
+-
+- case t_readtable:
+- if (x->rt.rt_self == NULL)
+- break;
+- if (what_to_collect == t_contiguous)
+- mark_contblock((char *)(x->rt.rt_self),RTABSIZE*sizeof(struct rtent));
+- for (i = 0; i < RTABSIZE; i++) {
+- sgc_mark_object(x->rt.rt_self[i].rte_macro);
+- if (x->rt.rt_self[i].rte_dtab != NULL) {
+- if (what_to_collect == t_contiguous)
+- mark_contblock((char *)(x->rt.rt_self[i].rte_dtab),RTABSIZE*sizeof(object));
+- for (j = 0; j < RTABSIZE; j++)
+- sgc_mark_object(x->rt.rt_self[i].rte_dtab[j]);
+- }
+- }
+- break;
+-
+- case t_pathname:
+- sgc_mark_object(x->pn.pn_host);
+- sgc_mark_object(x->pn.pn_device);
+- sgc_mark_object(x->pn.pn_directory);
+- sgc_mark_object(x->pn.pn_name);
+- sgc_mark_object(x->pn.pn_type);
+- sgc_mark_object(x->pn.pn_version);
+- break;
+-
+- case t_closure:
+- {
+- int i ;
+- for (i= 0 ; i < x->cl.cl_envdim ; i++)
+- sgc_mark_object(x->cl.cl_env[i]);
+- if (SGC_RELBLOCK_P(x->cl.cl_env) && COLLECT_RELBLOCK_P)
+- x->cl.cl_env=(void *)copy_relblock((void *)x->cl.cl_env,x->cl.cl_envdim*sizeof(object));
+-
+- }
+-
+- case t_cfun:
+- case t_sfun:
+- case t_vfun:
+- case t_afun:
+- case t_gfun:
+- sgc_mark_object(x->cf.cf_name);
+- sgc_mark_object(x->cf.cf_data);
+- break;
+-
+- case t_cfdata:
+-
+- if (x->cfd.cfd_self != NULL) {
+- int i=x->cfd.cfd_fillp;
+- while(i-- > 0)
+- sgc_mark_object(x->cfd.cfd_self[i]);
+- }
+- if (what_to_collect == t_contiguous) {
+- mark_contblock(x->cfd.cfd_start, x->cfd.cfd_size);
+- mark_link_array(x->cfd.cfd_start,x->cfd.cfd_start+x->cfd.cfd_size);
+- }
+- break;
+- case t_cclosure:
+- sgc_mark_object(x->cc.cc_name);
+- sgc_mark_object(x->cc.cc_env);
+- sgc_mark_object(x->cc.cc_data);
+- if (x->cc.cc_turbo!=NULL) {
+- sgc_mark_object(*(x->cc.cc_turbo-1));
+- if (SGC_RELBLOCK_P(x->cc.cc_turbo) && COLLECT_RELBLOCK_P)
+- x->cc.cc_turbo=(void *)copy_relblock((char *)(x->cc.cc_turbo-1),(1+fix(*(x->cc.cc_turbo-1)))*sizeof(object))+sizeof(object);
+- }
+- break;
+-
+- case t_spice:
+- break;
+-
+- default:
+-#ifdef DEBUG
+- if (debug)
+- printf("\ttype = %d\n", type_of(x));
+-#endif
+- error("mark botch");
+- }
+-
+-}
+-
+-static void
+ sgc_mark_phase(void) {
+
+ STATIC fixnum i, j;
+@@ -552,8 +71,8 @@ sgc_mark_phase(void) {
+ STATIC ihs_ptr ihsp;
+ STATIC struct pageinfo *v;
+
+- sgc_mark_object(Cnil->s.s_plist);
+- sgc_mark_object(Ct->s.s_plist);
++ mark_object(Cnil->s.s_plist);
++ mark_object(Ct->s.s_plist);
+
+ /* mark all non recent data on writable pages */
+ {
+@@ -563,15 +82,17 @@ sgc_mark_phase(void) {
+
+ for (v=cell_list_head;v;v=v->next) {
+ i=page(v);
+- if (!WRITABLE_PAGE_P(i)) continue;
++ if (v->sgc_flags&SGC_PAGE_FLAG || !WRITABLE_PAGE_P(i)) continue;
+
+ t=v->type;
+ tm=tm_of(t);
+ p=pagetochar(i);
+ for (j = tm->tm_nppage; --j >= 0; p += tm->tm_size) {
+ object x = (object) p;
+- if (SGC_OR_M(x)) continue;
+- sgc_mark_object1(x);
++#ifndef SGC_WHOLE_PAGE
++ if (TYPEWORD_TYPE_P(v->type) && x->d.s) continue;
++#endif
++ mark_object1(x);
+ }
+ }
+ }
+@@ -595,24 +116,24 @@ sgc_mark_phase(void) {
+ mark_stack_carefully(MVloc+(sizeof(MVloc)/sizeof(object)),MVloc,0);
+
+ for (bdp = bds_org; bdp<=bds_top; bdp++) {
+- sgc_mark_object(bdp->bds_sym);
+- sgc_mark_object(bdp->bds_val);
++ mark_object(bdp->bds_sym);
++ mark_object(bdp->bds_val);
+ }
+
+ for (frp = frs_org; frp <= frs_top; frp++)
+- sgc_mark_object(frp->frs_val);
++ mark_object(frp->frs_val);
+
+ for (ihsp = ihs_org; ihsp <= ihs_top; ihsp++)
+- sgc_mark_object(ihsp->ihs_function);
++ mark_object(ihsp->ihs_function);
+
+ for (i = 0; i < mark_origin_max; i++)
+- sgc_mark_object(*mark_origin[i]);
++ mark_object(*mark_origin[i]);
+ for (i = 0; i < mark_origin_block_max; i++)
+ for (j = 0; j < mark_origin_block[i].mob_size; j++)
+- sgc_mark_object(mark_origin_block[i].mob_addr[j]);
++ mark_object(mark_origin_block[i].mob_addr[j]);
+
+ for (pp = pack_pointer; pp != NULL; pp = pp->p_link)
+- sgc_mark_object((object)pp);
++ mark_object((object)pp);
+ #ifdef KCLOVM
+ if (ovm_process_created)
+ sgc_mark_all_stacks();
+@@ -624,20 +145,6 @@ sgc_mark_phase(void) {
+ fflush(stdout);
+ }
+ #endif
+- {
+- int size;
+-
+- for (pp = pack_pointer; pp != NULL; pp = pp->p_link) {
+- size = pp->p_internal_size;
+- if (pp->p_internal != NULL)
+- for (i = 0; i < size; i++)
+- sgc_mark_pack_list(pp->p_internal[i]);
+- size = pp->p_external_size;
+- if (pp->p_external != NULL)
+- for (i = 0; i < size; i++)
+- sgc_mark_pack_list(pp->p_external[i]);
+- }
+- }
+
+ mark_c_stack(0,N_RECURSION_REQD,mark_stack_carefully);
+
+@@ -657,9 +164,6 @@ sgc_sweep_phase(void) {
+
+ tm = tm_of((enum type)v->type);
+
+- if (!WRITABLE_PAGE_P(page(v)))
+- continue;
+-
+ p = pagetochar(page(v));
+ f = tm->tm_free;
+ k = 0;
+@@ -678,14 +182,18 @@ sgc_sweep_phase(void) {
+ continue;
+ }
+
+- if (TYPEWORD_TYPE_P(pageinfo(x)->type) && x->d.s == SGC_NORMAL)
++#ifndef SGC_WHOLE_PAGE
++ if (TYPEWORD_TYPE_P(v->type) && x->d.s == SGC_NORMAL)
+ continue;
++#endif
+
+ /* it is ok to free x */
+
+ SET_LINK(x,f);
+ make_free(x);
++#ifndef SGC_WHOLE_PAGE
+ if (TYPEWORD_TYPE_P(v->type)) x->d.s = SGC_RECENT;
++#endif
+ f = x;
+ k++;
+
+@@ -694,7 +202,7 @@ sgc_sweep_phase(void) {
+ tm->tm_nfree += k;
+ v->in_use-=k;
+
+- } else /*non sgc_page */
++ } else if (WRITABLE_PAGE_P(page(v))) /*non sgc_page */
+ for (j = tm->tm_nppage; --j >= 0; p += size) {
+ x = (object)p;
+ if (is_marked(x) && !is_free(x)) {
+@@ -711,9 +219,9 @@ sgc_contblock_sweep_phase(void) {
+
+ STATIC char *s, *e, *p, *q;
+ STATIC struct pageinfo *v;
++
++ reset_contblock_freelist();
+
+- cb_pointer = NULL;
+- ncb = 0;
+ for (v=contblock_list_head;v;v=v->next) {
+ bool z;
+
+@@ -739,13 +247,6 @@ sgc_contblock_sweep_phase(void) {
+
+ }
+
+-
+-
+-#define PAGE_ROUND_UP(adr) \
+- ((char *)(PAGESIZE*(((long)(adr)+PAGESIZE -1) >> PAGEWIDTH)))
+-
+-/* char *old_rb_start; */
+-
+ #undef tm
+
+ #ifdef SDEBUG
+@@ -763,11 +264,11 @@ sgc_count(object yy) {
+
+ fixnum writable_pages=0;
+
+-/* count writable pages excluding the hole */
++/* count read-only pages */
+ static fixnum
+-sgc_count_writable(void) {
++sgc_count_read_only(void) {
+
+- return page(core_end)-page(rb_start)+writable_pages-(page(old_rb_start)-page(heap_end));
++ return sgc_enabled ? sSAwritableA->s.s_dbind->v.v_dim-writable_pages : 0;
+
+ }
+
+@@ -1031,7 +532,11 @@ memprotect_test_reset(void) {
+ /* If opt_maxpage is set, add full pages to the sgc set if needed
+ too. 20040804 CM*/
+ /* #define FSGC(tm) (tm->tm_type==t_cons ? tm->tm_nppage : (tm->tm_opt_maxpage ? 0 : tm->tm_sgc_minfree)) */
++#ifdef SGC_WHOLE_PAGE
++#define FSGC(tm) tm->tm_nppage
++#else
+ #define FSGC(tm) (!TYPEWORD_TYPE_P(tm->tm_type) ? tm->tm_nppage : tm->tm_sgc_minfree)
++#endif
+
+ DEFVAR("*WRITABLE*",sSAwritableA,SI,Cnil,"");
+
+@@ -1047,13 +552,16 @@ sgc_start(void) {
+ object omp=sSAoptimize_maximum_pagesA->s.s_dbind;
+ double tmp,scale;
+
++ allocate_more_pages=0;
++ if (sgc_enabled)
++ return 1;
++
+ sSAoptimize_maximum_pagesA->s.s_dbind=Cnil;
+
+ if (memprotect_result!=memprotect_success && do_memprotect_test())
+ return 0;
+
+- if (sgc_enabled)
+- return 1;
++ empty_relblock();
+
+ /* Reset maxpage statistics if not invoked automatically on a hole
+ overrun. 20040804 CM*/
+@@ -1193,26 +701,7 @@ sgc_start(void) {
+
+ }
+
+- /* Now allocate the sgc relblock. We do this as the tail
+- end of the ordinary rb. */
+- {
+- char *new;
+- tm=tm_of(t_relocatable);
+-
+- {
+- old_rb_start=rb_start;
+- if(((unsigned long)WSGC(tm)) && allocate_more_pages) {
+- new=alloc_relblock(((unsigned long)WSGC(tm))*PAGESIZE);
+- /* the above may cause a gc, shifting the relblock */
+- old_rb_start=rb_start;
+- new= PAGE_ROUND_UP(new);
+- } else new=PAGE_ROUND_UP(rb_pointer);
+- rb_start=rb_pointer=new;
+- }
+- }
+- /* the relblock has been allocated */
+-
+- sSAwritableA->s.s_dbind=fSmake_vector1_1((page(rb_start)-first_data_page),aet_bit,Cnil);
++ sSAwritableA->s.s_dbind=fSmake_vector1_1((page(heap_end)-first_data_page),aet_bit,Ct);
+ wrimap=(void *)sSAwritableA->s.s_dbind->v.v_self;
+
+ /* now move the sgc free lists into place. alt_free should
+@@ -1231,12 +720,16 @@ sgc_start(void) {
+ #endif
+ if (pageinfo(f)->sgc_flags&SGC_PAGE_FLAG) {
+ SET_LINK(f,x);
++#ifndef SGC_WHOLE_PAGE
+ if (TYPEWORD_TYPE_P(pageinfo(f)->type)) f->d.s = SGC_RECENT;
++#endif
+ x=f;
+ count++;
+ } else {
+ SET_LINK(f,y);
++#ifndef SGC_WHOLE_PAGE
+ if (TYPEWORD_TYPE_P(pageinfo(f)->type)) f->d.s = SGC_NORMAL;
++#endif
+ y=f;
+ }
+ f=next;
+@@ -1253,9 +746,12 @@ sgc_start(void) {
+
+ {
+
+- struct contblock *new_cb_pointer=NULL,*tmp_cb_pointer=NULL,**cbpp;
++ struct contblock **cbpp;
+ void *p=NULL,*pe;
+ struct pageinfo *pi;
++
++ old_cb_pointer=cb_pointer;
++ reset_contblock_freelist();
+
+ for (pi=contblock_list_head;pi;pi=pi->next) {
+
+@@ -1264,26 +760,17 @@ sgc_start(void) {
+ p=CB_DATA_START(pi);
+ pe=p+CB_DATA_SIZE(pi->in_use);
+
+- for (cbpp=&cb_pointer;*cbpp;)
++ for (cbpp=&old_cb_pointer;*cbpp;)
+ if ((void *)*cbpp>=p && (void *)*cbpp<pe) {
+ void *s=*cbpp,*e=s+(*cbpp)->cb_size,*l=(*cbpp)->cb_link;
+ set_sgc_bits(pi,s,e);
+- tmp_cb_pointer=cb_pointer;
+- cb_pointer=new_cb_pointer;
+ insert_contblock(s,e-s);
+- new_cb_pointer=cb_pointer;
+- cb_pointer=tmp_cb_pointer;
+ *cbpp=l;
+ } else
+ cbpp=&(*cbpp)->cb_link;
+
+ }
+
+- /* SGC contblock pages: switch to new free SGC contblock list. CM
+- 20030827 */
+- old_cb_pointer=cb_pointer;
+- cb_pointer=new_cb_pointer;
+-
+ #ifdef SGC_CONT_DEBUG
+ overlap_check(old_cb_pointer,cb_pointer);
+ #endif
+@@ -1315,11 +802,13 @@ sgc_start(void) {
+ SET_WRITABLE(i);
+ }
+
+- for (i=page(heap_end);i<page(old_rb_start);i++)
+- SET_WRITABLE(i);
+- tm_of(t_relocatable)->tm_alt_npage=page(rb_start)-page(old_rb_start);
+- for (i=page(rb_start);i<page(core_end);i++)
++ {
++ object v=sSAwritableA->s.s_dbind;
++ for (i=page(v->v.v_self);i<=page(v->v.v_self+CEI(v->bv.bv_offset+v->v.v_dim-1,8*sizeof(fixnum))/(8*sizeof(fixnum)));i++)
+ SET_WRITABLE(i);
++ }
++
++ tm_of(t_relocatable)->tm_alt_npage=0;
+
+ fault_pages=0;
+
+@@ -1363,8 +852,7 @@ sgc_quit(void) {
+
+ struct typemanager *tm;
+ struct contblock *tmp_cb_pointer,*next;
+- unsigned long i,j,np;
+- char *p;
++ unsigned long i,np;
+ struct pageinfo *v;
+
+ memory_protect(0);
+@@ -1379,7 +867,6 @@ sgc_quit(void) {
+ wrimap=NULL;
+
+ sgc_enabled=0;
+- rb_start = old_rb_start;
+
+ /* SGC cont pages: restore contblocks, each tmp_cb_pointer coming
+ from the new list is guaranteed not to be on the old. Need to
+@@ -1389,9 +876,7 @@ sgc_quit(void) {
+ #ifdef SGC_CONT_DEBUG
+ overlap_check(old_cb_pointer,cb_pointer);
+ #endif
+- tmp_cb_pointer=cb_pointer;
+- cb_pointer=old_cb_pointer;
+- for (;tmp_cb_pointer; tmp_cb_pointer=next) {
++ for (tmp_cb_pointer=old_cb_pointer;tmp_cb_pointer; tmp_cb_pointer=next) {
+ next=tmp_cb_pointer->cb_link;
+ insert_contblock((void *)tmp_cb_pointer,tmp_cb_pointer->cb_size);
+ }
+@@ -1440,11 +925,13 @@ sgc_quit(void) {
+
+ /*FIXME*/
+ /* remove the recent flag from any objects on sgc pages */
+- for (v=cell_list_head;v;v=v->next)
++#ifndef SGC_WHOLE_PAGE
++ for (v=cell_list_head;v;v=v->next)
+ if (v->type==(tm=tm_of(v->type))->tm_type && TYPEWORD_TYPE_P(v->type) && v->sgc_flags & SGC_PAGE_FLAG)
+ for (p=pagetochar(page(v)),j=tm->tm_nppage;j>0;--j,p+=tm->tm_size)
+- ((object) p)->d.s=SGC_NORMAL;
+-
++ ((object) p)->d.s=SGC_NORMAL;
++#endif
++
+ for (v=contblock_list_head;v;v=v->next)
+ if (v->sgc_flags&SGC_PAGE_FLAG)
+ bzero(CB_SGCF_START(v),CB_DATA_START(v)-CB_SGCF_START(v));
+@@ -1488,7 +975,6 @@ memprotect_handler(int sig, long code, v
+ faddr = addr;
+ #endif
+ p = page(faddr);
+- /* p = ROUND_DOWN_PAGE_NO(p); */
+ if (p >= first_protectable_page
+ && faddr < (void *)core_end
+ && !(WRITABLE_PAGE_P(p))) {
+@@ -1560,10 +1046,10 @@ memory_protect(int on) {
+ INSTALL_MPROTECT_HANDLER;
+
+ beg=first_protectable_page;
+- writable = IS_WRITABLE(beg);
++ writable = WRITABLE_PAGE_P(beg);
+ for (i=beg ; ++i<= end; ) {
+
+- if (writable==IS_WRITABLE(i) && i<=end) continue;
++ if (writable==WRITABLE_PAGE_P(i) && i<end) continue;
+
+ if (sgc_mprotect(beg,i-beg,writable))
+ return -1;
+--- gcl-2.6.12.orig/o/string.d
++++ gcl-2.6.12/o/string.d
+@@ -403,7 +403,7 @@ LFD(Lstring_not_equal)() { string_sign
+ char_bits(initial_element) != 0 ||
+ char_font(initial_element) != 0)
+ initial_element
+- = wrong_type_argument(sLstring_char, initial_element);
++ = wrong_type_argument(sLcharacter, initial_element);
+ {BEGIN_NO_INTERRUPT;
+ x = alloc_simple_string(fix(size));
+ x->st.st_self = alloc_relblock(fix(size));
+--- gcl-2.6.12.orig/o/structure.c
++++ gcl-2.6.12/o/structure.c
+@@ -257,7 +257,7 @@ LFD(siLmake_structure)(void)
+ }
+
+ static void
+-FFN(siLcopy_structure)(void)
++FFN(Lcopy_structure)(void)
+ {
+ object x, y;
+ struct s_data *def;
+@@ -452,7 +452,7 @@ gcl_init_structure_function(void)
+
+ make_si_function("MAKE-STRUCTURE", siLmake_structure);
+ make_si_function("MAKE-S-DATA-STRUCTURE",siLmake_s_data_structure);
+- make_si_function("COPY-STRUCTURE", siLcopy_structure);
++ make_function("COPY-STRUCTURE", Lcopy_structure);
+ make_si_function("STRUCTURE-NAME", siLstructure_name);
+ /* make_si_function("STRUCTURE-REF", siLstructure_ref); */
+ /* make_si_function("STRUCTURE-DEF", siLstructure_def); */
+--- gcl-2.6.12.orig/o/toplevel.c
++++ gcl-2.6.12/o/toplevel.c
+@@ -68,12 +68,12 @@ FFN(Fdefun)(object args)
+ }
+ vs_base = vs_top;
+ if (lex_env[0] == Cnil && lex_env[1] == Cnil && lex_env[2] == Cnil) {
+- vs_push(MMcons(sLlambda_block, args));
++ vs_push(MMcons(sSlambda_block, args));
+ } else {
+ vs_push(MMcons(lex_env[2], args));
+ vs_base[0] = MMcons(lex_env[1], vs_base[0]);
+ vs_base[0] = MMcons(lex_env[0], vs_base[0]);
+- vs_base[0] = MMcons(sLlambda_block_closure, vs_base[0]);
++ vs_base[0] = MMcons(sSlambda_block_closure, vs_base[0]);
+ }
+ {object fname = clear_compiler_properties(name,vs_base[0]);
+ fname->s.s_gfdef = vs_base[0];
+--- gcl-2.6.12.orig/o/typespec.c
++++ gcl-2.6.12/o/typespec.c
+@@ -73,7 +73,7 @@ LFD(Ltype_of)(void)
+ if ((' ' <= i && i < '\177') || i == '\n')
+ vs_base[0] = sLstandard_char;
+ else
+- vs_base[0] = sLstring_char;
++ vs_base[0] = sLcharacter;
+ }
+ break;
+
+@@ -176,7 +176,6 @@ LFD(Ltype_of)(void)
+ DEF_ORDINARY("PROCLAIMED-ARG-TYPES",sSproclaimed_arg_types,SI,"");
+ DEF_ORDINARY("PROCLAIMED-RETURN-TYPE",sSproclaimed_return_type,SI,"");
+ DEF_ORDINARY("PROCLAIMED-FUNCTION",sSproclaimed_function,SI,"");
+-DEF_ORDINARY("COMMON",sLcommon,LISP,"");
+ DEF_ORDINARY("NULL",sLnull,LISP,"");
+ DEF_ORDINARY("CONS",sLcons,LISP,"");
+ DEF_ORDINARY("LIST",sLlist,LISP,"");
+@@ -197,7 +196,6 @@ DEF_ORDINARY("CHARACTER",sLcharacter,LIS
+ DEF_ORDINARY("NUMBER",sLnumber,LISP,"");
+ DEF_ORDINARY("RATIONAL",sLrational,LISP,"");
+ DEF_ORDINARY("FLOAT",sLfloat,LISP,"");
+-DEF_ORDINARY("STRING-CHAR",sLstring_char,LISP,"");
+ DEF_ORDINARY("REAL",sLreal,LISP,"");
+ DEF_ORDINARY("INTEGER",sLinteger,LISP,"");
+ DEF_ORDINARY("RATIO",sLratio,LISP,"");
+@@ -205,7 +203,6 @@ DEF_ORDINARY("SHORT-FLOAT",sLshort_float
+ DEF_ORDINARY("STANDARD-CHAR",sLstandard_char,LISP,"");
+ DEF_ORDINARY("BOOLEAN",sLboolean,LISP,"");
+ DEF_ORDINARY("FIXNUM",sLfixnum,LISP,"");
+-DEF_ORDINARY("POSITIVE-FIXNUM",sLpositive_fixnum,LISP,"");
+ DEF_ORDINARY("COMPLEX",sLcomplex,LISP,"");
+ DEF_ORDINARY("SINGLE-FLOAT",sLsingle_float,LISP,"");
+ DEF_ORDINARY("PACKAGE",sLpackage,LISP,"");
+@@ -228,10 +225,10 @@ DEF_ORDINARY("VALUES",sLvalues,LISP,"");
+ DEF_ORDINARY("MOD",sLmod,LISP,"");
+ DEF_ORDINARY("SIGNED-BYTE",sLsigned_byte,LISP,"");
+ DEF_ORDINARY("UNSIGNED-BYTE",sLunsigned_byte,LISP,"");
+-DEF_ORDINARY("SIGNED-CHAR",sLsigned_char,LISP,"");
+-DEF_ORDINARY("UNSIGNED-CHAR",sLunsigned_char,LISP,"");
+-DEF_ORDINARY("SIGNED-SHORT",sLsigned_short,LISP,"");
+-DEF_ORDINARY("UNSIGNED-SHORT",sLunsigned_short,LISP,"");
++DEF_ORDINARY("SIGNED-CHAR",sSsigned_char,SI,"");
++DEF_ORDINARY("UNSIGNED-CHAR",sSunsigned_char,SI,"");
++DEF_ORDINARY("SIGNED-SHORT",sSsigned_short,SI,"");
++DEF_ORDINARY("UNSIGNED-SHORT",sSunsigned_short,SI,"");
+ DEF_ORDINARY("*",sLA,LISP,"");
+ DEF_ORDINARY("PLUSP",sLplusp,LISP,"");
+ DEF_ORDINARY("DIVISION-BY-ZERO",sLdivision_by_zero,LISP,"");
+@@ -244,8 +241,6 @@ DEF_ORDINARY("UNDEFINED-FUNCTION",sLunde
+ DEF_ORDINARY("UNBOUND-VARIABLE",sLunbound_variable,LISP,"");
+ DEF_ORDINARY("PACKAGE-ERROR",sLpackage_error,LISP,"");
+
+-/* #ifdef ANSI_COMMON_LISP */
+-/* New ansi types */
+ DEF_ORDINARY("METHOD-COMBINATION",sLmethod_combination,LISP,"");
+ DEF_ORDINARY("ARITHMETIC-ERROR",sLarithmetic_error,LISP,"");
+ DEF_ORDINARY("BASE-CHAR",sLbase_char,LISP,"");
+@@ -290,7 +285,6 @@ DEF_ORDINARY("TWO-WAY-STREAM",sLtwo_way_
+ DEF_ORDINARY("TYPE-ERROR",sLtype_error,LISP,"");
+ DEF_ORDINARY("UNBOUND-SLOT",sLunbound_slot,LISP,"");
+ DEF_ORDINARY("WARNING",sLwarning,LISP,"");
+-/* #endif */
+
+ DEFCONST("CHAR-SIZE",sSchar_size,SI,small_fixnum(CHAR_SIZE),"Size in bits of a character");
+ DEFCONST("SHORT-SIZE",sSshort_size,SI,small_fixnum(CHAR_SIZE*sizeof(short)),"Size in bits of a short integer");
+--- gcl-2.6.12.orig/o/unexelf.c
++++ gcl-2.6.12/o/unexelf.c
+@@ -634,7 +634,7 @@ find_section (char *name, char *section_
+ static void
+ unexec (char *new_name, char *old_name, unsigned int data_start, unsigned int bss_start, unsigned int entry_address)
+ {
+- int new_file, old_file, new_file_size;
++ int new_file, old_file;
+
+ /* Pointers to the base of the image of the two files. */
+ caddr_t old_base, new_base;
+@@ -654,17 +654,14 @@ unexec (char *new_name, char *old_name,
+ /* Point to the section name table in the old file */
+ char *old_section_names;
+
+- ElfW(Addr) old_bss_addr, new_bss_addr;
+- ElfW(Word) old_bss_size, new_data2_size,old_bss_offset;
+- ElfW(Off) new_data2_offset;
+- ElfW(Addr) new_data2_addr;
++ ElfW(Addr) old_bss_addr, new_bss_addr,new_data2_addr;
++ ElfW(Off) old_bss_size, new_data2_size,old_bss_offset,new_data2_offset,old_file_size,new_file_size;
+
+ int n, nn;
+ int old_bss_index, old_sbss_index;
+ int old_data_index, new_data2_index;
+ int old_mdebug_index;
+ struct stat stat_buf;
+- int old_file_size;
+
+ /* Open the old file, allocate a buffer of the right size, and read
+ in the file contents. */
+--- gcl-2.6.12.orig/o/unixsave.c
++++ gcl-2.6.12/o/unixsave.c
+@@ -140,7 +140,7 @@ char *original_file, *save_file;
+
+ extern void _cleanup();
+
+-LFD(Lsave)() {
++LFD(siLsave)() {
+ char filename[256];
+
+ check_arg(1);
+@@ -159,6 +159,6 @@ LFD(Lsave)() {
+ void
+ gcl_init_unixsave(void)
+ {
+- make_function("SAVE", Lsave);
++ make_si_function("SAVE", siLsave);
+ }
+
+--- gcl-2.6.12.orig/o/unixsys.c
++++ gcl-2.6.12/o/unixsys.c
+@@ -169,7 +169,7 @@ msystem(const char *s) {
+ }
+
+ static void
+-FFN(Lsystem)(void)
++FFN(siLsystem)(void)
+ {
+ char command[32768];
+ int i;
+@@ -284,6 +284,6 @@ un_mmap(void *v1,void *ve) {
+ void
+ gcl_init_unixsys(void) {
+
+- make_function("SYSTEM", Lsystem);
++ make_si_function("SYSTEM", siLsystem);
+
+ }
+--- gcl-2.6.12.orig/o/unixtime.c
++++ gcl-2.6.12/o/unixtime.c
+@@ -282,7 +282,7 @@ DEFUN_NEW("CURRENT-TIMEZONE",object,fScu
+ localtime_r(&_t, <);
+ return (object)(gt.tm_hour-lt.tm_hour+24*(gt.tm_yday!=lt.tm_yday ? (gt.tm_year>lt.tm_year||gt.tm_yday>lt.tm_yday ? 1 : -1) : 0));
+ #else
+- fixnum _t=time(0);
++ time_t _t=time(0);
+ return (object)(-localtime(&_t)->tm_gmtoff/3600);
+ #endif
+ }
+@@ -296,7 +296,7 @@ DEFUN_NEW("CURRENT-DSTP",object,fScurren
+ #elif defined NO_SYSTEM_TIME_ZONE /*solaris*/
+ return Cnil;
+ #else
+- fixnum _t=time(0);
++ time_t _t=time(0);
+ return localtime(&_t)->tm_isdst > 0 ? Ct : Cnil;
+ #endif
+ }
+--- gcl-2.6.12.orig/pcl/defsys.lisp
++++ gcl-2.6.12/pcl/defsys.lisp
+@@ -52,24 +52,10 @@
+
+ (in-package :user)
+
+-#+kcl (in-package :walker :use '(:lisp))
+-#+kcl (in-package :iterate :use '(:lisp :walker))
+-#+kcl (in-package :pcl :use '(:walker :iterate :lisp))
++(load "package.lisp")
+
+ (eval-when (compile load eval)
+
+-(if (find-package ':walker)
+- (use-package '(:lisp) ':walker)
+- (make-package ':walker :use '(:lisp)))
+-
+-(if (find-package ':iterate)
+- (use-package '(:lisp :walker) ':iterate)
+- (make-package ':iterate :use '(:lisp :walker)))
+-
+-(if (find-package ':pcl)
+- (use-package '(:walker :iterate :lisp) ':pcl)
+- (make-package ':pcl :use '(:walker :iterate :lisp)))
+-
+ (export (intern (symbol-name :iterate) ;Have to do this here,
+ (find-package :iterate)) ;because in the defsystem
+ (find-package :iterate)) ;(later in this file)
+@@ -90,7 +76,7 @@
+
+ (eval-when (compile load eval)
+ (defvar *pcl-proclaim*
+- '(optimize (speed 3) (safety #+kcl 0 #-kcl 1) (space 0)
++ '(optimize (speed 3) (safety 1) (space 0)
+ #+lucid (compilation-speed 0)))
+ )
+
+@@ -261,7 +247,6 @@ and load your system with:
+ #+Xerox-Medley (Xerox-Medley xerox)
+ #+TI TI
+ #+(and dec vax common) Vaxlisp
+- #+KCL KCL
+ #+IBCL IBCL
+ #+gcl gcl
+ #+excl (excl franz)
+@@ -305,7 +290,6 @@ and load your system with:
+ #+Cloe-Runtime ("l" . "fasl")
+ #+(and dec common vax (not ultrix)) ("LSP" . "FAS")
+ #+(and dec common vax ultrix) ("lsp" . "fas")
+- #+KCL ("lsp" . "o")
+ #+IBCL ("lsp" . "o")
+ #+Xerox ("lisp" . "dfasl")
+ #+(and Lucid MC68000) ("lisp" . "lbin")
+@@ -675,7 +659,7 @@ and load your system with:
+ ;; 3.0 it's in the LUCID-COMMON-LISP package.
+ ;;
+ #+LUCID (or lucid::*source-pathname* (bad-time))
+- #+akcl si:*load-pathname*
++ #+akcl *load-pathname*
+ #+cmu17 *load-truename*
+ #-(or Lispm excl Xerox (and dec vax common) LUCID akcl cmu17) nil))
+
+--- gcl-2.6.12.orig/pcl/gcl_pcl_pkg.lisp
++++ gcl-2.6.12/pcl/gcl_pcl_pkg.lisp
+@@ -176,11 +176,8 @@
+
+ nil))
+
+-#+kcl
+-(progn
+-(import '(si:structurep si:structure-def si:structure-ref))
+-(shadow 'lisp:dotimes)
+-)
++#+kcl(import '(si:structurep si:structure-def si:structure-ref))
++
+ #+kcl
+ (in-package "SI")
+ #+kcl
+--- gcl-2.6.12.orig/pcl/gcl_pcl_walk.lisp
++++ gcl-2.6.12/pcl/gcl_pcl_walk.lisp
+@@ -608,7 +608,7 @@
+ (push `(,(car f) . (function . (,#'unbound-lexical-function . nil)))
+ lexicals))
+ (dolist (m macros)
+- (push `(,(car m) . (macro . ( ,(cadr m) . nil)))
++ (push `(,(car m) . (si::macro . ( ,(cadr m) . nil)))
+ lexicals))
+ (list first lexicals third)))
+
+@@ -623,7 +623,7 @@
+ (when env
+ (let ((entry (assoc macro (second env))))
+ (and entry
+- (eq (cadr entry) 'macro)
++ (eq (cadr entry) 'si::macro)
+ (caddr entry)))))
+ );#+(or KCL IBCL)
+
+@@ -1202,7 +1202,7 @@
+
+ #+(or KCL IBCL)
+ (progn
+- (define-walker-template lambda-block walk-named-lambda);Not really right,
++ (define-walker-template si::lambda-block walk-named-lambda);Not really right,
+ ;we don't hack block
+ ;names anyways.
+ )
+@@ -1367,7 +1367,7 @@
+ #+cmu17
+ (special-operator-p fn)
+ #-cmu17
+- (special-form-p fn))
++ (special-operator-p fn))
+ (error
+ "~S is a special form, not defined in the CommonLisp.~%~
+ manual This code walker doesn't know how to walk it.~%~
+--- gcl-2.6.12.orig/pcl/impl/gcl/gcl_pcl_impl_low.lisp
++++ gcl-2.6.12/pcl/impl/gcl/gcl_pcl_impl_low.lisp
+@@ -277,17 +277,17 @@ static object set_cclosure (object resul
+ (fourth slotd))
+
+ (defun renew-sys-files()
+- ;; packages:
+- (compiler::get-packages "sys-package.lisp")
+- (with-open-file (st "sys-package.lisp"
+- :direction :output
+- :if-exists :append)
+- (format st "(lisp::in-package \"SI\")
+-(export '(%structure-name
+- %compiled-function-name
+- %set-compiled-function-name))
+-(in-package \"PCL\")
+-"))
++;; ;; packages:
++;; (compiler::get-packages "sys-package.lisp")
++;; (with-open-file (st "sys-package.lisp"
++;; :direction :output
++;; :if-exists :append)
++;; (format st "(lisp::in-package \"SI\")
++;; (export '(%structure-name
++;; %compiled-function-name
++;; %set-compiled-function-name))
++;; (in-package \"PCL\")
++;; "))
+
+ ;; proclaims
+ (compiler::make-all-proclaims "*.fn")
+--- gcl-2.6.12.orig/pcl/makefile
++++ gcl-2.6.12/pcl/makefile
+@@ -9,9 +9,7 @@ GFILES:=$(addprefix gcl_pcl_gazonk,$(GFI
+
+ AFILES:=$(FILES) $(GFILES)
+
+-SETUP='(load "sys-package.lisp")' \
+- '(setq *features* (delete (quote :kcl) *features*))'\
+- '(load "defsys.lisp")(push (quote :kcl) *features*)' \
++SETUP='(load "defsys.lisp")' \
+ '(setq pcl::*default-pathname-extensions* (cons "lisp" "o"))' \
+ '(setq pcl::*pathname-extensions* (cons "lisp" "o"))' \
+ '(load "sys-proclaim.lisp")' \
+--- /dev/null
++++ gcl-2.6.12/pcl/package.lisp
+@@ -0,0 +1,21 @@
++(in-package :user)
++
++(eval-when (compile load eval)
++
++(if (find-package :walker)
++ (use-package '(:lisp) :walker)
++ (make-package :walker :use '(:lisp)))
++
++(if (find-package :iterate)
++ (use-package '(:lisp :walker) :iterate)
++ (make-package :iterate :use '(:lisp :walker)))
++
++(if (find-package :pcl)
++ (use-package '(:walker :iterate :lisp) :pcl)
++ (make-package :pcl :use '(:walker :iterate :lisp))))
++
++(in-package :pcl)
++(defvar *the-pcl-package* (find-package :pcl))
++(defun load-truename (&optional errorp) *load-pathname*)
++(import 'si::(clines defentry defcfun object void int double))
++(import 'si::compiler-let :walker)
+--- gcl-2.6.12.orig/pcl/sys-proclaim.lisp
++++ gcl-2.6.12/pcl/sys-proclaim.lisp
+@@ -1,775 +1,1044 @@
+
+-(IN-PACKAGE "PCL")
+-(PROCLAIM
+- '(FTYPE (FUNCTION NIL T)
+- INITIALIZE-CHECKING-OR-CACHING-FUNCTION-LIST MAKE-ARG-INFO
+- RENEW-SYS-FILES ALLOCATE-FUNCALLABLE-INSTANCE-1
+- SHOW-DFUN-CONSTRUCTORS MAKE-CACHE SHOW-EMF-CALL-TRACE
+- INITIAL-DISPATCH-DFUN-INFO DISPATCH-DFUN-INFO
+- IN-THE-COMPILER-P UPDATE-DISPATCH-DFUNS
+- SHOW-FREE-CACHE-VECTORS NO-METHODS-DFUN-INFO
+- %%ALLOCATE-INSTANCE--CLASS DEFAULT-METHOD-ONLY-DFUN-INFO
+- BOOTSTRAP-META-BRAID GET-EFFECTIVE-METHOD-GENSYM
+- STRUCTURE-FUNCTIONS-EXIST-P LIST-ALL-DFUNS MAKE-CPD
+- CACHES-TO-ALLOCATE INITIAL-DFUN-INFO
+- ALLOCATE-FUNCALLABLE-INSTANCE-2 BOOTSTRAP-BUILT-IN-CLASSES))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T) *) DEFAULT-CODE-CONVERTER
+- MAKE-FINAL-DISPATCH-DFUN PROTOTYPES-FOR-MAKE-METHOD-LAMBDA
+- FIND-STRUCTURE-CLASS EARLY-COLLECT-INHERITANCE
+- EMIT-ONE-INDEX-WRITERS NET-CODE-CONVERTER
+- MAKE-DISPATCH-DFUN *NORMALIZE-TYPE COMPILE-IIS-FUNCTIONS
+- GENERIC-FUNCTION-NAME-P EMIT-IN-CHECKING-CACHE-P
+- EMIT-ONE-CLASS-READER GET-GENERIC-FUNCTION-INFO
+- COMPUTE-APPLICABLE-METHODS-EMF ANALYZE-LAMBDA-LIST
+- EMIT-ONE-INDEX-READERS EARLY-METHOD-FUNCTION PCL-DESCRIBE
+- TYPE-FROM-SPECIALIZER FIND-WRAPPER METHOD-PROTOTYPE-FOR-GF
+- SPECIALIZER-FROM-TYPE STRUCTURE-WRAPPER
+- GET-DISPATCH-FUNCTION EMIT-TWO-CLASS-READER
+- PARSE-METHOD-GROUP-SPECIFIER CLASS-EQ-TYPE
+- EMIT-CONSTANT-VALUE EMIT-TWO-CLASS-WRITER
+- CONVERT-TO-SYSTEM-TYPE PARSE-DEFMETHOD
+- EMIT-ONE-CLASS-WRITER))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (*) T) |__si::MAKE-CACHING| |__si::MAKE-N-N|
+- MAKE-INITIALIZE-INFO |__si::MAKE-NO-METHODS|
+- |__si::MAKE-TWO-CLASS| INTERN-PV-TABLE
+- |__si::MAKE-ARG-INFO| |__si::MAKE-ONE-INDEX-DFUN-INFO|
+- FIX-EARLY-GENERIC-FUNCTIONS CALLED-FIN-WITHOUT-FUNCTION
+- MAKE-FAST-METHOD-CALL STRING-APPEND |__si::MAKE-ONE-INDEX|
+- |__si::MAKE-INITIAL| |__si::MAKE-CHECKING| ZERO
+- |__si::MAKE-PV-TABLE| MAKE-PROGN FALSE MAKE-PV-TABLE
+- WALKER::UNBOUND-LEXICAL-FUNCTION |__si::MAKE-DISPATCH|
+- USE-PACKAGE-PCL TRUE |__si::MAKE-DEFAULT-METHOD-ONLY|
+- |__si::MAKE-INITIAL-DISPATCH| |__si::MAKE-CONSTANT-VALUE|
+- |__si::MAKE-DFUN-INFO| |__si::MAKE-STD-INSTANCE|
+- MAKE-METHOD-CALL |__si::MAKE-CLASS-PRECEDENCE-DESCRIPTION|
+- MAKE-FAST-INSTANCE-BOUNDP |__si::MAKE-ACCESSOR-DFUN-INFO|
+- |STRUCTURE-OBJECT class constructor| |__si::MAKE-CACHE|
+- |__si::MAKE-ONE-CLASS| PV-WRAPPERS-FROM-PV-ARGS))
+-(PROCLAIM '(FTYPE (FUNCTION (T) (OR CACHE NULL)) PV-TABLE-CACHE))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T *) *) MAKE-METHOD-FUNCTION-INTERNAL
+- PARSE-METHOD-OR-SPEC MAKE-METHOD-LAMBDA-INTERNAL
+- COERCE-TO-CLASS MAKE-FINAL-DFUN-INTERNAL GET-FUNCTION
+- EXTRACT-DECLARATIONS COMPILE-LAMBDA GET-FUNCTION1
+- MAKE-CACHING-DFUN GET-METHOD-FUNCTION DISPATCH-DFUN-COST
+- MACROEXPAND-ALL PARSE-SPECIALIZED-LAMBDA-LIST ENSURE-CLASS
+- WALK-FORM MAKE-INSTANCE-1 GET-DFUN-CONSTRUCTOR
+- MAP-ALL-CLASSES ENSURE-GENERIC-FUNCTION
+- MAKE-CONSTANT-VALUE-DFUN))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T) T) ACCESSOR-MISS-FUNCTION ADD-TO-CVECTOR
+- QUALIFIER-CHECK-RUNTIME SET-FUNCTION-PRETTY-ARGLIST
+- ADD-DIRECT-SUBCLASSES REMOVE-METHOD SET-WRAPPER
+- DOCTOR-DFUN-FOR-THE-DEBUGGER MAKE-PLIST
+- SYMBOL-OR-CONS-LESSP MAKE-STD-BOUNDP-METHOD-FUNCTION
+- UPDATE-CPL METHODS-CONVERTER MAKE-DFUN-ARG-LIST
+- MAKE-DISCRIMINATING-FUNCTION-ARGLIST
+- STANDARD-INSTANCE-ACCESS REMTAIL DO-SATISFIES-DEFTYPE
+- CPL-FORWARD-REFERENCED-CLASS-ERROR FIND-STANDARD-II-METHOD
+- MAKE-UNORDERED-METHODS-EMF UPDATE-INITIALIZE-INFO-INTERNAL
+- ADD-METHOD COMPUTE-PV |SETF PCL FIND-CLASS-PREDICATE|
+- PROCLAIM-DEFMETHOD UPDATE-ALL-PV-TABLE-CACHES
+- ITERATE::SIMPLE-EXPAND-ITERATE-FORM CLASS-MIGHT-PRECEDE-P
+- MEC-ALL-CLASSES SET-FUNCALLABLE-INSTANCE-FUNCTION
+- MAKE-DFUN-LAMBDA-LIST CHECKING-DFUN-INFO
+- METHOD-FUNCTION-RETURNING-T PV-WRAPPERS-FROM-ALL-WRAPPERS
+- SET-METHODS ITERATE::MV-SETQ SUPERCLASSES-COMPATIBLE-P
+- SLOT-EXISTS-P SWAP-WRAPPERS-AND-SLOTS DESCRIBE-PACKAGE
+- VALUE-FOR-CACHING SAUT-NOT-PROTOTYPE
+- SET-STANDARD-SVUC-METHOD PLIST-VALUE AUGMENT-TYPE
+- UPDATE-CLASS N-N-DFUN-INFO VARIABLE-SPECIAL-P
+- UPDATE-STD-OR-STR-METHODS ADD-FORMS MAKE-CAXR
+- MAKE-DLAP-LAMBDA-LIST REDIRECT-EARLY-FUNCTION-INTERNAL
+- GET-KEY-ARG1 EMIT-N-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION
+- MAKE-INTERNAL-READER-METHOD-FUNCTION |SETF PCL FIND-CLASS|
+- COMPUTE-CALLS PROCLAIM-DEFGENERIC WALKER::NOTE-DECLARATION
+- SYSTEM:%SET-COMPILED-FUNCTION-NAME VARIABLE-LEXICAL-P
+- CANONICALIZE-DEFCLASS-OPTION RAISE-METATYPE
+- PARSE-QUALIFIER-PATTERN SAUT-NOT-CLASS-EQ
+- MAKE-PV-TABLE-INTERNAL WALKER::ENVIRONMENT-FUNCTION
+- COMPUTE-APPLICABLE-METHODS-FUNCTION
+- EMIT-1-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION
+- PV-TABLE-LOOKUP VARIABLE-CLASS
+- MAKE-FAST-METHOD-CALL-LAMBDA-LIST |SETF PCL GDEFINITION|
+- NET-CONSTANT-CONVERTER WALKER::VARIABLE-SYMBOL-MACRO-P
+- SYMBOL-LESSP GF-MAKE-FUNCTION-FROM-EMF
+- REMOVE-DIRECT-SUBCLASSES UPDATE-INITS
+- |SETF PCL METHOD-FUNCTION-PLIST| COMPUTE-STD-CPL
+- CPL-INCONSISTENT-ERROR CHANGE-CLASS-INTERNAL
+- FIND-SLOT-DEFINITION COMPUTE-LAYOUT NO-SLOT
+- %SET-CCLOSURE-ENV COMPUTE-CONSTANTS
+- SET-STRUCTURE-SVUC-METHOD GET-KEY-ARG REMOVE-SLOT-ACCESSORS
+- MAKE-CDXR MEMF-CONSTANT-CONVERTER BOOTSTRAP-SLOT-INDEX
+- CLASS-CAN-PRECEDE-P MEC-ALL-CLASSES-INTERNAL
+- CLASSES-HAVE-COMMON-SUBCLASS-P MAKE-CLASS-PREDICATE
+- SAUT-NOT-CLASS DESTRUCTURE-INTERNAL
+- ITERATE::EXTRACT-SPECIAL-BINDINGS MAKE-EARLY-ACCESSOR
+- MAP-PV-TABLE-REFERENCES-OF MAKE-STD-WRITER-METHOD-FUNCTION
+- FUNCALLABLE-STANDARD-INSTANCE-ACCESS
+- METHOD-FUNCTION-RETURNING-NIL MEC-ALL-CLASS-LISTS
+- ADD-SLOT-ACCESSORS EMIT-1-NIL-DLAP
+- MAKE-STD-READER-METHOD-FUNCTION
+- CANONICALIZE-SLOT-SPECIFICATION LIST-EQ REAL-REMOVE-METHOD
+- WALKER::ENVIRONMENT-MACRO SAUT-NOT-EQL UPDATE-SLOTS
+- DEAL-WITH-ARGUMENTS-OPTION PRINTING-RANDOM-THING-INTERNAL
+- WALKER::WALK-REPEAT-EVAL
+- PV-WRAPPERS-FROM-ALL-ARGS WALKER::NOTE-LEXICAL-BINDING))
+-(PROCLAIM '(FTYPE (FUNCTION (T) (INTEGER 1 255)) CACHE-NKEYS))
+-(PROCLAIM '(FTYPE (FUNCTION (T) (INTEGER 1 256)) CACHE-LINE-SIZE))
+-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM T T) *) COMPUTE-CACHE-PARAMETERS))
+-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM T *) *) FIND-FREE-CACHE-LINE))
+-(PROCLAIM '(FTYPE (FUNCTION (T) FIELD-TYPE) CACHE-FIELD))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T) FUNCTION) CACHE-LIMIT-FN
+- FAST-METHOD-CALL-FUNCTION METHOD-CALL-FUNCTION))
+-(MAPC (LAMBDA (COMPILER::X)
+- (SETF (GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE) T))
+- '(TRACE-METHOD-INTERNAL FDEFINE-CAREFULLY DO-STANDARD-DEFSETF-1
+- REDEFINE-FUNCTION))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (FIXNUM FIXNUM T) FIXNUM)
+- COMPUTE-PRIMARY-CACHE-LOCATION))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T FIXNUM *) T) GET-CACHE-FROM-CACHE
+- COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T) (VALUES T T)) MAKE-KEYWORD
+- MAKE-CLASS-PREDICATE-NAME))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T *) T) FIND-CLASS-PREDICATE FIND-CLASS-CELL
+- USE-CONSTANT-VALUE-DFUN-P MAKE-EARLY-GF ITERATE::MAYBE-WARN
+- TRACE-METHOD ALLOCATE-FUNCALLABLE-INSTANCE WALKER::RELIST
+- UPDATE-DFUN USE-DISPATCH-DFUN-P PV-TABLE-LOOKUP-PV-ARGS
+- MAKE-WRAPPER EARLY-METHOD-SPECIALIZERS
+- INITIALIZE-METHOD-FUNCTION MAKE-FINAL-DFUN
+- WALKER::WALKER-ENVIRONMENT-BIND-1 MAKE-TYPE-PREDICATE-NAME
+- ALLOCATE-STRUCTURE-INSTANCE MAKE-SPECIALIZABLE
+- CAPITALIZE-WORDS SET-DFUN ITERATE::FUNCTION-LAMBDA-P
+- FIND-CLASS INITIALIZE-INTERNAL-SLOT-GFS SET-ARG-INFO
+- WALKER::RELIST* ALLOCATE-STANDARD-INSTANCE))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T) *) SAUT-NOT ENSURE-CLASS-VALUES
+- EMIT-CHECKING EMIT-DEFAULT-ONLY-FUNCTION EMIT-DEFAULT-ONLY
+- SAUT-CLASS CLASS-APPLICABLE-USING-CLASS-P EMIT-CACHING
+- DESTRUCTURE GET-NEW-FUNCTION-GENERATOR-INTERNAL
+- COMPUTE-TEST MAKE-DIRECT-SLOTD SLOT-NAME-LISTS-FROM-SLOTS
+- SAUT-EQL INSURE-DFUN CHECK-INITARGS-VALUES
+- SET-FUNCTION-NAME INITIAL-DFUN COMPUTE-STD-CPL-PHASE-1
+- *SUBTYPEP COMPUTE-APPLICABLE-METHODS-USING-TYPES
+- SDFUN-FOR-CACHING INVOKE-EMF SPLIT-DECLARATIONS
+- GENERATE-FAST-CLASS-SLOT-ACCESS-P COMPUTE-CODE SLOT-VALUE
+- SPECIALIZER-APPLICABLE-USING-TYPE-P SLOT-BOUNDP
+- FORM-LIST-TO-LISP ITERATE::PARSE-DECLARATIONS
+- MAKE-INSTANCE-FUNCTION-TRAP SAUT-PROTOTYPE
+- MUTATE-SLOTS-AND-CALLS SAUT-AND SAUT-CLASS-EQ
+- FIND-SUPERCLASS-CHAIN SLOT-UNBOUND-INTERNAL
+- UPDATE-SLOT-VALUE-GF-INFO SLOT-MAKUNBOUND))
+-(PROCLAIM
+- '(FTYPE (FUNCTION NIL *) EMIT-N-N-WRITERS EMIT-N-N-READERS
+- COUNT-ALL-DFUNS))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T) T) CHECKING-FUNCTION
+- METHOD-CALL-CALL-METHOD-ARGS EARLY-COLLECT-CPL
+- METHOD-FUNCTION-PV-TABLE ECD-OTHER-INITARGS
+- BOOTSTRAP-CLASS-PREDICATES CONSTANT-SYMBOL-P GDEFINITION
+- %FBOUNDP INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION
+- MAKE-INSTANCE-FUNCTION-SYMBOL FGEN-TEST
+- GF-PRECOMPUTE-DFUN-AND-EMF-P VARIABLE-GLOBALLY-SPECIAL-P
+- SLOT-INITARGS-FROM-STRUCTURE-SLOTD ARG-INFO-P
+- STRUCTURE-TYPE-INTERNAL-SLOTDS CCLOSUREP CHECKING-CACHE
+- GF-LAMBDA-LIST
+- MAKE-OPTIMIZED-STRUCTURE-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION
+- STRUCTURE-SVUC-METHOD DISPATCH-CACHE
+- BOOTSTRAP-ACCESSOR-DEFINITIONS FINAL-ACCESSOR-DFUN-TYPE
+- SETFBOUNDP ONE-CLASS-P EARLY-GF-P UPDATE-C-A-M-GF-INFO
+- FGEN-GENSYMS SORT-SLOTS MAKE-CLASS-EQ-PREDICATE N-N-CACHE
+- SFUN-P DFUN-ARG-SYMBOL
+- INITIALIZE-INFO-CACHED-DEFAULT-INITARGS-FUNCTION
+- EARLY-METHOD-STANDARD-ACCESSOR-SLOT-NAME
+- MAKE-TYPE-PREDICATE SORT-CALLS
+- MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION TWO-CLASS-WRAPPER1
+- USE-DEFAULT-METHOD-ONLY-DFUN-P FGEN-SYSTEM
+- CACHING-DFUN-COST CPD-CLASS CACHING-CACHE
+- INITIAL-DISPATCH-P LOOKUP-FGEN
+- COMPUTE-APPLICABLE-METHODS-EMF-STD-P COMPUTE-LINE-SIZE
+- GF-INFO-STATIC-C-A-M-EMF FAST-INSTANCE-BOUNDP-P
+- N-N-ACCESSOR-TYPE KEYWORD-SPEC-NAME DEFAULT-TEST-CONVERTER
+- RESET-INITIALIZE-INFO INITIAL-P
+- INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION-SYMBOL
+- EXPAND-MAKE-INSTANCE-FORM STRUCTURE-SLOT-BOUNDP
+- STANDARD-SVUC-METHOD TWO-CLASS-INDEX
+- EARLY-CLASS-PRECEDENCE-LIST MAKE-INITIAL-DFUN GMAKUNBOUND
+- METHODS-CONTAIN-EQL-SPECIALIZER-P EXPAND-SHORT-DEFCOMBIN
+- ACCESSOR-DFUN-INFO-CACHE MAKE-CALL-METHODS
+- STRUCTURE-SLOTD-NAME ALLOCATE-CACHE-VECTOR
+- RESET-CLASS-INITIALIZE-INFO GET-SETF-FUNCTION-NAME
+- METHOD-CALL-P LEGAL-CLASS-NAME-P EXTRACT-PARAMETERS
+- EARLY-SLOT-DEFINITION-NAME ECD-METACLASS DISPATCH-P
+- METHOD-FUNCTION-PLIST %STD-INSTANCE-SLOTS
+- CANONICAL-SLOT-NAME CONSTANT-VALUE-DFUN-INFO
+- FUNCTION-RETURNING-T FUNCTION-PRETTY-ARGLIST
+- STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST CHECK-WRAPPER-VALIDITY
+- INITIALIZE-INFO-P CPD-AFTER
+- MAKE-OPTIMIZED-STRUCTURE-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION
+- ONE-INDEX-INDEX WALKER::ENV-DECLARATIONS
+- STRUCTURE-SLOTD-TYPE MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION
+- EVAL-FORM LIST-DFUN
+- INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-T-FUNCTION
+- CACHE-OWNER FAST-METHOD-CALL-PV-CELL DFUN-INFO-P
+- UPDATE-PV-TABLE-CACHE-INFO EARLY-CLASS-SLOTDS
+- FUNCTION-RETURNING-NIL ECD-CLASS-NAME
+- TWO-CLASS-ACCESSOR-TYPE EARLY-CLASS-DEFINITION
+- FAST-METHOD-CALL-P INITIALIZE-INFO-CACHED-RI-VALID-P
+- COMPUTE-MCASE-PARAMETERS GF-DFUN-INFO
+- INITIALIZE-INFO-CACHED-COMBINED-INITARGS-FORM-LIST
+- EARLY-METHOD-LAMBDA-LIST ONE-CLASS-WRAPPER0
+- CLASS-PRECEDENCE-DESCRIPTION-P GET-MAKE-INSTANCE-FUNCTIONS
+- EXPAND-LONG-DEFCOMBIN MAP-SPECIALIZERS
+- EARLY-CLASS-DIRECT-SUBCLASSES WALKER::ENV-WALK-FORM
+- STRUCTURE-TYPE-INCLUDED-TYPE-NAME
+- ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE GBOUNDP ECD-SOURCE
+- CLASS-FROM-TYPE INITIALIZE-INFO-CACHED-NEW-KEYS
+- ARG-INFO-NKEYS DEFAULT-CONSTANT-CONVERTER
+- INITIALIZE-INFO-CACHED-COMBINED-INITIALIZE-FUNCTION
+- STORE-FGEN EARLY-METHOD-STANDARD-ACCESSOR-P
+- INTERN-FUNCTION-NAME NET-TEST-CONVERTER ARG-INFO-KEY/REST-P
+- COMPLICATED-INSTANCE-CREATION-METHOD
+- FTYPE-DECLARATION-FROM-LAMBDA-LIST
+- GENERIC-CLOBBERS-FUNCTION DEFAULT-STRUCTUREP
+- GF-INFO-C-A-M-EMF-STD-P ARG-INFO-VALID-P
+- FORMAT-CYCLE-REASONS FAST-METHOD-CALL-ARG-INFO
+- GET-MAKE-INSTANCE-FUNCTION-SYMBOL %STD-INSTANCE-WRAPPER
+- SLOT-BOUNDP-SYMBOL INITIAL-CACHE
+- METHOD-FUNCTION-NEEDS-NEXT-METHODS-P
+- SYSTEM:%COMPILED-FUNCTION-NAME MAKE-CALLS-TYPE-DECLARATION
+- UPDATE-CLASS-CAN-PRECEDE-P SLOT-READER-SYMBOL FREE-CACHE
+- DNET-METHODS-P CONSTANT-VALUE-CACHE
+- GET-BUILT-IN-CLASS-SYMBOL UPDATE-GFS-OF-CLASS
+- ONE-CLASS-CACHE STD-INSTANCE-P ONE-INDEX-CACHE
+- STRUCTURE-SLOTD-WRITER-FUNCTION FGEN-GENERATOR-LAMBDA
+- EXTRACT-SPECIALIZER-NAMES EARLY-SLOT-DEFINITION-LOCATION
+- DO-STANDARD-DEFSETFS-FOR-DEFCLASS %CCLOSURE-ENV
+- EARLY-ACCESSOR-METHOD-SLOT-NAME ACCESSOR-DFUN-INFO-P
+- INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS SLOT-WRITER-SYMBOL
+- ARG-INFO-KEYWORDS INITIALIZE-INFO-WRAPPER
+- FAST-METHOD-CALL-NEXT-METHOD-CALL INITIAL-DISPATCH-CACHE
+- NEXT-WRAPPER-FIELD
+- INITIALIZE-INFO-CACHED-INITARGS-FORM-LIST CHECKING-P
+- EXTRACT-REQUIRED-PARAMETERS GET-BUILT-IN-WRAPPER-SYMBOL
+- INITIALIZE-INFO-CACHED-CONSTANTS
+- STRUCTURE-SLOTD-READER-FUNCTION EARLY-METHOD-CLASS
+- STRUCTURE-OBJECT-P DEFAULT-METHOD-ONLY-CACHE
+- PARSE-SPECIALIZERS INTERN-EQL-SPECIALIZER
+- COMPILE-LAMBDA-DEFERRED MAKE-CONSTANT-FUNCTION
+- MAKE-PV-TYPE-DECLARATION ARG-INFO-APPLYP
+- GET-PV-CELL-FOR-CLASS ONE-INDEX-DFUN-INFO-INDEX
+- UNENCAPSULATED-FDEFINITION CHECK-CACHE
+- WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE
+- INITIALIZE-INFO-KEY ONE-CLASS-INDEX SYSTEM:%STRUCTURE-NAME
+- SLOT-VECTOR-SYMBOL MAKE-PV-TABLE-TYPE-DECLARATION
+- TWO-CLASS-CACHE PROCLAIM-INCOMPATIBLE-SUPERCLASSES
+- BUILT-IN-OR-STRUCTURE-WRAPPER1 ECD-SUPERCLASS-NAMES
+- STRUCTURE-TYPE CLASS-HAS-A-FORWARD-REFERENCED-SUPERCLASS-P
+- N-N-P INTERNED-SYMBOL-P DEFAULT-METHOD-ONLY-P
+- EARLY-CLASS-SLOTS NO-METHODS-P ARG-INFO-NUMBER-OPTIONAL
+- ONE-INDEX-P GET-MAKE-INSTANCE-FUNCTION EARLY-CLASS-NAME
+- METHOD-FUNCTION-FROM-FAST-FUNCTION MAKE-PERMUTATION-VECTOR
+- ONE-CLASS-ACCESSOR-TYPE TWO-CLASS-P BUILT-IN-WRAPPER-OF
+- FREE-CACHE-VECTOR GET-CACHE-VECTOR ARG-INFO-LAMBDA-LIST
+- UPDATE-GF-INFO ONE-INDEX-DFUN-INFO-CACHE %SYMBOL-FUNCTION
+- ACCESSOR-DFUN-INFO-ACCESSOR-TYPE FUNCALLABLE-INSTANCE-P
+- ECD-CANONICAL-SLOTS EARLY-COLLECT-SLOTS
+- INITIALIZE-INFO-CACHED-VALID-P UNPARSE-SPECIALIZERS
+- GF-INFO-FAST-MF-P
+- MAKE-OPTIMIZED-STRUCTURE-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION
+- EARLY-CLASS-NAME-OF GF-DFUN-CACHE CLASS-PREDICATE
+- EXTRACT-LAMBDA-LIST CLASS-OF COPY-CACHE SYMBOL-PKG-NAME
+- ONE-INDEX-DFUN-INFO-P WRAPPER-OF METHOD-FUNCTION-METHOD
+- CPD-SUPERS DEFAULT-STRUCTURE-INSTANCE-P
+- STRUCTURE-SLOTD-INIT-FORM EARLY-METHOD-QUALIFIERS
+- LIST-LARGE-CACHE UPDATE-GF-SIMPLE-ACCESSOR-TYPE TYPE-CLASS
+- MAKE-EQL-PREDICATE EARLY-GF-NAME UPDATE-ALL-C-A-M-GF-INFO
+- FLUSH-CACHE-VECTOR-INTERNAL ITERATE::SEQUENCE-ACCESSOR
+- MAP-ALL-GENERIC-FUNCTIONS STRUCTURE-TYPE-P
+- FIND-CYCLE-REASONS DEFAULT-STRUCTURE-TYPE
+- COMPUTE-CLASS-SLOTS WRAPPER-FOR-STRUCTURE
+- INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-NIL-FUNCTION
+- USE-CACHING-DFUN-P EARLY-COLLECT-DEFAULT-INITARGS
+- DEFAULT-SECONDARY-DISPATCH-FUNCTION ONE-INDEX-ACCESSOR-TYPE
+- WALKER::ENV-WALK-FUNCTION WALKER::ENV-LOCK
+- STRUCTURE-SLOTD-ACCESSOR-SYMBOL
+- METHOD-LL->GENERIC-FUNCTION-LL CACHE-P WRAPPER-FIELD
+- INITIALIZE-INFO-BOUND-SLOTS DEFAULT-CONSTANTP
+- MAKE-FUNCTION-INLINE COMPUTE-STD-CPL-PHASE-2
+- CACHING-DFUN-INFO CONSTANT-VALUE-P
+- WALKER::GET-WALKER-TEMPLATE ARG-INFO-METATYPES COUNT-DFUN
+- MAKE-INITFUNCTION WALKER::ENV-LEXICAL-VARIABLES PV-TABLEP
+- COMPILE-LAMBDA-UNCOMPILED UNDEFMETHOD-1
+- GF-INFO-SIMPLE-ACCESSOR-TYPE FORCE-CACHE-FLUSHES
+- DFUN-INFO-CACHE GFS-OF-TYPE TWO-CLASS-WRAPPER0
+- ITERATE::VARIABLES-FROM-LET SHOW-DFUN-COSTS
+- ARG-INFO-PRECEDENCE FGEN-GENERATOR
+- RESET-CLASS-INITIALIZE-INFO-1 CACHING-P NO-METHODS-CACHE))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (*) *) INVALID-METHOD-ERROR
+- METHOD-COMBINATION-ERROR UNTRACE-METHOD
+- UPDATE-MAKE-INSTANCE-FUNCTION-TABLE LIST-LARGE-CACHES))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T) LIST) CACHE-OVERFLOW PV-TABLE-SLOT-NAME-LISTS
+- PV-TABLE-CALL-LIST))
+-(PROCLAIM '(FTYPE (FUNCTION (T) BOOLEAN) CACHE-VALUEP))
+-(PROCLAIM '(FTYPE (FUNCTION NIL FIXNUM) GET-WRAPPER-CACHE-NUMBER))
+-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM T) T) %CCLOSURE-ENV-NTHCDR))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T T) *)
+- COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL
+- WALK-METHOD-LAMBDA
+- |(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))|
+- |(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
+- |(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))|
+- |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))|
+- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))|
+- |(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))|
+- |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))|
+- |(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))|
+- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))|
+- ADD-METHOD-DECLARATIONS
+- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))|
+- MAKE-TWO-CLASS-ACCESSOR-DFUN
+- |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))|
+- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))|
+- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))|
+- |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
+- |(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))|
+- |(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))|
+- |(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))|
+- |(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))|))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T T T T) *)
+- |(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))|
+- ITERATE::ITERATE-TRANSFORM-BODY))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T *) *) ITERATE::RENAME-LET-BINDINGS
+- MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T) *) CONSTANT-VALUE-MISS
+- EMIT-ONE-OR-N-INDEX-READER/WRITER CACHING-MISS
+- CACHE-MISS-VALUES
+- |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))|
+- WALKER::WALK-FORM-INTERNAL
+- GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION
+- SLOT-VALUE-USING-CLASS-DFUN SLOT-BOUNDP-USING-CLASS-DFUN
+- |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))|
+- |(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))|
+- |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))|
+- MAKE-FINAL-CONSTANT-VALUE-DFUN CHECK-METHOD-ARG-INFO
+- MAKE-OPTIMIZED-STD-BOUNDP-METHOD-FUNCTION
+- MAKE-FINAL-CACHING-DFUN EMIT-READER/WRITER-FUNCTION
+- SET-SLOT-VALUE
+- |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))|
+- WALKER::WALK-LET-IF ACCESSOR-VALUES1
+- |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))|
+- ITERATE::EXPAND-INTO-LET OPTIMIZE-SLOT-VALUE-BY-CLASS-P
+- ITERATE::RENAME-VARIABLES
+- EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION CHECKING-MISS
+- |(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))|
+- ACCESSOR-VALUES-INTERNAL GET-CLASS-SLOT-VALUE-1
+- LOAD-LONG-DEFCOMBIN
+- |(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))|
+- |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))|
+- MAKE-OPTIMIZED-STD-WRITER-METHOD-FUNCTION
+- |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))|
+- MAKE-OPTIMIZED-STD-READER-METHOD-FUNCTION
+- EMIT-READER/WRITER GENERATING-LISP
+- MAKE-FINAL-N-N-ACCESSOR-DFUN
+- |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))|
+- ITERATE::WALK-GATHERING-BODY
+- |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))|
+- GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION
+- CONVERT-METHODS))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T) *) BOOTSTRAP-ACCESSOR-DEFINITION
+- INITIALIZE-INSTANCE-SIMPLE-FUNCTION
+- |(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))|
+- ORDER-SPECIALIZERS MAKE-ONE-CLASS-ACCESSOR-DFUN
+- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))|
+- |(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))|
+- GET-ACCESSOR-FROM-SVUC-METHOD-FUNCTION
+- |(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))|
+- SETF-SLOT-VALUE-USING-CLASS-DFUN
+- GENERATE-DISCRIMINATION-NET
+- MAKE-FINAL-ONE-INDEX-ACCESSOR-DFUN
+- |(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))|
+- |(FAST-METHOD DESCRIBE-OBJECT (T T))| ACCESSOR-VALUES
+- LOAD-SHORT-DEFCOMBIN SET-CLASS-SLOT-VALUE-1
+- |(FAST-METHOD MAKE-INSTANCE (SYMBOL))|
+- REAL-MAKE-METHOD-LAMBDA EMIT-CHECKING-OR-CACHING-FUNCTION
+- |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))|
+- |(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))|
+- MAKE-SHARED-INITIALIZE-FORM-LIST
+- |(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))|
+- ACCESSOR-MISS |(FAST-METHOD NO-APPLICABLE-METHOD (T))|
+- MAKE-FINAL-CHECKING-DFUN
+- |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))|
+- GET-ACCESSOR-METHOD-FUNCTION
+- |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))|
+- |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))|
+- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))|
+- |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))|
+- |(FAST-METHOD DESCRIBE-OBJECT (CLASS T))|
+- |(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))|
+- |(FAST-METHOD CHANGE-CLASS (T SYMBOL))|
+- EMIT-CHECKING-OR-CACHING))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T T T) *) MEMF-CODE-CONVERTER
+- |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
+- GENERATE-DISCRIMINATION-NET-INTERNAL
+- DO-SHORT-METHOD-COMBINATION
+- MAKE-LONG-METHOD-COMBINATION-FUNCTION
+- CACHE-MISS-VALUES-INTERNAL))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T *) *) MAKE-ONE-INDEX-ACCESSOR-DFUN
+- WALKER::WALK-DECLARATIONS GET-SECONDARY-DISPATCH-FUNCTION))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T *) *) SLOT-VALUE-OR-DEFAULT NESTED-WALK-FORM
+- LOAD-DEFGENERIC MAKE-ACCESSOR-TABLE
+- MAKE-DEFAULT-INITARGS-FORM-LIST
+- GET-EFFECTIVE-METHOD-FUNCTION MAKE-CHECKING-DFUN
+- GET-COMPLEX-INITIALIZATION-FUNCTIONS MAKE-N-N-ACCESSOR-DFUN
+- GET-SIMPLE-INITIALIZATION-FUNCTION MAKE-FINAL-ACCESSOR-DFUN
+- TYPES-FROM-ARGUMENTS MAKE-EFFECTIVE-METHOD-FUNCTION
+- COMPUTE-SECONDARY-DISPATCH-FUNCTION))
+-(PROCLAIM '(FTYPE (FUNCTION (T T T T T T *) *) REAL-MAKE-A-METHOD))
+-(PROCLAIM '(FTYPE (FUNCTION (T) SIMPLE-VECTOR) CACHE-VECTOR))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T T T) T) BOOTSTRAP-MAKE-SLOT-DEFINITION
+- |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
+- LOAD-DEFCLASS MAKE-EARLY-CLASS-DEFINITION
+- WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1 OPTIMIZE-GF-CALL
+- EMIT-SLOT-ACCESS REAL-LOAD-DEFCLASS SET-ARG-INFO1))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T T) T)
+- |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))|
+- |(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))|
+- |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))|
+- |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
+- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))|
+- EXPAND-EMF-CALL-METHOD
+- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))|
+- COMPUTE-PV-SLOT
+- |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
+- |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))|
+- UPDATE-SLOTS-IN-PV BOOTSTRAP-MAKE-SLOT-DEFINITIONS
+- WALKER::WALK-TEMPLATE-HANDLE-REPEAT WALKER::WALK-BINDINGS-1
+- OPTIMIZE-ACCESSOR-CALL REAL-MAKE-METHOD-INITARGS-FORM
+- |(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))|
+- |(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))|
+- MAKE-EMF-CACHE MAKE-METHOD-INITARGS-FORM-INTERNAL1
+- BOOTSTRAP-ACCESSOR-DEFINITIONS1
+- |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))|
+- MAKE-INSTANCE-FUNCTION-COMPLEX MAKE-FGEN
+- |(FAST-METHOD REMOVE-NAMED-METHOD (T T))|
+- |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))|
+- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))|
+- MAKE-FINAL-ORDINARY-DFUN-INTERNAL
+- |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
+- MAKE-INSTANCE-FUNCTION-SIMPLE OPTIMIZE-INSTANCE-ACCESS
+- MAKE-PARAMETER-REFERENCES
+- GET-MAKE-INSTANCE-FUNCTION-INTERNAL
+- |(FAST-METHOD SLOT-UNBOUND (T T T))|
+- |(FAST-METHOD (SETF DOCUMENTATION) (T T))|
+- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))|
+- |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
+- LOAD-FUNCTION-GENERATOR
+- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))|
+- |(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))|
+- |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))|
+- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))|
+- OPTIMIZE-GENERIC-FUNCTION-CALL))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T *) T) EMIT-FETCH-WRAPPER FILL-CACHE
+- GET-METHOD CHECK-INITARGS-2-PLIST MAKE-EMF-CALL
+- CHECK-INITARGS-1 WALKER::WALK-ARGLIST REAL-GET-METHOD
+- CAN-OPTIMIZE-ACCESS1 CHECK-INITARGS-2-LIST))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T) T) ONE-CLASS-DFUN-INFO
+- |(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| SORT-METHODS
+- OPTIMIZE-GF-CALL-INTERNAL WALKER::WALK-LABELS
+- |(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))|
+- |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))|
+- WALKER::WALK-DO
+- |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))|
+- ITERATE::RENAME-AND-CAPTURE-VARIABLES EXPAND-DEFGENERIC
+- |(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))|
+- |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))|
+- FLUSH-CACHE-TRAP WALKER::WALK-MACROLET
+- |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))|
+- |(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))|
+- COMPUTE-EFFECTIVE-METHOD OPTIMIZE-SET-SLOT-VALUE
+- WALKER::WALK-SYMBOL-MACROLET OPTIMIZE-SLOT-BOUNDP
+- |(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))|
+- GET-FUNCTION-GENERATOR FIX-SLOT-ACCESSORS
+- SET-FUNCTION-NAME-1 WALKER::WALK-LET EMIT-BOUNDP-CHECK
+- INITIALIZE-INTERNAL-SLOT-GFS* PRINT-CACHE WALKER::WALK-IF
+- WALKER::WALK-SETQ WALKER::RELIST-INTERNAL
+- |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))|
+- EMIT-1-T-DLAP CAN-OPTIMIZE-ACCESS WALKER::WALK-COMPILER-LET
+- |(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))|
+- |SETF PCL METHOD-FUNCTION-GET|
+- |(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))|
+- GET-NEW-FUNCTION-GENERATOR WALKER::WALK-UNEXPECTED-DECLARE
+- |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))|
+- VARIABLE-DECLARATION
+- |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))|
+- MAP-ALL-ORDERS ONE-INDEX-DFUN-INFO WALKER::WALK-LAMBDA
+- |(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))|
+- NOTE-PV-TABLE-REFERENCE WALKER::RECONS
+- STANDARD-COMPUTE-EFFECTIVE-METHOD
+- |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))|
+- |SETF PCL PLIST-VALUE| EMIT-GREATER-THAN-1-DLAP
+- MAKE-METHOD-SPEC ITERATE::OPTIMIZE-GATHERING-FORM
+- OPTIMIZE-SLOT-VALUE PRINT-STD-INSTANCE COMPUTE-PRECEDENCE
+- WALKER::WALK-TAGBODY WALKER::WALK-NAMED-LAMBDA
+- |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))|
+- SKIP-FAST-SLOT-ACCESS-P TRACE-EMF-CALL-INTERNAL
+- |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))|
+- |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))|
+- |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))|
+- ITERATE::SIMPLE-EXPAND-GATHERING-FORM
+- |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))|
+- SORT-APPLICABLE-METHODS SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P
+- OBSOLETE-INSTANCE-TRAP WALKER::WALK-PROG
+- |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))|
+- INVALIDATE-WRAPPER
+- |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))|
+- |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))|
+- |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))|
+- ENTRY-IN-CACHE-P WALKER::WALK-TAGBODY-1
+- |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))|
+- MAKE-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION
+- |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))|
+- WALKER::WALK-LOCALLY WALKER::WALK-MULTIPLE-VALUE-BIND
+- |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))|
+- |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))|
+- WRAP-METHOD-GROUP-SPECIFIER-BINDINGS WALKER::WALK-LET*
+- |(FAST-METHOD CLASS-PREDICATE-NAME (T))|
+- |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))|
+- |(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))|
+- EMIT-SLOT-READ-FORM FIRST-FORM-TO-LISP
+- MAKE-OPTIMIZED-STD-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION
+- |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))|
+- WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL
+- WALKER::WALK-PROG* WALKER::WALK-FLET
+- |(FAST-METHOD SPECIALIZER-CLASS (CLASS))|
+- MAKE-OPTIMIZED-STD-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION
+- |(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))|
+- MAKE-METHOD-INITARGS-FORM-INTERNAL WALKER::WALK-DO*
+- MAKE-TOP-LEVEL-FORM
+- |(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))|
+- |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))|
+- |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))|
+- ITERATE::OPTIMIZE-ITERATE-FORM DECLARE-STRUCTURE
+- MAKE-DFUN-CALL ITERATE::VARIABLE-SAME-P
+- |(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))|
+- WALKER::WALK-MULTIPLE-VALUE-SETQ CONVERT-TABLE
+- |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))|
+- |(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))|))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T) T)
+- |(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))|
+- EMIT-CHECKING-OR-CACHING-FUNCTION-PRELIMINARY
+- |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))|
+- WALKER::WALK-LET/LET*
+- |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))|
+- |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))|
+- |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))|
+- MAKE-EFFECTIVE-METHOD-FUNCTION-TYPE
+- |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))|
+- |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))|
+- |(FAST-METHOD DOCUMENTATION (T))|
+- |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))|
+- MAYBE-EXPAND-ACCESSOR-FORM BOOTSTRAP-SET-SLOT
+- |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))|
+- WALKER::WALK-TEMPLATE
+- |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))|
+- |(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))|
+- |(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))|
+- GET-WRAPPERS-FROM-CLASSES
+- |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))|
+- MAKE-EFFECTIVE-METHOD-FUNCTION1
+- |(FAST-METHOD PRINT-OBJECT (CLASS T))|
+- |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))|
+- |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))|
+- EXPAND-CACHE EXPAND-DEFCLASS
+- |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))|
+- |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))|
+- |(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))|
+- |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))|
+- |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))|
+- |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))|
+- |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))|
+- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))|
+- MAKE-EFFECTIVE-METHOD-FUNCTION-INTERNAL
+- |(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))|
+- |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))|
+- |(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))|
+- TWO-CLASS-DFUN-INFO
+- |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))|
+- |(FAST-METHOD PRINT-OBJECT (T T))|
+- |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))|
+- FILL-CACHE-P MEMF-TEST-CONVERTER
+- |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))|
+- WALKER::WALK-BINDINGS-2
+- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))|
+- |(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))|
+- |(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))|
+- |(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))|
+- |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))|
+- WALKER::WALK-DO/DO* ADJUST-CACHE
+- |(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))|
+- |(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))|
+- |(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))|
+- OPTIMIZE-READER
+- |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))|
+- |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))|
+- |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))|
+- EXPAND-SYMBOL-MACROLET-INTERNAL
+- |(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))|
+- |(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))|
+- MAKE-DISPATCH-LAMBDA
+- |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))|
+- |(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))|
+- INITIALIZE-INSTANCE-SIMPLE
+- |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))|
+- OPTIMIZE-WRITER
+- |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))|
+- |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))|
+- |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))|
+- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))|
+- LOAD-PRECOMPILED-IIS-ENTRY
+- LOAD-PRECOMPILED-DFUN-CONSTRUCTOR
+- |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))|
+- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))|
+- |(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))|
+- WALKER::WALK-PROG/PROG*
+- |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))|
+- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))|
+- |(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))|
+- |(FAST-METHOD MAKE-INSTANCE (CLASS))|
+- |(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))|
+- |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))|
+- |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))|))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T *) T) COMPUTE-SECONDARY-DISPATCH-FUNCTION1
+- FIND-CLASS-PREDICATE-FROM-CELL
+- ENSURE-GENERIC-FUNCTION-USING-CLASS GET-DECLARATION
+- METHOD-FUNCTION-GET CPL-ERROR EMIT-MISS
+- PRECOMPUTE-EFFECTIVE-METHODS GET-METHOD-FUNCTION-PV-CELL
+- MAP-CACHE EXPAND-EFFECTIVE-METHOD-FUNCTION
+- MAKE-EMF-FROM-METHOD GET-EFFECTIVE-METHOD-FUNCTION1
+- REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION
+- NAMED-OBJECT-PRINT-FUNCTION
+- MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE PROBE-CACHE
+- INITIALIZE-INFO REAL-ENSURE-GF-USING-CLASS--NULL
+- FIND-CLASS-FROM-CELL WALKER::CONVERT-MACRO-TO-LAMBDA
+- REAL-ADD-METHOD RECORD-DEFINITION))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T T T *) T) MAKE-DEFMETHOD-FORM
+- MAKE-DEFMETHOD-FORM-INTERNAL LOAD-DEFMETHOD
+- EARLY-MAKE-A-METHOD))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T T *) T) EMIT-DLAP
+- GET-SECONDARY-DISPATCH-FUNCTION1))
+-(PROCLAIM '(FTYPE (FUNCTION (T T FIXNUM) T) COMPUTE-STD-CPL-PHASE-3))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T T T T T) T)
+- GET-SECONDARY-DISPATCH-FUNCTION2))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T *) T) REAL-ADD-NAMED-METHOD
+- EARLY-ADD-NAMED-METHOD FILL-DFUN-CACHE))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T T T T) T)
+- |(FAST-METHOD SLOT-MISSING (T T T T))|
+- LOAD-DEFMETHOD-INTERNAL EXPAND-DEFMETHOD))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T FIXNUM) T) GET-CACHE
+- FILL-CACHE-FROM-CACHE-P))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T T T T T T T T T *) T)
+- BOOTSTRAP-INITIALIZE-CLASS))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T) FIXNUM) N-N-ACCESSORS-LIMIT-FN
+- FAST-INSTANCE-BOUNDP-INDEX PV-TABLE-PV-SIZE
+- ARG-INFO-NUMBER-REQUIRED EARLY-CLASS-SIZE DEFAULT-LIMIT-FN
+- CHECKING-LIMIT-FN ONE-INDEX-LIMIT-FN CPD-COUNT CACHE-COUNT
+- PV-CACHE-LIMIT-FN CACHING-LIMIT-FN))
+-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM) T) POWER-OF-TWO-CEILING))
+-(PROCLAIM '(FTYPE (FUNCTION (T T *) (VALUES T T)) SYMBOL-APPEND))
+-(PROCLAIM '(FTYPE (FUNCTION (T STREAM T) T) PRINT-DFUN-INFO))
+-(PROCLAIM
+- '(FTYPE (FUNCTION (T) NON-NEGATIVE-FIXNUM) CACHE-NLINES CACHE-MASK
+- CACHE-MAX-LOCATION CACHE-SIZE))
++(COMMON-LISP::IN-PACKAGE "PCL")
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FUNCTION)
++ PCL::CACHE-LIMIT-FN PCL::FAST-METHOD-CALL-FUNCTION
++ PCL::METHOD-CALL-FUNCTION))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T)
++ PCL::DISPATCH-DFUN-INFO PCL::DEFAULT-METHOD-ONLY-DFUN-INFO
++ PCL::MAKE-CACHE PCL::BOOTSTRAP-BUILT-IN-CLASSES
++ PCL::RENEW-SYS-FILES PCL::SHOW-EMF-CALL-TRACE PCL::MAKE-CPD
++ PCL::BOOTSTRAP-META-BRAID PCL::CACHES-TO-ALLOCATE
++ PCL::LIST-ALL-DFUNS PCL::INITIAL-DISPATCH-DFUN-INFO
++ PCL::INITIAL-DFUN-INFO PCL::%%ALLOCATE-INSTANCE--CLASS
++ PCL::MAKE-ARG-INFO PCL::ALLOCATE-FUNCALLABLE-INSTANCE-2
++ PCL::SHOW-FREE-CACHE-VECTORS PCL::UPDATE-DISPATCH-DFUNS
++ PCL::GET-EFFECTIVE-METHOD-GENSYM PCL::IN-THE-COMPILER-P
++ PCL::SHOW-DFUN-CONSTRUCTORS PCL::NO-METHODS-DFUN-INFO
++ PCL::INITIALIZE-CHECKING-OR-CACHING-FUNCTION-LIST
++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE-1
++ PCL::STRUCTURE-FUNCTIONS-EXIST-P))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) PCL::FIELD-TYPE)
++ PCL::CACHE-FIELD))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T)
++ COMMON-LISP::SIMPLE-VECTOR)
++ PCL::CACHE-VECTOR))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T)
++ (COMMON-LISP::INTEGER 1 256))
++ PCL::CACHE-LINE-SIZE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T)
++ (COMMON-LISP::INTEGER 1 255))
++ PCL::CACHE-NKEYS))
++(COMMON-LISP::MAPC
++ (COMMON-LISP::LAMBDA (COMPILER::X)
++ (COMMON-LISP::SETF
++ (COMMON-LISP::GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE)
++ COMMON-LISP::T))
++ '(PCL::REDEFINE-FUNCTION PCL::DO-STANDARD-DEFSETF-1
++ PCL::FDEFINE-CAREFULLY PCL::TRACE-METHOD-INTERNAL))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
++ (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T))
++ PCL::SYMBOL-APPEND))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T)
++ PCL::FAST-METHOD-CALL-NEXT-METHOD-CALL
++ PCL::GENERIC-CLOBBERS-FUNCTION PCL::STRUCTURE-SLOTD-TYPE
++ WALKER::GET-WALKER-TEMPLATE PCL::COMPILE-LAMBDA-UNCOMPILED
++ PCL::EXTRACT-LAMBDA-LIST PCL::DEFAULT-METHOD-ONLY-P
++ PCL::DISPATCH-CACHE PCL::STRUCTURE-SLOTD-NAME
++ PCL::FAST-METHOD-CALL-P PCL::SFUN-P
++ PCL::FTYPE-DECLARATION-FROM-LAMBDA-LIST
++ PCL::EARLY-CLASS-DEFINITION PCL::CONSTANT-SYMBOL-P
++ PCL::ARG-INFO-LAMBDA-LIST WALKER::ENV-LEXICAL-VARIABLES
++ PCL::INTERN-EQL-SPECIALIZER PCL::PARSE-SPECIALIZERS
++ PCL::%STD-INSTANCE-WRAPPER PCL::UPDATE-ALL-C-A-M-GF-INFO
++ PCL::INITIALIZE-INFO-CACHED-COMBINED-INITIALIZE-FUNCTION
++ PCL::STORE-FGEN PCL::COMPUTE-MCASE-PARAMETERS
++ PCL::INTERNED-SYMBOL-P PCL::MAKE-CALL-METHODS
++ PCL::USE-CACHING-DFUN-P PCL::LEGAL-CLASS-NAME-P
++ WALKER::VARIABLE-GLOBALLY-SPECIAL-P PCL::FUNCTION-RETURNING-T
++ PCL::METHOD-FUNCTION-METHOD PCL::GET-BUILT-IN-CLASS-SYMBOL
++ PCL::DEFAULT-STRUCTURE-TYPE PCL::GF-DFUN-INFO PCL::CACHING-P
++ PCL::FREE-CACHE-VECTOR PCL::ONE-CLASS-CACHE
++ PCL::DEFAULT-TEST-CONVERTER PCL::UNDEFMETHOD-1
++ PCL::MAKE-INITFUNCTION PCL::GET-CACHE-VECTOR
++ PCL::CLASS-PRECEDENCE-DESCRIPTION-P PCL::GF-INFO-FAST-MF-P
++ PCL::ECD-SOURCE PCL::INITIAL-P PCL::ARG-INFO-APPLYP
++ PCL::ARG-INFO-KEYWORDS
++ PCL::MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION
++ PCL::CACHING-DFUN-COST PCL::INITIAL-DISPATCH-P PCL::EVAL-FORM
++ PCL::MAKE-CONSTANT-FUNCTION PCL::FUNCTION-RETURNING-NIL
++ PCL::INITIALIZE-INFO-BOUND-SLOTS PCL::FGEN-GENSYMS
++ PCL::EXPAND-SHORT-DEFCOMBIN WALKER::ENV-LOCK
++ PCL::INITIALIZE-INFO-CACHED-CONSTANTS
++ PCL::INITIALIZE-INFO-WRAPPER
++ PCL::STRUCTURE-TYPE-INCLUDED-TYPE-NAME PCL::TWO-CLASS-INDEX
++ PCL::ONE-INDEX-ACCESSOR-TYPE
++ PCL::EARLY-COLLECT-DEFAULT-INITARGS WALKER::ENV-WALK-FORM
++ PCL::STRUCTURE-TYPE-INTERNAL-SLOTDS PCL::MAKE-FUNCTION-INLINE
++ PCL::FLUSH-CACHE-VECTOR-INTERNAL
++ PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-T-FUNCTION
++ PCL::FGEN-GENERATOR PCL::CONSTANT-VALUE-P
++ PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION
++ PCL::EARLY-CLASS-PRECEDENCE-LIST PCL::SLOT-BOUNDP-SYMBOL
++ PCL::ARG-INFO-NUMBER-OPTIONAL
++ PCL::GF-PRECOMPUTE-DFUN-AND-EMF-P PCL::GET-PV-CELL-FOR-CLASS
++ PCL::CHECKING-FUNCTION PCL::USE-DEFAULT-METHOD-ONLY-DFUN-P
++ PCL::INITIAL-DISPATCH-CACHE PCL::STRUCTURE-SVUC-METHOD
++ PCL::NO-METHODS-CACHE PCL::GF-DFUN-CACHE PCL::%CCLOSURE-ENV
++ PCL::CONSTANT-VALUE-CACHE PCL::BUILT-IN-WRAPPER-OF
++ PCL::CLASS-HAS-A-FORWARD-REFERENCED-SUPERCLASS-P
++ PCL::EARLY-COLLECT-CPL COMMON-LISP::CLASS-OF
++ PCL::STRUCTURE-SLOTD-ACCESSOR-SYMBOL PCL::SYMBOL-PKG-NAME
++ PCL::GDEFINITION
++ PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-NIL-FUNCTION
++ PCL::ACCESSOR-DFUN-INFO-CACHE PCL::EXTRACT-SPECIALIZER-NAMES
++ PCL::CHECK-WRAPPER-VALIDITY PCL::MAKE-INITIAL-DFUN
++ PCL::WRAPPER-FIELD PCL::EARLY-SLOT-DEFINITION-LOCATION
++ PCL::EARLY-GF-P PCL::GF-INFO-STATIC-C-A-M-EMF PCL::LOOKUP-FGEN
++ PCL::MAKE-PV-TYPE-DECLARATION
++ PCL::INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS
++ PCL::EARLY-METHOD-CLASS
++ PCL::DEFAULT-SECONDARY-DISPATCH-FUNCTION
++ WALKER::ENV-DECLARATIONS PCL::ALLOCATE-CACHE-VECTOR
++ PCL::FUNCTION-PRETTY-ARGLIST
++ PCL::EARLY-CLASS-DIRECT-SUBCLASSES
++ PCL::COMPUTE-APPLICABLE-METHODS-EMF-STD-P
++ PCL::MAKE-CLASS-EQ-PREDICATE PCL::ECD-OTHER-INITARGS
++ PCL::GBOUNDP PCL::METHOD-FUNCTION-PV-TABLE
++ WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE
++ PCL::MAKE-INSTANCE-FUNCTION-SYMBOL
++ PCL::MAKE-OPTIMIZED-STRUCTURE-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION
++ PCL::FIND-CYCLE-REASONS PCL::FGEN-TEST
++ PCL::SLOT-INITARGS-FROM-STRUCTURE-SLOTD PCL::FREE-CACHE
++ PCL::TYPE-CLASS PCL::INITIAL-CACHE
++ PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS
++ PCL::STRUCTURE-SLOTD-WRITER-FUNCTION
++ PCL::INITIALIZE-INFO-CACHED-DEFAULT-INITARGS-FUNCTION
++ PCL::EARLY-COLLECT-SLOTS PCL::LIST-DFUN
++ PCL::EXPAND-MAKE-INSTANCE-FORM PCL::N-N-CACHE
++ PCL::MAKE-TYPE-PREDICATE PCL::INTERN-FUNCTION-NAME
++ PCL::GET-MAKE-INSTANCE-FUNCTIONS WALKER::ENV-WALK-FUNCTION
++ PCL::TWO-CLASS-CACHE PCL::MAKE-CALLS-TYPE-DECLARATION
++ PCL::MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION
++ PCL::INITIALIZE-INFO-KEY PCL::GF-LAMBDA-LIST
++ ITERATE::VARIABLES-FROM-LET PCL::COMPUTE-CLASS-SLOTS
++ PCL::DFUN-ARG-SYMBOL PCL::CHECKING-P PCL::ARG-INFO-P
++ PCL::INITIALIZE-INFO-CACHED-RI-VALID-P PCL::CHECKING-CACHE
++ PCL::METHOD-FUNCTION-PLIST PCL::STRUCTURE-OBJECT-P
++ PCL::ARG-INFO-PRECEDENCE PCL::ONE-CLASS-INDEX
++ PCL::STD-INSTANCE-P PCL::STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST
++ PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION
++ PCL::EARLY-SLOT-DEFINITION-NAME PCL::UNPARSE-SPECIALIZERS
++ PCL::STRUCTURE-TYPE-P PCL::ACCESSOR-DFUN-INFO-ACCESSOR-TYPE
++ PCL::PV-TABLEP PCL::CLASS-FROM-TYPE
++ PCL::GF-INFO-SIMPLE-ACCESSOR-TYPE PCL::STRUCTURE-TYPE
++ PCL::MAKE-EQL-PREDICATE PCL::TWO-CLASS-ACCESSOR-TYPE
++ PCL::DEFAULT-STRUCTURE-INSTANCE-P
++ PCL::EARLY-METHOD-STANDARD-ACCESSOR-SLOT-NAME
++ PCL::ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE PCL::GFS-OF-TYPE
++ PCL::DEFAULT-STRUCTUREP PCL::EARLY-CLASS-NAME-OF
++ PCL::%STD-INSTANCE-SLOTS PCL::ONE-INDEX-INDEX PCL::WRAPPER-OF
++ PCL::ARG-INFO-VALID-P PCL::KEYWORD-SPEC-NAME
++ PCL::METHOD-CALL-P PCL::SHOW-DFUN-COSTS PCL::DFUN-INFO-CACHE
++ PCL::DEFAULT-CONSTANT-CONVERTER ITERATE::SEQUENCE-ACCESSOR
++ PCL::COUNT-DFUN PCL::EXPAND-LONG-DEFCOMBIN
++ PCL::CACHING-DFUN-INFO PCL::INITIALIZE-INFO-CACHED-VALID-P
++ PCL::FAST-INSTANCE-BOUNDP-P PCL::ARG-INFO-METATYPES
++ PCL::EXTRACT-PARAMETERS PCL::GF-INFO-C-A-M-EMF-STD-P
++ PCL::FINAL-ACCESSOR-DFUN-TYPE PCL::GMAKUNBOUND
++ PCL::FAST-METHOD-CALL-ARG-INFO PCL::COMPUTE-LINE-SIZE
++ PCL::ONE-INDEX-CACHE PCL::NO-METHODS-P
++ PCL::COMPUTE-STD-CPL-PHASE-2
++ PCL::COMPLICATED-INSTANCE-CREATION-METHOD
++ PCL::MAKE-PERMUTATION-VECTOR PCL::CONSTANT-VALUE-DFUN-INFO
++ PCL::TWO-CLASS-WRAPPER1 PCL::MAP-ALL-GENERIC-FUNCTIONS
++ PCL::CLASS-PREDICATE SYSTEM::%STRUCTURE-NAME
++ PCL::RESET-CLASS-INITIALIZE-INFO
++ PCL::BUILT-IN-OR-STRUCTURE-WRAPPER1 PCL::EARLY-CLASS-NAME
++ PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION-SYMBOL
++ PCL::UPDATE-PV-TABLE-CACHE-INFO PCL::SLOT-READER-SYMBOL
++ PCL::ARG-INFO-NKEYS PCL::METHOD-CALL-CALL-METHOD-ARGS
++ PCL::CCLOSUREP PCL::DEFAULT-METHOD-ONLY-CACHE
++ PCL::NEXT-WRAPPER-FIELD PCL::SLOT-WRITER-SYMBOL
++ PCL::ACCESSOR-DFUN-INFO-P
++ PCL::GET-MAKE-INSTANCE-FUNCTION-SYMBOL
++ PCL::EXTRACT-REQUIRED-PARAMETERS PCL::FORMAT-CYCLE-REASONS
++ PCL::UNENCAPSULATED-FDEFINITION
++ PCL::GET-BUILT-IN-WRAPPER-SYMBOL PCL::ONE-CLASS-P
++ PCL::ECD-METACLASS PCL::METHOD-LL->GENERIC-FUNCTION-LL
++ PCL::PROCLAIM-INCOMPATIBLE-SUPERCLASSES PCL::ONE-INDEX-P
++ PCL::INITIALIZE-INFO-CACHED-INITARGS-FORM-LIST
++ PCL::ECD-CANONICAL-SLOTS
++ PCL::METHOD-FUNCTION-NEEDS-NEXT-METHODS-P
++ PCL::INITIALIZE-INFO-CACHED-NEW-KEYS
++ PCL::STRUCTURE-SLOTD-READER-FUNCTION
++ PCL::INITIALIZE-INFO-CACHED-COMBINED-INITARGS-FORM-LIST
++ PCL::DISPATCH-P PCL::LIST-LARGE-CACHE
++ PCL::FAST-METHOD-CALL-PV-CELL PCL::GET-MAKE-INSTANCE-FUNCTION
++ PCL::DNET-METHODS-P PCL::STRUCTURE-SLOTD-INIT-FORM
++ PCL::UPDATE-CLASS-CAN-PRECEDE-P PCL::ONE-CLASS-ACCESSOR-TYPE
++ PCL::RESET-INITIALIZE-INFO PCL::STANDARD-SVUC-METHOD
++ PCL::DEFAULT-CONSTANTP PCL::UPDATE-C-A-M-GF-INFO
++ PCL::ONE-INDEX-DFUN-INFO-CACHE PCL::EARLY-CLASS-SLOTS
++ PCL::CPD-SUPERS PCL::FGEN-GENERATOR-LAMBDA
++ PCL::ECD-SUPERCLASS-NAMES PCL::ECD-CLASS-NAME PCL::SETFBOUNDP
++ PCL::GET-SETF-FUNCTION-NAME PCL::DFUN-INFO-P
++ PCL::SLOT-VECTOR-SYMBOL PCL::INITIALIZE-INFO-P
++ PCL::TWO-CLASS-P PCL::UPDATE-GF-SIMPLE-ACCESSOR-TYPE
++ PCL::COPY-CACHE PCL::MAKE-PV-TABLE-TYPE-DECLARATION
++ PCL::SORT-CALLS PCL::STRUCTURE-SLOT-BOUNDP PCL::%FBOUNDP
++ PCL::RESET-CLASS-INITIALIZE-INFO-1 PCL::UPDATE-GF-INFO
++ PCL::WRAPPER-FOR-STRUCTURE PCL::FUNCALLABLE-INSTANCE-P
++ PCL::CPD-CLASS PCL::EARLY-METHOD-STANDARD-ACCESSOR-P
++ PCL::SORT-SLOTS PCL::CANONICAL-SLOT-NAME
++ PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION
++ PCL::EARLY-ACCESSOR-METHOD-SLOT-NAME PCL::%SYMBOL-FUNCTION
++ PCL::EARLY-METHOD-LAMBDA-LIST PCL::ONE-INDEX-DFUN-INFO-INDEX
++ PCL::N-N-ACCESSOR-TYPE PCL::CACHING-CACHE
++ PCL::EARLY-CLASS-SLOTDS PCL::ONE-INDEX-DFUN-INFO-P
++ SYSTEM::%COMPILED-FUNCTION-NAME
++ PCL::BOOTSTRAP-CLASS-PREDICATES PCL::NET-TEST-CONVERTER
++ PCL::DO-STANDARD-DEFSETFS-FOR-DEFCLASS PCL::TWO-CLASS-WRAPPER0
++ PCL::MAP-SPECIALIZERS PCL::EARLY-GF-NAME PCL::N-N-P
++ PCL::FGEN-SYSTEM PCL::METHODS-CONTAIN-EQL-SPECIALIZER-P
++ PCL::UPDATE-GFS-OF-CLASS PCL::ONE-CLASS-WRAPPER0
++ PCL::CPD-AFTER
++ PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION
++ PCL::CACHE-P PCL::EARLY-METHOD-QUALIFIERS PCL::CHECK-CACHE
++ PCL::FORCE-CACHE-FLUSHES PCL::CACHE-OWNER
++ PCL::COMPILE-LAMBDA-DEFERRED PCL::ARG-INFO-KEY/REST-P))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*)
++ COMMON-LISP::INVALID-METHOD-ERROR PCL::LIST-LARGE-CACHES
++ PCL::UPDATE-MAKE-INSTANCE-FUNCTION-TABLE PCL::UNTRACE-METHOD
++ COMMON-LISP::METHOD-COMBINATION-ERROR))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T)
++ PCL::NON-NEGATIVE-FIXNUM)
++ PCL::CACHE-MAX-LOCATION PCL::CACHE-NLINES PCL::CACHE-SIZE
++ PCL::CACHE-MASK))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::T)
++ PCL::MAKE-INTERNAL-READER-METHOD-FUNCTION
++ ITERATE::SIMPLE-EXPAND-ITERATE-FORM PCL::ADD-DIRECT-SUBCLASSES
++ PCL::PROCLAIM-DEFMETHOD PCL::UPDATE-INITIALIZE-INFO-INTERNAL
++ PCL::RAISE-METATYPE PCL::CLASS-CAN-PRECEDE-P
++ WALKER::VARIABLE-SPECIAL-P PCL::GF-MAKE-FUNCTION-FROM-EMF
++ PCL::|SETF PCL METHOD-FUNCTION-PLIST|
++ PCL::SET-FUNCTION-PRETTY-ARGLIST
++ PCL::FUNCALLABLE-STANDARD-INSTANCE-ACCESS
++ PCL::MAKE-DISCRIMINATING-FUNCTION-ARGLIST
++ PCL::DEAL-WITH-ARGUMENTS-OPTION WALKER::NOTE-DECLARATION
++ PCL::MAKE-CLASS-PREDICATE PCL::VALUE-FOR-CACHING
++ PCL::EMIT-1-NIL-DLAP PCL::MAKE-CAXR PCL::SYMBOL-LESSP
++ PCL::GET-KEY-ARG1 PCL::ADD-FORMS
++ PCL::EMIT-N-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION
++ PCL::DOCTOR-DFUN-FOR-THE-DEBUGGER
++ PCL::CLASSES-HAVE-COMMON-SUBCLASS-P PCL::N-N-DFUN-INFO
++ PCL::CANONICALIZE-SLOT-SPECIFICATION
++ PCL::REDIRECT-EARLY-FUNCTION-INTERNAL
++ PCL::UPDATE-STD-OR-STR-METHODS PCL::%SET-CCLOSURE-ENV
++ PCL::QUALIFIER-CHECK-RUNTIME
++ PCL::MAKE-STD-READER-METHOD-FUNCTION
++ PCL::ADD-SLOT-ACCESSORS PCL::ADD-TO-CVECTOR
++ PCL::COMPUTE-LAYOUT PCL::DESTRUCTURE-INTERNAL
++ PCL::SUPERCLASSES-COMPATIBLE-P
++ PCL::COMPUTE-APPLICABLE-METHODS-FUNCTION ITERATE::MV-SETQ
++ PCL::COMPUTE-STD-CPL PCL::SET-METHODS PCL::CHECKING-DFUN-INFO
++ ITERATE::EXTRACT-SPECIAL-BINDINGS PCL::SWAP-WRAPPERS-AND-SLOTS
++ PCL::CANONICALIZE-DEFCLASS-OPTION PCL::MAKE-CDXR
++ PCL::PRINTING-RANDOM-THING-INTERNAL COMMON-LISP::ADD-METHOD
++ PCL::STANDARD-INSTANCE-ACCESS
++ SYSTEM::%SET-COMPILED-FUNCTION-NAME PCL::FIND-SLOT-DEFINITION
++ PCL::CLASS-MIGHT-PRECEDE-P
++ PCL::MAKE-STD-BOUNDP-METHOD-FUNCTION PCL::SAUT-NOT-EQL
++ PCL::SET-WRAPPER PCL::SET-STANDARD-SVUC-METHOD
++ PCL::SAUT-NOT-PROTOTYPE PCL::ACCESSOR-MISS-FUNCTION
++ PCL::NO-SLOT PCL::REMTAIL PCL::PV-WRAPPERS-FROM-ALL-ARGS
++ PCL::UPDATE-CLASS PCL::AUGMENT-TYPE PCL::MAKE-EARLY-ACCESSOR
++ PCL::MAKE-PLIST PCL::MEC-ALL-CLASSES-INTERNAL
++ PCL::MAKE-STD-WRITER-METHOD-FUNCTION
++ PCL::PARSE-QUALIFIER-PATTERN PCL::MEMF-CONSTANT-CONVERTER
++ PCL::|SETF PCL FIND-CLASS-PREDICATE|
++ PCL::MAKE-UNORDERED-METHODS-EMF WALKER::ENVIRONMENT-FUNCTION
++ PCL::MEC-ALL-CLASS-LISTS PCL::SAUT-NOT-CLASS-EQ
++ PCL::DO-SATISFIES-DEFTYPE PCL::SET-STRUCTURE-SVUC-METHOD
++ PCL::MAKE-DLAP-LAMBDA-LIST PCL::METHOD-FUNCTION-RETURNING-T
++ PCL::COMPUTE-CALLS PCL::REMOVE-SLOT-ACCESSORS
++ PCL::UPDATE-ALL-PV-TABLE-CACHES PCL::MAKE-DFUN-LAMBDA-LIST
++ WALKER::NOTE-LEXICAL-BINDING PCL::REMOVE-DIRECT-SUBCLASSES
++ PCL::MAP-PV-TABLE-REFERENCES-OF PCL::COMPUTE-CONSTANTS
++ PCL::METHOD-FUNCTION-RETURNING-NIL PCL::METHODS-CONVERTER
++ PCL::PV-TABLE-LOOKUP PCL::DESCRIBE-PACKAGE
++ COMMON-LISP::SLOT-EXISTS-P PCL::MAKE-PV-TABLE-INTERNAL
++ PCL::SAUT-NOT-CLASS PCL::|SETF PCL FIND-CLASS|
++ PCL::UPDATE-INITS PCL::UPDATE-CPL
++ PCL::EMIT-1-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION
++ PCL::COMPUTE-PV WALKER::VARIABLE-LEXICAL-P
++ PCL::PROCLAIM-DEFGENERIC PCL::MAKE-DFUN-ARG-LIST
++ PCL::GET-KEY-ARG COMMON-LISP::REMOVE-METHOD
++ PCL::PV-WRAPPERS-FROM-ALL-WRAPPERS PCL::VARIABLE-CLASS
++ PCL::UPDATE-SLOTS PCL::SYMBOL-OR-CONS-LESSP
++ PCL::MEC-ALL-CLASSES PCL::LIST-EQ
++ PCL::SET-FUNCALLABLE-INSTANCE-FUNCTION
++ WALKER::WALK-REPEAT-EVAL WALKER::ENVIRONMENT-MACRO
++ WALKER::VARIABLE-SYMBOL-MACRO-P
++ PCL::MAKE-FAST-METHOD-CALL-LAMBDA-LIST
++ PCL::BOOTSTRAP-SLOT-INDEX PCL::PLIST-VALUE
++ PCL::CHANGE-CLASS-INTERNAL PCL::NET-CONSTANT-CONVERTER
++ PCL::|SETF PCL GDEFINITION| PCL::FIND-STANDARD-II-METHOD))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::*)
++ WALKER::WALK-FORM PCL::MAKE-INSTANCE-1
++ PCL::EXTRACT-DECLARATIONS PCL::GET-FUNCTION
++ WALKER::MACROEXPAND-ALL PCL::ALLOCATE-STRUCTURE-INSTANCE
++ PCL::MAKE-FINAL-DFUN-INTERNAL PCL::GET-METHOD-FUNCTION
++ PCL::COERCE-TO-CLASS PCL::MAP-ALL-CLASSES PCL::ENSURE-CLASS
++ PCL::PARSE-METHOD-OR-SPEC COMMON-LISP::ENSURE-GENERIC-FUNCTION
++ PCL::MAKE-CACHING-DFUN PCL::GET-FUNCTION1
++ PCL::GET-DFUN-CONSTRUCTOR PCL::MAKE-CONSTANT-VALUE-DFUN
++ PCL::MAKE-METHOD-FUNCTION-INTERNAL PCL::COMPILE-LAMBDA
++ PCL::PARSE-SPECIALIZED-LAMBDA-LIST PCL::DISPATCH-DFUN-COST
++ PCL::MAKE-METHOD-LAMBDA-INTERNAL))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T)
++ (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T))
++ PCL::MAKE-CLASS-PREDICATE-NAME PCL::MAKE-KEYWORD))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::T)
++ PCL::FIND-CLASS-FROM-CELL PCL::GET-METHOD-FUNCTION-PV-CELL
++ PCL::PROBE-CACHE PCL::NAMED-OBJECT-PRINT-FUNCTION
++ PCL::PRECOMPUTE-EFFECTIVE-METHODS
++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE
++ PCL::GET-EFFECTIVE-METHOD-FUNCTION1 PCL::MAKE-EMF-FROM-METHOD
++ PCL::EMIT-MISS PCL::REAL-ENSURE-GF-USING-CLASS--NULL
++ PCL::RECORD-DEFINITION WALKER::CONVERT-MACRO-TO-LAMBDA
++ PCL::INITIALIZE-INFO PCL::EXPAND-EFFECTIVE-METHOD-FUNCTION
++ PCL::METHOD-FUNCTION-GET PCL::FIND-CLASS-PREDICATE-FROM-CELL
++ PCL::ENSURE-GENERIC-FUNCTION-USING-CLASS
++ PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION1 PCL::GET-DECLARATION
++ PCL::REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION
++ PCL::MAP-CACHE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T)
++ COMMON-LISP::T)
++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))|
++ PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))|
++ PCL::|(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))|
++ WALKER::WALK-PROG/PROG*
++ PCL::|(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))|
++ WALKER::WALK-BINDINGS-2
++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))|
++ WALKER::WALK-DO/DO*
++ PCL::|(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))|
++ PCL::|(FAST-METHOD DOCUMENTATION (T))|
++ PCL::|(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))|
++ PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))|
++ PCL::|(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))|
++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))|
++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))|
++ PCL::INITIALIZE-INSTANCE-SIMPLE PCL::BOOTSTRAP-SET-SLOT
++ PCL::|(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))|
++ PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))|
++ PCL::|(FAST-METHOD PRINT-OBJECT (CLASS T))|
++ PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))|
++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))|
++ PCL::|(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))|
++ PCL::FILL-CACHE-P
++ PCL::|(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))|
++ PCL::|(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))|
++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))|
++ PCL::|(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))|
++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))|
++ PCL::OPTIMIZE-WRITER PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-TYPE
++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-INTERNAL
++ PCL::|(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))|
++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION1
++ PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))|
++ PCL::|(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))|
++ PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))|
++ PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))|
++ PCL::|(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))|
++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))|
++ PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))|
++ PCL::|(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))|
++ PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))|
++ PCL::ADJUST-CACHE
++ PCL::|(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))|
++ PCL::LOAD-PRECOMPILED-DFUN-CONSTRUCTOR
++ PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))|
++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))|
++ PCL::|(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))|
++ PCL::|(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))|
++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))|
++ PCL::MEMF-TEST-CONVERTER
++ PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))|
++ PCL::|(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))|
++ PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))|
++ WALKER::WALK-TEMPLATE PCL::TWO-CLASS-DFUN-INFO
++ PCL::EXPAND-CACHE
++ PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))|
++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))|
++ PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))|
++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))|
++ PCL::GET-WRAPPERS-FROM-CLASSES
++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))|
++ PCL::|(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))|
++ PCL::LOAD-PRECOMPILED-IIS-ENTRY
++ PCL::|(FAST-METHOD PRINT-OBJECT (T T))|
++ PCL::EXPAND-SYMBOL-MACROLET-INTERNAL
++ PCL::MAYBE-EXPAND-ACCESSOR-FORM
++ PCL::EMIT-CHECKING-OR-CACHING-FUNCTION-PRELIMINARY
++ PCL::|(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))|
++ PCL::|(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))|
++ PCL::|(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))|
++ PCL::|(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))|
++ PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))|
++ PCL::EXPAND-DEFCLASS
++ PCL::|(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))|
++ WALKER::WALK-LET/LET* PCL::MAKE-DISPATCH-LAMBDA
++ PCL::|(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))|
++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))|
++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))|
++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))|
++ PCL::OPTIMIZE-READER
++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))|
++ PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))|
++ PCL::|(FAST-METHOD MAKE-INSTANCE (CLASS))|))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::T)
++ PCL::OPTIMIZE-SET-SLOT-VALUE
++ PCL::|(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))|
++ PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))|
++ PCL::MAKE-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION
++ PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))|
++ PCL::|(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))|
++ PCL::PRINT-CACHE WALKER::WALK-UNEXPECTED-DECLARE
++ ITERATE::OPTIMIZE-ITERATE-FORM
++ PCL::|(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))|
++ WALKER::WALK-MULTIPLE-VALUE-SETQ PCL::FIRST-FORM-TO-LISP
++ PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))|
++ WALKER::WALK-LABELS
++ PCL::|(FAST-METHOD SPECIALIZER-CLASS (CLASS))|
++ PCL::ONE-CLASS-DFUN-INFO PCL::GET-FUNCTION-GENERATOR
++ WALKER::RELIST-INTERNAL PCL::NOTE-PV-TABLE-REFERENCE
++ WALKER::WALK-LAMBDA PCL::WRAP-METHOD-GROUP-SPECIFIER-BINDINGS
++ PCL::ONE-INDEX-DFUN-INFO PCL::MAP-ALL-ORDERS
++ PCL::OPTIMIZE-GF-CALL-INTERNAL PCL::COMPUTE-PRECEDENCE
++ WALKER::WALK-DO PCL::PRINT-STD-INSTANCE
++ PCL::OBSOLETE-INSTANCE-TRAP PCL::SORT-APPLICABLE-METHODS
++ PCL::|(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))|
++ PCL::EMIT-GREATER-THAN-1-DLAP
++ PCL::|(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))|
++ WALKER::WALK-FLET
++ PCL::|(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))|
++ PCL::|SETF PCL PLIST-VALUE| WALKER::WALK-PROG*
++ WALKER::VARIABLE-DECLARATION
++ PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))|
++ PCL::SKIP-FAST-SLOT-ACCESS-P PCL::SET-FUNCTION-NAME-1
++ WALKER::WALK-MACROLET PCL::CAN-OPTIMIZE-ACCESS
++ WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL
++ PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))|
++ PCL::|(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))|
++ PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))|
++ PCL::SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P
++ PCL::|(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))|
++ PCL::|(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))|
++ PCL::EMIT-BOUNDP-CHECK PCL::|SETF PCL METHOD-FUNCTION-GET|
++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))|
++ PCL::MAKE-METHOD-SPEC PCL::FLUSH-CACHE-TRAP WALKER::WALK-IF
++ PCL::OPTIMIZE-SLOT-BOUNDP
++ PCL::STANDARD-COMPUTE-EFFECTIVE-METHOD
++ WALKER::WALK-MULTIPLE-VALUE-BIND
++ ITERATE::RENAME-AND-CAPTURE-VARIABLES WALKER::WALK-LET*
++ WALKER::WALK-DO*
++ PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))|
++ PCL::INVALIDATE-WRAPPER
++ PCL::|(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))|
++ PCL::|(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))|
++ PCL::MAKE-OPTIMIZED-STD-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION
++ ITERATE::SIMPLE-EXPAND-GATHERING-FORM PCL::ENTRY-IN-CACHE-P
++ WALKER::WALK-LOCALLY PCL::OPTIMIZE-SLOT-VALUE
++ PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL
++ PCL::|(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))|
++ PCL::|(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))|
++ PCL::|(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))|
++ PCL::|(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))|
++ PCL::TRACE-EMF-CALL-INTERNAL WALKER::WALK-SYMBOL-MACROLET
++ PCL::|(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))|
++ PCL::CONVERT-TABLE
++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))|
++ PCL::INITIALIZE-INTERNAL-SLOT-GFS*
++ PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))|
++ PCL::|(FAST-METHOD CLASS-PREDICATE-NAME (T))|
++ PCL::|(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))|
++ PCL::MAKE-OPTIMIZED-STD-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION
++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))|
++ PCL::|(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))|
++ PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))|
++ WALKER::WALK-SETQ PCL::EXPAND-DEFGENERIC
++ PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))|
++ ITERATE::OPTIMIZE-GATHERING-FORM PCL::FIX-SLOT-ACCESSORS
++ PCL::EMIT-SLOT-READ-FORM WALKER::WALK-PROG
++ PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))|
++ WALKER::WALK-NAMED-LAMBDA PCL::GET-NEW-FUNCTION-GENERATOR
++ PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))|
++ WALKER::WALK-TAGBODY
++ PCL::|(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))|
++ WALKER::WALK-COMPILER-LET PCL::DECLARE-STRUCTURE
++ WALKER::WALK-LET ITERATE::VARIABLE-SAME-P
++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))|
++ PCL::EMIT-1-T-DLAP PCL::MAKE-DFUN-CALL
++ PCL::COMPUTE-EFFECTIVE-METHOD PCL::SORT-METHODS
++ WALKER::WALK-TAGBODY-1
++ PCL::|(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))|
++ PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))|
++ PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))|
++ PCL::MAKE-TOP-LEVEL-FORM
++ PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))|
++ WALKER::RECONS))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::T)
++ PCL::UPDATE-SLOTS-IN-PV PCL::MAKE-INSTANCE-FUNCTION-COMPLEX
++ PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
++ PCL::GET-MAKE-INSTANCE-FUNCTION-INTERNAL
++ PCL::|(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))|
++ PCL::MAKE-INSTANCE-FUNCTION-SIMPLE
++ PCL::|(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))|
++ PCL::COMPUTE-PV-SLOT PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL1
++ PCL::|(FAST-METHOD SLOT-UNBOUND (T T T))|
++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))|
++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))|
++ PCL::OPTIMIZE-INSTANCE-ACCESS
++ PCL::|(FAST-METHOD REMOVE-NAMED-METHOD (T T))|
++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))|
++ PCL::REAL-MAKE-METHOD-INITARGS-FORM
++ PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))|
++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))|
++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T T))|
++ PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))|
++ PCL::MAKE-FINAL-ORDINARY-DFUN-INTERNAL
++ PCL::BOOTSTRAP-MAKE-SLOT-DEFINITIONS
++ PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))|
++ PCL::MAKE-PARAMETER-REFERENCES
++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))|
++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))|
++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))|
++ PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
++ PCL::OPTIMIZE-ACCESSOR-CALL
++ WALKER::WALK-TEMPLATE-HANDLE-REPEAT WALKER::WALK-BINDINGS-1
++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))|
++ PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS1
++ PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
++ PCL::MAKE-FGEN
++ PCL::|(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))|
++ PCL::|(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))|
++ PCL::OPTIMIZE-GENERIC-FUNCTION-CALL
++ PCL::LOAD-FUNCTION-GENERATOR PCL::MAKE-EMF-CACHE
++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))|
++ PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
++ PCL::EXPAND-EMF-CALL-METHOD))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T)
++ COMMON-LISP::T)
++ PCL::EXPAND-DEFMETHOD PCL::LOAD-DEFMETHOD-INTERNAL))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::*)
++ COMMON-LISP::T)
++ PCL::FILL-CACHE PCL::CAN-OPTIMIZE-ACCESS1 PCL::MAKE-EMF-CALL
++ PCL::EMIT-FETCH-WRAPPER PCL::CHECK-INITARGS-2-LIST
++ PCL::GET-METHOD PCL::CHECK-INITARGS-2-PLIST
++ PCL::CHECK-INITARGS-1 PCL::REAL-GET-METHOD
++ WALKER::WALK-ARGLIST))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::T)
++ PCL::GET-SECONDARY-DISPATCH-FUNCTION2))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::*)
++ COMMON-LISP::T)
++ PCL::LOAD-DEFMETHOD PCL::MAKE-DEFMETHOD-FORM
++ PCL::EARLY-MAKE-A-METHOD PCL::MAKE-DEFMETHOD-FORM-INTERNAL))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::T)
++ PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
++ PCL::SET-ARG-INFO1 PCL::BOOTSTRAP-MAKE-SLOT-DEFINITION
++ PCL::LOAD-DEFCLASS PCL::REAL-LOAD-DEFCLASS
++ PCL::OPTIMIZE-GF-CALL WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1
++ PCL::EMIT-SLOT-ACCESS PCL::MAKE-EARLY-CLASS-DEFINITION))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::T)
++ PCL::EMIT-DLAP PCL::GET-SECONDARY-DISPATCH-FUNCTION1))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::T)
++ PCL::EARLY-ADD-NAMED-METHOD PCL::FILL-DFUN-CACHE
++ PCL::REAL-ADD-NAMED-METHOD))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::*)
++ COMMON-LISP::T)
++ PCL::BOOTSTRAP-INITIALIZE-CLASS))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::FIXNUM)
++ COMMON-LISP::T)
++ PCL::COMPUTE-STD-CPL-PHASE-3))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::FIXNUM)
++ COMMON-LISP::T)
++ PCL::FILL-CACHE-FROM-CACHE-P PCL::GET-CACHE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::LIST)
++ PCL::PV-TABLE-CALL-LIST PCL::CACHE-OVERFLOW
++ PCL::PV-TABLE-SLOT-NAME-LISTS))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::FIXNUM COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::*)
++ PCL::COMPUTE-CACHE-PARAMETERS))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::FIXNUM COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::*)
++ PCL::FIND-FREE-CACHE-LINE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::BOOLEAN)
++ PCL::CACHE-VALUEP))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*)
++ PCL::DEFAULT-CODE-CONVERTER PCL::EMIT-IN-CHECKING-CACHE-P
++ PCL::METHOD-PROTOTYPE-FOR-GF PCL::EMIT-TWO-CLASS-WRITER
++ PCL::PARSE-METHOD-GROUP-SPECIFIER PCL::EMIT-ONE-CLASS-WRITER
++ PCL::EMIT-ONE-INDEX-WRITERS PCL::FIND-STRUCTURE-CLASS
++ PCL::PROTOTYPES-FOR-MAKE-METHOD-LAMBDA PCL::MAKE-DISPATCH-DFUN
++ PCL::COMPUTE-APPLICABLE-METHODS-EMF PCL::EARLY-METHOD-FUNCTION
++ PCL::NET-CODE-CONVERTER PCL::GET-DISPATCH-FUNCTION
++ PCL::STRUCTURE-WRAPPER PCL::FIND-WRAPPER PCL::CLASS-EQ-TYPE
++ PCL::TYPE-FROM-SPECIALIZER PCL::SPECIALIZER-FROM-TYPE
++ PCL::PCL-DESCRIBE PCL::PARSE-DEFMETHOD
++ PCL::ANALYZE-LAMBDA-LIST PCL::EMIT-ONE-CLASS-READER
++ PCL::EARLY-COLLECT-INHERITANCE PCL::GET-GENERIC-FUNCTION-INFO
++ PCL::COMPILE-IIS-FUNCTIONS PCL::EMIT-CONSTANT-VALUE
++ PCL::EMIT-ONE-INDEX-READERS PCL::GENERIC-FUNCTION-NAME-P
++ PCL::CONVERT-TO-SYSTEM-TYPE PCL::MAKE-FINAL-DISPATCH-DFUN
++ PCL::EMIT-TWO-CLASS-READER PCL::*NORMALIZE-TYPE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T)
++ PCL::|__si::MAKE-CLASS-PRECEDENCE-DESCRIPTION|
++ PCL::MAKE-FAST-INSTANCE-BOUNDP PCL::MAKE-INITIALIZE-INFO
++ PCL::|STRUCTURE-OBJECT class constructor|
++ PCL::|__si::MAKE-CACHE| PCL::|__si::MAKE-DEFAULT-METHOD-ONLY|
++ PCL::TRUE PCL::|__si::MAKE-PV-TABLE|
++ PCL::|__si::MAKE-ONE-INDEX| WALKER::UNBOUND-LEXICAL-FUNCTION
++ PCL::|__si::MAKE-CHECKING| PCL::MAKE-PV-TABLE
++ PCL::|__si::MAKE-NO-METHODS| PCL::MAKE-METHOD-CALL
++ PCL::CALLED-FIN-WITHOUT-FUNCTION PCL::USE-PACKAGE-PCL
++ PCL::INTERN-PV-TABLE PCL::|__si::MAKE-ACCESSOR-DFUN-INFO|
++ PCL::|__si::MAKE-DISPATCH|
++ PCL::|__si::MAKE-ONE-INDEX-DFUN-INFO|
++ PCL::|__si::MAKE-ARG-INFO| PCL::FIX-EARLY-GENERIC-FUNCTIONS
++ PCL::ZERO PCL::MAKE-PROGN PCL::|__si::MAKE-INITIAL|
++ PCL::|__si::MAKE-ONE-CLASS| PCL::|__si::MAKE-DFUN-INFO|
++ PCL::|__si::MAKE-CONSTANT-VALUE|
++ PCL::|__si::MAKE-STD-INSTANCE| PCL::PV-WRAPPERS-FROM-PV-ARGS
++ PCL::|__si::MAKE-TWO-CLASS| PCL::|__si::MAKE-N-N|
++ PCL::|__si::MAKE-CACHING| PCL::FALSE PCL::STRING-APPEND
++ PCL::|__si::MAKE-INITIAL-DISPATCH| PCL::MAKE-FAST-METHOD-CALL))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM)
++ PCL::ARG-INFO-NUMBER-REQUIRED PCL::PV-TABLE-PV-SIZE
++ PCL::CACHE-COUNT PCL::PV-CACHE-LIMIT-FN PCL::CHECKING-LIMIT-FN
++ PCL::CACHING-LIMIT-FN PCL::N-N-ACCESSORS-LIMIT-FN
++ PCL::DEFAULT-LIMIT-FN PCL::EARLY-CLASS-SIZE PCL::CPD-COUNT
++ PCL::ONE-INDEX-LIMIT-FN PCL::FAST-INSTANCE-BOUNDP-INDEX))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T)
++ PCL::POWER-OF-TWO-CEILING))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::T)
++ PCL::MAKE-TYPE-PREDICATE-NAME PCL::MAKE-FINAL-DFUN
++ PCL::CAPITALIZE-WORDS PCL::SET-DFUN ITERATE::MAYBE-WARN
++ PCL::MAKE-EARLY-GF PCL::USE-DISPATCH-DFUN-P WALKER::RELIST
++ PCL::MAKE-SPECIALIZABLE PCL::PV-TABLE-LOOKUP-PV-ARGS
++ PCL::ALLOCATE-STANDARD-INSTANCE
++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE
++ PCL::USE-CONSTANT-VALUE-DFUN-P ITERATE::FUNCTION-LAMBDA-P
++ PCL::UPDATE-DFUN PCL::SET-ARG-INFO
++ PCL::EARLY-METHOD-SPECIALIZERS PCL::MAKE-WRAPPER
++ PCL::FIND-CLASS-CELL WALKER::WALKER-ENVIRONMENT-BIND-1
++ PCL::TRACE-METHOD WALKER::RELIST* COMMON-LISP::FIND-CLASS
++ PCL::INITIALIZE-INTERNAL-SLOT-GFS PCL::FIND-CLASS-PREDICATE
++ PCL::INITIALIZE-METHOD-FUNCTION))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::*)
++ PCL::SAUT-NOT PCL::INVOKE-EMF PCL::SAUT-PROTOTYPE
++ PCL::COMPUTE-CODE ITERATE::PARSE-DECLARATIONS
++ PCL::SDFUN-FOR-CACHING
++ PCL::COMPUTE-APPLICABLE-METHODS-USING-TYPES
++ PCL::GET-NEW-FUNCTION-GENERATOR-INTERNAL
++ PCL::SLOT-NAME-LISTS-FROM-SLOTS PCL::DESTRUCTURE
++ PCL::SPLIT-DECLARATIONS PCL::MAKE-DIRECT-SLOTD
++ PCL::FORM-LIST-TO-LISP PCL::EMIT-CHECKING
++ PCL::CPL-FORWARD-REFERENCED-CLASS-ERROR PCL::COMPUTE-TEST
++ PCL::SET-FUNCTION-NAME COMMON-LISP::SLOT-BOUNDP PCL::SAUT-AND
++ PCL::EMIT-CACHING PCL::INITIAL-DFUN
++ COMMON-LISP::SLOT-MAKUNBOUND COMMON-LISP::SLOT-VALUE
++ PCL::UPDATE-SLOT-VALUE-GF-INFO
++ PCL::CLASS-APPLICABLE-USING-CLASS-P
++ PCL::CPL-INCONSISTENT-ERROR PCL::*SUBTYPEP
++ PCL::SLOT-UNBOUND-INTERNAL
++ PCL::GENERATE-FAST-CLASS-SLOT-ACCESS-P
++ PCL::CHECK-INITARGS-VALUES PCL::ENSURE-CLASS-VALUES
++ PCL::SAUT-EQL PCL::REAL-REMOVE-METHOD PCL::EMIT-DEFAULT-ONLY
++ PCL::INSURE-DFUN PCL::EMIT-DEFAULT-ONLY-FUNCTION
++ PCL::MUTATE-SLOTS-AND-CALLS PCL::FIND-SUPERCLASS-CHAIN
++ PCL::SAUT-CLASS PCL::MAKE-INSTANCE-FUNCTION-TRAP
++ PCL::SAUT-CLASS-EQ PCL::COMPUTE-STD-CPL-PHASE-1
++ PCL::SPECIALIZER-APPLICABLE-USING-TYPE-P))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T)
++ (COMMON-LISP::OR PCL::CACHE COMMON-LISP::NULL))
++ PCL::PV-TABLE-CACHE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::*)
++ COMMON-LISP::*)
++ WALKER::WALK-DECLARATIONS PCL::GET-SECONDARY-DISPATCH-FUNCTION
++ PCL::MAKE-ONE-INDEX-ACCESSOR-DFUN))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T)
++ COMMON-LISP::*)
++ PCL::MAKE-SHARED-INITIALIZE-FORM-LIST PCL::ACCESSOR-MISS
++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))|
++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))|
++ PCL::|(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))|
++ PCL::|(FAST-METHOD NO-APPLICABLE-METHOD (T))|
++ PCL::SET-CLASS-SLOT-VALUE-1
++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (CLASS T))|
++ PCL::|(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))|
++ PCL::GET-ACCESSOR-FROM-SVUC-METHOD-FUNCTION
++ PCL::SETF-SLOT-VALUE-USING-CLASS-DFUN
++ PCL::|(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))|
++ PCL::EMIT-CHECKING-OR-CACHING-FUNCTION
++ PCL::MAKE-FINAL-ONE-INDEX-ACCESSOR-DFUN
++ PCL::LOAD-SHORT-DEFCOMBIN PCL::EMIT-CHECKING-OR-CACHING
++ PCL::|(FAST-METHOD MAKE-INSTANCE (SYMBOL))|
++ PCL::MAKE-FINAL-CHECKING-DFUN
++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))|
++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))|
++ PCL::ACCESSOR-VALUES
++ PCL::|(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))|
++ PCL::|(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))|
++ PCL::REAL-MAKE-METHOD-LAMBDA
++ PCL::|(FAST-METHOD CHANGE-CLASS (T SYMBOL))|
++ PCL::GET-ACCESSOR-METHOD-FUNCTION
++ PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))|
++ PCL::|(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))|
++ PCL::ORDER-SPECIALIZERS
++ PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))|
++ PCL::GENERATE-DISCRIMINATION-NET
++ PCL::|(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))|
++ PCL::|(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))|
++ PCL::MAKE-ONE-CLASS-ACCESSOR-DFUN
++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (T T))|
++ PCL::BOOTSTRAP-ACCESSOR-DEFINITION
++ PCL::INITIALIZE-INSTANCE-SIMPLE-FUNCTION))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::*)
++ PCL::GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION
++ PCL::MAKE-OPTIMIZED-STD-WRITER-METHOD-FUNCTION
++ PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))|
++ PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))|
++ PCL::|(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))|
++ PCL::MAKE-OPTIMIZED-STD-BOUNDP-METHOD-FUNCTION
++ PCL::CONVERT-METHODS WALKER::WALK-LET-IF
++ PCL::EMIT-READER/WRITER-FUNCTION PCL::ACCESSOR-VALUES-INTERNAL
++ PCL::|(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))|
++ PCL::LOAD-LONG-DEFCOMBIN PCL::CHECK-METHOD-ARG-INFO
++ PCL::ACCESSOR-VALUES1
++ PCL::|(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))|
++ PCL::GENERATING-LISP PCL::MAKE-FINAL-N-N-ACCESSOR-DFUN
++ WALKER::WALK-FORM-INTERNAL PCL::CONSTANT-VALUE-MISS
++ PCL::SLOT-VALUE-USING-CLASS-DFUN PCL::CACHING-MISS
++ PCL::|(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))|
++ PCL::SLOT-BOUNDP-USING-CLASS-DFUN PCL::CHECKING-MISS
++ PCL::|(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))|
++ PCL::EMIT-READER/WRITER ITERATE::EXPAND-INTO-LET
++ PCL::GET-CLASS-SLOT-VALUE-1
++ PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION
++ PCL::MAKE-FINAL-CACHING-DFUN
++ PCL::|(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))|
++ PCL::|(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))|
++ PCL::GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION
++ PCL::|(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))|
++ PCL::OPTIMIZE-SLOT-VALUE-BY-CLASS-P PCL::SET-SLOT-VALUE
++ PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER
++ ITERATE::RENAME-VARIABLES
++ PCL::|(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))|
++ PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))|
++ ITERATE::WALK-GATHERING-BODY PCL::CACHE-MISS-VALUES
++ PCL::MAKE-OPTIMIZED-STD-READER-METHOD-FUNCTION
++ PCL::MAKE-FINAL-CONSTANT-VALUE-DFUN))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::*)
++ PCL::DO-SHORT-METHOD-COMBINATION PCL::MEMF-CODE-CONVERTER
++ PCL::GENERATE-DISCRIMINATION-NET-INTERNAL
++ PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
++ PCL::MAKE-LONG-METHOD-COMBINATION-FUNCTION
++ PCL::CACHE-MISS-VALUES-INTERNAL))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::*)
++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))|
++ PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))|
++ PCL::ADD-METHOD-DECLARATIONS
++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))|
++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))|
++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))|
++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))|
++ PCL::|(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))|
++ PCL::COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL
++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))|
++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))|
++ PCL::|(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))|
++ PCL::MAKE-TWO-CLASS-ACCESSOR-DFUN
++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))|
++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))|
++ PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
++ PCL::|(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))|
++ PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))|
++ PCL::|(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))|
++ PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
++ PCL::WALK-METHOD-LAMBDA
++ PCL::|(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))|))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::*)
++ COMMON-LISP::*)
++ PCL::REAL-MAKE-A-METHOD))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::*)
++ PCL::MAKE-DEFAULT-INITARGS-FORM-LIST
++ PCL::GET-COMPLEX-INITIALIZATION-FUNCTIONS
++ PCL::SLOT-VALUE-OR-DEFAULT
++ PCL::GET-SIMPLE-INITIALIZATION-FUNCTION PCL::REAL-ADD-METHOD
++ PCL::LOAD-DEFGENERIC PCL::CPL-ERROR
++ PCL::MAKE-FINAL-ACCESSOR-DFUN PCL::MAKE-N-N-ACCESSOR-DFUN
++ PCL::TYPES-FROM-ARGUMENTS PCL::MAKE-ACCESSOR-TABLE
++ PCL::MAKE-CHECKING-DFUN WALKER::NESTED-WALK-FORM
++ PCL::GET-EFFECTIVE-METHOD-FUNCTION
++ PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION
++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T)
++ COMMON-LISP::*)
++ ITERATE::ITERATE-TRANSFORM-BODY
++ PCL::|(FAST-METHOD SLOT-MISSING (T T T T))|
++ PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))|))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::*)
++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1
++ ITERATE::RENAME-LET-BINDINGS))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM COMMON-LISP::T)
++ COMMON-LISP::FIXNUM)
++ PCL::COMPUTE-PRIMARY-CACHE-LOCATION))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::*)
++ COMMON-LISP::T)
++ PCL::COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION
++ PCL::GET-CACHE-FROM-CACHE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM COMMON-LISP::T)
++ COMMON-LISP::T)
++ PCL::%CCLOSURE-ENV-NTHCDR))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::STREAM COMMON-LISP::T)
++ COMMON-LISP::T)
++ PCL::PRINT-DFUN-INFO))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*)
++ PCL::COUNT-ALL-DFUNS PCL::EMIT-N-N-WRITERS
++ PCL::EMIT-N-N-READERS))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::FIXNUM)
++ PCL::GET-WRAPPER-CACHE-NUMBER))
+ (IN-PACKAGE "PCL")
+
+-(DOLIST (V '(DISASSEMBLE |(FAST-WRITER-METHOD SLOT-OBJECT OPTIONS)|
+- |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHODS)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT METHODS)|
+- |(FAST-WRITER-METHOD SLOT-CLASS DIRECT-SLOTS)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SLOTS)|
+- |(FAST-WRITER-METHOD SLOT-CLASS SLOTS)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT SLOTS)|
++(DOLIST (V '(|(FAST-WRITER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)|
+ |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-METHODS)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT SLOTS)|
++ |(FAST-WRITER-METHOD SLOT-CLASS SLOTS)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SLOTS)|
++ |(FAST-WRITER-METHOD SLOT-CLASS DIRECT-SLOTS)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT METHODS)|
++ |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHODS)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT OPTIONS)|
+ |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)|
+ ADD-READER-METHOD
+ SHORT-COMBINATION-IDENTITY-WITH-ONE-ARGUMENT
+- REMOVE-READER-METHOD |LISP::T class predicate|
+- EQL-SPECIALIZER-P |(SETF GENERIC-FUNCTION-NAME)|
+- OBJECT-PLIST SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL
+- |PCL::STANDARD-METHOD-COMBINATION class predicate|
+- |PCL::STANDARD-EFFECTIVE-SLOT-DEFINITION class predicate|
+- |PCL::STANDARD-DIRECT-SLOT-DEFINITION class predicate|
++ REMOVE-READER-METHOD EQL-SPECIALIZER-P
++ |(SETF GENERIC-FUNCTION-NAME)| OBJECT-PLIST
++ SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL
+ |PCL::STANDARD-SLOT-DEFINITION class predicate|
+- |PCL::STANDARD-OBJECT class predicate|
++ |PCL::STANDARD-DIRECT-SLOT-DEFINITION class predicate|
++ |PCL::STANDARD-EFFECTIVE-SLOT-DEFINITION class predicate|
++ |PCL::STANDARD-METHOD-COMBINATION class predicate|
+ |(FAST-READER-METHOD SLOT-OBJECT METHOD)|
+- |PCL::BUILT-IN-CLASS class predicate| SPECIALIZER-TYPE
+- |LISP::RATIONAL class predicate|
+- |LISP::RATIO class predicate| GF-DFUN-STATE
++ SPECIALIZER-TYPE GF-DFUN-STATE
+ |(SETF GENERIC-FUNCTION-METHOD-CLASS)|
+- |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)|
+ |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)|
++ |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)|
+ |(SETF GENERIC-FUNCTION-METHOD-COMBINATION)|
+ CLASS-DEFSTRUCT-CONSTRUCTOR
+- |(FAST-READER-METHOD DEFINITION-SOURCE-MIXIN SOURCE)|
+ |(FAST-READER-METHOD SLOT-OBJECT SOURCE)|
++ |(FAST-READER-METHOD DEFINITION-SOURCE-MIXIN SOURCE)|
+ METHOD-FAST-FUNCTION |(SETF GENERIC-FUNCTION-METHODS)|
+ |(SETF GF-PRETTY-ARGLIST)|
+- |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)|
+- |(FAST-READER-METHOD SLOT-OBJECT ARG-INFO)|
+- |(FAST-READER-METHOD SLOT-CLASS INITIALIZE-INFO)|
+ |(FAST-READER-METHOD SLOT-OBJECT INITIALIZE-INFO)|
++ |(FAST-READER-METHOD SLOT-CLASS INITIALIZE-INFO)|
++ |(FAST-READER-METHOD SLOT-OBJECT ARG-INFO)|
++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)|
+ SPECIALIZERP EXACT-CLASS-SPECIALIZER-P
+- |(FAST-READER-METHOD PCL-CLASS WRAPPER)|
+ |(FAST-READER-METHOD SLOT-OBJECT WRAPPER)|
+- |(FAST-READER-METHOD SLOT-DEFINITION INITARGS)|
++ |(FAST-READER-METHOD PCL-CLASS WRAPPER)|
+ |(FAST-READER-METHOD SLOT-OBJECT INITARGS)|
+- |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-CONSTRUCTOR)|
+- |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)|
+- |(FAST-READER-METHOD SLOT-OBJECT OPERATOR)|
++ |(FAST-READER-METHOD SLOT-DEFINITION INITARGS)|
+ |(FAST-READER-METHOD SHORT-METHOD-COMBINATION OPERATOR)|
+- |LISP::CHARACTER class predicate|
++ |(FAST-READER-METHOD SLOT-OBJECT OPERATOR)|
++ |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)|
++ |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-CONSTRUCTOR)|
+ COMPATIBLE-META-CLASS-CHANGE-P
+- |LISP::SEQUENCE class predicate|
+- |(FAST-READER-METHOD CLASS CLASS-EQ-SPECIALIZER)|
+ |(FAST-READER-METHOD SLOT-OBJECT CLASS-EQ-SPECIALIZER)|
++ |(FAST-READER-METHOD CLASS CLASS-EQ-SPECIALIZER)|
+ |(BOUNDP READER-FUNCTION)| TRACE-METHOD-INTERNAL
+ |(BOUNDP PREDICATE-NAME)| |(BOUNDP READERS)|
+ UPDATE-GF-DFUN |(BOUNDP CLASS-PRECEDENCE-LIST)|
+- |(BOUNDP ACCESSOR-FLAGS)| |(BOUNDP DOCUMENTATION)|
+- |(BOUNDP LOCATION)| SPECIALIZER-OBJECT
++ |(BOUNDP ACCESSOR-FLAGS)| |(BOUNDP LOCATION)|
++ |(BOUNDP DOCUMENTATION)| SPECIALIZER-OBJECT
+ |(BOUNDP INCOMPATIBLE-SUPERCLASS-LIST)|
+ ACCESSOR-METHOD-SLOT-NAME |(BOUNDP SPECIALIZERS)|
+ |(BOUNDP IDENTITY-WITH-ONE-ARGUMENT)|
+@@ -783,158 +1052,146 @@
+ CLASS-EQ-SPECIALIZER-P
+ |(FAST-BOUNDP-METHOD SLOT-OBJECT SOURCE)| SLOTS-FETCHER
+ |(SETF SLOT-ACCESSOR-STD-P)| REMOVE-WRITER-METHOD
+- |(BOUNDP INITFUNCTION)| |(BOUNDP WRITER-FUNCTION)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT ARG-INFO)|
++ |(BOUNDP WRITER-FUNCTION)| |(BOUNDP INITFUNCTION)|
+ |(FAST-BOUNDP-METHOD SLOT-OBJECT INITIALIZE-INFO)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT ARG-INFO)|
+ STRUCTURE-CLASS-P |(BOUNDP WRITERS)|
+- |(BOUNDP INITFORM)|
++ |(BOUNDP INITFORM)| |SETF COMMON-LISP CLASS-NAME|
+ |(FAST-BOUNDP-METHOD SLOT-OBJECT WRAPPER)|
+ |(FAST-BOUNDP-METHOD SLOT-OBJECT INITARGS)|
+- |LISP::BIT-VECTOR class predicate|
+ |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)|
+ UPDATE-CONSTRUCTORS |(BOUNDP SLOT-NAME)|
+ |(SETF SLOT-DEFINITION-INITARGS)| |(BOUNDP ALLOCATION)|
+ |(FAST-BOUNDP-METHOD SLOT-OBJECT CLASS-EQ-SPECIALIZER)|
+- DOCUMENTATION |(BOUNDP GENERIC-FUNCTION)|
+- |(BOUNDP FUNCTION)| |(BOUNDP LAMBDA-LIST)|
++ DOCUMENTATION |(BOUNDP FUNCTION)|
++ |(BOUNDP GENERIC-FUNCTION)| |(BOUNDP LAMBDA-LIST)|
+ METHOD-PRETTY-ARGLIST |(BOUNDP SLOT-DEFINITION)|
+- |LISP::ARRAY class predicate|
+ |(BOUNDP CAN-PRECEDE-LIST)| |(BOUNDP PROTOTYPE)|
+ CLASS-EQ-SPECIALIZER INFORM-TYPE-SYSTEM-ABOUT-CLASS
+ |PCL::DEFINITION-SOURCE-MIXIN class predicate|
+- |(BOUNDP DFUN-STATE)|
+- |LISP::STRUCTURE-OBJECT class predicate|
+- |(BOUNDP FROM-DEFCLASS-P)| COMPILE |(READER METHOD)|
+- |LISP::STANDARD-OBJECT class predicate|
++ |(BOUNDP DFUN-STATE)| |(BOUNDP FROM-DEFCLASS-P)|
++ |(READER METHOD)|
+ |(CALL STANDARD-COMPUTE-EFFECTIVE-METHOD)|
+- |(BOUNDP FAST-FUNCTION)|
+- |LISP::COMPLEX class predicate| |(BOUNDP METHOD-CLASS)|
+- |(READER SOURCE)| |(BOUNDP METHOD-COMBINATION)|
++ |(BOUNDP FAST-FUNCTION)| |(BOUNDP METHOD-CLASS)|
++ |(READER SOURCE)| |(BOUNDP INTERNAL-WRITER-FUNCTION)|
+ |(BOUNDP INTERNAL-READER-FUNCTION)|
+- |(BOUNDP INTERNAL-WRITER-FUNCTION)|
+- ACCESSOR-METHOD-CLASS |(BOUNDP DIRECT-METHODS)|
+- |(BOUNDP DIRECT-SLOTS)| |(BOUNDP BOUNDP-FUNCTION)|
+- |(BOUNDP DIRECT-SUPERCLASSES)|
+- |(BOUNDP DIRECT-SUBCLASSES)| |(BOUNDP OPTIONS)|
+- |(BOUNDP METHODS)| |(WRITER METHOD)|
+- |LISP::BUILT-IN-CLASS class predicate|
++ |(BOUNDP METHOD-COMBINATION)| ACCESSOR-METHOD-CLASS
++ |(BOUNDP DIRECT-SLOTS)| |(BOUNDP DIRECT-METHODS)|
++ |(BOUNDP BOUNDP-FUNCTION)| |(BOUNDP DIRECT-SUBCLASSES)|
++ |(BOUNDP DIRECT-SUPERCLASSES)| |(BOUNDP METHODS)|
++ |(BOUNDP OPTIONS)| |(WRITER METHOD)|
+ |PCL::DEPENDENT-UPDATE-MIXIN class predicate|
+ GENERIC-FUNCTION-PRETTY-ARGLIST |(WRITER SOURCE)|
++ |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))|
++ |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))|
++ |(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))|
+ |(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))|
+- |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))|
+ |(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))|
+- |(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))|
+- |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))|
+- |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))|
++ |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))|
++ |(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))|
++ |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))|
++ |(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))|
+ |(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))|
+ |(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))|
+ |(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))|
+- |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))|
+- |(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))|
+- |(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))|
+ MAKE-BOUNDP-METHOD-FUNCTION
+- |LISP::STRING class predicate|
+ |(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))|
+ |(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))|
+ |PCL::METAOBJECT class predicate|
+- |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
+ |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
+ |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
+- |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
+ |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
+- |(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
+- |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
+- |(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))|
+- |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))|
+- |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))|
+- |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))|
+- |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))|
+- |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))|
++ |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
++ |(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))|
++ |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))|
++ |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))|
++ |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))|
++ |(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))|
++ |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))|
++ |(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))|
++ |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))|
++ |(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))|
++ |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))|
++ |(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))|
++ |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))|
++ |(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))|
++ |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))|
++ |(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))|
++ |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
++ |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))|
+ |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))|
+ |(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))|
+- |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))|
++ |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))|
++ |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))|
++ |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))|
+ |(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))|
+ |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))|
++ |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))|
++ |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))|
++ |(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
++ |(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))|
++ |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
++ |(FAST-METHOD CHANGE-CLASS (T SYMBOL))|
+ |(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))|
+ |(FAST-METHOD MAKE-INSTANCE (SYMBOL))|
+- |(FAST-METHOD CHANGE-CLASS (T SYMBOL))|
+ |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
+- |(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))|
+- |(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))|
+- |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))|
+- |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))|
+- |(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))|
+- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))|
+- |(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))|
+- |(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))|
+- |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))|
+- |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))|
+- |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))|
+- |(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))|
+- |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))|
+- |(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))|
+- |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))|
+ |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))|
+- |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))|
+- |(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))|
+- |(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))|
+- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))|
+- |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))|
+- |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))|
+- |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))|
+- |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))|
+- |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))|
+- |(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))|
+- |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))|
+- |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))|
+- |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))|
+- |(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))|
+- |(FAST-METHOD MAKE-INSTANCE (CLASS))|
+- |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))|
+- |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))|
+- |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))|
+- |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))|
+- |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))|
+- |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))|
+- |(FAST-METHOD SPECIALIZER-CLASS (CLASS))|
++ |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))|
+ |(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))|
+- |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))|
+- |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))|
+- |(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))|
+- |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))|
+- |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))|
+- |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))|
+- |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))|
+- |(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))|
+- |(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))|
+- |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))|
+- |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))|
+- |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))|
+- |(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))|
++ |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))|
++ |(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))|
+ |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))|
++ |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))|
++ |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))|
+ |(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))|
+- |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))|
++ |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))|
++ |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))|
++ |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))|
++ |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))|
+ |(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))|
+- |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))|
+- |(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))|
++ |(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))|
++ |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))|
++ |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))|
++ |(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))|
+ |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))|
+- |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))|
++ |(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))|
++ |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))|
++ |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))|
++ |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))|
++ |(FAST-METHOD SPECIALIZER-CLASS (CLASS))|
++ |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))|
++ |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))|
++ |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))|
++ |(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))|
++ |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))|
++ |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))|
++ |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))|
++ |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))|
++ |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))|
++ |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))|
++ |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))|
++ |(FAST-METHOD MAKE-INSTANCE (CLASS))|
++ |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))|
++ |(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))|
++ |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))|
++ |(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))|
++ |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))|
++ |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))|
++ |(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))|
++ |(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))|
++ |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))|
+ CLASS-PREDICATE-NAME
+- |PCL::STRUCTURE-EFFECTIVE-SLOT-DEFINITION class predicate|
+- |PCL::STRUCTURE-DIRECT-SLOT-DEFINITION class predicate|
+ |PCL::STRUCTURE-SLOT-DEFINITION class predicate|
+- |PCL::STRUCTURE-OBJECT class predicate|
+- |LISP::SYMBOL class predicate|
++ |PCL::STRUCTURE-DIRECT-SLOT-DEFINITION class predicate|
++ |PCL::STRUCTURE-EFFECTIVE-SLOT-DEFINITION class predicate|
+ |PCL::EFFECTIVE-SLOT-DEFINITION class predicate|
+ |(COMBINED-METHOD SHARED-INITIALIZE)|
+ LEGAL-QUALIFIERS-P ADD-BOUNDP-METHOD
+- LEGAL-LAMBDA-LIST-P |LISP::VECTOR class predicate|
+- |SETF PCL GENERIC-FUNCTION-NAME|
++ LEGAL-LAMBDA-LIST-P |SETF PCL GENERIC-FUNCTION-NAME|
+ |(READER READER-FUNCTION)| |(READER PREDICATE-NAME)|
+- |(READER READERS)| DESCRIBE-OBJECT
+- |(READER CLASS-PRECEDENCE-LIST)|
+- |(READER ACCESSOR-FLAGS)| |(READER DOCUMENTATION)|
+- |(READER LOCATION)| CLASS-INITIALIZE-INFO
++ |(READER READERS)| |(READER CLASS-PRECEDENCE-LIST)|
++ |(READER ACCESSOR-FLAGS)| |(READER LOCATION)|
++ |(READER DOCUMENTATION)| CLASS-INITIALIZE-INFO
+ |(SETF CLASS-SLOT-VALUE)| MAKE-WRITER-METHOD-FUNCTION
+ |SETF PCL GF-DFUN-STATE|
+ |(READER INCOMPATIBLE-SUPERCLASS-LIST)|
+@@ -942,75 +1199,75 @@
+ |(READER IDENTITY-WITH-ONE-ARGUMENT)|
+ |(SETF CLASS-INITIALIZE-INFO)|
+ |(READER PRETTY-ARGLIST)| |(READER DEFSTRUCT-FORM)|
+- |SETF PCL CLASS-NAME| |SETF PCL SLOT-DEFINITION-NAME|
++ |SETF PCL SLOT-DEFINITION-NAME|
+ |(WRITER READER-FUNCTION)|
+ |(SETF CLASS-DEFSTRUCT-CONSTRUCTOR)|
+ |(WRITER PREDICATE-NAME)| |(WRITER READERS)|
+- |(READER INITFUNCTION)| |(READER WRITER-FUNCTION)|
++ |(READER WRITER-FUNCTION)| |(READER INITFUNCTION)|
+ INITIALIZE-INTERNAL-SLOT-FUNCTIONS
+- |SETF PCL SLOT-DEFINITION-TYPE|
+- |(WRITER CLASS-PRECEDENCE-LIST)| |(READER WRITERS)|
++ |SETF PCL SLOT-DEFINITION-TYPE| |(READER WRITERS)|
++ |(WRITER CLASS-PRECEDENCE-LIST)|
+ |(WRITER ACCESSOR-FLAGS)| |(READER INITFORM)|
+- METHOD-COMBINATION-P |(WRITER DOCUMENTATION)|
+- |(WRITER LOCATION)|
++ METHOD-COMBINATION-P |(WRITER LOCATION)|
++ |(WRITER DOCUMENTATION)|
+ |(CALL REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION)|
+- |SETF PCL METHOD-GENERIC-FUNCTION|
+- |SETF PCL GENERIC-FUNCTION-METHOD-COMBINATION|
+ |SETF PCL GENERIC-FUNCTION-METHODS|
+- |(READER SLOT-NAME)|
++ |SETF PCL GENERIC-FUNCTION-METHOD-COMBINATION|
++ |SETF PCL METHOD-GENERIC-FUNCTION| |(READER SLOT-NAME)|
+ |(WRITER INCOMPATIBLE-SUPERCLASS-LIST)|
+ |SETF PCL SLOT-ACCESSOR-STD-P|
+ |(CALL REAL-MAKE-METHOD-INITARGS-FORM)|
+ |(READER ALLOCATION)| |(WRITER SPECIALIZERS)|
+ |(CALL REAL-ENSURE-GF-USING-CLASS--NULL)|
+ |(WRITER IDENTITY-WITH-ONE-ARGUMENT)|
+- |(SETF METHOD-GENERIC-FUNCTION)| LEGAL-SPECIALIZERS-P
+- |(WRITER PRETTY-ARGLIST)| |SETF PCL OBJECT-PLIST|
+- |LISP::FLOAT class predicate| |(WRITER DEFSTRUCT-FORM)|
+- |(READER GENERIC-FUNCTION)| |(READER FUNCTION)|
++ |(SETF METHOD-GENERIC-FUNCTION)|
++ |(WRITER PRETTY-ARGLIST)| LEGAL-SPECIALIZERS-P
++ |SETF PCL OBJECT-PLIST| |(WRITER DEFSTRUCT-FORM)|
++ |(READER FUNCTION)| |(READER GENERIC-FUNCTION)|
+ |(READER LAMBDA-LIST)| |(READER SLOT-DEFINITION)|
+ |PCL::CLASS-PROTOTYPE-SPECIALIZER class predicate|
+- |SETF PCL CLASS-DEFSTRUCT-FORM|
+ |SETF PCL SLOT-DEFINITION-INITFORM|
++ |SETF PCL CLASS-DEFSTRUCT-FORM|
+ |(READER CAN-PRECEDE-LIST)|
+ |SETF PCL GENERIC-FUNCTION-METHOD-CLASS|
+- |(READER PROTOTYPE)| |(WRITER INITFUNCTION)|
+- |(WRITER WRITER-FUNCTION)| |(WRITER WRITERS)|
++ |(READER PROTOTYPE)| |(WRITER WRITER-FUNCTION)|
++ |(WRITER INITFUNCTION)| |(WRITER WRITERS)|
+ SLOT-ACCESSOR-STD-P |(WRITER INITFORM)|
+ |(READER DFUN-STATE)| |(READER FROM-DEFCLASS-P)|
+ |SETF PCL GF-PRETTY-ARGLIST|
+- |SETF PCL SLOT-DEFINITION-INITFUNCTION|
+- |SETF PCL SLOT-DEFINITION-ALLOCATION|
+- |SETF PCL SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION|
+- |SETF PCL SLOT-DEFINITION-INTERNAL-READER-FUNCTION|
+- |SETF PCL SLOT-DEFINITION-BOUNDP-FUNCTION|
+- |SETF PCL SLOT-DEFINITION-WRITER-FUNCTION|
+- |SETF PCL SLOT-DEFINITION-READER-FUNCTION|
++ |SETF PCL SLOT-ACCESSOR-FUNCTION|
+ |SETF PCL SLOT-DEFINITION-LOCATION|
+- |SETF PCL SLOT-ACCESSOR-FUNCTION| |(WRITER SLOT-NAME)|
+- |(BOUNDP NAME)| |(WRITER ALLOCATION)|
+- |(READER FAST-FUNCTION)| |(READER METHOD-CLASS)|
+- |(SETF OBJECT-PLIST)| |(READER METHOD-COMBINATION)|
+- |(READER INTERNAL-READER-FUNCTION)|
++ |SETF PCL SLOT-DEFINITION-READER-FUNCTION|
++ |SETF PCL SLOT-DEFINITION-WRITER-FUNCTION|
++ |SETF PCL SLOT-DEFINITION-BOUNDP-FUNCTION|
++ |SETF PCL SLOT-DEFINITION-INTERNAL-READER-FUNCTION|
++ |SETF PCL SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION|
++ |SETF PCL SLOT-DEFINITION-ALLOCATION|
++ |SETF PCL SLOT-DEFINITION-INITFUNCTION|
++ |(WRITER SLOT-NAME)| |(BOUNDP NAME)|
++ |(READER FAST-FUNCTION)| |(WRITER ALLOCATION)|
++ |(READER METHOD-CLASS)| |(SETF OBJECT-PLIST)|
+ |(READER INTERNAL-WRITER-FUNCTION)|
+- METHOD-COMBINATION-OPTIONS |(READER DIRECT-METHODS)|
+- |(READER DIRECT-SLOTS)|
+- |SETF PCL SLOT-DEFINITION-READERS|
+- |(READER BOUNDP-FUNCTION)| |(WRITER GENERIC-FUNCTION)|
+- |(WRITER FUNCTION)| |(READER DIRECT-SUPERCLASSES)|
+- |(READER DIRECT-SUBCLASSES)| |SETF PCL DOCUMENTATION|
+- |(WRITER LAMBDA-LIST)| |LISP::LIST class predicate|
+- FUNCALLABLE-STANDARD-CLASS-P |(BOUNDP CLASS)|
++ |(READER INTERNAL-READER-FUNCTION)|
++ |(READER METHOD-COMBINATION)|
++ METHOD-COMBINATION-OPTIONS |(READER DIRECT-SLOTS)|
++ |(READER DIRECT-METHODS)|
++ |SETF PCL SLOT-DEFINITION-READERS| |(WRITER FUNCTION)|
++ |(WRITER GENERIC-FUNCTION)| |(READER BOUNDP-FUNCTION)|
++ |SETF PCL DOCUMENTATION| |(READER DIRECT-SUBCLASSES)|
++ |(READER DIRECT-SUPERCLASSES)| |(WRITER LAMBDA-LIST)|
++ FUNCALLABLE-STANDARD-CLASS-P
+ |(FAST-WRITER-METHOD SLOT-OBJECT METHOD)|
+- |(WRITER SLOT-DEFINITION)| |(READER OPTIONS)|
+- |(READER METHODS)| |(WRITER CAN-PRECEDE-LIST)|
+- |SETF PCL SLOT-VALUE-USING-CLASS|
++ |(BOUNDP CLASS)| |(WRITER SLOT-DEFINITION)|
++ |(READER METHODS)| |(READER OPTIONS)|
++ |(WRITER CAN-PRECEDE-LIST)|
+ |SETF PCL SLOT-DEFINITION-CLASS|
+- |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)|
++ |SETF PCL SLOT-VALUE-USING-CLASS|
+ |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)|
+- |(WRITER PROTOTYPE)| |(BOUNDP OBJECT)| |(BOUNDP TYPE)|
+- CLASS-CAN-PRECEDE-LIST |SETF PCL CLASS-SLOTS|
+- |SETF PCL CLASS-DIRECT-SLOTS| SLOT-ACCESSOR-FUNCTION
++ |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)|
++ |(WRITER PROTOTYPE)| |(BOUNDP TYPE)| |(BOUNDP OBJECT)|
++ CLASS-CAN-PRECEDE-LIST |SETF PCL CLASS-DIRECT-SLOTS|
++ |SETF PCL CLASS-SLOTS| SLOT-ACCESSOR-FUNCTION
+ |(BOUNDP PLIST)|
+ |SETF PCL CLASS-INCOMPATIBLE-SUPERCLASS-LIST|
+ |SETF PCL SLOT-DEFINITION-WRITERS|
+@@ -1018,290 +1275,287 @@
+ |(WRITER DFUN-STATE)| |(WRITER FROM-DEFCLASS-P)|
+ |(BOUNDP SLOTS)| SLOT-CLASS-P
+ MAKE-READER-METHOD-FUNCTION LEGAL-METHOD-FUNCTION-P
+- |(FAST-WRITER-METHOD SLOT-OBJECT ARG-INFO)|
+- |(FAST-WRITER-METHOD SLOT-CLASS INITIALIZE-INFO)|
+ |(FAST-WRITER-METHOD SLOT-OBJECT INITIALIZE-INFO)|
++ |(FAST-WRITER-METHOD SLOT-CLASS INITIALIZE-INFO)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT ARG-INFO)|
+ |PCL::PLIST-MIXIN class predicate|
+ |(WRITER FAST-FUNCTION)| |(WRITER METHOD-CLASS)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT WRAPPER)|
+- |(WRITER METHOD-COMBINATION)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT WRAPPER)| GET-METHOD
++ |(WRITER INTERNAL-WRITER-FUNCTION)|
+ |(WRITER INTERNAL-READER-FUNCTION)|
+- |(WRITER INTERNAL-WRITER-FUNCTION)| GET-METHOD
+- |(WRITER DIRECT-METHODS)| |(WRITER DIRECT-SLOTS)|
+- |(FAST-WRITER-METHOD SLOT-DEFINITION INITARGS)|
++ |(WRITER METHOD-COMBINATION)| |(WRITER DIRECT-SLOTS)|
++ |(WRITER DIRECT-METHODS)|
+ |(FAST-WRITER-METHOD SLOT-OBJECT INITARGS)|
+- |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-CONSTRUCTOR)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)|
++ |(FAST-WRITER-METHOD SLOT-DEFINITION INITARGS)|
+ |(FAST-WRITER-METHOD SLOT-OBJECT OPERATOR)|
+- |(WRITER BOUNDP-FUNCTION)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)|
++ |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-CONSTRUCTOR)|
++ |(WRITER BOUNDP-FUNCTION)| |(WRITER DIRECT-SUBCLASSES)|
+ |(WRITER DIRECT-SUPERCLASSES)|
+- |(WRITER DIRECT-SUBCLASSES)|
+ |(FAST-WRITER-METHOD SLOT-OBJECT CLASS-EQ-SPECIALIZER)|
+- |(WRITER OPTIONS)| |(WRITER METHODS)|
++ |(WRITER METHODS)| |(WRITER OPTIONS)|
+ SHORT-METHOD-COMBINATION-P GF-ARG-INFO
+ SPECIALIZER-METHOD-TABLE MAKE-METHOD-INITARGS-FORM
+ CLASS-DEFSTRUCT-FORM
+- |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION NAME)|
+- |(FAST-READER-METHOD SLOT-OBJECT NAME)|
+- |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION DFUN-STATE)|
+- |(FAST-READER-METHOD SLOT-OBJECT DFUN-STATE)|
+- |(FAST-READER-METHOD STANDARD-ACCESSOR-METHOD SLOT-NAME)|
+- |(FAST-READER-METHOD SLOT-OBJECT SLOT-NAME)|
+- |(FAST-READER-METHOD SLOT-DEFINITION NAME)|
+- |(FAST-READER-METHOD CLASS NAME)|
+- |(FAST-READER-METHOD CLASS PREDICATE-NAME)|
+ |(FAST-READER-METHOD SLOT-OBJECT PREDICATE-NAME)|
+- |LISP::INTEGER class predicate| GF-PRETTY-ARGLIST
+- SAME-SPECIALIZER-P
+- SLOT-DEFINITION-INTERNAL-READER-FUNCTION
+- SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION
+- SLOT-DEFINITION-READER-FUNCTION
+- SLOT-DEFINITION-WRITER-FUNCTION
++ |(FAST-READER-METHOD CLASS PREDICATE-NAME)|
++ |(FAST-READER-METHOD CLASS NAME)|
++ |(FAST-READER-METHOD SLOT-DEFINITION NAME)|
++ |(FAST-READER-METHOD SLOT-OBJECT SLOT-NAME)|
++ |(FAST-READER-METHOD STANDARD-ACCESSOR-METHOD SLOT-NAME)|
++ |(FAST-READER-METHOD SLOT-OBJECT DFUN-STATE)|
++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION DFUN-STATE)|
++ |(FAST-READER-METHOD SLOT-OBJECT NAME)|
++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION NAME)|
++ GF-PRETTY-ARGLIST SAME-SPECIALIZER-P
+ SLOT-DEFINITION-BOUNDP-FUNCTION
+- |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHOD-CLASS)|
+- |(FAST-READER-METHOD SLOT-OBJECT METHOD-CLASS)|
+- |(FAST-READER-METHOD SLOT-OBJECT ACCESSOR-FLAGS)|
+- |(FAST-READER-METHOD SLOT-DEFINITION CLASS)|
+- |(FAST-READER-METHOD SLOT-OBJECT CLASS)|
+- |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION DOCUMENTATION)|
+- |(FAST-READER-METHOD SLOT-OBJECT DOCUMENTATION)|
+- |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHOD-COMBINATION)|
+- |(FAST-READER-METHOD SLOT-OBJECT METHOD-COMBINATION)|
+- |(FAST-READER-METHOD STANDARD-ACCESSOR-METHOD SLOT-DEFINITION)|
+- |(FAST-READER-METHOD SLOT-OBJECT SLOT-DEFINITION)|
+- |(FAST-READER-METHOD STANDARD-METHOD GENERIC-FUNCTION)|
+- |(FAST-READER-METHOD SLOT-OBJECT GENERIC-FUNCTION)|
+- |(FAST-READER-METHOD SLOT-OBJECT FUNCTION)|
+- |(FAST-READER-METHOD STANDARD-METHOD FAST-FUNCTION)|
+- |(FAST-READER-METHOD SLOT-OBJECT FAST-FUNCTION)|
+- |(FAST-READER-METHOD STANDARD-EFFECTIVE-SLOT-DEFINITION LOCATION)|
+- |(FAST-READER-METHOD SLOT-OBJECT LOCATION)|
+- |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION READER-FUNCTION)|
+- |(FAST-READER-METHOD SLOT-OBJECT READER-FUNCTION)|
+- |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION WRITER-FUNCTION)|
+- |(FAST-READER-METHOD SLOT-OBJECT WRITER-FUNCTION)|
+- |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION BOUNDP-FUNCTION)|
+- |(FAST-READER-METHOD SLOT-OBJECT BOUNDP-FUNCTION)|
+- |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-READER-FUNCTION)|
+- |(FAST-READER-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)|
+- |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-WRITER-FUNCTION)|
+- |(FAST-READER-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)|
+- |(FAST-READER-METHOD STANDARD-SLOT-DEFINITION ALLOCATION)|
+- |(FAST-READER-METHOD SLOT-OBJECT ALLOCATION)|
+- |(FAST-READER-METHOD SLOT-DEFINITION INITFUNCTION)|
+- |(FAST-READER-METHOD SLOT-OBJECT INITFUNCTION)|
+- |(FAST-READER-METHOD LONG-METHOD-COMBINATION FUNCTION)|
+- |(FAST-READER-METHOD TRACED-METHOD FUNCTION)|
++ SLOT-DEFINITION-WRITER-FUNCTION
++ SLOT-DEFINITION-READER-FUNCTION
++ SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION
++ SLOT-DEFINITION-INTERNAL-READER-FUNCTION
++ |(FAST-READER-METHOD SLOT-OBJECT CLASS)|
++ |(FAST-READER-METHOD SLOT-DEFINITION CLASS)|
++ |(FAST-READER-METHOD SLOT-OBJECT ACCESSOR-FLAGS)|
++ |(FAST-READER-METHOD SLOT-OBJECT METHOD-CLASS)|
++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHOD-CLASS)|
+ |(FAST-READER-METHOD TRACED-METHOD GENERIC-FUNCTION)|
+- |(FAST-READER-METHOD STANDARD-METHOD SPECIALIZERS)|
+- |(FAST-READER-METHOD SLOT-OBJECT SPECIALIZERS)|
+- |(FAST-READER-METHOD SLOT-DEFINITION READERS)|
+- |(FAST-READER-METHOD SLOT-OBJECT READERS)|
+- |(FAST-READER-METHOD SLOT-DEFINITION WRITERS)|
++ |(FAST-READER-METHOD TRACED-METHOD FUNCTION)|
++ |(FAST-READER-METHOD LONG-METHOD-COMBINATION FUNCTION)|
++ |(FAST-READER-METHOD SLOT-OBJECT INITFUNCTION)|
++ |(FAST-READER-METHOD SLOT-DEFINITION INITFUNCTION)|
++ |(FAST-READER-METHOD SLOT-OBJECT ALLOCATION)|
++ |(FAST-READER-METHOD STANDARD-SLOT-DEFINITION ALLOCATION)|
++ |(FAST-READER-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)|
++ |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-WRITER-FUNCTION)|
++ |(FAST-READER-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)|
++ |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-READER-FUNCTION)|
++ |(FAST-READER-METHOD SLOT-OBJECT BOUNDP-FUNCTION)|
++ |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION BOUNDP-FUNCTION)|
++ |(FAST-READER-METHOD SLOT-OBJECT WRITER-FUNCTION)|
++ |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION WRITER-FUNCTION)|
++ |(FAST-READER-METHOD SLOT-OBJECT READER-FUNCTION)|
++ |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION READER-FUNCTION)|
++ |(FAST-READER-METHOD SLOT-OBJECT LOCATION)|
++ |(FAST-READER-METHOD STANDARD-EFFECTIVE-SLOT-DEFINITION LOCATION)|
++ |(FAST-READER-METHOD SLOT-OBJECT FAST-FUNCTION)|
++ |(FAST-READER-METHOD STANDARD-METHOD FAST-FUNCTION)|
++ |(FAST-READER-METHOD SLOT-OBJECT FUNCTION)|
++ |(FAST-READER-METHOD SLOT-OBJECT GENERIC-FUNCTION)|
++ |(FAST-READER-METHOD STANDARD-METHOD GENERIC-FUNCTION)|
++ |(FAST-READER-METHOD SLOT-OBJECT SLOT-DEFINITION)|
++ |(FAST-READER-METHOD STANDARD-ACCESSOR-METHOD SLOT-DEFINITION)|
++ |(FAST-READER-METHOD SLOT-OBJECT METHOD-COMBINATION)|
++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHOD-COMBINATION)|
++ |(FAST-READER-METHOD SLOT-OBJECT DOCUMENTATION)|
++ |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION DOCUMENTATION)|
+ |(FAST-READER-METHOD SLOT-OBJECT WRITERS)|
+- |(FAST-READER-METHOD EQL-SPECIALIZER OBJECT)|
+- |(FAST-READER-METHOD SLOT-OBJECT OBJECT)|
+- |(FAST-READER-METHOD CLASS-PROTOTYPE-SPECIALIZER OBJECT)|
+- |(FAST-READER-METHOD CLASS-EQ-SPECIALIZER OBJECT)|
+- |(FAST-READER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)|
+- |(FAST-READER-METHOD SHORT-METHOD-COMBINATION IDENTITY-WITH-ONE-ARGUMENT)|
+- |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION TYPE)|
+- |(FAST-READER-METHOD SLOT-OBJECT TYPE)|
+- |(FAST-READER-METHOD SLOT-DEFINITION TYPE)|
+- |(FAST-READER-METHOD PCL-CLASS PROTOTYPE)|
+- |(FAST-READER-METHOD SLOT-OBJECT PROTOTYPE)|
++ |(FAST-READER-METHOD SLOT-DEFINITION WRITERS)|
++ |(FAST-READER-METHOD SLOT-OBJECT READERS)|
++ |(FAST-READER-METHOD SLOT-DEFINITION READERS)|
++ |(FAST-READER-METHOD SLOT-OBJECT SPECIALIZERS)|
++ |(FAST-READER-METHOD STANDARD-METHOD SPECIALIZERS)|
+ |(FAST-READER-METHOD SPECIALIZER TYPE)|
+- |(FAST-READER-METHOD SLOT-DEFINITION INITFORM)|
+- |(FAST-READER-METHOD SLOT-OBJECT INITFORM)|
+- |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)|
++ |(FAST-READER-METHOD SLOT-OBJECT PROTOTYPE)|
++ |(FAST-READER-METHOD PCL-CLASS PROTOTYPE)|
++ |(FAST-READER-METHOD SLOT-DEFINITION TYPE)|
++ |(FAST-READER-METHOD SLOT-OBJECT TYPE)|
++ |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION TYPE)|
++ |(FAST-READER-METHOD SHORT-METHOD-COMBINATION IDENTITY-WITH-ONE-ARGUMENT)|
++ |(FAST-READER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)|
++ |(FAST-READER-METHOD CLASS-EQ-SPECIALIZER OBJECT)|
++ |(FAST-READER-METHOD CLASS-PROTOTYPE-SPECIALIZER OBJECT)|
++ |(FAST-READER-METHOD SLOT-OBJECT OBJECT)|
++ |(FAST-READER-METHOD EQL-SPECIALIZER OBJECT)|
+ |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-FORM)|
+- |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION PRETTY-ARGLIST)|
+- |(FAST-READER-METHOD SLOT-OBJECT PRETTY-ARGLIST)|
+- |(FAST-READER-METHOD STANDARD-METHOD LAMBDA-LIST)|
+- |(FAST-READER-METHOD SLOT-OBJECT LAMBDA-LIST)|
+- |(FAST-READER-METHOD PCL-CLASS CLASS-PRECEDENCE-LIST)|
+- |(FAST-READER-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)|
+- |(FAST-READER-METHOD PCL-CLASS CAN-PRECEDE-LIST)|
+- |(FAST-READER-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)|
+- |(FAST-READER-METHOD PCL-CLASS INCOMPATIBLE-SUPERCLASS-LIST)|
+- |(FAST-READER-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)|
+- |(FAST-READER-METHOD PLIST-MIXIN PLIST)|
++ |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)|
++ |(FAST-READER-METHOD SLOT-OBJECT INITFORM)|
++ |(FAST-READER-METHOD SLOT-DEFINITION INITFORM)|
+ |(FAST-READER-METHOD SLOT-OBJECT PLIST)|
+- |(FAST-READER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)|
+- |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION OPTIONS)|
+- |(FAST-READER-METHOD SLOT-OBJECT OPTIONS)|
+- |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHODS)|
+- |(FAST-READER-METHOD SLOT-OBJECT METHODS)|
+- |(FAST-READER-METHOD SLOT-CLASS DIRECT-SLOTS)|
+- |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SLOTS)|
+- |(FAST-READER-METHOD SLOT-CLASS SLOTS)|
+- |(FAST-READER-METHOD SLOT-OBJECT SLOTS)|
++ |(FAST-READER-METHOD PLIST-MIXIN PLIST)|
++ |(FAST-READER-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)|
++ |(FAST-READER-METHOD PCL-CLASS INCOMPATIBLE-SUPERCLASS-LIST)|
++ |(FAST-READER-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)|
++ |(FAST-READER-METHOD PCL-CLASS CAN-PRECEDE-LIST)|
++ |(FAST-READER-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)|
++ |(FAST-READER-METHOD PCL-CLASS CLASS-PRECEDENCE-LIST)|
++ |(FAST-READER-METHOD SLOT-OBJECT LAMBDA-LIST)|
++ |(FAST-READER-METHOD STANDARD-METHOD LAMBDA-LIST)|
++ |(FAST-READER-METHOD SLOT-OBJECT PRETTY-ARGLIST)|
++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION PRETTY-ARGLIST)|
+ |(FAST-READER-METHOD SLOT-OBJECT DIRECT-METHODS)|
+- |(FAST-READER-METHOD CLASS DIRECT-SUPERCLASSES)|
+- |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)|
+- |(FAST-READER-METHOD CLASS DIRECT-SUBCLASSES)|
++ |(FAST-READER-METHOD SLOT-OBJECT SLOTS)|
++ |(FAST-READER-METHOD SLOT-CLASS SLOTS)|
++ |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SLOTS)|
++ |(FAST-READER-METHOD SLOT-CLASS DIRECT-SLOTS)|
++ |(FAST-READER-METHOD SLOT-OBJECT METHODS)|
++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHODS)|
++ |(FAST-READER-METHOD SLOT-OBJECT OPTIONS)|
++ |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION OPTIONS)|
++ |(FAST-READER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)|
+ |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)|
++ |(FAST-READER-METHOD CLASS DIRECT-SUBCLASSES)|
++ |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)|
++ |(FAST-READER-METHOD CLASS DIRECT-SUPERCLASSES)|
+ SLOT-DEFINITION-CLASS EQL-SPECIALIZER-OBJECT
+ |PCL::DIRECT-SLOT-DEFINITION class predicate|
+ CLASS-CONSTRUCTORS |(BOUNDP WRAPPER)| SLOTS-TO-INSPECT
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT NAME)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT DFUN-STATE)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOT-NAME)|
+ |(FAST-BOUNDP-METHOD SLOT-OBJECT PREDICATE-NAME)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOT-NAME)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DFUN-STATE)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT NAME)|
+ |(BOUNDP DEFSTRUCT-ACCESSOR-SYMBOL)|
+ SPECIALIZER-DIRECT-GENERIC-FUNCTIONS
+ |(BOUNDP CLASS-EQ-SPECIALIZER)|
+ |(SETF SLOT-DEFINITION-NAME)| ADD-WRITER-METHOD
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT METHOD-CLASS)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT ACCESSOR-FLAGS)|
+ |(FAST-BOUNDP-METHOD SLOT-OBJECT CLASS)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT DOCUMENTATION)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT METHOD-COMBINATION)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOT-DEFINITION)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT GENERIC-FUNCTION)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT FUNCTION)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT FAST-FUNCTION)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT LOCATION)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT READER-FUNCTION)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT WRITER-FUNCTION)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT BOUNDP-FUNCTION)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT ALLOCATION)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT ACCESSOR-FLAGS)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT METHOD-CLASS)|
+ |(FAST-BOUNDP-METHOD SLOT-OBJECT INITFUNCTION)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT ALLOCATION)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT BOUNDP-FUNCTION)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT WRITER-FUNCTION)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT READER-FUNCTION)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT LOCATION)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT FAST-FUNCTION)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT FUNCTION)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT GENERIC-FUNCTION)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOT-DEFINITION)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT METHOD-COMBINATION)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DOCUMENTATION)|
+ |(BOUNDP OPERATOR)| |(BOUNDP ARG-INFO)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT SPECIALIZERS)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT READERS)|
+ |(FAST-BOUNDP-METHOD SLOT-OBJECT WRITERS)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT OBJECT)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT TYPE)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT READERS)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT SPECIALIZERS)|
+ |(FAST-BOUNDP-METHOD SLOT-OBJECT PROTOTYPE)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT INITFORM)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT TYPE)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT OBJECT)|
+ |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-FORM)|
+- |(SETF SLOT-DEFINITION-CLASS)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT INITFORM)|
+ |(SETF SLOT-VALUE-USING-CLASS)|
+- |(SETF SLOT-DEFINITION-LOCATION)|
+- |(SETF SLOT-DEFINITION-READER-FUNCTION)|
+- |(SETF SLOT-DEFINITION-WRITER-FUNCTION)|
+- |(SETF SLOT-DEFINITION-BOUNDP-FUNCTION)|
+- |(SETF SLOT-DEFINITION-INTERNAL-READER-FUNCTION)|
+- |(SETF SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION)|
+- |(SETF SLOT-DEFINITION-ALLOCATION)|
+- |(SETF SLOT-DEFINITION-INITFUNCTION)|
++ |(SETF SLOT-DEFINITION-CLASS)|
+ |(SETF SLOT-ACCESSOR-FUNCTION)|
++ |(SETF SLOT-DEFINITION-INITFUNCTION)|
++ |(SETF SLOT-DEFINITION-ALLOCATION)|
++ |(SETF SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION)|
++ |(SETF SLOT-DEFINITION-INTERNAL-READER-FUNCTION)|
++ |(SETF SLOT-DEFINITION-BOUNDP-FUNCTION)|
++ |(SETF SLOT-DEFINITION-WRITER-FUNCTION)|
++ |(SETF SLOT-DEFINITION-READER-FUNCTION)|
++ |(SETF SLOT-DEFINITION-LOCATION)|
+ |(BOUNDP DEFSTRUCT-CONSTRUCTOR)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT PRETTY-ARGLIST)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT LAMBDA-LIST)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)|
+ |(FAST-BOUNDP-METHOD SLOT-OBJECT PLIST)|
+- |(SETF SLOT-DEFINITION-READERS)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT LAMBDA-LIST)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT PRETTY-ARGLIST)|
+ |(SETF SLOT-DEFINITION-WRITERS)|
++ |(SETF SLOT-DEFINITION-READERS)|
+ |(SETF SLOT-DEFINITION-TYPE)|
+ |(SETF SLOT-DEFINITION-INITFORM)|
+ |(BOUNDP INITIALIZE-INFO)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT OPTIONS)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT METHODS)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SLOTS)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOTS)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-METHODS)|
+ |(FAST-BOUNDP-METHOD SLOT-OBJECT FROM-DEFCLASS-P)|
+- |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-METHODS)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOTS)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SLOTS)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT METHODS)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT OPTIONS)|
+ |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)|
++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)|
+ |(FAST-INTERNAL-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)|
+ |(BOUNDP INITARGS)| LONG-METHOD-COMBINATION-FUNCTION
+ GENERIC-FUNCTION-P
+- |PCL::SLOT-DEFINITION class predicate|
+- |LISP::NULL class predicate| |(READER NAME)|
+- |(READER CLASS)| |(FAST-METHOD SLOT-MISSING (T T T T))|
++ |PCL::SLOT-DEFINITION class predicate| |(READER NAME)|
++ |(READER CLASS)| |(FAST-METHOD SLOT-UNBOUND (T T T))|
+ |(FAST-METHOD (SETF DOCUMENTATION) (T T))|
+- |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))|
+- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))|
+- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))|
+- |(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))|
+- |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))|
+- |(FAST-METHOD SLOT-UNBOUND (T T T))|
+- |(FAST-METHOD REMOVE-NAMED-METHOD (T T))|
+- |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))|
++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))|
+ |(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))|
+ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))|
+- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))|
+ |(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))|
++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))|
++ |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))|
++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))|
++ |(FAST-METHOD REMOVE-NAMED-METHOD (T T))|
++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))|
+ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))|
++ |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))|
+ |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))|
+- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))|
+- |(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))|
+- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))|
+- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))|
+- |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))|
++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))|
++ |(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))|
++ |(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))|
++ |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))|
++ |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))|
++ |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))|
++ |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))|
++ |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))|
++ |(FAST-METHOD PRINT-OBJECT (CLASS T))|
++ |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))|
++ |(FAST-METHOD PRINT-OBJECT (T T))|
++ |(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))|
++ |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))|
++ |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))|
++ |(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))|
++ |(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))|
++ |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))|
++ |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))|
++ |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))|
++ |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))|
++ |(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))|
++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))|
++ |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))|
++ |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))|
++ |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))|
++ |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))|
++ |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))|
++ |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))|
++ |(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))|
++ |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))|
++ |(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))|
++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))|
++ |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))|
++ |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))|
++ |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))|
++ |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))|
++ |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))|
++ |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))|
++ |(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))|
++ |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))|
+ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))|
++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))|
+ |(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))|
++ |(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))|
++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))|
++ |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))|
++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))|
++ |(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))|
++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))|
++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))|
+ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))|
+- |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))|
+- |(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))|
+ |(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))|
+- |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))|
+- |(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))|
+- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))|
+- |(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))|
+- |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))|
+- |(FAST-METHOD DESCRIBE-OBJECT (T T))|
+- |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))|
+- |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))|
+- |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))|
+ |(FAST-METHOD DESCRIBE-OBJECT (CLASS T))|
++ |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))|
++ |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))|
+ |(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))|
++ |(FAST-METHOD DESCRIBE-OBJECT (T T))|
+ |(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))|
+ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))|
+ |(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))|
++ |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))|
++ |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))|
+ |(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))|
++ |(FAST-METHOD SLOT-MISSING (T T T T))|
+ |(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))|
+- |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))|
+- |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))|
+- |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))|
+- |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))|
+- |(FAST-METHOD PRINT-OBJECT (T T))|
+- |(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))|
+- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))|
+- |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))|
+- |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))|
+- |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))|
+- |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))|
+- |(FAST-METHOD PRINT-OBJECT (CLASS T))|
+- |(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))|
+- |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))|
+- |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))|
+- |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))|
+- |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))|
+- |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))|
+- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))|
+- |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))|
+- |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))|
+- |(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))|
+- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))|
+- |(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))|
+- |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))|
+- |(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))|
+- |(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))|
+- |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))|
+- |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))|
+- |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))|
+- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))|
+- |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))|
+- |(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))|
+- |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))|
+- |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))|
+- |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))|
+- LEGAL-SLOT-NAME-P |(READER OBJECT)| |(READER TYPE)|
++ LEGAL-SLOT-NAME-P |(READER TYPE)| |(READER OBJECT)|
+ CLASS-WRAPPER |(READER PLIST)|
+- |(FAST-METHOD NO-APPLICABLE-METHOD (T))|
+- |(FAST-METHOD DOCUMENTATION (T))|
+ |(FAST-METHOD CLASS-PREDICATE-NAME (T))|
++ |(FAST-METHOD DOCUMENTATION (T))|
++ |(FAST-METHOD NO-APPLICABLE-METHOD (T))|
+ |(READER SLOTS)| |(WRITER NAME)| DEFINITION-SOURCE
+ |PCL::SLOT-OBJECT class predicate| DEFAULT-INITARGS
+- |(WRITER CLASS)| CLASS-SLOT-VALUE |(WRITER OBJECT)|
+- |(WRITER TYPE)|
++ |(WRITER CLASS)| CLASS-SLOT-VALUE |(WRITER TYPE)|
++ |(WRITER OBJECT)|
+ |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))|
+ |(WRITER PLIST)| |(WRITER SLOTS)|
+ |PCL::DOCUMENTATION-MIXIN class predicate|
+@@ -1309,37 +1563,55 @@
+ LEGAL-QUALIFIER-P METHOD-P
+ |PCL::SPECIALIZER-WITH-OBJECT class predicate|
+ CLASS-SLOT-CELLS
+- |(COMBINED-METHOD REINITIALIZE-INSTANCE)|
+ |(COMBINED-METHOD INITIALIZE-INSTANCE)|
++ |(COMBINED-METHOD REINITIALIZE-INSTANCE)|
+ STANDARD-ACCESSOR-METHOD-P |(SETF CLASS-NAME)|
+- STANDARD-METHOD-P STANDARD-READER-METHOD-P
+- STANDARD-GENERIC-FUNCTION-P |(READER WRAPPER)|
++ STANDARD-GENERIC-FUNCTION-P STANDARD-READER-METHOD-P
++ STANDARD-METHOD-P |(READER WRAPPER)|
+ |(READER DEFSTRUCT-ACCESSOR-SYMBOL)|
+ |(READER CLASS-EQ-SPECIALIZER)|
+- COMPUTE-DEFAULT-INITARGS
+ COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS
+- |(SETF CLASS-DEFSTRUCT-FORM)|
++ COMPUTE-DEFAULT-INITARGS |(SETF CLASS-DEFSTRUCT-FORM)|
+ |(CALL REAL-MAKE-METHOD-LAMBDA)|
+ |(SETF CLASS-INCOMPATIBLE-SUPERCLASS-LIST)|
+- |SETF PCL CLASS-SLOT-VALUE| |(SETF CLASS-DIRECT-SLOTS)|
+- |(SETF CLASS-SLOTS)| DO-STANDARD-DEFSETF-1
+- |(READER OPERATOR)| |(CALL REAL-ADD-METHOD)|
+- |(CALL REAL-REMOVE-METHOD)| |(CALL REAL-GET-METHOD)|
++ |COMMON-LISP::NULL class predicate|
++ |COMMON-LISP::SYMBOL class predicate|
++ |COMMON-LISP::CHARACTER class predicate|
++ |COMMON-LISP::BIT-VECTOR class predicate|
++ |COMMON-LISP::STRING class predicate|
++ |COMMON-LISP::VECTOR class predicate|
++ |COMMON-LISP::ARRAY class predicate|
++ |COMMON-LISP::CONS class predicate|
++ |COMMON-LISP::LIST class predicate|
++ |COMMON-LISP::SEQUENCE class predicate|
++ |COMMON-LISP::RATIO class predicate|
++ |COMMON-LISP::INTEGER class predicate|
++ |COMMON-LISP::RATIONAL class predicate|
++ |COMMON-LISP::FLOAT class predicate|
++ |COMMON-LISP::COMPLEX class predicate|
++ |COMMON-LISP::NUMBER class predicate|
++ |COMMON-LISP::T class predicate|
++ |COMMON-LISP::STRUCTURE-OBJECT class predicate|
++ |COMMON-LISP::STANDARD-OBJECT class predicate|
++ |COMMON-LISP::BUILT-IN-CLASS class predicate|
++ |SETF PCL CLASS-SLOT-VALUE| |(SETF CLASS-SLOTS)|
++ |(SETF CLASS-DIRECT-SLOTS)| DO-STANDARD-DEFSETF-1
++ |(READER OPERATOR)| |(CALL REAL-GET-METHOD)|
++ |(CALL REAL-REMOVE-METHOD)| |(CALL REAL-ADD-METHOD)|
+ |(READER ARG-INFO)| METHOD-COMBINATION-TYPE
+ |(READER DEFSTRUCT-CONSTRUCTOR)|
+ |(INTERNAL-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)|
+ |(READER INITIALIZE-INFO)| |(WRITER WRAPPER)|
+- STANDARD-CLASS-P |LISP::NUMBER class predicate|
+- LEGAL-SPECIALIZER-P
++ STANDARD-CLASS-P LEGAL-SPECIALIZER-P
+ |PCL::LONG-METHOD-COMBINATION class predicate|
+ |(WRITER DEFSTRUCT-ACCESSOR-SYMBOL)|
+ COMPUTE-SLOT-ACCESSOR-INFO |(READER INITARGS)|
+ |(WRITER CLASS-EQ-SPECIALIZER)|
+ STANDARD-BOUNDP-METHOD-P FDEFINE-CAREFULLY
+ |(SETF DOCUMENTATION)| RAW-INSTANCE-ALLOCATOR
+- |SETF PCL CLASS-INITIALIZE-INFO|
+ |SETF PCL SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL|
+- |(WRITER OPERATOR)| |(WRITER ARG-INFO)|
++ |SETF PCL CLASS-INITIALIZE-INFO| |(WRITER OPERATOR)|
++ |(WRITER ARG-INFO)|
+ COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO
+ STANDARD-WRITER-METHOD-P
+ CLASS-INCOMPATIBLE-SUPERCLASS-LIST
+@@ -1349,78 +1621,77 @@
+ METHOD-COMBINATION-DOCUMENTATION
+ |SETF PCL SLOT-DEFINITION-INITARGS|
+ REMOVE-BOUNDP-METHOD ADD-NAMED-METHOD
+- |(WRITER INITARGS)|
+ |SETF PCL CLASS-DEFSTRUCT-CONSTRUCTOR|
+- |LISP::CONS class predicate| |(BOUNDP METHOD)|
+- |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION NAME)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT NAME)|
+- |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION DFUN-STATE)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT DFUN-STATE)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT SLOT-NAME)|
+- |(FAST-WRITER-METHOD SLOT-DEFINITION NAME)|
+- |(FAST-WRITER-METHOD CLASS NAME)|
++ |(WRITER INITARGS)| |(BOUNDP METHOD)|
+ |(FAST-WRITER-METHOD SLOT-OBJECT PREDICATE-NAME)|
++ |(FAST-WRITER-METHOD CLASS NAME)|
++ |(FAST-WRITER-METHOD SLOT-DEFINITION NAME)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT SLOT-NAME)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT DFUN-STATE)|
++ |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION DFUN-STATE)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT NAME)|
++ |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION NAME)|
+ |(BOUNDP SOURCE)| |(SETF GF-DFUN-STATE)|
+ SHORT-COMBINATION-OPERATOR
+- |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHOD-CLASS)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT METHOD-CLASS)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT ACCESSOR-FLAGS)|
+- |(FAST-WRITER-METHOD SLOT-DEFINITION CLASS)|
+ |(FAST-WRITER-METHOD SLOT-OBJECT CLASS)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT DOCUMENTATION)|
+- |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHOD-COMBINATION)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT METHOD-COMBINATION)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT SLOT-DEFINITION)|
+- |(FAST-WRITER-METHOD STANDARD-METHOD GENERIC-FUNCTION)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT GENERIC-FUNCTION)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT FUNCTION)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT FAST-FUNCTION)|
+- |(FAST-WRITER-METHOD STANDARD-EFFECTIVE-SLOT-DEFINITION LOCATION)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT LOCATION)|
+- |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION READER-FUNCTION)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT READER-FUNCTION)|
+- |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION WRITER-FUNCTION)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT WRITER-FUNCTION)|
+- |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION BOUNDP-FUNCTION)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT BOUNDP-FUNCTION)|
+- |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-READER-FUNCTION)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)|
+- |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-WRITER-FUNCTION)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)|
+- |(FAST-WRITER-METHOD STANDARD-SLOT-DEFINITION ALLOCATION)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT ALLOCATION)|
+- |(FAST-WRITER-METHOD SLOT-DEFINITION INITFUNCTION)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT INITFUNCTION)|
++ |(FAST-WRITER-METHOD SLOT-DEFINITION CLASS)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT ACCESSOR-FLAGS)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT METHOD-CLASS)|
++ |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHOD-CLASS)|
+ |(FAST-WRITER-METHOD TRACED-METHOD GENERIC-FUNCTION)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT SPECIALIZERS)|
+- |(FAST-WRITER-METHOD SLOT-DEFINITION READERS)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT READERS)|
+- |(FAST-WRITER-METHOD SLOT-DEFINITION WRITERS)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT INITFUNCTION)|
++ |(FAST-WRITER-METHOD SLOT-DEFINITION INITFUNCTION)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT ALLOCATION)|
++ |(FAST-WRITER-METHOD STANDARD-SLOT-DEFINITION ALLOCATION)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)|
++ |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-WRITER-FUNCTION)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)|
++ |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-READER-FUNCTION)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT BOUNDP-FUNCTION)|
++ |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION BOUNDP-FUNCTION)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT WRITER-FUNCTION)|
++ |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION WRITER-FUNCTION)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT READER-FUNCTION)|
++ |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION READER-FUNCTION)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT LOCATION)|
++ |(FAST-WRITER-METHOD STANDARD-EFFECTIVE-SLOT-DEFINITION LOCATION)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT FAST-FUNCTION)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT FUNCTION)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT GENERIC-FUNCTION)|
++ |(FAST-WRITER-METHOD STANDARD-METHOD GENERIC-FUNCTION)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT SLOT-DEFINITION)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT METHOD-COMBINATION)|
++ |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHOD-COMBINATION)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT DOCUMENTATION)|
+ |(FAST-WRITER-METHOD SLOT-OBJECT WRITERS)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT OBJECT)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT TYPE)|
+- |(FAST-WRITER-METHOD SLOT-DEFINITION TYPE)|
++ |(FAST-WRITER-METHOD SLOT-DEFINITION WRITERS)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT READERS)|
++ |(FAST-WRITER-METHOD SLOT-DEFINITION READERS)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT SPECIALIZERS)|
+ |(FAST-WRITER-METHOD SLOT-OBJECT PROTOTYPE)|
++ |(FAST-WRITER-METHOD SLOT-DEFINITION TYPE)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT TYPE)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT OBJECT)|
+ REMOVE-NAMED-METHOD
+- |(FAST-WRITER-METHOD SLOT-DEFINITION INITFORM)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT INITFORM)|
+- |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)|
+ |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-FORM)|
+- |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION PRETTY-ARGLIST)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT PRETTY-ARGLIST)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT LAMBDA-LIST)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)|
+- |(FAST-WRITER-METHOD PCL-CLASS INCOMPATIBLE-SUPERCLASS-LIST)|
+- |(FAST-WRITER-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)|
+- |(FAST-WRITER-METHOD PLIST-MIXIN PLIST)|
++ |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT INITFORM)|
++ |(FAST-WRITER-METHOD SLOT-DEFINITION INITFORM)|
+ |(FAST-WRITER-METHOD SLOT-OBJECT PLIST)|
++ |(FAST-WRITER-METHOD PLIST-MIXIN PLIST)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)|
++ |(FAST-WRITER-METHOD PCL-CLASS INCOMPATIBLE-SUPERCLASS-LIST)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT LAMBDA-LIST)|
++ |(FAST-WRITER-METHOD SLOT-OBJECT PRETTY-ARGLIST)|
++ |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION PRETTY-ARGLIST)|
+ LEGAL-DOCUMENTATION-P CLASS-DIRECT-SUPERCLASSES
+ CLASS-DIRECT-SUBCLASSES CLASS-DIRECT-DEFAULT-INITARGS
+ SLOT-DEFINITION-READERS SLOT-VALUE-USING-CLASS
+- COMPUTE-APPLICABLE-METHODS CLASS-NAME CLASSP
+- CLASS-PROTOTYPE READER-METHOD-CLASS REMOVE-METHOD
++ COMPUTE-APPLICABLE-METHODS CLASS-NAME CLASS-PROTOTYPE
++ CLASSP READER-METHOD-CLASS REMOVE-METHOD
+ SLOT-DEFINITION-INITFORM
+ UPDATE-INSTANCE-FOR-REDEFINED-CLASS
+ UPDATE-INSTANCE-FOR-DIFFERENT-CLASS CHANGE-CLASS
+@@ -1454,5 +1725,6 @@
+ ENSURE-CLASS-USING-CLASS NO-APPLICABLE-METHOD
+ SLOT-DEFINITION-WRITERS
+ COMPUTE-APPLICABLE-METHODS-USING-CLASSES
+- CLASS-PRECEDENCE-LIST))
++ CLASS-PRECEDENCE-LIST DISASSEMBLE DESCRIBE-OBJECT
++ COMPILE))
+ (SETF (GET V 'SYSTEM::PROCLAIMED-CLOSURE) T))
+--- gcl-2.6.12.orig/unixport/makefile
++++ gcl-2.6.12/unixport/makefile
+@@ -69,42 +69,7 @@ $(LSPDIR)/auto_new.lsp: $(LSPDIR)/auto.l
+ [ "$(RL_OBJS)" = "" ] || \
+ echo "(AUTOLOAD 'init-readline '|readline|)" >>$@
+
+-init_gcl.lsp.tmp: init_gcl.lsp.in
+- cp $< $@
+-
+-init_pre_gcl.lsp.tmp: init_pre_gcl.lsp.in
+- cp $< $@
+-
+-init_mod_gcl.lsp.tmp: init_mod_gcl.lsp.in
+- cp $< $@
+-
+-init_xgcl.lsp.tmp: init_gcl.lsp.tmp
+- ln -snf $< $@
+-
+-init_pcl_gcl.lsp.tmp: init_pcl_gcl.lsp.in ../cmpnew/gcl_cmpmain.lsp \
+- ../pcl/sys-package.lisp ../clcs/package.lisp \
+- $(shell find ../clcs/ -name "clcs_*.lisp")
+-
+- awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} {if (i==0) print}' $< >$@
+-# cat ../cmpnew/gcl_cmpmain.lsp >>$@
+- cat ../pcl/sys-package.lisp >>$@
+- awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} {if (i==1) print}' $< >>$@
+-
+-init_ansi_gcl.lsp.tmp: init_ansi_gcl.lsp.in ../cmpnew/gcl_cmpmain.lsp \
+- ../pcl/sys-package.lisp ../clcs/package.lisp
+-
+- awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} \
+- /^ *@LI-CLCS-PACKAGE@/{i=2;next} {if (i==0) print}' $< >$@
+-# cat ../cmpnew/gcl_cmpmain.lsp >>$@
+- cat ../pcl/sys-package.lisp >>$@
+- awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} \
+- /^ *@LI-CLCS-PACKAGE@/{i=2;next} {if (i==1) print}' $< >>$@
+- cat ../clcs/package.lisp >>$@
+- awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} \
+- /^ *@LI-CLCS-PACKAGE@/{i=2;next} {if (i==2) print}' $< >>$@
+-
+-
+-init_%.lsp: init_%.lsp.tmp
++sys_init.lsp: sys_init.lsp.in
+
+ cat $< | sed \
+ -e "s#@LI-VERS@#(`cat ../majvers`.`cat ../minvers`) `date`#1" \
+@@ -118,14 +83,14 @@ init_%.lsp: init_%.lsp.tmp
+ -e "s#@LI-OPT-TWO@#\"$(O2FLAGS)\"#1" \
+ -e "s#@LI-INIT-LSP@#\"$@\"#1" >$@
+
+-saved_%:raw_% $(RSYM) init_%.lsp raw_%_map msys \
++saved_%:raw_% $(RSYM) sys_init.lsp raw_%_map msys \
+ $(CMPDIR)/gcl_cmpmain.lsp \
+ $(CMPDIR)/gcl_lfun_list.lsp \
+ $(CMPDIR)/gcl_cmpopt.lsp $(HDIR)/cmpinclude.h \
+ $(LSPDIR)/gcl_auto_new.lsp
+
+- cp init_$*.lsp foo
+- echo " (in-package \"USER\")(system:save-system \"$@\")" >>foo
++ cp sys_init.lsp foo
++ echo "(unless si::*quit-tags* (in-package \"USER\")(system:save-system \"$@\"))" >>foo
+ ar x lib$*.a $$(ar t lib$*.a |grep ^gcl_)
+ $(PORTDIR)/raw_$*$(EXE) $(PORTDIR)/ -libdir $(GCLDIR)/ < foo
+ # check that saved image can be prelinked
+@@ -194,7 +159,7 @@ map_%:
+ clean:
+ rm -rf saved_*$(EXE) raw_*$(EXE) *.o core a.out $(RSYM) \
+ $(LSPDIR)/auto_new.lsp foo *maxima* init_*.lsp lib*.a gmp* bfd* *.lsp.tmp \
+- gazonk*.lsp plt*h *_map saved_* lib* raw_* msys out* log* tmp* gcl.script
++ gazonk*.lsp plt*h *_map saved_* lib* raw_* msys out* log* tmp* gcl.script sys_init.lsp
+
+ .INTERMEDIATE: init_ansi_gcl.lsp.tmp init_gcl.lsp.tmp raw_gcl raw_ansi_gcl
+ .PRECIOUS: init_pre_gcl.lsp init_gcl.lsp init_ansi_gcl.lsp
+--- gcl-2.6.12.orig/unixport/sys_ansi_gcl.c
++++ gcl-2.6.12/unixport/sys_ansi_gcl.c
+@@ -7,6 +7,10 @@ void
+ gcl_init_init()
+ {
+
++ object features;
++ features=find_symbol(make_simple_string("*FEATURES*"),system_package);
++ features->s.s_dbind=make_cons(make_keyword("ANSI-CL"),make_cons(make_keyword("COMMON-LISP"),features->s.s_dbind));
++
+ build_symbol_table();
+
+ lsp_init("../lsp/gcl_export.lsp");
+@@ -86,7 +90,7 @@ gcl_init_system(object no_init)
+ ar_check_init(gcl_cmpmain,no_init);
+
+ #ifdef HAVE_XGCL
+- lsp_init("../xgcl-2/sysdef.lisp");
++ lsp_init("../xgcl-2/package.lisp");
+ ar_check_init(gcl_Xlib,no_init);
+ ar_check_init(gcl_Xutil,no_init);
+ ar_check_init(gcl_X,no_init);
+--- gcl-2.6.12.orig/unixport/sys_gcl.c
++++ gcl-2.6.12/unixport/sys_gcl.c
+@@ -83,7 +83,7 @@ gcl_init_system(object no_init) {
+ ar_check_init(gcl_cmpmain,no_init);
+
+ #ifdef HAVE_XGCL
+- lsp_init("../xgcl-2/sysdef.lisp");
++ lsp_init("../xgcl-2/package.lisp");
+ ar_check_init(gcl_Xlib,no_init);
+ ar_check_init(gcl_Xutil,no_init);
+ ar_check_init(gcl_X,no_init);
+--- /dev/null
++++ gcl-2.6.12/unixport/sys_init.lsp.in
+@@ -0,0 +1,82 @@
++(make-package :compiler :use '(:lisp :si))
++(make-package :sloop :use '(:lisp))
++(make-package :ansi-loop :use'(:lisp))
++(make-package :defpackage :use '(:lisp))
++(make-package :tk :use '(:lisp :sloop))
++(make-package :fpe :use '(:lisp))
++(make-package :cltl1-compat)
++
++(in-package :system)
++(use-package :fpe)
++
++#+(or pcl ansi-cl)(load "../pcl/package.lisp")
++#+ansi-cl(load "../clcs/package.lisp")
++
++(init-system)
++(in-package :si)
++(gbc t)
++
++(unless *link-array*
++ (setq *link-array* (make-array (ash 1 11) :element-type 'character :fill-pointer 0)))
++(use-fast-links t)
++
++(let* ((x (append (pathname-directory *system-directory*) (list :parent)))
++ (lsp (append x (list "lsp")))
++ (cmpnew (append x (list "cmpnew")))
++ (h (append x (list "h")))
++ (xgcl-2 (append x (list "xgcl-2")))
++ (pcl (append x (list "pcl")))
++ (clcs (append x (list "clcs")))
++ (gtk (append x (list "gcl-tk"))))
++ (dolist (d (list lsp cmpnew #-pre-gcl xgcl-2 #+(or pcl ansi-cl) pcl #+ansi-cl clcs))
++ (load (make-pathname :name "sys-proclaim" :type "lisp" :directory d)))
++ (load (make-pathname :name "tk-package" :type "lsp" :directory gtk))
++ (load (make-pathname :name "gcl_lfun_list" :type "lsp" :directory cmpnew))
++ (load (make-pathname :name "gcl_cmpopt" :type "lsp" :directory cmpnew))
++ (load (make-pathname :name "gcl_auto_new" :type "lsp" :directory lsp))
++
++ (gbc t))
++
++(setf (symbol-function 'clear-compiler-properties)
++ (symbol-function 'compiler::compiler-clear-compiler-properties))
++
++(terpri)
++(setq *inhibit-macro-special* t)
++(gbc t)
++(reset-gbc-count)
++
++(defun top-level nil (gcl-top-level))
++
++(set-up-top-level)
++
++(setq *gcl-extra-version* @LI-EXTVERS@
++ *gcl-minor-version* @LI-MINVERS@
++ *gcl-major-version* @LI-MAJVERS@)
++
++(defvar *system-banner* (default-system-banner))
++(setq *optimize-maximum-pages* t)
++
++(fmakunbound 'init-cmp-anon)
++(when (fboundp 'user-init) (user-init))
++(in-package :compiler)
++(setq *cc* @LI-CC@
++ *ld* @LI-LD@
++ *ld-libs* @LI-LD-LIBS@
++ *opt-three* @LI-OPT-THREE@
++ *opt-two* @LI-OPT-TWO@
++ *init-lsp* @LI-INIT-LSP@)
++
++(import 'si::(clines defentry defcfun object void int double
++ quit bye gbc system commonp
++ *break-on-warnings*
++ make-char char-bits char-font char-bit set-char-bit string-char-p int-char
++ char-font-limit char-bits-limit char-control-bit
++ char-meta-bit char-super-bit char-hyper-bit compiler-let) :cltl1-compat)
++(deftype cltl1-compat::string-char nil 'character)
++(do-symbols (s :cltl1-compat) (export s :cltl1-compat))
++
++#-ansi-cl(use-package :cltl1-compat :lisp)
++#-ansi-cl(do-symbols (s :cltl1-compat) (export s :lisp)))
++(export '*load-pathname* :si);For maxima, at least as of 5.34.1
++
++#+ansi-cl (use-package :pcl :user)
+--- gcl-2.6.12.orig/unixport/sys_pcl_gcl.c
++++ gcl-2.6.12/unixport/sys_pcl_gcl.c
+@@ -7,6 +7,10 @@ void
+ gcl_init_init()
+ {
+
++ object features;
++ features=find_symbol(make_simple_string("*FEATURES*"),system_package);
++ features->s.s_dbind=make_cons(make_keyword("PCL"),features->s.s_dbind);
++
+ build_symbol_table();
+
+ lsp_init("../lsp/gcl_export.lsp");
+@@ -86,7 +90,7 @@ gcl_init_system(object no_init)
+ ar_check_init(gcl_cmpmain,no_init);
+
+ #ifdef HAVE_XGCL
+- lsp_init("../xgcl-2/sysdef.lisp");
++ lsp_init("../xgcl-2/package.lisp");
+ ar_check_init(gcl_Xlib,no_init);
+ ar_check_init(gcl_Xutil,no_init);
+ ar_check_init(gcl_X,no_init);
+--- gcl-2.6.12.orig/unixport/sys_pre_gcl.c
++++ gcl-2.6.12/unixport/sys_pre_gcl.c
+@@ -4,6 +4,10 @@ void
+ gcl_init_init()
+ {
+
++ object features;
++ features=find_symbol(make_simple_string("*FEATURES*"),system_package);
++ features->s.s_dbind=make_cons(make_keyword("PRE-GCL"),features->s.s_dbind);
++
+ build_symbol_table();
+
+ lsp_init("../lsp/gcl_export.lsp");
+@@ -80,6 +84,7 @@ gcl_init_system(object no_init)
+ lsp_init("../cmpnew/gcl_cmpvar.lsp");
+ lsp_init("../cmpnew/gcl_cmpvs.lsp");
+ lsp_init("../cmpnew/gcl_cmpwt.lsp");
++ lsp_init("../cmpnew/gcl_cmpmain.lsp");
+
+
+ }
+--- gcl-2.6.12.orig/xgcl-2/gcl_init_xgcl.lsp
++++ gcl-2.6.12/xgcl-2/gcl_init_xgcl.lsp
+@@ -36,8 +36,8 @@
+ (progn (allocate 'cons 100) (allocate 'string 40)
+ (system:init-system) (gbc t)
+ (si::multiply-bignum-stack 25)
+- (or lisp::*link-array*
+- (setq lisp::*link-array*
++ (or si::*link-array*
++ (setq si::*link-array*
+ (make-array 500 :element-type 'fixnum :fill-pointer 0)))
+ (use-fast-links t)
+ (setq compiler::*cmpinclude* "<cmpinclude.h>") (load #"../cmpnew/cmpmain.lsp") (gbc t) (load #"../cmpnew/lfun_list.lsp")
+--- gcl-2.6.12.orig/xgcl-2/makefile
++++ gcl-2.6.12/xgcl-2/makefile
+@@ -4,10 +4,13 @@
+ all: objects #docs
+
+ objects: $(LISP)
+- echo '(load "sysdef.lisp")(xlib::compile-xgcl)' | $(LISP)
++ echo '(load "sysdef.lisp")(load "sys-proclaim.lisp")(xlib::compile-xgcl)' | $(LISP)
+
+ saved_xgcl: $(LISP)
+- echo '(load "sysdef.lisp")(xlib::compile-xgcl)(xlib::save-xgcl "$@")' | $(LISP)
++ echo '(load "sysdef.lisp")(load "sys-proclaim.lisp")(xlib::compile-xgcl)(xlib::save-xgcl "$@")' | $(LISP)
++
++sys-proclaim.lisp:
++ echo '(load "sysdef.lisp")(compiler::emit-fn t)(xlib::compile-xgcl)(compiler::make-all-proclaims "*.fn")' | $(LISP)
+
+ docs: dwdoc/dwdoccontents.html dwdoc.pdf
+
+@@ -22,7 +25,7 @@ dwdoc.pdf: dwdoc.tex
+
+ clean:
+ rm -f *.o *.data saved_* cmpinclude.h dwdoc.aux dwdoc.log gmon.out
+- rm -f gcl*c gcl*h gcl*data gcl_xrecompile* user-init*
++ rm -f gcl*c gcl*h gcl*data gcl_xrecompile* user-init* *fn
+
+ clean-docs:
+ rm -rf dwdoc dwdoc.pdf
+--- /dev/null
++++ gcl-2.6.12/xgcl-2/package.lisp
+@@ -0,0 +1 @@
++(make-package :XLIB :use '(:lisp :system))
+--- /dev/null
++++ gcl-2.6.12/xgcl-2/sys-proclaim.lisp
+@@ -0,0 +1,287 @@
++
++(COMMON-LISP::IN-PACKAGE "COMMON-LISP-USER")
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*)
++ XLIB::WINDOW-UNSET XLIB::WINDOW-GET-GEOMETRY
++ XLIB::WINDOW-SET-INVERT XLIB::WINDOW-FONT-INFO
++ XLIB::GET-ST-POINT XLIB::EDITMENU-YANK
++ XLIB::WINDOW-INIT-MOUSE-POLL XLIB::WINDOW-SET-XOR
++ XLIB::WINDOW-TOP-NEG-Y XLIB::WINDOW-LEFT
++ XLIB::WINDOW-QUERY-POINTER XLIB::TEXTMENU-DRAW
++ XLIB::EDITMENU-CARAT XLIB::EDITMENU-DRAW
++ XLIB::WINDOW-STD-LINE-ATTR XLIB::WINDOW-UNMAP
++ XLIB::WINDOW-QUERY-POINTER-B XLIB::WINDOW-BACKGROUND
++ XLIB::EDITMENU-DELETE XLIB::WINDOW-MOVE XLIB::DOWINDOWCOM
++ XLIB::WINDOW-SYNC XLIB::PICMENU-DRAW XLIB::WINDOW-MAP
++ XLIB::WINDOW-RESET-COLOR XLIB::EDITMENU-KILL
++ XLIB::BARMENU-DRAW XLIB::WINDOW-GET-GEOMETRY-B
++ XLIB::MENU-CLEAR XLIB::WINDOW-RESET XLIB::WINDOW-WFUNCTION
++ XLIB::MENU-DRAW XLIB::WINDOW-FOREGROUND XLIB::WINDOW-CLEAR
++ XLIB::EDITMENU-BACKSPACE XLIB::WINDOW-DRAW-BORDER
++ XLIB::LISP-STRING XLIB::WINDOW-SET-ERASE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T)
++ XLIB::OPEN-WINDOW))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::T)
++ XLIB::WINDOW-GET-ELLIPSE XLIB::EDITMENU-SELECT
++ XLIB::WINDOW-SET-XCOLOR XLIB::TEXTMENU-SELECT
++ XLIB::PICMENU-SELECT XLIB::MAKECONT XLIB::WINDOW-GET-CIRCLE
++ XLIB::MENU XLIB::WINDOW-GET-REGION XLIB::TEXTMENU-SET-TEXT
++ XLIB::MENU-SELECT XLIB::BARMENU-SELECT
++ XLIB::PICMENU-CREATE-FROM-SPEC XLIB::PRINTINDEX
++ XLIB::EDITMENU-EDIT XLIB::MENU-CREATE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::*)
++ XLIB::BARMENU-UPDATE-VALUE XLIB::WINDOW-FONT-STRING-WIDTH
++ XLIB::MENU-FIND-ITEM-WIDTH XLIB::WINDOW-STRING-WIDTH
++ XLIB::PICMENU-BOX-ITEM XLIB::WINDOW-SET-FOREGROUND
++ XLIB::WINDOW-INVERTAREA XLIB::PICMENU-UNBOX-ITEM
++ XLIB::PICMENU-DRAW-NAMED-BUTTON XLIB::WINDOW-SET-CURSOR
++ XLIB::WINDOW-SET-LINE-WIDTH XLIB::PICMENU-DELETE-NAMED-BUTTON
++ XLIB::EDITMENU-ERASE XLIB::PICMENU-DRAW-BUTTON
++ XLIB::WINDOW-SET-BACKGROUND))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*)
++ XLIB::XINIT XLIB::WINDOW-SCREEN-HEIGHT))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
++ (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T))
++ XLIB::WINDOW-CIRCLE-RADIUS))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::*)
++ XLIB::WINDOW-XOR-BOX-XY XLIB::WINDOW-DRAW-BOX-CORNERS
++ XLIB::WINDOW-DRAW-LINE-XY XLIB::WINDOW-DRAW-ARROW2-XY
++ XLIB::WINDOW-DRAW-ARROW-XY XLIB::WINDOW-DRAW-ELLIPSE-XY
++ XLIB::WINDOW-ERASE-BOX-XY XLIB::WINDOW-DRAW-BOX-XY
++ XLIB::WINDOW-DRAW-ARROWHEAD-XY))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T)
++ COMMON-LISP::*)
++ XLIB::WINDOW-COPY-AREA-XY))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::*)
++ XLIB::WINDOW-PRETTYPRINTAT XLIB::MENU-UNBOX-ITEM
++ XLIB::WINDOW-PRINTAT XLIB::WINDOW-DRAW-CROSSHAIRS-XY
++ XLIB::WINDOW-MOVETO-XY XLIB::WINDOW-INVERT-AREA
++ XLIB::WINDOW-DRAW-DOT-XY XLIB::WINDOW-DRAW-CARAT
++ XLIB::WINDOW-ERASE-AREA XLIB::MENU-BOX-ITEM
++ XLIB::WINDOW-DRAW-CROSS-XY))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::*)
++ XLIB::WINDOW-DRAW-CIRCLE-XY XLIB::WINDOW-PRINT-LINE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T)
++ COMMON-LISP::*)
++ XLIB::WINDOW-PRETTYPRINTAT-XY XLIB::WINDOW-DRAW-CIRCLE-PT
++ XLIB::EDITMENU-DISPLAY XLIB::WINDOW-PRINTAT-XY
++ XLIB::WINDOW-PROCESS-CHAR-EVENT XLIB::MENU-DISPLAY-ITEM))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::*)
++ XLIB::WINDOW-ADJ-BOX-XY))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::*)
++ XLIB::WINDOW-DRAW-ARC-XY))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::*)
++ XLIB::WINDOW-DRAW-ELLIPSE-PT XLIB::WINDOW-ERASE-AREA-XY
++ XLIB::WINDOW-INVERT-AREA-XY XLIB::WINDOW-DRAW-VECTOR-PT))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::*)
++ COMMON-LISP::*)
++ XLIB::WINDOW-DRAW-LINE XLIB::WINDOW-DRAW-BOX
++ XLIB::WINDOW-DRAW-CIRCLE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::*)
++ COMMON-LISP::*)
++ XLIB::WINDOW-DRAW-RCBOX-XY))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::*)
++ XLIB::WINDOW-DRAW-LATEX-XY))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::*)
++ XLIB::WINDOW-SET-LINE-ATTR))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::*)
++ XLIB::WINDOW-DRAW-BOX-LINE-XY))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::T)
++ XLIB::WINDOW-POSITIVE-Y XLIB::WINDOW-STRING-EXTENTS
++ XLIB::MENU-CHOOSE XLIB::WINDOW-SET-FONT XLIB::PUSHFONT
++ XLIB::WINDOW-STRING-HEIGHT XLIB::WORDLIST<
++ XLIB::EDITMENU-LINE-Y XLIB::MENU-ITEM-Y
++ XLIB::MENU-FIND-ITEM-HEIGHT XLIB::XFERCHARS
++ XLIB::WINDOW-CENTEROFFSET XLIB::MENU-FIND-ITEM-Y
++ XLIB::EDITMENU-CHAR XLIB::MENU-ITEM-VALUE
++ XLIB::MENU-FIND-ITEM))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::*)
++ XLIB::WINDOW-FREE-COLOR))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T)
++ XLIB::SEARCHFORALPHA XLIB::SAFE-CHAR XLIB::WINDOW-XINIT
++ XLIB::WINDOW-MENU XLIB::WINDOW-INIT-KEYMAP XLIB::PARSE-INT
++ XLIB::WINDOW-DESTROY-SELECTED-WINDOW
++ XLIB::WINDOW-GET-MOUSE-POSITION))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::FIXNUM)
++ XLIB::FLUSHLINE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::T)
++ XLIB::PICMENU-BUTTON-CONTAINSXY? XLIB::MENU-MOVETO-XY
++ XLIB::WINDOW-GET-BOX-SIZE XLIB::PRINTINDEXN
++ XLIB::WINDOW-GET-LINE-POSITION
++ XLIB::PICMENU-SET-NAMED-BUTTON-COLOR XLIB::EDITMENU-SETXY
++ XLIB::MENU-SELECT-B XLIB::MENU-REPOSITION-LINE
++ XLIB::WINDOW-GET-VECTOR-END))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::T)
++ XLIB::WINDOW-CREATE XLIB::WINDOW-TRACK-MOUSE
++ XLIB::PICMENU-ITEM-POSITION XLIB::WINDOW-GET-CHARS
++ XLIB::TEXTMENU-CREATE XLIB::EDITMENU-CREATE XLIB::TOHTML
++ XLIB::WINDOW-SET-COLOR XLIB::MENU-ITEM-POSITION))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::T)
++ XLIB::WINDOW-INPUT-STRING XLIB::PICMENU-CREATE-SPEC
++ XLIB::WINDOW-SET-COLOR-RGB XLIB::WINDOW-PRINT-LINES
++ XLIB::PICMENU-CREATE))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::*)
++ COMMON-LISP::T)
++ XLIB::WINDOW-GET-ICON-POSITION XLIB::BARMENU-CREATE
++ XLIB::WINDOW-GET-LATEX-POSITION XLIB::WINDOW-GET-BOX-POSITION))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::T)
++ XLIB::WINDOW-EDIT XLIB::WINDOW-TRACK-MOUSE-IN-REGION))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
++ COMMON-LISP::T)
++ XLIB::WINDOW-ADJUST-BOX-SIDE XLIB::EDITMENU-EDIT-FN))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION
++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
++ COMMON-LISP::T COMMON-LISP::*)
++ COMMON-LISP::T)
++ XLIB::WINDOW-GET-BOX-LINE-POSITION))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T)
++ XLIB::WINDOW-DESTROY XLIB::EDITMENU-CALCULATE-SIZE
++ XLIB::STRINGIFY XLIB::DOLINE XLIB::PUSHENV
++ XLIB::WINDOW-POLL-MOUSE XLIB::WINDOW-FONT XLIB::WINDOW-SIZE
++ XLIB::EDITMENU-END XLIB::WINDOW-PAINT XLIB::WINDOW-GEOMETRY
++ XLIB::MENU-DESTROY XLIB::WINDOW-LABEL
++ XLIB::PICMENU-CALCULATE-SIZE XLIB::POPENV XLIB::WINDOW-PARENT
++ XLIB::WINDOW-WAIT-UNMAP XLIB::EDITMENU-INIT
++ XLIB::WINDOW-GET-POINT XLIB::MENU-SELECT!
++ XLIB::MENU-CALCULATE-SIZE XLIB::BARMENU-INIT XLIB::DOCOMMAND
++ XLIB::MENU-INIT XLIB::WINDOW-OPEN XLIB::EDITMENU-META-B
++ XLIB::WINDOW-GET-RAW-CHAR XLIB::WINDOW-DRAWABLE-HEIGHT
++ XLIB::MENU-REPOSITION XLIB::WINDOW-YPOSITION
++ XLIB::EDITMENU-ALPHANUMBERICP XLIB::EDITMENU-NEXT
++ XLIB::MENU-SIZE XLIB::EDITMENU-PREVIOUS XLIB::EDITMENU-FORWARD
++ XLIB::EDITMENU-BEGINNING XLIB::PICMENU-DESTROY
++ XLIB::WINDOW-RESET-GEOMETRY XLIB::WINDOW-GCONTEXT
++ XLIB::EDITMENU-BACKWARD XLIB::TERMLINE
++ XLIB::WINDOW-DRAWABLE-WIDTH XLIB::WINDOW-GET-CROSSHAIRS
++ XLIB::BARMENU-CALCULATE-SIZE XLIB::WINDOW-CHAR-DECODE
++ XLIB::DOTABULAR XLIB::PICMENU-INIT XLIB::WINDOW-WAIT-EXPOSURE
++ XLIB::PARSE-WORD XLIB::TEXTMENU-INIT XLIB::SEARCHFOR
++ XLIB::MENU-OFFSET XLIB::MENU-ADJUST-OFFSET
++ XLIB::WINDOW-SET-COPY XLIB::TEXTMENU-CALCULATE-SIZE
++ XLIB::WINDOW-GET-CROSS XLIB::EDITMENU-META-F
++ XLIB::WINDOW-GET-CLICK XLIB::EDITMENU-CURRENT-CHAR
++ XLIB::DOHTML XLIB::WINDOW-CLOSE XLIB::EDITMENU-RETURN
++ XLIB::WINDOW-CODE-CHAR))
++(COMMON-LISP::PROCLAIM
++ '(COMMON-LISP::FTYPE
++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*)
++ XLIB::WINDOW-FORCE-OUTPUT))
+\ No newline at end of file
+--- gcl-2.6.12.orig/xgcl-2/sysdef.lisp
++++ gcl-2.6.12/xgcl-2/sysdef.lisp
+@@ -19,9 +19,8 @@
+ ; Some of the files that interface to the Xlib are adapted from DEC/MIT files.
+ ; See the file dec.copyright for details.
+
+-(make-package :XLIB)
++(load "package.lisp")
+ (in-package :XLIB)
+-(sys::use-package '(:lisp :system :sys))
+
+ (defvar *files* '( "gcl_Xlib"
+ "gcl_Xutil"
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-10) unstable; urgency=medium
+ .
+ * rebuild in clean sid environment
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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);
++ rb_pointer=init ? rb_start : rb_end;
++ rb_limit=rb_pointer+(nrbpage<<PAGEWIDTH);
++
++ alloc_page(-(2*nrbpage+((new_rb_start-heap_end)>>PAGEWIDTH)));
++
++}
++
++void
+ resize_hole(ufixnum hp,enum type tp) {
+
+- char *new_start=heap_end+hp*PAGESIZE;
+ char *start=rb_pointer<rb_end ? rb_start : rb_end;
+ ufixnum size=rb_pointer-start;
+
+- if ((new_start<start && new_start+size>=start) || (new_start<start+size && new_start+size>=start+size)) {
++ new_rb_start=heap_end+hp*PAGESIZE;
++
++ if ((new_rb_start<start && new_rb_start+size>=start) || (new_rb_start<start+size && new_rb_start+size>=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<<PAGEWIDTH);
+- }
++ if (rb_start==heap_end && rb_end==rb_start && rb_limit==rb_start && rb_pointer==rb_start)
++ resize_hole(new_holepage,t_relocatable);
+ }
+
+ void
+@@ -1345,11 +1361,9 @@ gcl_init_alloc(void *cs_start) {
+ initial_sbrk=data_start=heap_end;
+ first_data_page=page(data_start);
+
+- holepage=new_holepage;
+-
+ #ifdef GCL_GPROF
+- if (holepage<textpage)
+- holepage=textpage;
++ if (new_holepage<textpage)
++ new_holepage=textpage;
+ #endif
+
+ /* Unused (at present) tm_distinct flag added. Note that if cons
+@@ -1401,12 +1415,8 @@ gcl_init_alloc(void *cs_start) {
+
+ set_tm_maxpage(tm_table+t_relocatable,1);
+ nrbpage=0;
+-
+- alloc_page(-(holepage + 2*nrbpage));
+
+- rb_start = rb_pointer = heap_end + PAGESIZE*holepage;
+- rb_end = rb_start + PAGESIZE*nrbpage;
+- rb_limit = rb_end - 2*RB_GETA;
++ resize_hole(new_holepage,t_relocatable);
+ #ifdef SGC
+ tm_table[(int)t_relocatable].tm_sgc = 50;
+ #endif
+@@ -1912,7 +1922,7 @@ void *
+ realloc(void *ptr, size_t size) {
+
+ object x;
+- int i, j;
++ int i;
+ /* was allocated by baby_malloc */
+ #ifdef BABY_MALLOC_SIZE
+ if (ptr >= (void*)baby_malloc_data && ptr - (void*)baby_malloc_data <BABY_MALLOC_SIZE)
+@@ -1938,17 +1948,10 @@ realloc(void *ptr, size_t size) {
+ x->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_BITS_CHAR);
+-#ifdef CONTBLOCK_MARK_DEBUG
+- off_check(v,ve,i,pi);
+-#endif
+- v[i]|=(1UL<<s);
+-}
++/* 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_BITS_CHAR); */
++/* #ifdef CONTBLOCK_MARK_DEBUG */
++/* off_check(v,ve,i,pi); */
++/* #endif */
++/* v[i]|=(1UL<<s); */
++/* } */
+
+ #define bit_get(v,i,s) ((v[i]>>s)&0x1)
+ #define bit_set(v,i,s) (v[i]|=(1UL<<s))
+@@ -237,10 +228,10 @@ get_mark_bit(struct pageinfo *pi,void *x
+ return get_bit(CB_MARK_START(pi),pi,x);
+ }
+
+-static inline void
+-set_mark_bit(struct pageinfo *pi,void *x) {
+- set_bit(CB_MARK_START(pi),pi,x);
+-}
++/* static inline void */
++/* set_mark_bit(struct pageinfo *pi,void *x) { */
++/* set_bit(CB_MARK_START(pi),pi,x); */
++/* } */
+
+ static inline void *
+ get_mark_bits(struct pageinfo *pi,void *x) {
+@@ -252,15 +243,17 @@ set_mark_bits(struct pageinfo *pi,void *
+ set_bits(CB_MARK_START(pi),pi,x1,x2);
+ }
+
++#ifdef SGC
++
+ static inline char
+ get_sgc_bit(struct pageinfo *pi,void *x) {
+ return get_bit(CB_SGCF_START(pi),pi,x);
+ }
+
+-static inline void
+-set_sgc_bit(struct pageinfo *pi,void *x) {
+- set_bit(CB_SGCF_START(pi),pi,x);
+-}
++/* static inline void */
++/* set_sgc_bit(struct pageinfo *pi,void *x) { */
++/* set_bit(CB_SGCF_START(pi),pi,x); */
++/* } */
+
+ static inline void *
+ get_sgc_bits(struct pageinfo *pi,void *x) {
+@@ -272,6 +265,8 @@ set_sgc_bits(struct pageinfo *pi,void *x
+ set_bits(CB_SGCF_START(pi),pi,x1,x2);
+ }
+
++#endif
++
+ #ifdef KCLOVM
+ void mark_all_stacks();
+ bool ovm_process_created;
+@@ -1067,7 +1062,7 @@ contblock_sweep_phase(void) {
+
+ z=get_mark_bit(v,s);
+ for (p=s;p<e;) {
+- q=get_bits(CB_MARK_START(v),v,p);
++ q=get_mark_bits(v,p);
+ if (!z)
+ insert_contblock(p,q-p);
+ z=1-z;
+@@ -1107,6 +1102,19 @@ int (*GBC_exit_hook)() = NULL;
+
+ fixnum fault_pages=0;
+
++static ufixnum
++count_contblocks(void) {
++
++ ufixnum ncb;
++ struct contblock *cbp;
++
++ for (ncb=0,cbp=cb_pointer;cbp;cbp=cbp->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<rb_end) ? rb_end : rb_start;
+- rb_limit=rb_pointer+(new_end-new_start);
+- }
+-
+- alloc_page(-(holepage+2*nrbpage));
+-
+- }
++ if (COLLECT_RELBLOCK_P)
++ setup_rb();
+
+ #ifdef DEBUG
+ if (debug) {
+@@ -1254,8 +1249,8 @@ GBC(enum type t) {
+
+ if (COLLECT_RELBLOCK_P) {
+
+- rb_start = heap_end + PAGESIZE*holepage;
+- rb_end = heap_end + (holepage + nrbpage) *PAGESIZE;
++ /* rb_start = new_rb_start; */
++ /* rb_end = rb_start + nrbpage*PAGESIZE; */
+
+
+ #ifdef SGC
+@@ -1332,6 +1327,7 @@ GBC(enum type t) {
+
+ #ifdef DEBUG
+ if (debug) {
++ int i,j;
+ for (i = 0, j = 0; i < (int)t_end; i++) {
+ if (tm_table[i].tm_type == (enum type)i) {
+ printf("%13s: %8ld used %8ld free %4ld/%ld pages\n",
+@@ -1346,8 +1342,8 @@ GBC(enum type t) {
+ tm_table[i].tm_name,
+ tm_table[(int)tm_table[i].tm_type].tm_name);
+ }
+- printf("contblock: %ld blocks %ld pages\n", ncb, ncbpage);
+- printf("hole: %ld pages\n", holepage);
++ printf("contblock: %ld blocks %ld pages\n", count_contblocks(), ncbpage);
++ printf("hole: %ld pages\n", ((rb_start-heap_end)>>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<<i;
+ vs_push(make_fixnum(((unsigned long)cs_base+i-1)&-i));
+- vs_push(make_fixnum(abs(cs_base-cs_org)));
++ vs_push(make_fixnum(labs(cs_base-cs_org)));
+ vs_push(make_fixnum((CSTACK_DIRECTION+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_pointer<rb_end ? rb_start : rb_end)));
+ vs_push(make_fixnum((rb_pointer<rb_end ? rb_end : (rb_end+(rb_end-rb_start))) - rb_pointer));
+ vs_push(make_fixnum(nrbpage));
+--- gcl-2.6.12.orig/o/hash.d
++++ gcl-2.6.12/o/hash.d
+@@ -152,7 +152,7 @@ BEGIN:
+ if (depth++ <=3)
+ switch ((tx=type_of(x))) {
+ case t_cons:
+- h^=ihash_equal(x->c.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<t_other;i++) {
++ for (i=t_start;i<t_other;i++)
+ massert(set_tm_maxpage(tm_table+i,tm_table[i].tm_npage));
+- j+=tm_table[i].tm_maxpage;
+- }
++
+ resv_pages=40<available_pages ? 40 : available_pages;
+ available_pages-=resv_pages;
+
+@@ -270,13 +277,11 @@ update_real_maxpage(void) {
+ for (i=t_start,j=0;i<t_relocatable;i++)
+ j+=tm_table[i].tm_maxpage;
+
+- if (j<free_phys_pages) {
+- for (i=t_start,k=0;i<t_relocatable;i++)
+- if (tm_table[i].tm_maxpage) {
+- massert(set_tm_maxpage(tm_table+i,((double)0.7*free_phys_pages/j)*tm_table[i].tm_maxpage));
+- k+=tm_table[i].tm_maxpage;
+- }
+- set_tm_maxpage(tm_table+t_relocatable,(free_phys_pages-k)>>1);
++ if (j<phys_pages) {
++ for (i=t_start;i<t_relocatable;i++)
++ if (tm_table[i].tm_maxpage)
++ massert(set_tm_maxpage(tm_table+i,((double)0.7*phys_pages/j)*tm_table[i].tm_maxpage));
++ set_tm_maxpage(tm_table+t_relocatable,(phys_pages+(tm_table[t_relocatable].tm_maxpage<<1)-sum_maxpages())>>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;"
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-12) unstable; urgency=medium
+ .
+ * Version_2_6_13pre13
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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<new_rb_start ? rb_start : new_rb_start;/*do not allow static promotion to go past this point*/
+ setup_rb();
++ }
+
+ #ifdef DEBUG
+ if (debug) {
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-12) unstable; urgency=medium
+ .
+ * Version_2_6_13pre13
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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 <<EOFF
+ #include <math.h>
+ #include <stdio.h>
+-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 <stdio.h>
+ #include <stdlib.h>
+- 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 <stdio.h>
+ #include <stdlib.h>
+- 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 <stdio.h>
+ #include <stdlib.h>
+- 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 <stdio.h>
+ #include <stdlib.h>
+- 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 <stdio.h>
+ #include <stdlib.h>
+- 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 <<EOFF
+ #include <math.h>
+ #include <stdio.h>
+-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 <stdio.h>
+ #include <stdlib.h>
+- 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 <stdio.h>
+ #include <stdlib.h>
+- 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 <stdio.h>
+ #include <stdlib.h>
+- 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 <stdio.h>
+ #include <stdlib.h>
+- 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 <stdio.h>
+ #include <stdlib.h>
+- 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 <limits.h>
+
+
++#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 <unistd.h>
++#include <stdio.h>
++#include <stdarg.h>
++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 <sys/types.h>
++#include <sys/stat.h>
++#include <fcntl.h>
++#include <sys/mman.h>
++#include <errno.h>
++
++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);
+- rb_pointer=init ? rb_start : rb_end;
+- rb_limit=rb_pointer+(nrbpage<<PAGEWIDTH);
+-
++ if (!preserve_rb_pointerp)
++ rb_pointer=lowp ? rb_start : rb_end;
++ rb_limit=rb_begin()+(nrbpage<<PAGEWIDTH);
++ pool_check();
++
+ alloc_page(-(2*nrbpage+((new_rb_start-heap_end)>>PAGEWIDTH)));
+
+ }
+
+ void
+-resize_hole(ufixnum hp,enum type tp) {
++resize_hole(ufixnum hp,enum type tp,bool in_placep) {
+
+- char *start=rb_pointer<rb_end ? rb_start : rb_end;
++ char *start=rb_begin(),*new_start=heap_end+hp*PAGESIZE;
+ ufixnum size=rb_pointer-start;
+
+- new_rb_start=heap_end+hp*PAGESIZE;
+-
+- if ((new_rb_start<start && new_rb_start+size>=start) || (new_rb_start<start+size && new_rb_start+size>=start+size)) {
+- fprintf(stderr,"Toggling relblock when resizing hole to %lu\n",hp);
+- fflush(stderr);
++ if (!in_placep &&
++ ((new_start<=start && start<new_start+size) || (new_start<start+size && start+size<=new_start+size))) {
++ emsg("Toggling relblock when resizing hole to %lu\n",hp);
+ tm_table[t_relocatable].tm_adjgbccnt--;
+ GBC(t_relocatable);
+- return resize_hole(hp,tp);
++ return resize_hole(hp,tp,in_placep);
+ }
+
+- if (size) {
++ new_rb_start=new_start;
++
++ if (!size || in_placep)
++ setup_rb(in_placep);
++ else {
+ tm_of(tp)->tm_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<d ? new_holepage : d;
++ d=(available_pages/3)<d ? (available_pages/3) : d;
+
+- resize_hole(d+nn,t_relocatable);
++ emsg("Hole overrun\n");
++
++ resize_hole(d+nn,t_relocatable,0);
+
+ }
+ }
+@@ -390,11 +397,13 @@ alloc_page(long n) {
+ e=heap_end;
+ v=e+nn*PAGESIZE;
+
+- if (!s)
++ if (!s) {
+
+ heap_end=v;
+-
+- else if (v>(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;i<t_other;i++)
+- if (tm_table+i!=my_tm)
+- k+=(tm_table[i].tm_maxpage-tm_table[i].tm_npage)*(i==t_relocatable ? 2 : 1);
+-
+- e=e>k ? k : e;
+- if (e+phys_pages<=j)
+- return 0;
+-
+- f=k ? 1.0-(double)e/k : 1.0;
+-
+- for (i=t_start;i<t_other;i++)
+- if (tm_table[i].tm_npage && tm_table+i!=my_tm) {
+- massert(set_tm_maxpage(tm_table+i,tm_table[i].tm_npage+f*(tm_table[i].tm_maxpage-tm_table[i].tm_npage)));
+- }
+-
+- massert(set_tm_maxpage(my_tm,(my_tm->tm_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);tm<tme;tm++) {
+- x+=tm->tm_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+n<rb_end+nrbpage*PAGESIZE)
+- rb_limit=rb_pointer+n;
++ /* if (rb_pointer>rb_end && rb_pointer+n>rb_limit && rb_pointer+n<rb_end+nrbpage*PAGESIZE)/\**\/ */
++ /* rb_limit=rb_pointer+n; */
+ if (rb_limit-rb_pointer>n)
+ return ((rb_pointer+=n)-n);
+ break;
+@@ -847,7 +766,7 @@ too_full_p(struct typemanager *tm) {
+
+ switch (tm->tm_type) {
+ case t_relocatable:
+- return 100*(rb_limit-rb_pointer)<pf*(rb_end-rb_start);
++ return 100*(rb_limit-rb_pointer)<pf*rb_size();
+ break;
+ case t_contiguous:
+ for (cbp=cb_pointer,k=0;cbp;cbp=cbp->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<textpage)
+- new_holepage=textpage;
+-#endif
++/* #ifdef GCL_GPROF */
++/* if (new_holepage<textpage) */
++/* new_holepage=textpage; */
++/* #endif */
+
+ /* Unused (at present) tm_distinct flag added. Note that if cons
+ and fixnum share page types, errors will be introduced.
+@@ -1416,7 +1350,7 @@ gcl_init_alloc(void *cs_start) {
+ set_tm_maxpage(tm_table+t_relocatable,1);
+ nrbpage=0;
+
+- resize_hole(new_holepage,t_relocatable);
++ resize_hole(ufmin(phys_pages,available_pages/3),t_relocatable,0);
+ #ifdef SGC
+ tm_table[(int)t_relocatable].tm_sgc = 50;
+ #endif
+@@ -1620,7 +1554,7 @@ DEFUN_NEW("ALLOCATED-RELOCATABLE-PAGES",
+
+ DEFUN_NEW("GET-HOLE-SIZE",object,fSget_hole_size,SI,0,0,NONE,OO,OO,OO,OO,(void),"") {
+ /* 0 args */
+- RETURN1((make_fixnum(new_holepage)));
++ RETURN1(make_fixnum((rb_start-heap_end)>>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_start<new_rb_start ? rb_start : new_rb_start;/*do not allow static promotion to go past this point*/
+- setup_rb();
++ setup_rb(0);
+ }
+
+ #ifdef DEBUG
+@@ -1243,10 +1241,6 @@ GBC(enum type t) {
+
+ if (COLLECT_RELBLOCK_P) {
+
+- /* rb_start = new_rb_start; */
+- /* rb_end = rb_start + nrbpage*PAGESIZE; */
+-
+-
+ #ifdef SGC
+ if (sgc_enabled)
+ wrimap=(void *)sSAwritableA->s.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_pointer<rb_end ? rb_start : rb_end)));
+- vs_push(make_fixnum((rb_pointer<rb_end ? rb_end : (rb_end+(rb_end-rb_start))) - rb_pointer));
++ vs_push(make_fixnum(rb_pointer - rb_begin()));
++ vs_push(make_fixnum((rb_begin()+rb_size()) - rb_pointer));
+ vs_push(make_fixnum(nrbpage));
+ vs_push(make_fixnum(maxrbpage));
+ vs_push(make_fixnum(rbgbccount));
+@@ -1533,13 +1499,13 @@ DEFUN_NEW("CONTIGUOUS-REPORT",object,fSc
+
+ 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);
++ 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;k<contblock_array->v.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;k<tm->tm_nppage;k++,p+=tm->tm_size) {
+ object o=p;
+ if (!is_free(o) && type_of(o)==t_cfdata && (void *)o->cfd.cfd_start>=data_start) {
+- fprintf(stderr,"%lu code bytes at %p\n",(unsigned long)o->cfd.cfd_size,o->cfd.cfd_start);
++ 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 <stdio.h>
+ #include <stdlib.h>
+ #include <unistd.h>
++#include <sys/time.h>
++#include <sys/types.h>
+ #include <string.h>
+ #include <readline/history.h>
+
+--- 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<t_other;i++)
++ npages+=tm_table[i].tm_maxpage=tm_table[i].tm_npage;
++
++ massert(scale*maxpages>=npages);
++
++ maxpages*=scale;
++ phys_pages*=scale;
++ real_maxpage=maxpages+page(beg);
++
++ resv_pages=available_pages=0;
++ available_pages=check_avail_pages();
++
++ resv_pages=40<available_pages ? 40 : available_pages;
++ available_pages-=resv_pages;
++
++ recent_allocation=0;
++
++}
++
+ void *initial_sbrk=NULL;
+
+ int
+@@ -231,7 +294,6 @@ update_real_maxpage(void) {
+
+ ufixnum i,j;
+ void *end,*cur,*beg;
+- ufixnum maxpages;
+ #ifdef __MINGW32__
+ static fixnum n;
+
+@@ -241,8 +303,6 @@ update_real_maxpage(void) {
+ }
+ #endif
+
+- phys_pages=get_phys_pages_no_malloc(0);
+-
+ massert(cur=sbrk(0));
+ beg=data_start ? data_start : cur;
+ for (i=0,j=(1L<<log_maxpage_bound);j>PAGESIZE;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;i<t_other;i++)
+- massert(set_tm_maxpage(tm_table+i,tm_table[i].tm_npage));
+-
+- resv_pages=40<available_pages ? 40 : available_pages;
+- available_pages-=resv_pages;
+-
+- if (sSAoptimize_maximum_pagesA && sSAoptimize_maximum_pagesA->s.s_dbind!=Cnil) {
+-
+- for (i=t_start,j=0;i<t_relocatable;i++)
+- j+=tm_table[i].tm_maxpage;
+-
+- if (j<phys_pages) {
+- for (i=t_start;i<t_relocatable;i++)
+- if (tm_table[i].tm_maxpage)
+- massert(set_tm_maxpage(tm_table+i,((double)0.7*phys_pages/j)*tm_table[i].tm_maxpage));
+- set_tm_maxpage(tm_table+t_relocatable,(phys_pages+(tm_table[t_relocatable].tm_maxpage<<1)-sum_maxpages())>>1);
+- }
+-
+- new_holepage=0;
+- for (i=t_start;i<t_relocatable;i++)
+- new_holepage+=tm_table[i].tm_maxpage-tm_table[i].tm_npage;
+-
+- } else
+- new_holepage=available_pages/starting_hole_div;
+-
+ return 0;
+
+ }
+@@ -298,12 +325,11 @@ update_real_maxpage(void) {
+ static int
+ minimize_image(void) {
+
+- extern long new_holepage;
+ fixnum i;
+
+ empty_relblock();
+ nrbpage=0;
+- resize_hole(0,t_relocatable);
++ resize_hole(0,t_relocatable,0);
+
+ #ifdef GCL_GPROF
+ gprof_cleanup();
+@@ -330,10 +356,10 @@ DEFUN_NEW("SET-LOG-MAXPAGE-BOUND",object
+ l=l<def ? l : def;
+ end=data_start+(1L<<l)-PAGESIZE;
+ GBC(t_relocatable);
+- dend=heap_end+PAGESIZE+CEI(rb_pointer-(rb_pointer<rb_end ? rb_start : rb_end),PAGESIZE);
++ dend=heap_end+PAGESIZE+CEI(rb_pointer-rb_begin(),PAGESIZE);
+ if (end >= 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 <string.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
+@@ -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,"<socket 0x%x>",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<n && i<FPRC+1 && isdigit(p[i]);i++)
++ for (i=0;i<n && i<FPRC+1 && isdigit((int)p[i]);i++)
+ s[i] = p[i];
+ for (;i<n;i++)
+ s[i] = '0';
+--- gcl-2.6.12.orig/o/regexp.c
++++ gcl-2.6.12/o/regexp.c
+@@ -553,8 +553,8 @@ regatom(int *flagp)
+ *flagp |= HASWIDTH|SIMPLE;
+ }
+ if (regcp - buf > 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 <windows.h>
+-#define sleep(n) Sleep(1000 * n)
+-#endif
+-
+ #ifdef ATT3B2
+ #include <signal.h>
+ 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) (a<b?a :b)
+ p->token_st_dim = MINN(token->st.st_dim,tok_leng+1);
+--- /dev/null
++++ gcl-2.6.12/o/wpool.c
+@@ -0,0 +1,35 @@
++#include <stdio.h>
++
++#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;
++}
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-13) unstable; urgency=medium
+ .
+ * Version_2_6_13pre16
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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<available_pages ? 40 : available_pages;
++ resv_pages=available_pages/100;
+ available_pages-=resv_pages;
+
+ recent_allocation=0;
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-14) unstable; urgency=medium
+ .
+ * Version_2_6_13pre17
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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 && s<ggote) {
+- massert(!write_stub(s,got,gote));
+- } else
+- *gote=s;
++ *gote=s;
+ break;
+ case R_MIPS_HI16:
+ if (sym->st_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->address<ggote)
+- (*gs)+=5;
+-
+- return 0;
+-
+-}
++static ul gpd; static Rel *hr;
+
+ 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;p<pe;p+=sec->sh_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;sym<dse;sym++)
+- if (!sym->st_value || (sym->st_value>=stub && sym->st_value<stube))
+- sym->st_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;sym<syme;sym++) {
+- char *s=st1+sym->st_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<ggote) {
+- massert(!write_stub(s,got,gote));
+- } else
+- *gote=s+(a&~MASK(16))+((a&0x8000)<<1);
++ *gote=s+(a&~MASK(16))+((a&0x8000)<<1);
+ break;
+ case R_MIPS_GOT_OFST:
+ store_val(where,MASK(16),a);
+@@ -40,8 +37,9 @@
+ a&=~MASK(16);
+ {
+ Rela *ra=(void *)r;
+- for (hr=hr ? hr : (void *)ra;--ra>=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->address<ggote)
+- (*gs)+=3;
+-
+- 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;p<pe;p+=sec->sh_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;sym<dse;sym++)
+- if (!sym->st_value || (sym->st_value>=stub && sym->st_value<stube))
+- sym->st_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 <stdio.h>
+-#include <stdlib.h>
+-#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<k) {
++ if (j<=k) {
+ k=j;
+ n=c;
+ }
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-15) unstable; urgency=medium
+ .
+ * Version_2_6_13pre18
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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)()
+ {
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-2) unstable; urgency=medium
+ .
+ * Version_2_6_13pre1
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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<<PAGEWIDTH);
++ 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<<PAGEWIDTH);
++ }
+ return;
+ }
+
+@@ -1814,25 +1815,19 @@ void
+ free(void *ptr) {
+
+ object *p,pp;
++ static void *initial_monstartup_pointer_echo;
+
+ if (ptr == 0)
+ return;
+
+ 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 */
+ (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<sizeof(ptr) || ptr!=*(void **)heap_end) {
++ if (ptr!=initial_monstartup_pointer_echo) {
+ static void *old_ptr;
+ if (old_ptr==ptr) return;
+ old_ptr=ptr;
+ FEerror("free(3) error.",0);
+ }
++ initial_monstartup_pointer_echo=NULL;
+ return;
+ #endif
+ }
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-2) unstable; urgency=medium
+ .
+ * Version_2_6_13pre1
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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) \
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-2) unstable; urgency=medium
+ .
+ * Version_2_6_13pre1
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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_holepage<d ? new_holepage : d;
+
+- resize_hole(d+n,t_relocatable);
+-
+- }
++ if (in_signal_handler)/*FIXME*/
++ fprintf(stderr,"Can't 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);
+
+- holepage -= n;
++ resize_hole(d+nn,t_relocatable);
+
+- if (heap_end==core_end) {
+- /* can happen when mallocs occur before rel block set up..*/
+- sbrk(PAGESIZE*n);
+- core_end+=PAGESIZE*n;
+ }
++ }
+
+- {
+- void *e=heap_end;
+- heap_end+=PAGESIZE*n;
++ e=heap_end;
++ v=e+nn*PAGESIZE;
+
+- return(e);
+- }
++ if (!s) {
+
+- }
++ holepage -= nn;
++ heap_end=v;
++ return e;
+
+- /* n < 0 , then this says ensure there are -n pages
+- starting at heap_end, and return pointer to heap_end */
+- n=-n;
+- m=(core_end-heap_end)/PAGESIZE;
++ }
+
+- if (n<=m)
++ if (nn<=(core_end-heap_end)/PAGESIZE)
+ return(heap_end);
+
+- IF_ALLOCATE_ERR error("Can't allocate. Good-bye!");
++ if (mbrk(v))
++ error("Can't allocate. Good-bye!");
+
+- core_end+=PAGESIZE*(n-m);
++ core_end=v;
+
+ return(heap_end);
+
+@@ -692,7 +684,7 @@ 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",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+(uv<uc ? -m : m)) || mbrk(v);
++
+ return uc==(ufixnum)sbrk(uv-uc) ? 0 : -1;
++
+ }
+
+ #if defined(__CYGWIN__)||defined(__MINGW32__)
+@@ -451,7 +455,6 @@ main(int argc, char **argv, char **envp)
+ #ifdef NEED_STACK_CHK_GUARD
+ __stack_chk_guard=random_ulong();/*Cannot be safely set inside a function which returns*/
+ #endif
+- allocate_code_block_reserve();
+
+ }
+
+--- gcl-2.6.12.orig/o/sfaslelf.c
++++ gcl-2.6.12/o/sfaslelf.c
+@@ -268,20 +268,6 @@ alloc_memory(ul sz) {
+
+ }
+
+-void
+-allocate_code_block_reserve(void) {
+-
+- const char *s=getenv("GCL_CODESPACE");
+- ul n;
+-
+- if (!s || sscanf(s,"%lu",&n)!=1)
+- return;
+-
+- sSAcode_block_reserveA->s.s_dbind=alloc_simple_string(n);
+- sSAcode_block_reserveA->s.s_dbind->st.st_self=alloc_memory(n);
+-
+-}
+-
+ static object
+ load_memory(Shdr *sec1,Shdr *sece,void *v1,ul **got,ul **gote) {
+
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-16) unstable; urgency=medium
+ .
+ * Version_2_6_13pre19
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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;
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-17) unstable; urgency=medium
+ .
+ * Version_2_6_13pre20
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/configure
++++ gcl-2.6.12/configure
+@@ -6553,6 +6553,7 @@ else
+
+ #include <stdio.h>
+ #define EXTER
++ #define INLINE
+ #include "$MP_INCLUDE"
+ #include "./h/enum.h"
+ #define OBJ_ALIGN
+@@ -6681,6 +6682,7 @@ else
+ /* end confdefs.h. */
+ #include <stdio.h>
+ #define EXTER
++ #define INLINE
+ #include "$MP_INCLUDE"
+ #include "h/enum.h"
+ #include "h/type.h"
+@@ -6710,6 +6712,7 @@ else
+ /* end confdefs.h. */
+ #include <stdio.h>
+ #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 <stdio.h>
+ #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 <stdio.h>
+ #define EXTER
++ #define INLINE
+ #include "$MP_INCLUDE"
+ #include "h/enum.h"
+ #include "h/type.h"
+@@ -1357,6 +1359,7 @@ AC_TRY_RUN([#include <stdio.h>
+ else
+ AC_TRY_RUN([#include <stdio.h>
+ #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<ggote) {
++ massert(!write_stub(s,got,gote));
++ } else
++ *gote=s+(a&~MASK(16))+((a&0x8000)<<1);
+ break;
+ case R_MIPS_GOT_OFST:
+ 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
+@@ -1,4 +1,4 @@
+-static Rela *hr;
++static ul ggot,ggote; static Rela *hr;
+
+ #undef ELF_R_SYM
+ #define ELF_R_SYM(a_) (a_&0xffffffff)
+@@ -7,9 +7,66 @@ 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->address<ggote)
++ (*gs)+=3;
++
++ 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;p<pe;p+=sec->sh_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;sym<dse;sym++)
++ if (!sym->st_value || (sym->st_value>=stub && sym->st_value<stube))
++ sym->st_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)
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-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 <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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 <config-patches@gnu.org>.
+
+
+ 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)
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-20) unstable; urgency=medium
+ .
+ * Version_2_6_13pre25
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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 && s<ggote) {
++ massert(!write_stub(s,got,gote));
++ } else
++ *gote=s;
+ break;
+ case R_MIPS_HI16:
+ if (sym->st_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 <page.h>
++
++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;p<pe;p+=sec->sh_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;sym<dse;sym++)
++ if (!sym->st_value || (sym->st_value>=stub && sym->st_value<stube))
++ sym->st_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;sym<syme;sym++) {
+ const char *s=st1+sym->st_name;
+@@ -29,20 +109,32 @@ label_got_symbols(void *v1,Shdr *sec1,Sh
+ for (sym=sym1;sym<syme;sym++)
+ sym->st_size=0;
+
+- for (*gs=0,sec=sec1;sec<sece;sec++)
+- if (sec->sh_type==SHT_REL)
++ for (*gs=1,sec=sec1;sec<sece;sec++)/*can_gp in got[0]*/
++ if (sec->sh_type==SHT_REL)/*no addend*/
+ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;v<ve;v+=sec->sh_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->address<ggote)
++ (*gs)+=sizeof(call_16_tramp)/sizeof(ul)-1;
++ break;
++ case R_MIPS_GOT16:
++ sym->st_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;
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-21) unstable; urgency=medium
+ .
+ * Version_2_6_13pre26
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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 <limits.h>
+ #include <sys/stat.h>
+ #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 <stdio.h>
++#include <stdlib.h>
++#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 <stdio.h>
+-#include <stdlib.h>
+-#include "unrandomize.h"
+-#endif
+-
+ setbuf(stdin, stdin_buf);
+ setbuf(stdout, stdout_buf);
+ #ifdef _WIN32
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-23) unstable; urgency=medium
+ .
+ * Version_2_6_13pre28
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/h/linux.h
++++ gcl-2.6.12/h/linux.h
+@@ -132,20 +132,18 @@ do { int c = 0; \
+
+ #include <limits.h>
+ #include <sys/stat.h>
+-#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 && start<new_start+size) || (new_start<start+size && start+size<=new_start+size))) {
+- emsg("Toggling relblock when resizing hole to %lu\n",hp);
++ if (sSAnotify_gbcA->s.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)<d ? (available_pages/3) : d;
+
+- emsg("Hole overrun\n");
++ if (sSAnotify_gbcA && sSAnotify_gbcA->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 <sys/sysinfo.h>
++
+ 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 <stdio.h>
+ #include <stdlib.h>
+ #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;
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-23) unstable; urgency=medium
+ .
+ * Version_2_6_13pre28
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-3) unstable; urgency=medium
+ .
+ * Version_2_6_13pre2
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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 <signal.h>
+
+ 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<<PAGEWIDTH);
++ }
++}
++
++void
+ gcl_init_alloc(void *cs_start) {
+
+ fixnum cssize=(1L<<23);
+@@ -1261,11 +1266,7 @@ gcl_init_alloc(void *cs_start) {
+ update_real_maxpage();
+
+ if (gcl_alloc_initialized) {
+- 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<<PAGEWIDTH);
+- }
++ maybe_set_hole_from_maxpages();
+ return;
+ }
+
+--- gcl-2.6.12.orig/o/main.c
++++ gcl-2.6.12/o/main.c
+@@ -327,6 +327,7 @@ DEFUN_NEW("SET-LOG-MAXPAGE-BOUND",object
+ minimize_image();
+ log_maxpage_bound=l;
+ update_real_maxpage();
++ maybe_set_hole_from_maxpages();
+ }
+
+ return (object)log_maxpage_bound;
+--- gcl-2.6.12.orig/o/symbol.d
++++ gcl-2.6.12/o/symbol.d
+@@ -533,8 +533,8 @@ DEFVAR("*GENSYM-COUNTER*",sLgensym_count
+ set_up_string_register("");
+ sym = make_symbol(string_register);
+ {BEGIN_NO_INTERRUPT;
+- sym->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))
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-23) unstable; urgency=medium
+ .
+ * Version_2_6_13pre29
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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<ggote)
+- (*gs)+=3;
++ (*gs)+=sizeof(call_16_tramp)/sizeof(ul)-1;
+
+ return 0;
+
+--- gcl-2.6.12.orig/o/main.c
++++ gcl-2.6.12/o/main.c
+@@ -212,7 +212,7 @@ get_phys_pages_no_malloc(char freep) {
+
+ struct sysinfo s;
+ sysinfo(&s);
+- return (freep ? s.freeram : s.totalram)>>PAGEWIDTH;
++ return ((freep ? s.freeram : s.totalram)>>PAGEWIDTH)*s.mem_unit;
+
+ }
+
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-24) unstable; urgency=medium
+ .
+ * Version_2_6_13pre30
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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 <sys/types.h>
++#include <sys/sysctl.h>
++
++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)))<sizeof(b));
+- b[n]=0;
+- massert(!close(l));
+- massert((c=strstr(b,k)));
+- c+=strlen(k);
+- massert(sscanf(c,"%lu%n",&n,&m)==1);
+- massert(!strncmp(c+m," kB\n",4));
+- return n>>(PAGEWIDTH-10);
+ }
+
++#else /*Linux*/
++
+ #include <sys/sysinfo.h>
+
+ 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;
+
+ }
+
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-25) unstable; urgency=medium
+ .
+ * Version_2_6_13pre31, kfreebsd and mips64 FTBFS fix
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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) {
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-26) unstable; urgency=medium
+ .
+ * Version_2_6_13pre32
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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;w<u+s && !*w;w++);
++ RETURN1((object)(w-u));
++}
++
+
+ int
+ main(int argc, char **argv, char **envp) {
+--- gcl-2.6.12.orig/o/predicate.c
++++ gcl-2.6.12/o/predicate.c
+@@ -446,23 +446,9 @@ equal1(register object x, register objec
+
+ /*x and y are not == and not Cnil and not immfix*/
+
+-#ifdef __MINGW32__ /*FIXME mingw compiler cannot do tail recursion and blows out stack*/
+- BEGIN:
+- if (valid_cdr(x)) {
+- if (valid_cdr(y)&&equal(x->c.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)))
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-27) unstable; urgency=medium
+ .
+ * Version_2_6_13pre33; mips64 relocs; stack saving tail-recursive equal.
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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)))
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-27) unstable; urgency=medium
+ .
+ * Version_2_6_13pre34; mips64 relocs; stack saving tail-recursive equal.
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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) {
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-28) unstable; urgency=medium
+ .
+ * Version_2_6_13pre35; restore hppa build
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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;
+
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-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 <camm@debian.org>
+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: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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<r.rlim_cur;i++)
+- close(i);
+- errno=0;
+-
+- if ((i=open("/dev/null",O_RDWR))==-1)
+- FEerror("Can't open /dev/null for stdin",0);
+- if ((i=dup(i))==-1)
+- FEerror("Can't dup",0);
+- if ((i=dup(i))==-1)
+- FEerror("Can't dup twice",0);
++ close(i);/*FIXME some of this will return error*/
+
+- if (chdir("/"))
+- FEerror("Cannot chdir to /",0);
++ massert((i=open("/dev/null",O_RDWR))>=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
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-30) unstable; urgency=medium
+ .
+ * Version_2_6_13pre38
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-4) unstable; urgency=medium
+ .
+ * Version_2_6_13pre3
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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<d ? new_holepage : d;
+
+- if (in_signal_handler)/*FIXME*/
+- fprintf(stderr,"Can't 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);
+-
+ resize_hole(d+nn,t_relocatable);
+
+ }
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-4) unstable; urgency=medium
+ .
+ * Version_2_6_13pre3a
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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 p1<p2 ? -1 : (p1==p2 ? 0 : 1);
++
++}
++
++inline 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);
++ 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;i<t_other;i++)
+ if (tm_table[i].tm_npage) {
+ if (tm_table+i==my_tm) {
+- massert(set_tm_maxpage(tm_table+i,z));
++ massert(set_tm_maxpage(tm_table+i,z) || !fprintf(stderr,"%lu %lu %lu %lu %lu\n",i,z,tm_table[i].tm_npage,tm_table[i].tm_maxpage,available_pages));
+ } else {
+ massert(set_tm_maxpage(tm_table+i,tm_table[i].tm_npage+(1.0-(double)(j+d-phys_pages)/k)*(tm_table[i].tm_maxpage-tm_table[i].tm_npage)));
+ }
+@@ -562,7 +623,7 @@ 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=fSmake_vector1_2(16,aet_fix,Cnil,make_fixnum(0));
+ cbv->v.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;i<contblock_array->v.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*k<pf*j*PAGESIZE;
+ break;
+ default:
+@@ -833,8 +881,6 @@ alloc_after_gc(struct typemanager *tm,fi
+
+ }
+
+-struct pageinfo *contblock_list_head=NULL,*contblock_list_tail=NULL;
+-
+ inline void
+ add_pages(struct typemanager *tm,fixnum m) {
+
+@@ -890,7 +936,6 @@ alloc_after_adding_pages(struct typemana
+
+ }
+
+- /* m=tm->tm_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)<MAX_CODE_ADDRESS);
++
++ return v;
++
++}
++
+ inline void *
+ alloc_relblock(size_t n) {
+
+@@ -1316,6 +1389,7 @@ gcl_init_alloc(void *cs_start) {
+
+
+ ncbpage = 0;
++ tm_table[t_contiguous].tm_min_grow=256;
+ set_tm_maxpage(tm_table+t_contiguous,1);
+ #ifdef GCL_GPROF
+ if (maxcbpage<textpage)
+--- gcl-2.6.12.orig/o/array.c
++++ gcl-2.6.12/o/array.c
+@@ -445,6 +445,11 @@ fSmake_vector1_1(fixnum n,fixnum elt_typ
+ VFUN_NARGS=3;
+ return FFN(fSmake_vector1)(make_fixnum(n),make_fixnum(elt_type),staticp);
+ }
++object
++fSmake_vector1_2(fixnum n,fixnum elt_type,object staticp,object fillp) {
++ VFUN_NARGS=4;
++ return FFN(fSmake_vector1)(make_fixnum(n),make_fixnum(elt_type),staticp,fillp);
++}
+
+
+ static object DFLT_aet_object = Cnil;
+--- gcl-2.6.12.orig/o/gbc.c
++++ gcl-2.6.12/o/gbc.c
+@@ -36,9 +36,6 @@
+
+ #ifdef SGC
+ static void
+-sgc_contblock_sweep_phase(void);
+-
+-static void
+ sgc_sweep_phase(void);
+
+ static void
+@@ -142,8 +139,6 @@ off_check(void *v,void *ve,fixnum i,stru
+ }
+ #endif
+
+-void **contblock_stack_list=NULL;
+-
+ static inline bool
+ pageinfo_p(void *v) {
+
+@@ -163,28 +158,6 @@ in_contblock_stack_list(void *p,void ***
+ return a && a[0]==p;
+ }
+
+-inline struct pageinfo *
+-get_pageinfo(void *x) {
+-
+- 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) {
+ 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;i<contblock_array->v.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;i<v->in_use;i++) {
+- tv=pagetoinfo(page(v)+i);
+- if (pageinfo_p(tv)) {
+- a=contblock_stack_list;
+- /* fprintf(stderr,"pushing %p\n",tv); */
+- contblock_stack_list=alloca(2*sizeof(a));
+- contblock_stack_list[0]=tv;
+- contblock_stack_list[1]=a;
+- }
+- }
+- }
+-
+ if (in_signal_handler && t == t_relocatable)
+ error("cant gc relocatable in signal handler");
+
+@@ -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;k<contblock_array->v.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)<MAX_CODE_ADDRESS);
+-
+- return v;
+-
+-}
+-
+ static object
+ load_memory(Shdr *sec1,Shdr *sece,void *v1,ul **got,ul **gote) {
+
+@@ -301,7 +275,7 @@ load_memory(Shdr *sec1,Shdr *sece,void *
+ memory->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;i<contblock_array->v.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;p<e;) {
+- q=get_mark_bits(v,p);
+- if (!z)
+- insert_contblock(p,q-p);
+- z=1-z;
+- p=q;
+- }
+-
+- bzero(CB_MARK_START(v),CB_SGCF_START(v)-CB_MARK_START(v));
+-
+- }
+-
+- sweep_link_array();
+-
+-}
+-
+ #undef tm
+
+ #ifdef SDEBUG
+@@ -664,7 +630,7 @@ sgc_start(void) {
+
+ tm=tm_of(t_contiguous);
+
+- for (pi=contblock_list_head;pi && count<WSGC(tm);pi=pi->next) {
++ for (i=0;i<contblock_array->v.v_fillp && (pi=(void *)contblock_array->v.v_self[i]) && count<WSGC(tm);i++) {
+
+ p=CB_DATA_START(pi);
+ pe=CB_DATA_END(pi);
+@@ -685,7 +651,7 @@ sgc_start(void) {
+ /* SGC cont pages: allocate more if necessary, dumping possible
+ GBC freed pages onto the old contblock list. CM 20030827*/
+ unsigned long z=(i-count)+1;
+- void *old_contblock_list_tail=contblock_list_tail;
++ ufixnum fp=contblock_array->v.v_fillp;
+
+ if (maxcbpage<ncbpage+z)
+ if (!set_tm_maxpage(tm_table+t_contiguous,ncbpage+z))
+@@ -693,9 +659,9 @@ sgc_start(void) {
+
+ add_pages(tm_table+t_contiguous,z);
+
+- massert(old_contblock_list_tail!=contblock_list_tail);
++ massert(fp!=contblock_array->v.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;i<contblock_array->v.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;j<contblock_array->v.v_fillp && (pi=(void *)contblock_array->v.v_self[j]);j++)
+ if (pi->sgc_flags&SGC_WRITABLE)
+ for (i=0;i<pi->in_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;i<contblock_array->v.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;i<contblock_array->v.v_fillp &&(pi=(void *)contblock_array->v.v_self[i]);i++)
+ pi->sgc_flags&=SGC_PERM_WRITABLE;
+ }
+
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-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 <camm@debian.org>
+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: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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 <errno.h>
++#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 <stdlib.h>
++#include <string.h>
+ #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))))
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-34) unstable; urgency=medium
+ .
+ * Version_2_6_13pre45
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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 <stdio.h>
+-#include <stdlib.h>
+-#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 <stdio.h>
++#include <stdlib.h>
++#include "unrandomize.h"
++#endif
++
++ gcl_init_alloc(&argv);
++
+ setbuf(stdin, stdin_buf);
+ setbuf(stdout, stdout_buf);
+ #ifdef _WIN32
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-34) unstable; urgency=medium
+ .
+ * Version_2_6_13pre45
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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<syme;sym++) {
+
+- if (!LOAD_SYM(sym))
++ if (!LOAD_SYM(sym,st1))
+ continue;
+
+ if (d1) {
+@@ -436,7 +437,7 @@ load_ptable(struct node **a,char **s,Sym
+
+ for (sym=sym1;sym<syme;sym++) {
+
+- if (!LOAD_SYM(sym))
++ if (!LOAD_SYM(sym,st1))
+ continue;
+
+ if (d1) {
+--- gcl-2.6.12.orig/o/unixsys.c
++++ gcl-2.6.12/o/unixsys.c
+@@ -24,10 +24,38 @@ Foundation, 675 Mass Ave, Cambridge, MA
+ #include <string.h>
+ #include <sys/stat.h>
+ #include <sys/types.h>
+-
++#include <sys/wait.h>
+
+ #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 <signal.h>
+ int
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-35) unstable; urgency=medium
+ .
+ * Version_2_6_13pre46
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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);
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-35) unstable; urgency=medium
+ .
+ * Version_2_6_13pre47
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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())) {
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-36) unstable; urgency=medium
+ .
+ * Version_2_6_13pre48
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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))
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-5) unstable; urgency=medium
+ .
+ * Version_2_6_13pre4
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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;i<t_other;i++)
++ for (k=0,i=t_start;i<t_other;i++)
+ if (tm_table+i!=my_tm)
+ k+=(tm_table[i].tm_maxpage-tm_table[i].tm_npage)*(i==t_relocatable ? 2 : 1);
+
+- d=d>k+phys_pages-j ? k+phys_pages-j : d;
+- if (d<=0)
++ e=e>k ? k : e;
++ if (e+phys_pages-j<=0)
+ return 0;
+
++ f=1.0-(double)e/k;
++
+ for (i=t_start;i<t_other;i++)
+- if (tm_table[i].tm_npage) {
+- if (tm_table+i==my_tm) {
+- massert(set_tm_maxpage(tm_table+i,z) || !fprintf(stderr,"%lu %lu %lu %lu %lu\n",i,z,tm_table[i].tm_npage,tm_table[i].tm_maxpage,available_pages));
+- } else {
+- massert(set_tm_maxpage(tm_table+i,tm_table[i].tm_npage+(1.0-(double)(j+d-phys_pages)/k)*(tm_table[i].tm_maxpage-tm_table[i].tm_npage)));
++ if (tm_table[i].tm_npage && tm_table+i!=my_tm) {
++ massert(set_tm_maxpage(tm_table+i,tm_table[i].tm_npage+f*(tm_table[i].tm_maxpage-tm_table[i].tm_npage)));
+ }
+- }
+
+- /* for (i=t_start;i<t_other;i++) */
+- /* if (tm_table[i].tm_npage && tm_table[i].tm_npage>((double)phys_pages/(j+d))*(tm_table+i==my_tm ? z : tm_table[i].tm_maxpage)) */
+- /* return 0; */
+- /* for (i=t_start;i<t_other;i++) */
+- /* if (tm_table[i].tm_npage) */
+- /* massert(set_tm_maxpage(tm_table+i,((double)phys_pages/(j+d))*(tm_table+i==my_tm ? z : tm_table[i].tm_maxpage))); */
++ massert(set_tm_maxpage(my_tm,(my_tm->tm_maxpage+(phys_pages-sum_maxpages()))/(my_tm->tm_type==t_relocatable ? 2 : 1)));
+
+ return 1;
+
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-37) unstable; urgency=medium
+ .
+ * Version_2_6_13pre49
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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;
+
+ }
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-65) unstable; urgency=medium
+ .
+ * list_order.25
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-65) unstable; urgency=medium
+ .
+ * Version_2_6_13pre52
+ * Bug fix: "FTBFS on hurd-i386", thanks to svante.signell@gmail.com</a>;
+ (Closes: #802593).
+Author: Camm Maguire <camm@debian.org>
+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: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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;i<n;i++) {
++ y=*p;
++ *p++=*q;
++ *q++=y;
++ }
+
+- q = statVV;
+- for (i=0; i<=n ; i++)
+- { y = *p;
+- *p++ = *q;
+- *q++ = y;
+- }
+-
+ data->cfd.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;sym<syme;sym++) {
+
+- if (sym->n_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;sym<syme;sym++) {
++ for (c_table.local_ptable=a,sym=sym1;sym<syme;sym++) {
+
+- if (sym->n_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__
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-67) unstable; urgency=medium
+ .
+ * Version_2_6_13pre55
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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),"") {
+
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-67) unstable; urgency=medium
+ .
+ * Version_2_6_13pre55
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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 && s<ggote) {
+ massert(!write_stub(s,got,gote));
+ } else
+- *gote=s;
++ *gote=s+a;
+ s=(gote-got)*sizeof(*got);
+- massert(!(s&0x8000));
++ massert(!(s&~MASK(16)));
+ 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
+@@ -1,4 +1,4 @@
+-static ul ggot1,ggote,gotp;
++static ul ggot1,ggote;
+
+ static int
+ write_stub(ul s,ul *got,ul *gote) {
+@@ -65,12 +65,24 @@ label_got_symbols(void *v1,Shdr *sec1,Sh
+ Sym *sym;
+ Shdr *sec;
+ void *v,*ve;
+- ul q=0;
++ ul q=0,a;
+
+- gotp=0;
+ for (sym=sym1;sym<syme;sym++)
+ sym->st_other=sym->st_size=0;
+
++ for (sec=sec1;sec<sece;sec++)
++ if (sec->sh_type==SHT_RELA)
++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;v<ve;v+=sec->sh_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;sec<sece;sec++)
+ if (sec->sh_type==SHT_RELA)
+ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;v<ve;v+=sec->sh_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)<<b);
++
+ }
+
+ return 0;
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-68) unstable; urgency=medium
+ .
+ * Version_2_6_13pre57
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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;
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-68) unstable; urgency=medium
+ .
+ * Version_2_6_13pre57
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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;sym<syme;sym++)
+ sym->st_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_self<min_cfd_self)
++ min_cfd_self=data->cfd.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)
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-69) unstable; urgency=medium
+ .
+ * Version_2_6_13pre58
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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;sym<syme;sym++)
+- sym->st_other=sym->st_size=0;
+-
+- for (sec=sec1;sec<sece;sec++)
+- if (sec->sh_type==SHT_RELA)
+- for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;v<ve;v+=sec->sh_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;sec<sece;sec++)
+ if (sec->sh_type==SHT_RELA)
+ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;v<ve;v+=sec->sh_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)<<b);
++ r->r_addend|=(q<<b);
+
+ }
+
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-6) unstable; urgency=medium
+ .
+ * Version_2_6_13pre5
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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;i<t_other;i++)
+ if (tm_table[i].tm_npage && tm_table+i!=my_tm) {
+ massert(set_tm_maxpage(tm_table+i,tm_table[i].tm_npage+f*(tm_table[i].tm_maxpage-tm_table[i].tm_npage)));
+ }
+
+- massert(set_tm_maxpage(my_tm,(my_tm->tm_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;i<contblock_array->v.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);
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-70) unstable; urgency=medium
+ .
+ * Version_2_6_13pre59
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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<<b);
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-71) unstable; urgency=medium
+ .
+ * Version_2_6_13pre60
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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";;
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-72) unstable; urgency=medium
+ .
+ * Version_2_6_13pre61
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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 && s<ggote) {
+ massert(!write_stub(s,got,gote));
+ } else
+- *gote=s+a;
++ *gote=s+(a&MASK(32));
+ s=(gote-got)*sizeof(*got);
+ massert(!(s&~MASK(15)));
+ store_val(where,MASK(16),s);
+--- gcl-2.6.12.orig/h/elf64_alpha_reloc_special.h
++++ gcl-2.6.12/h/elf64_alpha_reloc_special.h
+@@ -61,36 +61,45 @@ 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;
+ Shdr *sec;
+ void *v,*ve,*vv;
+- ul b,q;
++ ul q;
++
++ for (sym=sym1;sym<syme;sym++)
++ sym->st_size=0;
+
+ for (*gs=0,sec=sec1;sec<sece;sec++)
+- if (sec->sh_type==SHT_RELA)
+- for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;v<ve;v+=sec->sh_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;v<ve;v+=sec->sh_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<<b);
++
++ } else {
++
++ 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=vv<v1 ? ++*gs : rr->r_addend>>32;
++ massert(!(r->r_addend>>32));
++ r->r_addend|=(q<<32);
+
+ }
+-
++
++ }
++
+ return 0;
+
+ }
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-73) unstable; urgency=medium
+ .
+ * Version_2_6_13pre62
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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;sec<sece;sec++)
+- for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;v<ve;v+=sec->sh_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;v<ve;v+=sec->sh_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 <string.h>
++
+ #include "include.h"
+ #include "page.h"
+ #include "ptable.h"
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-74) unstable; urgency=medium
+ .
+ * Version_2_6_13pre63
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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<ggote) {
+- massert(!write_stub(s,got,gote));
++ massert(!write_stub(s,(ul *)gotoff,got+a));
+ } else
+- *gote=s+(a&MASK(32));
+- s=(gote-got)*sizeof(*got);
+- massert(!(s&~MASK(15)));
+- store_val(where,MASK(16),s);
++ got[a]=s;
++ store_vals(where,MASK(16),(ul)(got+a)-gotoff);
+ break;
+ case R_ALPHA_GPRELHIGH:
+- s+=a-(ul)got;
+- s+=(s&0x8000)<<1;
+- store_val(where,MASK(16),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;sym<syme;sym++)
+ sym->st_size=0;
+
+- for (*gs=0,sec=sec1;sec<sece;sec++)
+- if (sec->sh_type==SHT_RELA || sec->sh_type==SHT_REL)
++ for (*gs=gotp=0,sec=sec1;sec<sece;sec++)
++ if (sec->sh_type==SHT_RELA)
+ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;v<ve;v+=sec->sh_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=vv<v1 ? ++*gs : rr->r_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;sym<syme && (sym->st_shndx!=1 || sym->st_value!=r->r_offset);sym++);
++
++ if (sym<syme) {
++ fsym=sym;
++ gotp=*gs+1;
+ }
+
++ r->r_addend|=(gotp<<32);
++
++ break;
++
+ }
+
+ return 0;
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-75) unstable; urgency=medium
+ .
+ * Version_2_6_13pre64
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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<vs_top) vs_base++;")))
+
+ (wt-nl) (reset-top)
+
+- (let ((label (next-label)))
+- (wt-nl) (wt-go label)
+-
+- (setq labels (nreverse labels))
+-
+- (dolist** (v vars)
+- (wt-label (car labels))
+- (pop labels)
+- (c2bind-loc v nil))
+-
+- (wt-label label))
+-
+ (c2expr body)
+- (when block-p (wt "}"))
+- )
++ (when block-p (wt "}")))
+--- gcl-2.6.12.orig/cmpnew/gcl_cmptag.lsp
++++ gcl-2.6.12/cmpnew/gcl_cmptag.lsp
+@@ -178,7 +178,7 @@
+ (*value-to-go* 'trash))
+ (c2expr (car l))
+ (wt-label *exit*))
+- (unless (eq (caar l) 'go) (unwind-exit nil)))))
++ (unless (member (caar l) '(go return-from)) (unwind-exit nil)))))
+ (declare (object l written))
+ (cond (written (setq written nil))
+ ((typep (car l) 'tag)
+--- gcl-2.6.12.orig/configure
++++ gcl-2.6.12/configure
+@@ -4159,7 +4159,7 @@ case $use in
+ case $use in
+ alpha*)
+ assert_arg_to_cflags -mieee
+- if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1
++# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1
+ ;;
+ aarch64*)
+ TLIBS="$TLIBS -lgcc_s";;
+--- gcl-2.6.12.orig/configure.in
++++ gcl-2.6.12/configure.in
+@@ -382,7 +382,7 @@ case $use in
+ case $use in
+ alpha*)
+ assert_arg_to_cflags -mieee
+- if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1
++# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1
+ ;;
+ aarch64*)
+ TLIBS="$TLIBS -lgcc_s";;
+--- gcl-2.6.12.orig/h/elf64_alpha_reloc.h
++++ gcl-2.6.12/h/elf64_alpha_reloc.h
+@@ -1,5 +1,5 @@
+ case R_ALPHA_GPDISP:
+- gotoff=(ul)(got+(a>>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 && s<ggote) {
+- massert(!write_stub(s,(ul *)gotoff,got+a));
++ massert(!write_stub(s,got+a));
+ } else
+ got[a]=s;
+ store_vals(where,MASK(16),(ul)(got+a)-gotoff);
+--- gcl-2.6.12.orig/h/elf64_alpha_reloc_special.h
++++ gcl-2.6.12/h/elf64_alpha_reloc_special.h
+@@ -1,16 +1,16 @@
+ static ul ggot1,ggote,gotoff;
+
+ static int
+-write_stub(ul s,ul *got,ul *gote) {
++write_stub(ul s,ul *gote) {
+
+ unsigned int *goti;
+
+ *gote=(ul)(goti=(void *)(gote+2));
+ *++gote=s;
+- *goti++=(0x29<<26)|(0x1b<<21)|(0x1d<<16)|((void *)gote-(void *)got);
+- *goti++=(0x29<<26)|(0x1b<<21)|(0x1b<<16)|0;
+- *goti++=(0x1a<<26)|(0x1f<<21)|(0x1b<<16)|0x4000;
+- *goti++=0;
++ *goti++=(0x29<<26)|(0x1b<<21)|(0x1b<<16)|0xfff8; /*ldq t12,-8(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*/
+
+ return 0;
+
+@@ -94,7 +94,10 @@ label_got_symbols(void *v1,Shdr *sec1,Sh
+
+ q=++*gs;
+
+- massert(!(r->r_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;
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-75) unstable; urgency=medium
+ .
+ * Version_2_6_13pre65
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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<vs_top){")
+- (set-var 'fun-val (car vref) (cadr vref))
+- (unless (endp (cdr vs)) (wt-nl "vs_base++;"))
+- (wt-nl "}else{") (set-var nil (car vref) (cadr vref))
+- (wt "}"))
+- )
++ (set-var 'fun-val (car vref) (cadr vref))
++ (unless (endp (cdr vs)) (wt-nl "if(vs_base<vs_top) vs_base++;"))))
+ (cond ((null vrefs)
+- (wt-nl "if(vs_base=vs_top){vs_base[0]=Cnil;vs_top=vs_base+1;}")
++ (wt-nl "if(vs_base==vs_top){vs_base[0]=Cnil;vs_top=vs_base+1;}")
+ (unwind-exit 'fun-val))
+ (t (unless (eq *exit* 'return) (wt-nl) (reset-top))
+- (unwind-exit (cons 'var (car vrefs)))))
+- )
++ (unwind-exit (cons 'var (car vrefs))))))
+
+ (defun c1multiple-value-bind (args &aux (info (make-info))
+ (vars nil) (vnames nil) init-form
+--- gcl-2.6.12.orig/configure
++++ gcl-2.6.12/configure
+@@ -4121,6 +4121,7 @@ $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
+@@ -4132,7 +4133,9 @@ $as_echo "disabled" >&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),"") {
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-76) unstable; urgency=medium
+ .
+ * Version_2_6_13pre66
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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<ggote) {
+ massert(!write_stub(s,got+a));
+ } else
+--- gcl-2.6.12.orig/h/elf64_alpha_reloc_special.h
++++ gcl-2.6.12/h/elf64_alpha_reloc_special.h
+@@ -1,10 +1,32 @@
+-static ul ggot1,ggote,gotoff;
++static ul ggot1,ggote,gotoff,mcount;
++
++static int
++write_stub_mcount(ul s,ul *gote) {
++
++ unsigned int *goti;
++
++ /*mcount calls written using at register, address not available in stub*/
++ /*mcount guaranteed to be within 32bits*/
++ *gote=(ul)(goti=(void *)(gote+1));
++ *goti++=(0x9<<26)|(0x1b<<21)|(0x1f<<16)|((s-(short)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;v<ve;v+=sec->sh_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;sym<syme;sym++)
+- sym->st_size=0;
++ for (sym=sym1;sym<syme;sym++) {
++ massert(!HIGH(sym->st_value));
++ massert(!HIGH(sym->st_size));
++ }
+
+ for (*gs=gotp=0,sec=sec1;sec<sece;sec++)
+ if (sec->sh_type==SHT_RELA)
+- for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;v<ve;v+=sec->sh_entsize,r=v)
++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;v<ve;v+=sec->sh_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;sym<syme && (sym->st_shndx!=1 || sym->st_value!=r->r_offset);sym++);
++ for (sym=fsym;sym<syme && (sym->st_shndx!=1 || LOW(sym->st_value)!=r->r_offset);sym++);/*ordered search*/
+
+ if (sym<syme) {
+ fsym=sym;
+- gotp=*gs+1;
++ SET_HIGH(fsym->st_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;sym<syme && (sym->st_shndx!=1 || LOW(sym->st_value)>q || LOW(sym->st_value)+LOW(sym->st_size)<q);sym++);
++ massert(sym<syme);
++
++ SET_HIGH(r->r_addend,HIGH(sym->st_value));
+
+ break;
+
+ }
+
++ }
++
++ for (sym=sym1;sym<syme;sym++) {
++ SET_HIGH(sym->st_value,0UL);
++ SET_HIGH(sym->st_size,0UL);
++ }
++
+ return 0;
+
+ }
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-76) unstable; urgency=medium
+ .
+ * Version_2_6_13pre67
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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;
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-78) unstable; urgency=medium
+ .
+ * rebuild against latest compilers and tools
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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*/
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-7) unstable; urgency=medium
+ .
+ * Version_2_6_13pre6
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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 <Windows.h>
+
+-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 <sys/sysctl.h>
+
+-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;sec<sece;sec++) {
+ sec->s_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)
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-78) unstable; urgency=medium
+ .
+ * rebuild against latest compilers and tools
+ * Version_2_6_13pre69
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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 <limits.h>
+ #include <sys/stat.h>
+-#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 <stdio.h>
+ #include <stdlib.h>
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-79) unstable; urgency=medium
+ .
+ * Version_2_6_13pre70
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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")))
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-81) unstable; urgency=high
+ .
+ * Version_2_6_13pre72
+ * Fix to ppc64el for acl2 FTBFS bug
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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;v<ve;v+=sec->sh_entsize,r=v)
++ for (j=0,r=v;v<ve;v+=sec->sh_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;v<ve;v+=sec->sh_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;v<ve;v+=sec->sh_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;v<ve;v+=sec->sh_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;
+
+ }
+
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-81) unstable; urgency=high
+ .
+ * Version_2_6_13pre72
+ * Fix to ppc64el for acl2 FTBFS bug
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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;sym<syme;sym++)
++ sym->st_size=0;
++
++ for (*gs=0,sec=sec1;sec<sece;sec++)
++ if (sec->sh_type==SHT_REL)
++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;v<ve;v+=sec->sh_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;
++
++}
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-82) unstable; urgency=high
+ .
+ * Version_2_6_13pre73
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-83) unstable; urgency=high
+ .
+ * Version_2_6_13pre75
+ * FIx acl2 arm builds (Closes: #919477).
+Author: Camm Maguire <camm@debian.org>
+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: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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;sec<sece;sec++)
+ if (sec->sh_type==SHT_REL)
+ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;v<ve;v+=sec->sh_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 (;p<pe && (*p&l0)!=l0 && (*p&l1)!=l1;p++);
++ if ((*p&l0)==l0) p++;
++
++ return p+1;
++
++}
++
++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,*psec;
++ Rel *r;
++ ul *p,*pe;
++ void *ve;
++
++ /*plt entries are not of uniform size*/
++
++ massert(psec=get_section(".plt",sec1,sece,sn));
++ p=(void *)psec->sh_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;v<ve && p<pe;v+=sec->sh_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;sym<syme;sym++)
++ sym->st_size=0;
++
++ for (*gs=0,sec=sec1;sec<sece;sec++)
++ if (sec->sh_type==SHT_REL)
++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;v<ve;v+=sec->sh_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. */
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-83) unstable; urgency=high
+ .
+ * Version_2_6_13pre76
+ * FIx acl2 arm builds (Closes: #919477).
+Author: Camm Maguire <camm@debian.org>
+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: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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));
+
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-83) unstable; urgency=high
+ .
+ * Version_2_6_13pre77
+ * FIx acl2 arm builds (Closes: #919477).
+Author: Camm Maguire <camm@debian.org>
+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: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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?*/
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-83) unstable; urgency=high
+ .
+ * Version_2_6_13pre78
+ * FIx acl2 arm builds (Closes: #919477).
+Author: Camm Maguire <camm@debian.org>
+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: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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));
+
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-83) unstable; urgency=high
+ .
+ * Version_2_6_13pre79
+ * Fix acl2 arm builds (Closes: #919477).
+Author: Camm Maguire <camm@debian.org>
+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: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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<<s)
+ #define TS_MEMBER(t1,ts) ((TS(t1)) & (ts))
+
+-#define ASSURE_TYPE(val,t) if(type_of(val)!=t) val= Icheck_one_type(val,t)
++#define ASSURE_TYPE(val,t) if (type_of(val)!=t) TYPE_ERROR(val,type_name(t))
+
+ object IisArray();
+
+--- gcl-2.6.12.orig/o/alloc.c
++++ gcl-2.6.12/o/alloc.c
+@@ -526,16 +526,9 @@ exhausted_report(enum type t,struct type
+
+ available_pages+=resv_pages;
+ resv_pages=0;
+- vs_push(type_name(t));
+- vs_push(make_fixnum(tm->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) (/\* ??? *\/)) */
+ /* {;} */
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-84) unstable; urgency=medium
+ .
+ * Version_2_6_13pre80
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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 && start<new_start+size) || (new_start<start+size && start+size<=new_start+size))) {
++ if (!in_placep && (rb_high() ?
++ new_start+size>rb_end :
++ new_start+(nrbpage<<PAGEWIDTH)<start+size
++ /* 0 (20190401 never reached)*/
++ )) {
+ if (sSAnotify_gbcA->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)<d ? (available_pages/3) : d;
+
+ if (sSAnotify_gbcA && sSAnotify_gbcA->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);
+ }
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-85) unstable; urgency=medium
+ .
+ * Version_2_6_13pre81
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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<<PAGEWIDTH)<start+size
++ OVERLAP(start,new_start,size) :
++ OVERLAP(start,new_start+(nrbpage<<PAGEWIDTH),size)
+ /* 0 (20190401 never reached)*/
+ )) {
+ if (sSAnotify_gbcA->s.s_dbind != Cnil)
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-85) unstable; urgency=medium
+ .
+ * Version_2_6_13pre82
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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 <stdio.h>
+ #include <stdlib.h>
+- 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 <stdio.h>
++ #include <stdlib.h>
++ 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 <stdio.h>
+ #include <stdlib.h>
+- 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 <stdio.h>
+- #include <stdlib.h>
+- 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 <stdio.h>
+ #include <stdlib.h>
+- 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 <stdio.h>
++ #include <stdlib.h>
++ 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 <stdio.h>
+ #include <stdlib.h>
+- 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 <stdio.h>
+- #include <stdlib.h>
+- 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 <stdio.h>
+ ]],
+ [[
+- 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")) {
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-86) unstable; urgency=medium
+ .
+ * Version_2_6_13pre83
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-88) unstable; urgency=medium
+ .
+ * Source only upload
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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;sym<syme;sym++)
++ sym->st_size=0;
++
++ for (*gs=0,sec=sec1;sec<sece;sec++)
++ if (sec->sh_type==SHT_RELA)
++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;v<ve;v+=sec->sh_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;
+
+ }
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-88) unstable; urgency=medium
+ .
+ * Source only upload
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-89) unstable; urgency=medium
+ .
+ * Bug fix: "gcl - FTBFS on ppc64el - invalid relocation type 31", thanks
+ to thierry.fauck@fr.ibm.com</a>; (Closes: #942312).
+ * Bug fix: "FTBFS on ppc64el", thanks to Ivo De Decker (Closes:
+ #944651).
+Author: Camm Maguire <camm@debian.org>
+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: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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;sym<syme;sym++) {
++ for (toc=NULL,sym=sym1;sym<syme;sym++) {
+ const char *s=st1+sym->st_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;
+ }
+ }
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-90) unstable; urgency=medium
+ .
+ * Version_2_6_13pre87
+ * latest standards
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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_fillp<sizeof(FN2));
+- memcpy(FN2,nm->st.st_self+1,nm->st.st_fillp-1);
+- FN2[nm->st.st_fillp-1]=0;
++ massert(s<sizeof(FN2));
++ memcpy(FN2,n+1,s-1);
++ FN2[s-1]=0;
+
+ massert(!getpwnam_r(FN2,&pw,GETPW_BUF,r,&pwent) && pwent);
+
+ }
+
+- massert((r=strlen(pwent->pw_dir))+2<sizeof(FN3));
+- memcpy(FN3,pwent->pw_dir,r);
+- FN3[r]='/';
+- FN3[r+1]=0;
+- RETURN1(make_simple_string(FN3));
++ massert((r=strlen(pwent->pw_dir))+2<so);
++ memcpy(o,pwent->pw_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)
+
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-91) unstable; urgency=medium
+ .
+ * Version_2_6_13pre88
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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)
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-8) unstable; urgency=medium
+ .
+ * Version_2_6_13pre7
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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 <stdlib.h>
+
+ #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 <stdarg.h>
+ #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<<y) : (x ? fixnum_big_shift(x,y) : make_fixnum(0));
+ }
+-EXTER inline object
++INLINE object
+ fixnum_shft(fixnum x,fixnum y) {
+ return y<0 ? make_fixnum(fixnum_rshft(x,-y)) : fixnum_lshft(x,y);
+ }
+-EXTER inline object
++INLINE object
+ immnum_shft(object x,object y) {return iif2(x,y) ? fixnum_shft(fif(x),fif(y)) : integer_shift(x,y);}
+
+-EXTER inline bool
++INLINE bool
+ fixnum_bitp(fixnum p,fixnum x) {return fixnum_rshft(x,p)&0x1;}
+
+-EXTER inline bool
++INLINE bool
+ immnum_bitp(object x,object y) {return iif2(x,y) ? fixnum_bitp(fif(x),fif(y)) : integer_bitp(x,y);}
+
+
+ #define immnum_comp(x,y,c) iif2(x,y) ? (x c y) : (number_compare(x,y) c 0)
+
+-EXTER inline bool
++INLINE bool
+ immnum_lt(object x,object y) {return immnum_comp(x,y,<);}
+-EXTER inline bool
++INLINE bool
+ immnum_le(object x,object y) {return immnum_comp(x,y,<=);}
+-EXTER inline bool
++INLINE bool
+ immnum_eq(object x,object y) {return immnum_comp(x,y,==);}
+-EXTER inline bool
++INLINE bool
+ immnum_ne(object x,object y) {return immnum_comp(x,y,!=);}
+-EXTER inline bool
++INLINE bool
+ immnum_gt(object x,object y) {return immnum_comp(x,y,>);}
+-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<uz ? mif(-1) : (ux==uz ? mif(0) : mif(1))) : number_signum(x);
+ }
+-EXTER inline object
++INLINE object
+ immnum_abs(object x) {return iif(x) ? make_fixnum(labs(fif(x))) : number_abs(x);}
+
+-EXTER inline fixnum
++INLINE fixnum
+ fixnum_ldb(fixnum s,fixnum p,fixnum i) {
+ return ((1UL<<s)-1)&fixnum_rshft(i,p);
+ }
+
+-EXTER inline object
++INLINE object
+ immnum_ldb(object x,object i) {
+ if (iif(i))
+ if (consp(x)) {
+@@ -256,7 +256,7 @@ immnum_ldb(object x,object i) {
+ return number_ldb(x,i);
+ }
+
+-EXTER inline bool
++INLINE bool
+ immnum_ldbt(object x,object i) {
+ if (iif(i))
+ if (consp(x)) {
+@@ -270,13 +270,13 @@ immnum_ldbt(object x,object i) {
+ return number_ldbt(x,i)!=Cnil;
+ }
+
+-EXTER inline fixnum
++INLINE fixnum
+ fixnum_dpb(fixnum s,fixnum p,fixnum n,fixnum i) {
+ fixnum z=(1UL<<s)-1;
+ return (i&~(z<<p))|((n&z)<<p);
+ }
+
+-EXTER inline object
++INLINE object
+ immnum_dpb(object n,object x,object i) {
+ if (iif2(n,i))
+ if (consp(x)) {
+@@ -290,13 +290,13 @@ immnum_dpb(object n,object x,object i) {
+ return number_dpb(n,x,i);
+ }
+
+-EXTER inline fixnum
++INLINE fixnum
+ fixnum_dpf(fixnum s,fixnum p,fixnum n,fixnum i) {
+ fixnum z=((1UL<<s)-1)<<p;
+ return (i&~z)|(n&z);
+ }
+
+-EXTER inline object
++INLINE object
+ immnum_dpf(object n,object x,object i) {
+ if (iif2(n,i))
+ if (consp(x)) {
+@@ -310,15 +310,15 @@ immnum_dpf(object n,object x,object i) {
+ return number_dpf(n,x,i);
+ }
+
+-EXTER inline object
++INLINE object
+ immnum_max(object x,object y) {return iif2(x,y) ? ((ufixnum)x>=(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<<LOG_BITS_CHAR);
+@@ -168,7 +168,7 @@ get_bit(char *v,struct pageinfo *pi,void
+ return (v[i]>>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_BITS_CHAR);
+@@ -183,7 +183,7 @@ set_bit(char *v,struct pageinfo *pi,void
+ #define ptr_get(v,i,s) (v+(((i<<LOG_BITS_CHAR)|s)<<LOG_BYTES_CONTBLOCK))
+ #define ptr_set(x,v,i,s) ({fixnum _o=(x-v)>>LOG_BYTES_CONTBLOCK;i=_o>>LOG_BITS_CHAR;s=_o&~(~0UL<<LOG_BITS_CHAR);})
+
+-inline void
++static inline void
+ set_bits(char *v,struct pageinfo *pi,void *x1,void *x2) {
+
+ void *ds=CB_DATA_START(pi);
+@@ -206,7 +206,7 @@ set_bits(char *v,struct pageinfo *pi,voi
+
+ }
+
+-inline void *
++static inline void *
+ get_bits(char *v,struct pageinfo *pi,void *x) {
+
+ void *ds=CB_DATA_START(pi),*de=CB_DATA_END(pi);
+@@ -232,42 +232,42 @@ get_bits(char *v,struct pageinfo *pi,voi
+ return ds<de ? ds : de;
+ }
+
+-inline char
++static inline char
+ get_mark_bit(struct pageinfo *pi,void *x) {
+ return get_bit(CB_MARK_START(pi),pi,x);
+ }
+
+-inline void
++static inline void
+ set_mark_bit(struct pageinfo *pi,void *x) {
+ set_bit(CB_MARK_START(pi),pi,x);
+ }
+
+-inline void *
++static inline void *
+ get_mark_bits(struct pageinfo *pi,void *x) {
+ return get_bits(CB_MARK_START(pi),pi,x);
+ }
+
+-inline void
++static inline void
+ set_mark_bits(struct pageinfo *pi,void *x1,void *x2) {
+ set_bits(CB_MARK_START(pi),pi,x1,x2);
+ }
+
+-inline char
++static inline char
+ get_sgc_bit(struct pageinfo *pi,void *x) {
+ return get_bit(CB_SGCF_START(pi),pi,x);
+ }
+
+-inline void
++static inline void
+ set_sgc_bit(struct pageinfo *pi,void *x) {
+ set_bit(CB_SGCF_START(pi),pi,x);
+ }
+
+-inline void *
++static inline void *
+ get_sgc_bits(struct pageinfo *pi,void *x) {
+ return get_bits(CB_SGCF_START(pi),pi,x);
+ }
+
+-inline void
++static inline void
+ set_sgc_bits(struct pageinfo *pi,void *x1,void *x2) {
+ set_bits(CB_SGCF_START(pi),pi,x1,x2);
+ }
+--- gcl-2.6.12.orig/o/gmp_big.c
++++ gcl-2.6.12/o/gmp_big.c
+@@ -93,6 +93,7 @@ object big_fixnum1;
+ void
+ gcl_init_big1(void) {
+ mp_set_memory_functions( gcl_gmp_alloc,gcl_gmp_realloc,gcl_gmp_free);
++ jmp_gmp=0;
+ }
+
+ #else
+--- gcl-2.6.12.orig/o/gmp_num_log.c
++++ gcl-2.6.12/o/gmp_num_log.c
+@@ -46,7 +46,7 @@ integer_log_op2(fixnum op,object x,enum
+
+ }
+
+-inline object
++object
+ log_op2(fixnum op,object x,object y) {
+
+ enum type tx=type_of(x),ty=type_of(y);
+--- gcl-2.6.12.orig/o/main.c
++++ gcl-2.6.12/o/main.c
+@@ -38,8 +38,6 @@ initlisp(void);
+ static int
+ multiply_stacks(int);
+
+-#define IN_MAIN
+-
+ #ifdef KCLOVM
+ #include <ovm/ovm.h>
+ void change_contexts();
+@@ -47,6 +45,11 @@ int ovm_process_created;
+ void initialize_process();
+ #endif
+
++
++#define EXTER
++#define INLINE
++
++
+ #include "include.h"
+ #include <signal.h>
+ #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++;}
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-9) unstable; urgency=medium
+ .
+ * Version_2_6_13pre8a
+ * Bug fix: "ftbfs with GCC-5", thanks to Matthias Klose (Closes:
+ #777866).
+Author: Camm Maguire <camm@debian.org>
+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: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/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) {
+
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-93) unstable; urgency=medium
+ .
+ * Version_2_6_13pre90
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 2020-02-21
+
+--- gcl-2.6.12.orig/configure
++++ gcl-2.6.12/configure
+@@ -3974,7 +3974,7 @@ $as_echo "removing $1 from LDFLAGS" >&6;
+
+ }
+
+-add_args_to_cflags -fsigned-char -pipe \
++add_args_to_cflags -fsigned-char -pipe -fcommon \
+ -fno-builtin-malloc -fno-builtin-free \
+ -fno-PIE -fno-pie -fno-PIC -fno-pic \
+ -Wall \
+--- gcl-2.6.12.orig/configure.in
++++ gcl-2.6.12/configure.in
+@@ -258,7 +258,7 @@ remove_arg_from_ldflags() {
+
+ }
+
+-add_args_to_cflags -fsigned-char -pipe \
++add_args_to_cflags -fsigned-char -pipe -fcommon \
+ -fno-builtin-malloc -fno-builtin-free \
+ -fno-PIE -fno-pie -fno-PIC -fno-pic \
+ -Wall \
+--- gcl-2.6.12.orig/o/main.c
++++ gcl-2.6.12/o/main.c
+@@ -445,20 +445,21 @@ gcl_cleanup(int gc) {
+ }
+
+ /*gcc boolean expression tail position bug*/
++static char *stack_to_be_allocated;
+
+-void *
+-cclear_stack(unsigned long size) {
+- void *v=alloca(size);
+- memset(v,0,size);
+- return v;
++void
++get_stack_to_be_allocated(unsigned long size) {
++ stack_to_be_allocated=alloca(size);
+ }
+
+ 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;
++ char *w;
++ get_stack_to_be_allocated(s);
++ memset(stack_to_be_allocated,0,s);
+ fLequal(x0,x1);
+- for (w=u;w<u+s && !*w;w++);
+- RETURN1((object)(w-u));
++ for (w=stack_to_be_allocated;w<stack_to_be_allocated+s && !*w;w++);
++ RETURN1((object)(w-stack_to_be_allocated));
+ }
+
+ static int
+--- gcl-2.6.12.orig/o/unixfsys.c
++++ gcl-2.6.12/o/unixfsys.c
+@@ -537,7 +537,7 @@ un_mmap(void *v1,void *ve) {
+ /* 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*/
++int gcl_strncpy_chk(char *a1,char *b1,size_t z) {char a[10],b[10];strncpy(a,a1,z);strncpy(b,b1,z);return strncmp(a,b,z);}/*compile in __strncpy_chk with FORTIFY_SOURCE*/
+ #ifdef __MINGW32__
+ #define uid_t int
+ #endif
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-95) unstable; urgency=high
+ .
+ * Version_2_6_13pre90
+ * build under GCL_MEM_MULTIPLE=0.1
+ * Bug fix: "FTBFS: Unrecoverable error: Segmentation violation..",
+ thanks to Lucas Nussbaum (Closes: #952334).
+Author: Camm Maguire <camm@debian.org>
+Bug-Debian: https://bugs.debian.org/952334
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 2020-08-23
+
+--- gcl-2.6.12.orig/h/elf32_armhf_reloc_special.h
++++ gcl-2.6.12/h/elf32_armhf_reloc_special.h
+@@ -6,13 +6,15 @@ 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,#]*/
++ /* 4778 bx pc */ /*optional*/
++ /* e7fd b.n 20dd0 <__fprintf_chk@plt> */ /*optional*/
++ /* above when stripped becomes undefined instruction*/
++ /* e28fc601 add ip, pc, #1048576 ; 0x100000 */
++ /* e28ccab0 add ip, ip, #176, 20 ; 0xb0000 */
++ /* e5bcf914 ldr pc, [ip, #2324]! ; 0x914 */
+
+- for (;p<pe && (*p&l0)!=l0 && (*p&l1)!=l1;p++);
+- if ((*p&l0)==l0) p++;
+-
+- return p+1;
++ for (p=p+2;p<pe && ((*p)>>20)!=0xe28;p++);
++ return p;
+
+ }
+
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-39) unstable; urgency=medium
+ .
+ * pathnames1.1
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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'
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-31) unstable; urgency=medium
+ .
+ * Version_2_6_13pre39
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: <YYYY-MM-DD>
+
+--- gcl-2.6.12.orig/o/unexelf.c
++++ gcl-2.6.12/o/unexelf.c
+@@ -428,6 +428,8 @@ extern void fatal (char *, ...);
+ #include <syms.h> /* 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
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-50) unstable; urgency=medium
+ .
+ * list_order.6
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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<<log_maxpage_bound);j>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();
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-54) unstable; urgency=medium
+ .
+ * list_order.11
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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;
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-47) unstable; urgency=high
+ .
+ * pathnames1.13
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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;q<vs_top;q++,l=&(*l)->c.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;q<vs_top;q++,l=&(*l)->c.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 <config-patches@gnu.org>.
+ #
+ # 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 <config-patch
+ version="\
+ GNU config.sub ($timestamp)
+
+-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."
+@@ -117,7 +117,7 @@ maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-
+ case $maybe_os in
+ nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \
+ linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \
+- knetbsd*-gnu* | netbsd*-gnu* | \
++ knetbsd*-gnu* | netbsd*-gnu* | netbsd*-eabi* | \
+ kopensolaris*-gnu* | \
+ storm-chaos* | os2-emx* | rtmk-nova*)
+ os=-$maybe_os
+@@ -255,12 +255,13 @@ case $basic_machine in
+ | arc | arceb \
+ | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \
+ | avr | avr32 \
++ | ba \
+ | be32 | be64 \
+ | bfin \
+ | c4x | c8051 | clipper \
+ | d10v | d30v | dlx | dsp16xx \
+- | epiphany \
+- | fido | fr30 | frv \
++ | e2k | epiphany \
++ | fido | fr30 | frv | ft32 \
+ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \
+ | hexagon \
+ | i370 | i860 | i960 | ia64 \
+@@ -302,9 +303,10 @@ case $basic_machine in
+ | pdp10 | pdp11 | pj | pjl \
+ | powerpc | powerpc64 | powerpc64le | powerpcle \
+ | pyramid \
++ | riscv32 | riscv64 \
+ | rl78 | rx \
+ | score \
+- | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \
++ | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[234]eb | sheb | shbe | shle | sh[1234]le | sh3ele \
+ | sh64 | sh64le \
+ | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \
+ | sparcv8 | sparcv9 | sparcv9b | sparcv9v \
+@@ -312,6 +314,7 @@ case $basic_machine in
+ | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \
+ | ubicom32 \
+ | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \
++ | visium \
+ | we32k \
+ | x86 | xc16x | xstormy16 | xtensa \
+ | z8k | z80)
+@@ -326,6 +329,9 @@ case $basic_machine in
+ c6x)
+ basic_machine=tic6x-unknown
+ ;;
++ leon|leon[3-9])
++ basic_machine=sparc-$basic_machine
++ ;;
+ m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | nvptx | picochip)
+ basic_machine=$basic_machine-unknown
+ os=-none
+@@ -371,12 +377,13 @@ case $basic_machine in
+ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* | arceb-* \
+ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \
+ | avr-* | avr32-* \
++ | ba-* \
+ | be32-* | be64-* \
+ | bfin-* | bs2000-* \
+ | c[123]* | c30-* | [cjt]90-* | c4x-* \
+ | c8051-* | clipper-* | craynv-* | cydra-* \
+ | d10v-* | d30v-* | dlx-* \
+- | elxsi-* \
++ | e2k-* | elxsi-* \
+ | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \
+ | h8300-* | h8500-* \
+ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \
+@@ -423,12 +430,13 @@ case $basic_machine in
+ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \
+ | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \
+ | pyramid-* \
++ | riscv32-* | riscv64-* \
+ | rl78-* | romp-* | rs6000-* | rx-* \
+ | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \
+ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \
+ | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \
+ | sparclite-* \
+- | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \
++ | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx*-* \
+ | tahoe-* \
+ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \
+ | tile*-* \
+@@ -436,6 +444,7 @@ case $basic_machine in
+ | ubicom32-* \
+ | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \
+ | vax-* \
++ | visium-* \
+ | we32k-* \
+ | x86-* | x86_64-* | xc16x-* | xps100-* \
+ | xstormy16-* | xtensa*-* \
+@@ -512,6 +521,9 @@ case $basic_machine in
+ basic_machine=i386-pc
+ os=-aros
+ ;;
++ asmjs)
++ basic_machine=asmjs-unknown
++ ;;
+ aux)
+ basic_machine=m68k-apple
+ os=-aux
+@@ -773,6 +785,9 @@ case $basic_machine in
+ basic_machine=m68k-isi
+ os=-sysv
+ ;;
++ leon-*|leon[3-9]-*)
++ basic_machine=sparc-`echo $basic_machine | sed 's/-.*//'`
++ ;;
+ m68knommu)
+ basic_machine=m68k-unknown
+ os=-linux
+@@ -828,6 +843,10 @@ case $basic_machine in
+ basic_machine=powerpc-unknown
+ os=-morphos
+ ;;
++ moxiebox)
++ basic_machine=moxie-unknown
++ os=-moxiebox
++ ;;
+ msdos)
+ basic_machine=i386-pc
+ os=-msdos
+@@ -1360,7 +1379,7 @@ case $os in
+ | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \
+ | -sym* | -kopensolaris* | -plan9* \
+ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \
+- | -aos* | -aros* \
++ | -aos* | -aros* | -cloudabi* | -sortix* \
+ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \
+ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \
+ | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \
+@@ -1373,7 +1392,7 @@ case $os in
+ | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
+ | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \
+ | -linux-newlib* | -linux-musl* | -linux-uclibc* \
+- | -uxpv* | -beos* | -mpeix* | -udk* \
++ | -uxpv* | -beos* | -mpeix* | -udk* | -moxiebox* \
+ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \
+ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \
+ | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \
+--- gcl-2.6.12.orig/h/att_ext.h
++++ gcl-2.6.12/h/att_ext.h
+@@ -257,8 +257,8 @@ object cddddr();
+ object nth();
+ object nthcdr();
+ object make_cons();
+-object list(int,...);
+-object listA(int,...);
++object list(fixnum,...);
++object listA(fixnum,...);
+ object append();
+ object copy_list();
+ object make_list();
+@@ -399,6 +399,8 @@ object coerce_to_namestring();
+ EXTER object sKupcase;
+ EXTER object sKdowncase;
+ EXTER object sKcapitalize;
++EXTER object sKpreserve;
++EXTER object sKinvert;
+ EXTER object sKstream;
+ EXTER object sKreadably;
+ EXTER object sKescape;
+--- gcl-2.6.12.orig/h/compdefs.h
++++ gcl-2.6.12/h/compdefs.h
+@@ -51,7 +51,6 @@ complex
+ I
+ NOT_SPECIAL
+ VOL
+-compiled_functionp(x)
+ mpz_even_p(x)
+ mpz_odd_p(x)
+ mpz_sgn(x)
+@@ -115,5 +114,12 @@ SIGNED_CHAR(x)
+ FEerror(x,y...)
+ FEwrong_type_argument(x,y)
+ BIT_ENDIAN(x)
++integerp(x)
++rationalp(x)
++floatp(x)
++realp(x)
++numberp(x)
++vectorp(x)
++arrayp(x)
++compiled_function_p(x)
+ pathname_designatorp(x)
+-pathnamep(x)
+--- gcl-2.6.12.orig/h/compprotos.h
++++ gcl-2.6.12/h/compprotos.h
+@@ -27,8 +27,8 @@ object get_lcm(object,object);
+ object integer_count(object);
+ object integer_length(object);
+ object integer_shift(object,object);
+-object listA(int,...);
+-object list(int,...);
++object listA(fixnum,...);
++object list(fixnum,...);
+ object log_op2(fixnum,object,object);
+ object make_cons(object,object);
+ object make_fixnum1(long);
+--- gcl-2.6.12.orig/h/elf64_mips_reloc.h
++++ gcl-2.6.12/h/elf64_mips_reloc.h
+@@ -22,14 +22,33 @@
+ case R_MIPS_GOT_DISP:
+ case R_MIPS_CALL16:
+ case R_MIPS_GOT_PAGE:
++ case R_MIPS_GOT_HI16:
++ case R_MIPS_GOT_LO16:
++ case R_MIPS_CALL_HI16:
++ case R_MIPS_CALL_LO16:
+ recurse(s+a);
+ gote=got+(a>>32)-1;
+ a&=MASK(32);
+- store_val(where,MASK(16),((void *)gote-(void *)got));
+ if (s>=ggot && s<ggote) {
+ massert(!write_stub(s,got,gote));
+ } else
+ *gote=s+(a&~MASK(16))+((a&0x8000)<<1);
++ ((Rela *)r)->r_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;v<ve;v+=sec->sh_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 (;x<xe;f=x,x=(object)((void *)x+size)) {
++ x->fw=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;i<narg;i++)
++ collect(l,make_cons(base[i],Cnil));
++ *l=Cnil;
++ bind_var(rest->rest_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;a<vs_top;a++)
++ collect(l,make_cons(*a,Cnil));
++ *l=Cnil;
++ base++;
+ }
+ top = base + n;
+ va_start(ap,n);
+--- gcl-2.6.12.orig/o/cfun.c
++++ gcl-2.6.12/o/cfun.c
+@@ -217,20 +217,21 @@ DEFUN_NEW("MF",object,fSmf,SI
+ static object
+ MM(object sym, void (*self)(), char *start, int size, object data)
+ {
+- object cf;
++ object sfn;
+
+ if (type_of(sym) != t_symbol)
+ not_a_symbol(sym);
+ if (sym->s.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; j<n ; j++)
+- {enum ftype typ=SFUN_NEXT_TYPE(i);
+- x[j]=COERCE_ARG(vs_base[j],typ);}}
+- res=c_apply_n_fun(fun,n,x);
+- base[0]=
+- (restype==f_object ? res :
+- restype==f_fixnum ? make_fixnum((long)res)
+- :(object) (FEerror("Bad result type",0),Cnil));
+- vs_base = base;
+- vs_top=base+1;
++
++ x=vs_base;
++ if (i) {
++ int j;
++ x=alloca(n*sizeof(object));
++ for (j=0;j<n;j++) {
++ enum ftype typ=SFUN_NEXT_TYPE(i);
++ x[j]=COERCE_ARG(vs_base[j],typ);
++ }
++ }
++
++ base=vs_base;
++ *base=c_apply_n_fun(fun,n,x);
++ if (restype==f_fixnum)
++ *base=make_fixnum((fixnum)*base);
++
++ vs_top=(vs_base=base)+1;
++
+ CHECK_AVMA;
+- return;}
++ return;
++
++}
+
+ /* only for sfun not gfun !! Does not check number of args */
+ static void
+@@ -604,27 +607,33 @@ super_funcall(object fun)
+ }
+
+ void
+-super_funcall_no_event(object fun)
+-{
++super_funcall_no_event(object fun) {
++
+ #ifdef DEBUGGING_AVMA
+ funcall_no_event(fun); return;
+ #endif
+- if (type_of(fun)==t_cfun){(*fun->cf.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;i<RTABSIZE;i++)
+ mark_object_address(&x->rt.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;j<q;j++) { \
+- e = &hashtable->ht.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;e<ee;e++) { \
++ object hkey=e->hte_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_top<vs_base*/ \
+ BEGIN_NO_INTERRUPT; \
+- \
+- _tm->tm_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;i<fix(nn) && consp(y);i++,y=y->c.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<minargs;i++,atypes >>=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;i<x->s.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;i<x->s.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;i<x->s.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;i<x->s.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 || o<n)) {
++ SET_LINK(f,o);
++ f=o;
++ o=OBJ_LINK(o);
++ } else {
++ SET_LINK(f,n);
++ f=n;
++ n=OBJ_LINK(n);
+ }
+-
+- count=0;
+- if (f==tm->tm_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)&&i<n; s=s->c.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)&&i<n;s=s->c.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)
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-53) unstable; urgency=medium
+ .
+ * list_order.9
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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;i<x->s.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;i<x->s.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;i<x->s.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;i<x->a.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;i<x->v.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;i<x->a.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;i<x->v.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);
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-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 <camm@debian.org>
+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: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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);
+
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-57) unstable; urgency=medium
+ .
+ * list_order.13
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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);
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-58) unstable; urgency=medium
+ .
+ * list_order.14
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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;i<x->a.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;i<x->v.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;i<x->a.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;i<x->a.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;i<x->v.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;xp<PRINTvs_limit;xp++)
+- sethash(*xp,vs_head,MMcons(make_fixnum(xp-PRINTvs_top),Cnil));
+- PRINTvs_top[0]=vs_head;
+- PRINTvs_limit=vs_top=PRINTvs_top+1;
++}
++
++object sLeq;
++
++static void
++setupPRINTcircle(object x,int dogensyms) {
++
++ object *vp=vs_top,*v=vp,h;
++ fixnum j;
++
++ travel(x,dogensyms,PRINTarray);
++
++ h=vs_top>vp ? funcall_cfun(Lmake_hash_table,2,sKtest,sLeq) : Cnil;
++ for (j=0;v<vs_top;v++)
++ if (!imcdr(*v) || gethash(*v,h)->hte_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));
+
+ }
+
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-59) unstable; urgency=medium
+ .
+ * list_order.16
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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 (s<textend && (textstart>textend || s>textstart))
+- textstart=s;
+-
+- textpage=2*(textend-textstart)/PAGESIZE;
+-
+-}
+-#endif
+-
+ object malloc_list=Cnil;
+
+ #include <signal.h>
+@@ -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<textpage) */
+-/* new_holepage=textpage; */
+-/* #endif */
+-
+ /* Unused (at present) tm_distinct flag added. Note that if cons
+ and fixnum share page types, errors will be introduced.
+
+@@ -1348,10 +1321,6 @@ gcl_init_alloc(void *cs_start) {
+ ncbpage = 0;
+ tm_table[t_contiguous].tm_min_grow=256;
+ set_tm_maxpage(tm_table+t_contiguous,1);
+-#ifdef GCL_GPROF
+- if (maxcbpage<textpage)
+- set_tm_maxpage(tm_table+t_contiguous,textpage);
+-#endif
+
+ set_tm_maxpage(tm_table+t_relocatable,1);
+ nrbpage=0;
+@@ -1563,113 +1532,6 @@ DEFUN_NEW("GET-HOLE-SIZE",object,fSget_h
+ RETURN1(make_fixnum((rb_start-heap_end)>>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;i<tm->tm_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_start<min ? x->cfd.cfd_start : min;
++ max=(void *)x->cfd.cfd_start+x->cfd.cfd_size>max ? x->cfd.cfd_start+x->cfd.cfd_size : max;
++ }
++
++ if (max<min)
++ min=max;
++
++ if (!mintext) {
++
++ mintext=data_start;
++
++#ifdef GCL_GPROF
++ for (i=0;i<c_table.length;i++)
++ mintext=(void *)c_table.ptable[i].address<mintext ? (void *)c_table.ptable[i].address : mintext;
++ for (i=0;i<c_table.local_length;i++)
++ mintext=(void *)c_table.local_ptable[i].address<mintext ? (void *)c_table.local_ptable[i].address : mintext;
++#endif
++
++ }
++
++ if (mintext<data_start)
++ min=mintext;
++
++ RETURN2(make_fixnum((fixnum)min),make_fixnum((fixnum)max));
++
++}
++
++DEFUN_NEW("KCL-SELF",object,fSkcl_self,SI,0,0,NONE,OO,OO,OO,OO,(void),"") {
++
++ return make_simple_string(kcl_self);
++
++}
++
++DEFUN_NEW("WRITE-SYMTAB",object,fSwrite_symtab,SI,3,3,NONE,OO,II,OO,OO,
++ (object symtab,ufixnum start,ufixnum end),"") {
++
++ struct package *p;
++ object l,s,f,*b,*be;
++ FILE *pp;
++ ufixnum i;
++
++ coerce_to_filename(symtab,FN1);
++ pp=fopen(FN1,"w");
++ fprintf(pp,"%016lx T GCL_MONSTART\n",start);
++ for (p=pack_pointer;p;p=p->p_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 (;b<be;b++)
++ for (l=*b;consp(l);l=l->c.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_self<end)
++ fprintf(pp,"%016lx T %-.*s::%-.*s\n",
++ (ufixnum)f->cf.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;i<c_table.length;i++)
++ fprintf(pp,"%016lx T %s\n",c_table.ptable[i].address,c_table.ptable[i].string);
++ for (i=0;i<c_table.local_length;i++)
++ fprintf(pp,"%016lx t %s\n",c_table.local_ptable[i].address,c_table.local_ptable[i].string);
++ fclose(pp);
++
++ return symtab;
++
++}
+--- gcl-2.6.12.orig/o/main.c
++++ gcl-2.6.12/o/main.c
+@@ -334,9 +334,7 @@ minimize_image(void) {
+ nrbpage=0;
+ resize_hole(0,t_relocatable,0);
+
+-#ifdef GCL_GPROF
+ gprof_cleanup();
+-#endif
+
+ #if defined(BSD) || defined(ATT)
+ mbrk(core_end=heap_end);
+@@ -425,9 +423,7 @@ gcl_cleanup(int gc) {
+ {extern void _cleanup(void);_cleanup();}
+ #endif
+
+-#ifdef GCL_GPROF
+ gprof_cleanup();
+-#endif
+
+ if (gc) {
+
+--- 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 clxsocket init_pari nsocket sfasl prelink)
++ sockets clxsocket init_pari nsocket sfasl prelink gprof)
+ OBJS:=$(OBJS) $(RL_OBJS) $(EXTRAS)
+
+ INI_FILES=$(patsubst %.o,%.ini,${OBJS})
+@@ -33,6 +33,9 @@ all: $(OBJECTS)
+ 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)
++
+ prelink.o: prelink.c $(DECL)
+ $(CC) -c $(filter-out -pg,$(CFLAGS)) -fPIE $(DEFS) $*.c $(AUX_INFO)
+
+--- gcl-2.6.12.orig/o/sfasl.c
++++ gcl-2.6.12/o/sfasl.c
+@@ -273,17 +273,15 @@ SEEK_TO_END_OFILE(fp);
+ /* allocate some memory */
+ #ifndef STAND
+ {BEGIN_NO_INTERRUPT;
+- memory = alloc_object(t_cfdata);
+- memory->cfd.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<<max_align;
+
+- memory = alloc_object(t_cfdata);
+- memory->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;sec<sece;sec++) {
+@@ -259,7 +257,7 @@ load_self_symbols() {
+
+ for (ns=sl=0,sym=sy1;sym<sye;sym++) {
+
+- if (sym->n_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;sym<sye;sym++) {
++
++ if (sym->n_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;sym<syme;sym++) {
+
+- if (!LOAD_SYM(sym,st1))
++ if (!LOAD_SYM(sym))
+ continue;
+
+ if (d1) {
+@@ -431,13 +432,13 @@ calc_space(ul *ns,ul *sl,Sym *sym1,Sym *
+
+ static int
+ load_ptable(struct node **a,char **s,Sym *sym1,Sym *syme,const char *st1,
+- Sym *d1,Sym *de,const char *ds1) {
++ Sym *d1,Sym *de,const char *ds1,ufixnum lp) {
+
+ Sym *sym,*d;
+
+ for (sym=sym1;sym<syme;sym++) {
+
+- if (!LOAD_SYM(sym,st1))
++ if (!LOAD_SYM(sym) || (LOCAL_SYM(sym) ? !lp : lp))
+ continue;
+
+ if (d1) {
+@@ -488,16 +489,23 @@ load_self_symbols() {
+ massert(!calc_space(&ns,&sl,dsym1,dsyme,dst1,NULL,NULL,NULL));
+ massert(!calc_space(&ns,&sl,sym1,syme,st1,dsym1,dsyme,dst1));
+
+- c_table.alloc_length=c_table.length=ns;
++ c_table.alloc_length=ns;
+ massert(c_table.ptable=malloc(sizeof(*c_table.ptable)*c_table.alloc_length));
+ massert(s=malloc(sl));
+
+ a=c_table.ptable;
+- massert(!load_ptable(&a,&s,dsym1,dsyme,dst1,NULL,NULL,NULL));
+- massert(!load_ptable(&a,&s,sym1,syme,st1,dsym1,dsyme,dst1));
+-
++ massert(!load_ptable(&a,&s,dsym1,dsyme,dst1,NULL,NULL,NULL,0));
++ massert(!load_ptable(&a,&s,sym1,syme,st1,dsym1,dsyme,dst1,0));
++ 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;
++ massert(!load_ptable(&a,&s,sym1,syme,st1,dsym1,dsyme,dst1,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(v1,ve));
+ massert(!fclose(f));
+
+--- gcl-2.6.12.orig/o/sfaslmacho.c
++++ gcl-2.6.12/o/sfaslmacho.c
+@@ -203,10 +203,8 @@ load_memory(struct section *sec1,struct
+ 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,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;sym<syme;sym++) {
+
+- if (sym->n_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;sym<syme;sym++) {
++
++ if (sym->n_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@)
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-60) unstable; urgency=medium
+ .
+ * list_order.17
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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)
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-60) unstable; urgency=medium
+ .
+ * list_order.18
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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;i<c_table.length;i++)
++ for (i=0;i<c_table.alloc_length;i++)
+ mintext=(void *)c_table.ptable[i].address<mintext ? (void *)c_table.ptable[i].address : mintext;
+- for (i=0;i<c_table.local_length;i++)
+- mintext=(void *)c_table.local_ptable[i].address<mintext ? (void *)c_table.local_ptable[i].address : mintext;
+ #endif
+
+ }
+@@ -88,7 +83,7 @@ DEFUNM_NEW("GPROF-ADDRESSES",object,fSgp
+ if (mintext<data_start)
+ min=mintext;
+
+- RETURN2(make_fixnum((fixnum)min),make_fixnum((fixnum)max));
++ return MMcons(make_fixnum((fixnum)min),make_fixnum((fixnum)max));
+
+ }
+
+@@ -98,40 +93,14 @@ DEFUN_NEW("KCL-SELF",object,fSkcl_self,S
+
+ }
+
+-DEFUN_NEW("WRITE-SYMTAB",object,fSwrite_symtab,SI,3,3,NONE,OO,II,OO,OO,
+- (object symtab,ufixnum start,ufixnum end),"") {
+-
+- struct package *p;
+- object l,s,f,*b,*be;
+- FILE *pp;
+- ufixnum i;
+-
+- coerce_to_filename(symtab,FN1);
+- pp=fopen(FN1,"w");
+- fprintf(pp,"%016lx T GCL_MONSTART\n",start);
+- for (p=pack_pointer;p;p=p->p_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 (;b<be;b++)
+- for (l=*b;consp(l);l=l->c.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_self<end)
+- fprintf(pp,"%016lx T %-.*s::%-.*s\n",
+- (ufixnum)f->cf.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;i<c_table.length;i++)
+- fprintf(pp,"%016lx T %s\n",c_table.ptable[i].address,c_table.ptable[i].string);
+- for (i=0;i<c_table.local_length;i++)
+- fprintf(pp,"%016lx t %s\n",c_table.local_ptable[i].address,c_table.local_ptable[i].string);
+- fclose(pp);
+-
+- return symtab;
++DEFUN_NEW("PTABLE-ALLOC-LENGTH",object,fSptable_alloc_length,SI,0,0,NONE,OO,OO,OO,OO,(void),"") {
++ return make_fixnum(c_table.alloc_length);
++}
+
++DEFUNM_NEW("PTABLE",object,fSptable,SI,2,2,NONE,OI,OO,OO,OO,(ufixnum i,object s),"") {
++ check_type_string(&s);
++ massert(i<c_table.alloc_length);
++ s->st.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);
+ }
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-60) unstable; urgency=medium
+ .
+ * list_order.19
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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);
+ }
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-61) unstable; urgency=medium
+ .
+ * list_order.20
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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 <ucontext.h>
+-#define GET_FAULT_ADDR(sig,code,scp,addr) \
+- (char *)((struct ucontext *)scp )->uc_mcontext.sc_traparg_a0
+-#endif
+-#define SGC
++/* #ifdef IN_GBC */
++/* #include <ucontext.h> */
++/* #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"
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-61) unstable; urgency=medium
+ .
+ * list_order.21
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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<syme;sym++) {
+
+- if (!LOAD_SYM(sym))
++ if (!LOAD_SYM(sym,st1))
+ continue;
+
+ if (d1) {
+@@ -438,7 +436,7 @@ load_ptable(struct node **a,char **s,Sym
+
+ for (sym=sym1;sym<syme;sym++) {
+
+- if (!LOAD_SYM(sym) || (LOCAL_SYM(sym) ? !lp : lp))
++ if (!LOAD_SYM(sym,st1) || (EXT_SYM(sym,st1) ? lp : !lp))
+ continue;
+
+ if (d1) {
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-62) unstable; urgency=medium
+ .
+ * list_order.22
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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")),
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-63) unstable; urgency=medium
+ .
+ * list_order.23
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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*/
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-64) unstable; urgency=medium
+ .
+ * list_order.24
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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
+
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-57) unstable; urgency=medium
+ .
+ * list_order.13
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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)
+
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-48) unstable; urgency=medium
+ .
+ * list_order.1
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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 && s<ggote) {
+ massert(!write_stub(s,got,gote));
+ } else
+- *gote=s+(a&~MASK(16))+((a&0x8000)<<1);
+- ((Rela *)r)->r_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;sym<syme;sym++)
+- sym->st_size=0;
++ sym->st_other=sym->st_size=0;
+
+- for (*gs=0,sec=sec1;sec<sece;sec++)
++ for (sec=sec1;sec<sece;sec++)
+ if (sec->sh_type==SHT_RELA)
+ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;v<ve;v+=sec->sh_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;sec<sece;sec++)
++ if (sec->sh_type==SHT_RELA)
++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;v<ve;v+=sec->sh_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*a<sizeof(sym->st_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))<<b);
+
+ }
+
+--- gcl-2.6.12.orig/h/pool.h
++++ gcl-2.6.12/h/pool.h
+@@ -20,7 +20,7 @@ static struct pool {
+ ufixnum s;
+ } *Pool;
+
+-static struct flock pl;
++static struct flock pl,*plp=&pl;
+
+ static const char *gcl_pool="/tmp/gcl_pool";
+
+@@ -28,7 +28,7 @@ static int
+ set_lock(void) {
+
+ errno=0;
+- if (fcntl(pool,F_SETLKW,&pl)) {
++ if (fcntl(pool,F_SETLKW,plp)) {
+ if (errno==EINTR)
+ set_lock();
+ return -1;
+@@ -90,16 +90,13 @@ open_pool(void) {
+ 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));
++ plp=&f;
++ massert(!set_lock());
++
++ plp=&pl;
+
+ register_pool(1);
+ massert(!atexit(close_pool));
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-49) unstable; urgency=medium
+ .
+ * list_order.5
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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;
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-50) unstable; urgency=medium
+ .
+ * list_order.6
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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 <asm/cachectl.h>
+ 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;
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-51) unstable; urgency=medium
+ .
+ * list_order.7
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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;
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-52) unstable; urgency=medium
+ .
+ * list_order.8
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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);
+ }
+ }
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-38) unstable; urgency=medium
+ .
+ * Version_2_6_13pre50
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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: #<error during printing>~%")))
++ (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 <errno.h>
+ #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"\1f"))
+ (defconstant +crnp+ (compile-regexp #u"[\1f\f]"))
+
+--- 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 <string.h>
+
+ 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) {
+
+ \f
+
++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<<LOG_BITS_CHAR); */
+-/* #ifdef CONTBLOCK_MARK_DEBUG */
+-/* off_check(v,ve,i,pi); */
+-/* #endif */
+-/* v[i]|=(1UL<<s); */
+-/* } */
+-
+ #define bit_get(v,i,s) ((v[i]>>s)&0x1)
+ #define bit_set(v,i,s) (v[i]|=(1UL<<s))
+ #define ptr_get(v,i,s) (v+(((i<<LOG_BITS_CHAR)|s)<<LOG_BYTES_CONTBLOCK))
+@@ -226,11 +216,6 @@ get_mark_bit(struct pageinfo *pi,void *x
+ return get_bit(CB_MARK_START(pi),pi,x);
+ }
+
+-/* static inline void */
+-/* set_mark_bit(struct pageinfo *pi,void *x) { */
+-/* set_bit(CB_MARK_START(pi),pi,x); */
+-/* } */
+-
+ static inline void *
+ get_mark_bits(struct pageinfo *pi,void *x) {
+ return get_bits(CB_MARK_START(pi),pi,x);
+@@ -248,11 +233,6 @@ get_sgc_bit(struct pageinfo *pi,void *x)
+ return get_bit(CB_SGCF_START(pi),pi,x);
+ }
+
+-/* static inline void */
+-/* set_sgc_bit(struct pageinfo *pi,void *x) { */
+-/* set_bit(CB_SGCF_START(pi),pi,x); */
+-/* } */
+-
+ static inline void *
+ get_sgc_bits(struct pageinfo *pi,void *x) {
+ return get_bits(CB_SGCF_START(pi),pi,x);
+@@ -438,16 +418,16 @@ mark_leaf_data(object x,void **pp,ufixnu
+ if (!marking(p)||!collecting(p))
+ return;
+
+- if (what_to_collect!=t_contiguous &&
++ if (what_to_collect!=t_contiguous &&
+ x && x->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.st<rst.d.st) x->d.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;i<j;i++)
+- if (s_type[i]==0)
++ if (s_type[i]==aet_object)
+ mark_object_address(&STREF(object,x,s_pos[i]),i);
+ MARK_LEAF_DATA(x,x->str.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;i<contblock_array->v.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;tm<tm_table+t_end;tm++) { */
+-
+-/* for (x=tm->tm_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;p<promotion_pointer;p++) { */
+-/* fixnum j; */
+-/* object x=*p; */
+-
+-/* if (type_of(x)==t_string) */
+-
+-/* j=x->st.st_dim; */
+-
+-/* else switch (x->v.v_elttype) { */
+-
+-/* case aet_lf: */
+-/* j=sizeof(longfloat)*x->v.v_dim; */
+-/* break; */
+-/* case aet_bit: */
+-/* #define W_SIZE (8*sizeof(fixnum)) */
+-/* j=sizeof(fixnum)*((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE); */
+-/* break; */
+-/* case aet_char: */
+-/* case aet_uchar: */
+-/* j=sizeof(char)*x->v.v_dim; */
+-/* break; */
+-/* case aet_short: */
+-/* case aet_ushort: */
+-/* j=sizeof(short)*x->v.v_dim; */
+-/* break; */
+-/* default: */
+-/* j=sizeof(fixnum)*x->v.v_dim; */
+-/* } */
+-
+-/* st->st.st_dim=j; */
+-/* st->st.st_self=alloc_contblock(st->st.st_dim); */
+-/* fprintf(stderr,"Promoting vector leaf bytes %lu at %p, %p -> %p\n",j,x,x->v.v_self,st->st.st_self); */
+-/* fflush(stderr); */
+-/* memcpy(st->st.st_self,x->v.v_self,st->st.st_dim); */
+-/* x->v.v_self=(void *)st->st.st_self; */
+-/* } */
+-/* promoting=0; */
+-/* } */
+-/* } */
+-
+-
+ #ifdef DEBUG
+ if (debug) {
+ 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;k<contblock_array->v.v_fillp && (v=(void *)contblock_array->v.v_self[k]);k++,i+=v->in_use,j++)
++
++ for (i=j=k=0;k<contblock_array->v.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 <string.h>
+ #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 <string.h>
+ #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("#<synonym stream to ");
+ write_object(x->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;i<contblock_array->v.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) && i<end) continue;
+
+- if (sgc_mprotect(beg,i-beg,writable))
++ if (sgc_mprotect(beg,i-beg,writable))
+ return -1;
+ writable=1-writable;
+ beg=i;
+--- gcl-2.6.12.orig/o/toplevel.c
++++ gcl-2.6.12/o/toplevel.c
+@@ -173,7 +173,7 @@ FFN(Flocally)(object body)
+ object *oldlex = lex_env;
+
+ lex_copy();
+- body = find_special(body, NULL, NULL);
++ body = find_special(body, NULL, NULL,NULL);
+ vs_push(body);
+ Fprogn(body);
+ lex_env = oldlex;
+--- gcl-2.6.12.orig/o/typespec.c
++++ gcl-2.6.12/o/typespec.c
+@@ -231,114 +231,71 @@ DEF_ORDINARY("SIGNED-SHORT",sSsigned_sho
+ 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,"");
+-DEF_ORDINARY("FLOATING-POINT-INEXACT",sLfloating_point_inexact,LISP,"");
+-DEF_ORDINARY("FLOATING-POINT-INVALID-OPERATION",sLfloating_point_invalid_operation,LISP,"");
+-DEF_ORDINARY("FLOATING-POINT-OVERFLOW",sLfloating_point_overflow,LISP,"");
+-DEF_ORDINARY("FLOATING-POINT-UNDERFLOW",sLfloating_point_underflow,LISP,"");
+-DEF_ORDINARY("PROGRAM-ERROR",sLprogram_error,LISP,"");
+-DEF_ORDINARY("UNDEFINED-FUNCTION",sLundefined_function,LISP,"");
+-DEF_ORDINARY("UNBOUND-VARIABLE",sLunbound_variable,LISP,"");
+-DEF_ORDINARY("PACKAGE-ERROR",sLpackage_error,LISP,"");
+
+ DEF_ORDINARY("METHOD-COMBINATION",sLmethod_combination,LISP,"");
+-DEF_ORDINARY("ARITHMETIC-ERROR",sLarithmetic_error,LISP,"");
+ DEF_ORDINARY("BASE-CHAR",sLbase_char,LISP,"");
+ DEF_ORDINARY("BASE-STRING",sLbase_string,LISP,"");
+ DEF_ORDINARY("BROADCAST-STREAM",sLbroadcast_stream,LISP,"");
+ DEF_ORDINARY("BUILT-IN-CLASS",sLbuilt_in_class,LISP,"");
+-DEF_ORDINARY("CELL-ERROR",sLcell_error,LISP,"");
+ DEF_ORDINARY("CLASS",sLclass,LISP,"");
+ DEF_ORDINARY("CONCATENATED-STREAM",sLconcatenated_stream,LISP,"");
+-DEF_ORDINARY("CONDITION",sLcondition,LISP,"");
+-DEF_ORDINARY("CONTROL-ERROR",sLcontrol_error,LISP,"");
+ DEF_ORDINARY("ECHO-STREAM",sLecho_stream,LISP,"");
+-DEF_ORDINARY("END-OF-FILE",sLend_of_file,LISP,"");
+-DEF_ORDINARY("ERROR",sLerror,LISP,"");
+ DEF_ORDINARY("EXTENDED-CHAR",sLextended_char,LISP,"");
+-DEF_ORDINARY("FILE-ERROR",sLfile_error,LISP,"");
+ DEF_ORDINARY("FILE-STREAM",sLfile_stream,LISP,"");
+ DEF_ORDINARY("GENERIC-FUNCTION",sLgeneric_function,LISP,"");
+ DEF_ORDINARY("LOGICAL-PATHNAME",sLlogical_pathname,LISP,"");
+ DEF_ORDINARY("METHOD",sLmethod,LISP,"");
+ /* FIXME -- need this for types in predlib.lsp, why can't we use the keyword sKpackage_error ? */
+-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("SERIOUS-CONDITION",sLserious_condition,LISP,"");
+ DEF_ORDINARY("SIMPLE-BASE-STRING",sLsimple_base_string,LISP,"");
+-DEF_ORDINARY("SIMPLE-CONDITION",sLsimple_condition,LISP,"");
+-DEF_ORDINARY("SIMPLE-TYPE-ERROR",sLsimple_type_error,LISP,"");
+-DEF_ORDINARY("SIMPLE-WARNING",sLsimple_warning,LISP,"");
+ DEF_ORDINARY("STANDARD-CLASS",sLstandard_class,LISP,"");
+ DEF_ORDINARY("STANDARD-GENERIC-FUNCTION",sLstandard_generic_function,LISP,"");
+ DEF_ORDINARY("STANDARD-METHOD",sLstandard_method,LISP,"");
+ DEF_ORDINARY("STANDARD-OBJECT",sLstandard_object,LISP,"");
+-DEF_ORDINARY("STORAGE-CONDITION",sLstorage_condition,LISP,"");
+-DEF_ORDINARY("STREAM-ERROR",sLstream_error,LISP,"");
+ DEF_ORDINARY("STRING-STREAM",sLstring_stream,LISP,"");
+ DEF_ORDINARY("STRUCTURE-CLASS",sLstructure_class,LISP,"");
+ DEF_ORDINARY("STRUCTURE-OBJECT",sLstructure_object,LISP,"");
+-DEF_ORDINARY("STYLE-WARNING",sLstyle_warning,LISP,"");
+ DEF_ORDINARY("SYNONYM-STREAM",sLsynonym_stream,LISP,"");
+ DEF_ORDINARY("TWO-WAY-STREAM",sLtwo_way_stream,LISP,"");
+-DEF_ORDINARY("TYPE-ERROR",sLtype_error,LISP,"");
+-DEF_ORDINARY("UNBOUND-SLOT",sLunbound_slot,LISP,"");
+-DEF_ORDINARY("WARNING",sLwarning,LISP,"");
+
+ 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");
+
+ void
+-gcl_init_typespec(void)
+-{
++gcl_init_typespec(void) {
+ }
+
+ void
+-gcl_init_typespec_function(void)
+-{
+- TSor_symbol_string
+- = make_cons(sLor, make_cons(sLsymbol, make_cons(sLstring, Cnil)));
+- enter_mark_origin(&TSor_symbol_string);
+- TSor_string_symbol
+- = make_cons(sLor, make_cons(sLstring, make_cons(sLsymbol, Cnil)));
+- enter_mark_origin(&TSor_string_symbol);
+- TSor_symbol_string_package
+- = make_cons(sLor,
+- make_cons(sLsymbol,
+- make_cons(sLstring,
+- make_cons(sLpackage, Cnil))));
+- enter_mark_origin(&TSor_symbol_string_package);
+-
+- TSnon_negative_integer
+- = make_cons(sLinteger,
+- make_cons(make_fixnum(0), make_cons(sLA, Cnil)));
+- enter_mark_origin(&TSnon_negative_integer);
+- TSpositive_number = make_cons(sLsatisfies, make_cons(sLplusp, Cnil));
+- enter_mark_origin(&TSpositive_number);
+- TSor_integer_float
+- = make_cons(sLor, make_cons(sLinteger, make_cons(sLfloat, Cnil)));
+- enter_mark_origin(&TSor_integer_float);
+- TSor_rational_float
+- = make_cons(sLor, make_cons(sLrational, make_cons(sLfloat, Cnil)));
+- enter_mark_origin(&TSor_rational_float);
++gcl_init_typespec_function(void) {
++
++ TSor_symbol_string=make_cons(sLor, make_cons(sLsymbol, make_cons(sLstring, Cnil)));
++ enter_mark_origin(&TSor_symbol_string);
++
++ TSor_string_symbol=make_cons(sLor, make_cons(sLstring, make_cons(sLsymbol, Cnil)));
++ enter_mark_origin(&TSor_string_symbol);
++
++ TSor_symbol_string_package=make_cons(sLor,make_cons(sLsymbol,make_cons(sLstring,make_cons(sLpackage, Cnil))));
++ enter_mark_origin(&TSor_symbol_string_package);
++
++ TSnon_negative_integer= make_cons(sLinteger,make_cons(make_fixnum(0), make_cons(sLA, Cnil)));
++ enter_mark_origin(&TSnon_negative_integer);
++
++ TSpositive_number=make_cons(sLsatisfies, make_cons(sLplusp, Cnil));
++ enter_mark_origin(&TSpositive_number);
++
++ TSor_integer_float=make_cons(sLor, make_cons(sLinteger, make_cons(sLfloat, Cnil)));
++ enter_mark_origin(&TSor_integer_float);
++
++ TSor_rational_float=make_cons(sLor, make_cons(sLrational, make_cons(sLfloat, Cnil)));
++ enter_mark_origin(&TSor_rational_float);
++
+ #ifdef UNIX
+- TSor_pathname_string_symbol
+- = make_cons(sLor,
+- make_cons(sLpathname,
+- make_cons(sLstring,
+- make_cons(sLsymbol,
+- Cnil))));
+- enter_mark_origin(&TSor_pathname_string_symbol);
++ TSor_pathname_string_symbol=make_cons(sLor,make_cons(sLpathname,make_cons(sLstring,make_cons(sLsymbol,Cnil))));
++ enter_mark_origin(&TSor_pathname_string_symbol);
+ #endif
+- TSor_pathname_string_symbol_stream
+- = make_cons(sLor,
+- make_cons(sLpathname,
+- make_cons(sLstring,
+- make_cons(sLsymbol,
+- make_cons(sLstream,
+- Cnil)))));
+- enter_mark_origin(&TSor_pathname_string_symbol_stream);
+
+- make_function("TYPE-OF", Ltype_of);
++ TSor_pathname_string_symbol_stream=make_cons(sLor,make_cons(sLpathname,make_cons(sLstring,make_cons(sLsymbol,make_cons(sLstream,Cnil)))));
++ enter_mark_origin(&TSor_pathname_string_symbol_stream);
++
++ make_function("TYPE-OF", Ltype_of);
++
+ }
+--- gcl-2.6.12.orig/o/unexec-19.29.c
++++ gcl-2.6.12/o/unexec-19.29.c
+@@ -936,7 +936,7 @@ copy_text_and_data (int new, int a_out)
+
+
+ /* The use of _execname is incompatible with RISCiX 1.1 */
+- sprintf (command, "nm %s | fgrep mcount", _execname);
++ sprintf (command, "nm '%s' | fgrep mcount", _execname);
+
+ if ( (pfile = popen(command, "r")) == NULL)
+ {
+--- gcl-2.6.12.orig/o/unexec.c
++++ gcl-2.6.12/o/unexec.c
+@@ -937,7 +937,7 @@ copy_text_and_data (int new, int a_out)
+
+
+ /* The use of _execname is incompatible with RISCiX 1.1 */
+- sprintf (command, "nm %s | fgrep mcount", _execname);
++ sprintf (command, "nm '%s' | fgrep mcount", _execname);
+
+ if ( (pfile = popen(command, "r")) == NULL)
+ {
+--- gcl-2.6.12.orig/o/unixfasl.c
++++ gcl-2.6.12/o/unixfasl.c
+@@ -279,9 +279,7 @@ AGAIN:
+ #define FASLINK
+ #ifndef PRIVATE_FASLINK
+
+-static int
+-faslink(object faslfile, object ldargstring)
+-{
++DEFUN_NEW("FASLINK-INT",object,fSfaslink_int,SI,2,2,NONE,II,OO,OO,OO,(object faslfile, object ldargstring),"") {
+ #if defined(__ELF__) || defined(DARWIN)
+ FEerror("faslink() not supported for ELF or DARWIN yet",0);
+ return 0;
+@@ -381,36 +379,10 @@ SEEK_TO_END_OFILE(faslfile->sm.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 <sys/dir.h>
+
+@@ -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 <sys/dir.h>
+-
+-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 <sys/types.h>
+ #include <dirent.h>
+
+@@ -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 <sys/types.h>
++#include <dirent.h>
++#include <fcntl.h>
++#include <unistd.h>
++
++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
+
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-45) unstable; urgency=high
+ .
+ * pathnames1.11
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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 || tp<t_fixnum;}))) */
+- /* tree=subst1qi(new,tree); */
+- /* else */
+- /* tree=subst1(new,tree); */
+- restoreTEST;
+- @(return tree)
+-@)
++/* @(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 || tp<t_fixnum;}))) *\/ */
++/* /\* tree=subst1qi(new,tree); *\/ */
++/* /\* else *\/ */
++/* /\* tree=subst1(new,tree); *\/ */
++/* restoreTEST; */
++/* @(return tree) */
++/* @) */
+
+-PREDICATE(Lsubst,Lsubst_if,Lsubst_if_not, 3)
++/* PREDICATE(Lsubst,Lsubst_if,Lsubst_if_not, 3) */
+
+
+ @(defun nsubst (new old tree &key test test_not key)
+@@ -1506,9 +1506,9 @@ gcl_init_list_function()
+ make_function("LDIFF", Lldiff);
+ make_function("RPLACA", Lrplaca);
+ make_function("RPLACD", Lrplacd);
+- make_function("SUBST", Lsubst);
+- make_function("SUBST-IF", Lsubst_if);
+- make_function("SUBST-IF-NOT", Lsubst_if_not);
++ /* make_function("SUBST", Lsubst); */
++ /* make_function("SUBST-IF", Lsubst_if); */
++ /* make_function("SUBST-IF-NOT", Lsubst_if_not); */
+ make_function("NSUBST", Lnsubst);
+ make_function("NSUBST-IF", Lnsubst_if);
+ make_function("NSUBST-IF-NOT", Lnsubst_if_not);
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-46) unstable; urgency=high
+ .
+ * pathnames1.12
+ * Bug fix: "maintainer script(s) do not start on #!", thanks to
+ treinen@debian.org</a>; (Closes: #843303).
+Author: Camm Maguire <camm@debian.org>
+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: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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)))
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-46) unstable; urgency=high
+ .
+ * pathnames1.12
+ * Bug fix: "maintainer script(s) do not start on #!", thanks to
+ treinen@debian.org</a>; (Closes: #843303).
+Author: Camm Maguire <camm@debian.org>
+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: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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))
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-39) unstable; urgency=medium
+ .
+ * pathnames1.1
+ * ansi-test clean target
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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 <errno.h>
+ #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 <string.h>
+-#include <stdlib.h>
+ #include <unistd.h>
+ #include <errno.h>
+
+@@ -32,140 +30,17 @@ Foundation, 675 Mass Ave, Cambridge, MA
+ #include <pwd.h>
+ #endif
+
+-#ifdef __MINGW32__
+-# include <windows.h>
++#ifdef __MINGW32__
++# include <windows.h>
+ /* 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 <sys/dir.h>
+-
+-
+-#ifndef HAVE_GETCWD
+-char dotdot[3*16+2] = "../../../../../../../../../../../../../../../../.";
+-#include <mnttab.h>
+-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_fillp<sz);
++ memcpy(p,namestring->st.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 (;s<qe && *s!='/';s++);
++}
+
+- if (s==q && (c=getenv("HOME")))
++DEFUN_NEW("UID-TO-NAME",object,fSuid_to_name,SI,1,1,NONE,OI,OO,OO,OO,(fixnum uid),"") {
++ struct passwd *pwent,pw;
++ long r;
+
+- pcopy(c,p,0,m=strlen(c));
+-
+-#if !defined(NO_PWD_H) && !defined(STATIC_LINKING)
+- else {
+-#ifndef __STDC__
+- extern struct passwd *getpwuid();
+- extern struct passwd *getpwnam();
+-#endif
+- struct passwd *pwent;
+-
+- if (s==q)
+- pwent=getpwuid(getuid());
+- else {
+- *s=0;
+- pwent=getpwnam(q);
+- *s='/';
+- }
+-
+- if (!pwent)
+- FEerror("Can't expand pathname ~a",1,namestring);
+- pcopy(pwent->pw_dir,p,0,m=strlen(pwent->pw_dir));
+-
+- }
+-#endif
++ massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0);
++ massert(r<sizeof(FN1));
+
+- pcopy(s,p,m,qe-s);
+-
+- } else
++ massert(!getpwuid_r(uid,&pw,FN1,r,&pwent));
++
++ RETURN1(make_simple_string(pwent->pw_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<sizeof(FN1));
+
+-#ifdef __MINGW32__
+- {
+- char *p;
+- for (p = filename; *p != '\0'; p++);
+- if ( (p > 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_fillp<sizeof(FN2));
++ memcpy(FN2,nm->st.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)+2<sizeof(FN3));
++ memcpy(FN3,pwent->pw_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 <sys/types.h>
++#include <dirent.h>
++#include <fcntl.h>
++#include <unistd.h>
++
++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(z1<sizeof(FN1));
++ memcpy(FN1,s->st.st_self,z1);
++ FN1[z1]=0;
++ massert((l=readlinkat(d ? dirfd((DIR *)d) : AT_FDCWD,FN1,FN2,sizeof(FN2)))>=0 && l<sizeof(FN2));
++ FN2[l]=0;
++ RETURN1(make_simple_string(FN2));
++
++}
++
++DEFUN_NEW("GETCWD",object,fSgetcwd,SI,0,0,NONE,OO,OO,OO,OO,(void),"") {
++ massert((getcwd(FN1,sizeof(FN1))));
++ RETURN1(make_simple_string(FN1));
++}
++
+ DEFUN_NEW("SETENV",object,fSsetenv,SI,2,2,NONE,OO,OO,OO,OO,(object variable,object value),"Set environment VARIABLE to VALUE")
+
+ {
+@@ -407,13 +235,9 @@ DEFUN_NEW("SETENV",object,fSsetenv,SI,2,
+ #include <dirent.h>
+
+ 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 <sys/types.h>
+-#include <dirent.h>
+-#include <fcntl.h>
+-#include <unistd.h>
++ 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 <sys/mman.h>
+
+- 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 <sys/mman.h>
+-
+-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) {
+
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-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 <camm@debian.org>
+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: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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<sizeof(FN1));
++ massert(r<=sizeof(FN1));/*FIXME maybe once at image startup*/
+
+ massert(!getpwuid_r(uid,&pw,FN1,r,&pwent));
+
+@@ -97,7 +97,7 @@ DEFUN_NEW("HOME-NAMESTRING",object,fShom
+ long r;
+
+ massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0);
+- massert(r<sizeof(FN1));
++ massert(r<=sizeof(FN1));/*FIXME maybe once at image startup*/
+
+ if (nm->st.st_fillp==1)
+
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-41) unstable; urgency=medium
+ .
+ * pathnames1.3, kfreebsd fix
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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));
+ }
+
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-41) unstable; urgency=medium
+ .
+ * pathnames1.4, kfreebsd fix
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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<<XXXX can be attained
+- --enable-holepage=XXXX will compile in a XXX-sized hole between the heap and relocatable memory area (eg '--enable-holepage=64*1024' would give 64K pages allowing 256 MB if pages are 4K each)
+- --enable-vssize=XXXX will compile in a value stack of size XXX
+- --enable-bdssize=XXXX will compile in a binding stack of size XXX
+- --enable-ihssize=XXXX will compile in a invocation history stack of size XXX
+- --enable-frssize=XXXX will compile in a frame stack of size XXX
+- --enable-machine=XXXX will force the use of one of the definitions in h/XXXX.defs
+- --enable-immfix will enable an immediate fixnum table
+- above the C stack
+- --enable-notify=no will disable the automatic notification of gcl maintainers of successful builds/problems
+- try to build gcl-tk
+- --enable-tkconfig=XXXX will force the use of a TK_CONFIG_PREFIX=XXXXX as place to look for tkConfig.sh and tclConfig.sh
+- --enable-tclconfig=XXXX will force the use of a TCL_CONFIG_PREFIX=XXXXX as place to look for tclConfig.sh and tclConfig.sh
+- --enable-infodir=XXXX will force the use of a INFO_DIR=XXXXX as place to look for info
+- --enable-emacsdir=XXXX will manually specify the location for elisp files
+- --enable-common-binary=yes forces use of lowest common denominator instruction sets, (default is =yes)
+- --enable-japi=yes will compile in support for the JAPI graphical interface if present on your system
+- --enable-xdr=yes will compile in support for XDR
+- --enable-xgcl=yes will compile in support for XGCL
+- --enable-dlopen uses dlopen for loading objects, which can then not be retained in saved images
+-
+- --enable-statsysbfd uses a static sytem bfd library for loading and relocationing object files
+-
+- --enable-dynsysbfd uses a dynamic shared sytem bfd library for loading and relocationing object files
+-
+- --enable-custreloc uses custom gcl code if available for loading and relocationing object files
+-
+- --enable-debug builds gcl with -g in CFLAGS to enable running under gdb
+-
+- --enable-gprof builds gcl with -pg in CFLAGS to enable profiling with gprof
+-
+- --enable-static will link your GCL against static as opposed to shared system libraries
+- --enable-pic builds gcl with -fPIC in CFLAGS
+-
+- --enable-oldgmp will link against gmp2 instead of gmp3
+-
+- --enable-dynsysgmp will link against the system libgmp3 overriding certain functions with patched versions from the local source
+-
+---enable-readline enables command line completion via the readline library
+---enable-ansi builds a large gcl aiming for ansi compliance,
+- --disable-ansi builds the smaller traditional CLtL1 image
++ --enable-machine=XXXX will force the use of one of the definitions in h/XXXX.defs
++ --enable-widecons will use a three word cons with simplified typing
++ --enable-safecdr will protect cdr from immfix and speed up type processing
++ --enable-safecdrdbg will debug safecdr code
++ --enable-prelink will insist that the produced images may be prelinked
++ --enable-vssize=XXXX will compile in a value stack of size XXX
++ --enable-bdssize=XXXX will compile in a binding stack of size XXX
++ --enable-ihssize=XXXX will compile in a invocation history stack of size XXX
++ --enable-frssize=XXXX will compile in a frame stack of size XXX
++ --enable-infodir=XXXX will force the use of a INFO_DIR=XXXXX as place to look for info
++ --enable-emacsdir=XXXX will manually specify the location for elisp files
++ --enable-xgcl=yes will compile in support for XGCL
++ --enable-dlopen uses dlopen for loading objects, which can then not be retained in saved images
++ --enable-statsysbfd uses a static sytem bfd library for loading and relocationing object files
++ --enable-dynsysbfd uses a dynamic shared sytem bfd library for loading and relocationing object files
++ --enable-custreloc uses custom gcl code if available for loading and relocationing object files
++ --enable-debug builds gcl with -g in CFLAGS to enable running under gdb
++ --enable-static will link your GCL against static as opposed to shared system libraries
++ --enable-pic builds gcl with -fPIC in CFLAGS
++ --enable-gprof builds gcl with -pg in CFLAGS to enable profiling with gprof
++ --enable-dynsysgmp will link against the system libgmp3 overriding certain functions with patched versions from the local source
++ --enable-xdr=yes will compile in support for XDR
++ --enable-immfix will enable an immediate fixnum table above the C stack
++ --enable-fastimmfix=XXXX will reject low immediate fixnums unless 2^XXX can be attained
++ --enable-ansi builds a large gcl aiming for ansi compliance
++ --enable-japi=yes will compile in support for the JAPI graphical interface if present on your system
++ --enable-readline enables command line completion via the readline library
++ --enable-tcltk will try to build gcl-tk
++ --enable-tkconfig=XXXX will force the use of a TK_CONFIG_PREFIX=XXXXX as place to look for tkConfig.sh and tclConfig.sh
++ --enable-tclconfig=XXXX will force the use of a TCL_CONFIG_PREFIX=XXXXX as place to look for tclConfig.sh and tclConfig.sh
++ --enable-notify=no will disable the automatic notification of gcl maintainers of successful builds/problems
+
+ Optional Packages:
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+@@ -1844,6 +1827,52 @@ $as_echo "$ac_res" >&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 <malloc/malloc.h>
++ #include <malloc/malloc.h>
+
+ "
+ 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 <stdio.h>
++ #include <setjmp.h>
+
+- #include <stdio.h>
+- #include <setjmp.h>
+- 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 <unistd.h>
+- #include <stdio.h>
+- 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 <unistd.h>
++ #include <stdio.h>
+
++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 <gmp.h>
+- int main() {
+- #if __GNU_MP_VERSION > 3
+- return 0;
+- #else
+- return -1;
+- #endif
+- }
++
++ #include <gmp.h>
++
++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 <<EOFF
+ #include <math.h>
+ #include <stdio.h>
+@@ -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 <stdio.h>
+- #include "$MP_INCLUDE"
++ #include <stdio.h>
++ #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 <stdio.h>
+- #include "$MP_INCLUDE"
++ #include <stdio.h>
++ #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 <stdio.h>
+- #include "$MP_INCLUDE"
++ #include <stdio.h>
++ #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 <bfd.h>
+- int main() { symbol_info t; return 0;}
++
++ #define IN_GCC
++ #include <bfd.h>
++
++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 <bfd.h>
+- int main() {symbol_info t; return 0;}
++
++ #define CONST const
++ #define IN_GCC
++ #include <bfd.h>
++
++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.h>
+- bfd_boolean foo() {return FALSE;}
++ #define IN_GCC
++ #include <bfd.h>
++ 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 <bfd.h>
+- #include <bfdlink.h>
++ #
++ # 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 <bfd.h>
++ #include <bfdlink.h>
+
+ "
+ 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 <stdio.h>
+- #include <unistd.h>
+- 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 <stdio.h>
++ #include <unistd.h>
++
++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 <stdio.h>
+- #include <unistd.h>
+- int main() {
+- unsigned long u;
+- long j;
+- if (__builtin_ctzl(0)!=sizeof(long)*8)
+- return -1;
+- for (u=1,j=0;j<sizeof(long)*8-1;j++,u<<=1)
+- if (__builtin_ctzl(u)!=j)
+- return -1;
+- return 0;
+- }
++ #include <stdio.h>
++ #include <unistd.h>
++
++int
++main ()
++{
++
++ unsigned long u;
++ long j;
++ if (__builtin_ctzl(0)!=sizeof(long)*8)
++ return -1;
++ for (u=1,j=0;j<sizeof(long)*8-1;j++,u<<=1)
++ if (__builtin_ctzl(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
+@@ -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 <stdio.h>
+- #include <unistd.h>
+- #ifdef __CYGWIN__
+- #define getpagesize() 4096
+- #endif
++ #include <stdio.h>
++ #include <unistd.h>
++ #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 <stdio.h>
+- #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 <stdio.h>
++ #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 <stdio.h>
+- #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 <stdio.h>
+- #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 <stdio.h>
++ #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 <unistd.h>
+- #include <stdio.h>
+- int main() {
++
++ #include <unistd.h>
++ #include <stdio.h>
++
++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 <sys/personality.h>
+- #include <stdio.h>
++ #include <sys/personality.h>
++ #include <stdio.h>
+
+ 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 <sys/personality.h>
+- #include <stdio.h>
++ #include <sys/personality.h>
++ #include <stdio.h>
+
+ 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 <sys/personality.h>
+- #include <stdio.h>
++ #include <sys/personality.h>
++ #include <stdio.h>
+
+ 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 <stdio.h>
++ #include <stdlib.h>
++ int main(int argc,char *argv[],char *envp[]) {
++ #include "h/unrandomize.h"
++ return 0;
++ }
+
+- #include <stdio.h>
+- #include <stdlib.h>
+- 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 <stdio.h>
+- #include <stdlib.h>
++
++ #include <stdio.h>
++ #include <stdlib.h>
+ 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 <stdio.h>
+- #include <stdlib.h>
++
++ #include <stdio.h>
++ #include <stdlib.h>
+ 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 <stdio.h>
+- #include <stdlib.h>
+- 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 <stdio.h>
++ #include <stdlib.h>
++ 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 <stdio.h>
+- #include <stdlib.h>
+- 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 <stdio.h>
++ #include <stdlib.h>
++ 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 <stdio.h>
+- #include <stdlib.h>
+- 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 <stdio.h>
++ #include <stdlib.h>
++ 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 <stdio.h>
+- #include <stdlib.h>
+- 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 <stdio.h>
++ #include <stdlib.h>
++ 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 <stdio.h>
+- #include <stdlib.h>
+- 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 <stdio.h>
++ #include <stdlib.h>
++ 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 </dev/null`
+- 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 -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 </dev/null`
+- done
++ 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 </dev/null`
++ 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 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 </dev/null`
++ done
+
+- { $as_echo "$as_me:${as_lineno-$LINENO}: min log text start $min" >&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 </dev/null`
+ low_shft=`$AWK 'END {print n+1}' n=$max </dev/null`;
+ { $as_echo "$as_me:${as_lineno-$LINENO}: raising log text to $j for a $max bit wide low immfix table" >&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 <stdio.h>
++ #include <stdio.h>
+
+ 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<k ? k-1 : -1) : l;
+- for (i=j=k;j && i<l;j>>=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<k ? k-1 : -1) : l;
++ for (i=j=k;j && i<l;j>>=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 <stdio.h>
++ #include <stdio.h>
+
+ 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 <stdio.h>
++ #include <stdio.h>
+
+ 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 <dirent.h>
++ #include <dirent.h>
+
+ 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 <stdio.h>
++ #include <stdio.h>
+
+ 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 <math.h>
++ #define _GNU_SOURCE
++ #include <math.h>
+
+ 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 <ieeefp.h>
++ #include <ieeefp.h>
+
+ int
+ main ()
+ {
+
+- float f;
+- return fpclass(f)>=FP_NZERO || fpclass(f)<FP_NZERO ? 0 : 1;
++ float f;
++ return fpclass(f)>=FP_NZERO || fpclass(f)<FP_NZERO ? 0 : 1;
+
+ ;
+ return 0;
+@@ -8131,15 +7724,15 @@ else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+ /* end confdefs.h. */
+
+- #define _GNU_SOURCE
+- #include <math.h>
++ #define _GNU_SOURCE
++ #include <math.h>
+
+ 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 <math.h>
+- #include <ieeefp.h>
++ #include <math.h>
++ #include <ieeefp.h>
+
+ 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 <sys/time.h>
+-#include <sys/types.h>
+-#include <unistd.h>
+-
+-#include <errno.h>
+-#include <fcntl.h>
+-#include <stdio.h>
+-
+-/************* for the sockets ******************/
+-#include <sys/socket.h> /* struct sockaddr, SOCK_STREAM, ... */
+-#ifndef NO_UNAME
+-# include <sys/utsname.h> /* uname system call. */
+-#endif
+-#include <netinet/in.h> /* struct in_addr, struct sockaddr_in */
+-#include <arpa/inet.h> /* inet_ntoa() */
+-#include <netdb.h> /* gethostbyname() */
++ #include <sys/time.h>
++ #include <sys/types.h>
++ #include <unistd.h>
++
++ #include <errno.h>
++ #include <fcntl.h>
++ #include <stdio.h>
++
++ /************* for the sockets ******************/
++ #include <sys/socket.h> /* struct sockaddr, SOCK_STREAM, ... */
++ #ifndef NO_UNAME
++ # include <sys/utsname.h> /* uname system call. */
++ #endif
++ #include <netinet/in.h> /* struct in_addr, struct sockaddr_in */
++ #include <arpa/inet.h> /* inet_ntoa() */
++ #include <netdb.h> /* 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 <stdio.h>
+-#include <fcntl.h>
++
++ #include <stdio.h>
++ #include <fcntl.h>
+
+ 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 <signal.h>
+-int joe=SV_ONSTACK;
++
++ #include <signal.h>
++ 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 <signal.h>
+-int joe=SIGSYS;
++
++ #include <signal.h>
++ 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 <signal.h>
+-int joe=SIGEMT;
++
++ #include <signal.h>
++ 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 <signal.h>
++
++ #include <signal.h>
+
+ 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 <signal.h>
+- #ifdef HAVE_ASM_SIGCONTEXT_H
+- #include <asm/sigcontext.h>
+- #endif
+- #ifdef HAVE_ASM_SIGNAL_H
+- #include <asm/signal.h>
+- #endif
++
++ #include <signal.h>
++ #ifdef HAVE_ASM_SIGCONTEXT_H
++ #include <asm/sigcontext.h>
++ #endif
++ #ifdef HAVE_ASM_SIGNAL_H
++ #include <asm/signal.h>
++ #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 <<EOF
++ rm -f conftest.tcl
++ cat >> conftest.tcl <<EOF
+
+ puts [set tcl_version]
+
+ EOF
+
+- TCL_VERSION=`${TCLSH} < conftest.tcl`
+- fi
++ TCL_VERSION=`${TCLSH} < conftest.tcl`
++ fi
+
+- if test -x /usr/lib/tcl$TCL_VERSION/tclConfig.sh ; then
+- TCL_CONFIG_PREFIX=/usr/lib/tcl$TCL_VERSION
+- fi
++ if test -x /usr/lib/tcl$TCL_VERSION/tclConfig.sh ; then
++ TCL_CONFIG_PREFIX=/usr/lib/tcl$TCL_VERSION
++ fi
+
+- fi
++ fi
+
+- if test -f ${TCL_CONFIG_PREFIX}/tclConfig.sh ; then . ${TCL_CONFIG_PREFIX}/tclConfig.sh ; fi
++ if test -f ${TCL_CONFIG_PREFIX}/tclConfig.sh ; then . ${TCL_CONFIG_PREFIX}/tclConfig.sh ; fi
+
+- if test -d "${TK_CONFIG_PREFIX}" ; then true ; else
+- if test -f ${TCL_CONFIG_PREFIX}/tkConfig.sh ; then
+- TK_CONFIG_PREFIX=${TCL_CONFIG_PREFIX}
+- else
+- if test -x `echo $TCL_CONFIG_PREFIX | sed 's,tcl,tk,g'`/tkConfig.sh ; then
+- TK_CONFIG_PREFIX=`echo $TCL_CONFIG_PREFIX | sed 's,tcl,tk,g'`
+- fi
+- fi
+- fi
++ if test -d "${TK_CONFIG_PREFIX}" ; then true ; else
++ if test -f ${TCL_CONFIG_PREFIX}/tkConfig.sh ; then
++ TK_CONFIG_PREFIX=${TCL_CONFIG_PREFIX}
++ else
++ if test -x `echo $TCL_CONFIG_PREFIX | sed 's,tcl,tk,g'`/tkConfig.sh ; then
++ TK_CONFIG_PREFIX=`echo $TCL_CONFIG_PREFIX | sed 's,tcl,tk,g'`
++ fi
++ fi
++ fi
+
+- if test -f ${TK_CONFIG_PREFIX}/tkConfig.sh ; then . ${TK_CONFIG_PREFIX}/tkConfig.sh ; fi
++ if test -f ${TK_CONFIG_PREFIX}/tkConfig.sh ; then . ${TK_CONFIG_PREFIX}/tkConfig.sh ; fi
+
+- if test -d ${TCL_CONFIG_PREFIX}/tcl${TCL_VERSION} ; then
+- TCL_LIBRARY=${TCL_CONFIG_PREFIX}/tcl${TCL_VERSION}
+- else
+- if test -d ${TCL_CONFIG_PREFIX}/../tcl${TCL_VERSION} ; then
+- TCL_LIBRARY=${TCL_CONFIG_PREFIX}/../tcl${TCL_VERSION}
+- fi
+- fi
++ if test -d ${TCL_CONFIG_PREFIX}/tcl${TCL_VERSION} ; then
++ TCL_LIBRARY=${TCL_CONFIG_PREFIX}/tcl${TCL_VERSION}
++ else
++ if test -d ${TCL_CONFIG_PREFIX}/../tcl${TCL_VERSION} ; then
++ TCL_LIBRARY=${TCL_CONFIG_PREFIX}/../tcl${TCL_VERSION}
++ fi
++ fi
+
+- if test -d ${TK_CONFIG_PREFIX}/tk${TK_VERSION} ; then
+- TK_LIBRARY=${TK_CONFIG_PREFIX}/tk${TK_VERSION}
+- else
+- if test -d ${TK_CONFIG_PREFIX}/../tk${TK_VERSION} ; then
+- TK_LIBRARY=${TK_CONFIG_PREFIX}/../tk${TK_VERSION}
+- fi
+- fi
++ if test -d ${TK_CONFIG_PREFIX}/tk${TK_VERSION} ; then
++ TK_LIBRARY=${TK_CONFIG_PREFIX}/tk${TK_VERSION}
++ else
++ if test -d ${TK_CONFIG_PREFIX}/../tk${TK_VERSION} ; then
++ TK_LIBRARY=${TK_CONFIG_PREFIX}/../tk${TK_VERSION}
++ fi
++ fi
+
+- if test -f ${TCL_CONFIG_PREFIX}/../include/tcl.h ; then
+- TCL_INCLUDE=-I${TCL_CONFIG_PREFIX}/../include
+- else
+- if test -f /usr/include/tcl${TCL_VERSION}/tcl.h ; then
+- TCL_INCLUDE=-I/usr/include/tcl${TCL_VERSION}
+- fi
+- fi
++ if test -f ${TCL_CONFIG_PREFIX}/../include/tcl.h ; then
++ TCL_INCLUDE=-I${TCL_CONFIG_PREFIX}/../include
++ else
++ if test -f /usr/include/tcl${TCL_VERSION}/tcl.h ; then
++ TCL_INCLUDE=-I/usr/include/tcl${TCL_VERSION}
++ fi
++ fi
+
+- if test -f ${TK_CONFIG_PREFIX}/../include/tk.h ; then
+- TK_INCLUDE=-I${TK_CONFIG_PREFIX}/../include
+- else
+- if test -f /usr/include/tcl${TCL_VERSION}/tk.h ; then
+- TK_INCLUDE=-I/usr/include/tcl${TCL_VERSION}
+- fi
+- fi
++ if test -f ${TK_CONFIG_PREFIX}/../include/tk.h ; then
++ TK_INCLUDE=-I${TK_CONFIG_PREFIX}/../include
++ else
++ if test -f /usr/include/tcl${TCL_VERSION}/tk.h ; then
++ TK_INCLUDE=-I/usr/include/tcl${TCL_VERSION}
++ fi
++ fi
+
+- 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
++ 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 <stdio.h>
+-dnl #include <unistd.h>
+-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<<XXXX can be attained],
+-,[enable_fastimmfix=64])
+-
+-
+-AC_ARG_ENABLE(holepage,[ --enable-holepage=XXXX will compile in a XXX-sized hole between the heap and relocatable memory area (eg '--enable-holepage=64*1024' would give 64K pages allowing 256 MB if pages are 4K each)] ,
+-[AC_DEFINE_UNQUOTED(HOLEPAGE,$enable_holepage,[number of pages to use for hole])])
+-
+-AC_ARG_ENABLE(vssize,[ --enable-vssize=XXXX will compile in a value stack of size XXX] ,
+-,enable_vssize=262144)
+-AC_DEFINE_UNQUOTED(VSSIZE,$enable_vssize,[value stack size])
+-
+-AC_ARG_ENABLE(bdssize,[ --enable-bdssize=XXXX will compile in a binding stack of size XXX] ,
+-,enable_bdssize=2048)
+-AC_DEFINE_UNQUOTED(BDSSIZE,$enable_bdssize,[binding stack size])
+-
+-AC_ARG_ENABLE(ihssize,[ --enable-ihssize=XXXX will compile in a invocation history stack of size XXX] ,
+-,enable_ihssize=4096)
+-AC_DEFINE_UNQUOTED(IHSSIZE,$enable_ihssize,[invocation history stack size])
+-
+-AC_ARG_ENABLE(frssize,[ --enable-frssize=XXXX will compile in a frame stack of size XXX] ,
+-,enable_frssize=4096)
+-AC_DEFINE_UNQUOTED(FRSSIZE,$enable_frssize,[frame stack size])
+-
+-AC_ARG_ENABLE(machine,[ --enable-machine=XXXX will force the use of one of the definitions in h/XXXX.defs] ,
+-[enable_machine=$enableval],[enable_machine=""])
+-
+-AC_ARG_ENABLE(immfix,
+-[ --enable-immfix will enable an immediate fixnum table
+- above the C stack],
+-,enable_immfix=yes)
+-
+-#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"
+-
+-AC_ARG_ENABLE(notify,[ --enable-notify=no will disable the automatic notification of gcl maintainers of successful builds/problems] ,
+-[enable_notify=$enableval],[enable_notify="yes"])
+-
+-AC_ARG_ENABLE(tcltk,[ try to build gcl-tk ] ,
+-[enable_tcltk=$enableval],[enable_tcltk="yes"])
+-
+-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_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(common-binary,[ --enable-common-binary=yes forces use of lowest common denominator instruction sets, (default is =yes)] ,
+-[use_common_binary=$enableval],[use_common_binary="yes"])
+-
+-AC_ARG_ENABLE(japi,[ --enable-japi=yes will compile in support for the JAPI graphical interface if present on your system],
+-[try_japi=$enableval],[try_japi="no"])
+-
+-AC_ARG_ENABLE(xdr,[ --enable-xdr=yes will compile in support for XDR],
+-[enable_xdr=$enableval],[enable_xdr="yes"])
+-
+-AC_ARG_ENABLE(xgcl,[ --enable-xgcl=yes will compile in support for XGCL],
+-[enable_xgcl=$enableval],[enable_xgcl="yes"])
+
+ #
+ # Host information
+@@ -119,341 +18,150 @@ my_host_system=`echo $host_os | awk '{j=
+ AC_DEFINE_UNQUOTED(HOST_CPU,"`echo $host_cpu | awk '{print toupper($0)}'`",[Host cpu])
+ AC_DEFINE_UNQUOTED(HOST_KERNEL,"`echo $my_host_kernel | awk '{print toupper($0)}'`",[Host kernel])
+ if test "$my_host_system" != "" ; then
+- AC_DEFINE_UNQUOTED(HOST_SYSTEM,"`echo $my_host_system | awk '{print toupper($0)}'`",[Host system])
++ AC_DEFINE_UNQUOTED(HOST_SYSTEM,"`echo $my_host_system | awk '{print toupper($0)}'`",[Host system])
+ fi
+ ## host=CPU-COMPANY-SYSTEM
+ AC_MSG_RESULT(host=$host)
+
+-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";
+- fi;;
+-
+- 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;;
+-
+- *86-ncr-sysv4)
+- use=ncr;;
+-
+- *[3-9]86-*netbsd*)
+- use=NetBSD;;
+-
+- old)
+- use=NeXT;;
+-
+- old)
+- use=NeXT30-m68k;;
+-
+- *86-*nextstep*)
+- use=NeXT32-i386;;
+-
+- *m68*-*nextstep*)
+- use=NeXT32-m68k;;
+-
+- *rs6000-*-aix4*)
+- use=rios;;
+-
+- *rs6000-*-aix3*)
+- use=rios-aix3;;
+-
+- old)
+- use=rt_aix;;
+-
+- old)
+- use=sgi;;
+-
+- sparc-sun-solaris*)
+- use=solaris;;
+-
+- i?86-pc-solaris*)
+- use=solaris-i386;;
+-
+- old)
+- use=sun2r3;;
+-
+- old)
+- use=sun3;;
+-
+- m68*-sunos*)
+- use=sun3-os4;;
+-
+- old)
+- use=sun386i;;
+-
+- sparc*sunos*)
+- use=sun4;;
+-
+- *86-sequent-dynix)
+- use=symmetry;;
+-
+- u370*aix)
+- use=u370_aix;;
+-
+- old)
+- use=vax;;
+-
+- 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;;
+-
+- i*cygwin*)
+- if $CC -v 2>&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 <malloc/malloc.h>
+- ])
++ AC_DEFINE(HAVE_MALLOC_ZONE_MEMALIGN,1,[memalign element present]), [],
++ [
++ #include <malloc/malloc.h>
++ ])
+ 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 <stdio.h>
+- #include <setjmp.h>
+- 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 <stdio.h>
++ #include <setjmp.h>
++ ]],
++ [[
++ 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 <unistd.h>
++ #include <stdio.h>
++ ]],
++ [[
++ 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 <unistd.h>
+- #include <stdio.h>
+- 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 <stdio.h>
+- dnl #include <unistd.h>
+- 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 <gmp.h>
+- 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 <gmp.h>
++ ]],
++ [[
++ #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 <<EOFF
+ #include <math.h>
+ #include <stdio.h>
+@@ -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 <stdio.h>
+- #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 <stdio.h>
++ #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 <stdio.h>
+- #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 <stdio.h>
++ #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 <stdio.h>
+- #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 <stdio.h>
++ #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 <bfd.h>
+- int main() { symbol_info t; return 0;}],
+- AC_MSG_RESULT(no),
+- AC_TRY_RUN([#define CONST const
+- #define IN_GCC
+- #include <bfd.h>
+- 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.h>
+- 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 <bfd.h>
+- #include <bfdlink.h>
+- ])
+- 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 <bfd.h>
++ ]],
++ [[
++ symbol_info t;
++ ]])],
++ AC_MSG_RESULT([no]),
++ AC_RUN_IFELSE(
++ [AC_LANG_PROGRAM(
++ [[
++ #define CONST const
++ #define IN_GCC
++ #include <bfd.h>
++ ]],
++ [[
++ 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.h>
++ 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 <bfd.h>
++ #include <bfdlink.h>
++ ]])
++ 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 <stdio.h>
+- #include <unistd.h>
+- 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 <stdio.h>
++ #include <unistd.h>
++ ]],
++ [[
++ 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 <stdio.h>
+- #include <unistd.h>
+- int main() {
+- unsigned long u;
+- long j;
+- if (__builtin_ctzl(0)!=sizeof(long)*8)
+- return -1;
+- for (u=1,j=0;j<sizeof(long)*8-1;j++,u<<=1)
+- if (__builtin_ctzl(u)!=j)
+- return -1;
+- return 0;
+- }]])],[AC_MSG_RESULT([yes])
+- AC_DEFINE(HAVE_CTZL,[1],[ctzl instruction])],
+- [AC_MSG_RESULT([no])])
++AC_RUN_IFELSE(
++ [AC_LANG_PROGRAM(
++ [[
++ #include <stdio.h>
++ #include <unistd.h>
++ ]],
++ [[
++ unsigned long u;
++ long j;
++ if (__builtin_ctzl(0)!=sizeof(long)*8)
++ return -1;
++ for (u=1,j=0;j<sizeof(long)*8-1;j++,u<<=1)
++ if (__builtin_ctzl(u)!=j)
++ return -1;
++ ]])],
++ [AC_MSG_RESULT([yes])
++ AC_DEFINE(HAVE_CTZL,[1],[ctzl instruction])],
++ [AC_MSG_RESULT([no])])
+
+
+ case $use in
+- sh4*) ;; #FIXME, these exceptions needed as of gcc 4.7
+- hppa*) ;; #FIXME
+- powerpc*) ;; #FIXME
+- alpha*) ;; #FIXME
+- ia64*) ;; #FIXME
+- *)
+- AC_MSG_CHECKING(__builtin___clear_cache)
+- AC_RUN_IFELSE([
+- AC_LANG_PROGRAM([[]],[[
++ sh4*) ;; #FIXME, these exceptions needed as of gcc 4.7
++ hppa*) ;; #FIXME
++ powerpc*) ;; #FIXME
++ alpha*) ;; #FIXME
++ ia64*) ;; #FIXME
++ *)
++ AC_MSG_CHECKING(__builtin___clear_cache)
++ AC_RUN_IFELSE(
++ [AC_LANG_PROGRAM(
++ [[]],
++ [[
+ void *v,*ve;
+ __builtin___clear_cache(v,ve);
+- ]])],
+- [AC_DEFINE(HAVE_BUILTIN_CLEAR_CACHE,1,[have __builtin__clear_cache instruction])
+- AC_MSG_RESULT(yes)],
+- AC_MSG_RESULT(no));;
++ ]])],
++ [AC_DEFINE(HAVE_BUILTIN_CLEAR_CACHE,1,[have __builtin__clear_cache instruction])
++ AC_MSG_RESULT(yes)],
++ AC_MSG_RESULT(no));;
+ esac
+
+ #AC_CONFIG_SUBDIRS($MY_SUBDIRS)
+@@ -1247,547 +912,481 @@ AC_CHECK_SIZEOF(long,0)
+ #### Memory areas and alignment
+
+ AC_MSG_CHECKING(for byte order)
+-AC_RUN_IFELSE([
+- AC_LANG_PROGRAM([[
+- ]],[[
+-
++AC_RUN_IFELSE(
++ [AC_LANG_PROGRAM(
++ [[]],
++ [[
+ /* Are we little or big endian? Adapted from Harbison&Steele. */
+ union {long l;char c[sizeof(long)];} u;
+ u.l = 1;
+ return u.c[sizeof(long)-1] ? 1 : 0;
+- ]])],[
++ ]])],[
+ AC_MSG_RESULT(little)],
+- [AC_MSG_RESULT(big)
+- AC_DEFINE(WORDS_BIGENDIAN,1,[big endian byte order])])
++ [AC_MSG_RESULT(big)
++ AC_DEFINE(WORDS_BIGENDIAN,1,[big endian byte order])])
+ AC_SUBST(WORDS_BIGENDIAN)
+
+
+ AC_MSG_CHECKING(for word order)
+-AC_RUN_IFELSE([
+- AC_LANG_PROGRAM([[
+- ]],[[
++AC_RUN_IFELSE(
++ [AC_LANG_PROGRAM(
++ [[]],
++ [[
+ /* Are we little or big endian? Adapted from Harbison&Steele. */
+ union {double d;int l[sizeof(double)/sizeof(int)];} u;
+ u.d = 1.0;
+ return u.l[sizeof(double)/sizeof(int)-1] ? 0 : 1;
+- ]])],
+- [AC_MSG_RESULT(little)],
+- [AC_MSG_RESULT(big)
+- AC_DEFINE(DOUBLE_BIGENDIAN,1,[big endian word order])])
++ ]])],
++ [AC_MSG_RESULT(little)],
++ [AC_MSG_RESULT(big)
++ AC_DEFINE(DOUBLE_BIGENDIAN,1,[big endian word order])])
+ AC_SUBST(DOUBLE_BIGENDIAN)
+
+ # pagewidth
+ AC_MSG_CHECKING(for pagewidth)
+ case $use in
+- mips*) min_pagewidth=14;;
+- *) min_pagewidth=12;;
++ mips*) min_pagewidth=14;;
++ *) min_pagewidth=12;;
+ esac
+-AC_RUN_IFELSE([
+- AC_LANG_PROGRAM([[
+- #include <stdio.h>
+- #include <unistd.h>
+- #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 <stdio.h>
++ #include <unistd.h>
++ #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 <stdio.h>
+- #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 <stdio.h>
++ #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 <stdio.h>
++ #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 <stdio.h>
+- #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 <stdio.h>
+- #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 <unistd.h>
+- #include <stdio.h>
+- int main() {
++AC_RUN_IFELSE(
++ [AC_LANG_PROGRAM(
++ [[
++ #include <unistd.h>
++ #include <stdio.h>
++ ]],
++ [[
+ 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 <sys/personality.h>
+- #include <stdio.h>
+- ]],[[
+- 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 <sys/personality.h>
++ #include <stdio.h>
++ ]],
++ [[
++ 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 <sys/personality.h>
+- #include <stdio.h>
+- ]],[[
+- 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 <sys/personality.h>
++ #include <stdio.h>
++ ]],
++ [[
++ 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 <sys/personality.h>
+- #include <stdio.h>
+- ]],[[
+- 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 <sys/personality.h>
++ #include <stdio.h>
++ ]],
++ [[
++ 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 <stdio.h>
+- #include <stdlib.h>
+- 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 <stdio.h>
++ #include <stdlib.h>
++ 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 <stdio.h>
+- #include <stdlib.h>
++ AC_MSG_CHECKING([that sbrk is (now) non-random])
++ SBRK=0
++ AC_RUN_IFELSE(
++ [AC_LANG_SOURCE(
++ [[
++ #include <stdio.h>
++ #include <stdlib.h>
+ 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 <stdio.h>
+- #include <stdlib.h>
++ 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 <stdio.h>
++ #include <stdlib.h>
+ 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 <stdio.h>
+-dnl #include <stdlib.h>
+-dnl #include <unistd.h>
+-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<<PAGEWIDTH)-1));
+-dnl #endif
+-dnl #endif
+-dnl fclose(fp);
+-dnl return 0;}]])],
+-dnl [dbegin=`cat conftest1`],[dbegin=0])
+-
+-dnl AC_MSG_RESULT($dbegin)
+-
+-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[
+-dnl #include <stdio.h>
+-dnl #include <unistd.h>
+-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 <stdio.h>
+- #include <stdlib.h>
+- 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 <stdio.h>
++ #include <stdlib.h>
++ 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 <stdio.h>
+- #include <stdlib.h>
+- 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 <stdio.h>
++ #include <stdlib.h>
++ 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 <stdio.h>
+- #include <stdlib.h>
+- 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 <stdio.h>
++ #include <stdlib.h>
++ 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 <stdio.h>
+- #include <stdlib.h>
+- 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 <stdio.h>
++ #include <stdlib.h>
++ 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 <stdio.h>
+- #include <stdlib.h>
+- 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 <stdio.h>
++ #include <stdlib.h>
++ 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 <stdio.h>\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 <stdio.h>
+-dnl ]],[[
+-dnl FILE *fp=fopen("conftest1","w");
+-dnl unsigned long h=$heap_ceiling,d=$dbegin,c=$cstack_address;
+-dnl h=h<d ? 0 : h;
+-dnl h=c>d && c<h ? c : h;
+-dnl fprintf(fp,"0x%lx",h);
+-dnl return 0;]])],[heap_ceiling=`cat conftest1`],[AC_MSG_ERROR([failed])])
+-dnl fi
+-dnl fi
+-dnl fi
+-dnl fi
+-dnl AC_MSG_RESULT($heap_ceiling)
+-dnl AC_DEFINE_UNQUOTED(SHARED_LIB_HEAP_CEILING,$heap_ceiling,
+-dnl [address at which shared lib placement terminates heap growth])
+-
+-dnl ## Don't lower heap start if C stack is below default dbegin, as we're
+-dnl # likely to get more heap this way.
+-dnl if test "$enable_static" = "yes" ; then
+-dnl echo "int main() {return !((unsigned long)$dbegin < (unsigned long)$cstack_address);}" >foo.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 </dev/null`
+- 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 -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 </dev/null`
+- done
+-
+- AC_MSG_NOTICE([min log text start $min])
+- AC_MSG_NOTICE([max log text start $max])
+-
+- if test $neg_cstack_address -eq 1 ; then #FIXME test this
+- if test $cstack_bits -lt $max ; then
+- max=$cstack_bits;
+- AC_MSG_NOTICE([max log text start reduced to $max considering c stack address])
+- fi
+- fi
+-
+- j=-1;
+- low_shft="";
+- if test $min -le $max ; then
+- if test $max -ge $enable_fastimmfix && test "$enable_immfix" = "yes" ; then
++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 $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 </dev/null`
++ 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 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 </dev/null`
++ done
++
++ AC_MSG_NOTICE([min log text start $min])
++ AC_MSG_NOTICE([max log text start $max])
++
++ if test $neg_cstack_address -eq 1 ; then #FIXME test this
++ if test $cstack_bits -lt $max ; then
++ max=$cstack_bits;
++ AC_MSG_NOTICE([max log text start reduced to $max considering c stack address])
++ fi
++ fi
++
++ 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 </dev/null`
+ low_shft=`$AWK 'END {print n+1}' n=$max </dev/null`;
+ AC_MSG_NOTICE([raising log text to $j for a $max bit wide low immfix table])
+@@ -1795,356 +1394,139 @@ if test "$use" != "386-gnu" ; then #hurd
+ j=`$AWK 'END {for (i=j=0;j<=n;j++) i=i ? i*2 : 1;printf("%x\n",3*i)}' n=$min </dev/null`
+ AC_MSG_NOTICE([lowering log text to $j to maximize data area])
+ fi
+- fi
+-
+- if test "$low_shft" != "" ; then
++ fi
++
++ if test "$low_shft" != "" ; then
+ AC_DEFINE_UNQUOTED(LOW_SHFT,$low_shft,[upper immediate fixnum bound])
+ AC_DEFINE_UNQUOTED(OBJNULL,(object)0x$j,[lowest address non-object])
+- else
++ else
+ AC_DEFINE_UNQUOTED(OBJNULL,NULL,[lowest address non-object])
+- fi
+-
+-# echo $j;
+- AC_MSG_CHECKING([our linker script])
+- if test "$j" -ne "-1" ; then
++ fi
++
++ # echo $j;
++ AC_MSG_CHECKING([our linker script])
++ 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
+ 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 <stdio.h>
+- dnl #include <stdlib.h>
+- dnl #include <unistd.h>
+-
+- 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 <stdio.h>
+-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 <stdio.h>
+-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<k && $dbegin < $cstack_address) ? k : j;
+-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 fixnum table)
+-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[
+-dnl #include <stdio.h>
+-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 <stdio.h>
+-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 <stdio.h>
+-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 <stdio.h>
+- ]],[[
+- 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<k ? k-1 : -1) : l;
+- for (i=j=k;j && i<l;j>>=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 <stdio.h>
++ ]],
++ [[
++ 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<k ? k-1 : -1) : l;
++ for (i=j=k;j && i<l;j>>=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 <stdio.h>
+- ]],[[
+- 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 <stdio.h>
++ ]],
++ [[
++ 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 <stdio.h>
+-dnl #include <stdlib.h>
+-
+-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<<PAGEWIDTH)-1) : b1;
+-dnl fprintf(fp,"0x%lx",b);
+-dnl #endif
+-dnl #endif
+-dnl fclose(fp);
+-dnl return 0;
+-dnl }],dbegin=`cat conftest1`,dbegin=0,dbegin=0)
+-dnl AC_DEFINE_UNQUOTED(DBEGIN,$dbegin /* where data begins */)
+-dnl AC_MSG_RESULT(got $dbegin)
+-dnl LDFLAGS="$old_LDFLAGS"
+-
+-
+-dnl AC_MSG_CHECKING("finding CSTACK_ADDRESS")
+-dnl AC_TRY_RUN([#include <stdio.h>
+-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 <stdio.h>
+- ]],[[
+- 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 <stdio.h>
++ ]],
++ [[
++ 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 <dirent.h>
+- ]],[[
+- 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 <dirent.h>
++ ]],
++ [[
++ 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 <stdio.h>
+- ]],[[
+- 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 <stdio.h>
++ ]],
++ [[
++ 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 <math.h>
+- ]],[[
+- float f;
+- return isnormal(f) || !isnormal(f) ? 0 : 1;
++AC_RUN_IFELSE(
++ [AC_LANG_PROGRAM(
++ [[
++ #define _GNU_SOURCE
++ #include <math.h>
++ ]],
++ [[
++ 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 <ieeefp.h>
+- ]],[[
+- float f;
+- return fpclass(f)>=FP_NZERO || fpclass(f)<FP_NZERO ? 0 : 1;
+- ]])],[AC_DEFINE(HAVE_IEEEFP,1,[Have ieeefp fpclass function]) AC_MSG_RESULT(yes)],
+- [AC_MSG_RESULT(no)])])
++ [AC_DEFINE(HAVE_ISNORMAL,1,[Have isnormal function]) AC_MSG_RESULT(yes)],
++ [AC_MSG_CHECKING([for fpclass of ieeefp.h])
++ AC_RUN_IFELSE(
++ [AC_LANG_PROGRAM(
++ [[
++ #include <ieeefp.h>
++ ]],
++ [[
++ float f;
++ return fpclass(f)>=FP_NZERO || fpclass(f)<FP_NZERO ? 0 : 1;
++ ]])],[AC_DEFINE(HAVE_IEEEFP,1,[Have ieeefp fpclass function]) AC_MSG_RESULT(yes)],
++ [AC_MSG_RESULT(no)])])
+
+ AC_MSG_CHECKING([for isfinite])
+-AC_RUN_IFELSE([AC_LANG_PROGRAM([[
+- #define _GNU_SOURCE
+- #include <math.h>
+- ]],[[
+- 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 <math.h>
+- #include <ieeefp.h>
+- ]],[[
++ ]],
++ [[
+ 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 <math.h>
+-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 <math.h>
+-dnl #include <ieeefp.h>
+-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 <math.h>
+-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 <math.h>
+-dnl #include <ieeefp.h>
+-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 <math.h>
++ #include <ieeefp.h>
++ ]],
++ [[
++ 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 <sys/time.h>
+-#include <sys/types.h>
+-#include <unistd.h>
+-
+-#include <errno.h>
+-#include <fcntl.h>
+-#include <stdio.h>
+-
+-/************* for the sockets ******************/
+-#include <sys/socket.h> /* struct sockaddr, SOCK_STREAM, ... */
+-#ifndef NO_UNAME
+-# include <sys/utsname.h> /* uname system call. */
+-#endif
+-#include <netinet/in.h> /* struct in_addr, struct sockaddr_in */
+-#include <arpa/inet.h> /* inet_ntoa() */
+-#include <netdb.h> /* 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 <stdio.h>
+-#include <fcntl.h>
+-],
+-[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 <sys/time.h>
++ #include <sys/types.h>
++ #include <unistd.h>
++
++ #include <errno.h>
++ #include <fcntl.h>
++ #include <stdio.h>
++
++ /************* for the sockets ******************/
++ #include <sys/socket.h> /* struct sockaddr, SOCK_STREAM, ... */
++ #ifndef NO_UNAME
++ # include <sys/utsname.h> /* uname system call. */
++ #endif
++ #include <netinet/in.h> /* struct in_addr, struct sockaddr_in */
++ #include <arpa/inet.h> /* inet_ntoa() */
++ #include <netdb.h> /* 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 <stdio.h>
++ #include <fcntl.h>
++ ]],
++ [[
++ 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 <signal.h>
+-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 <signal.h>
++ 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 <signal.h>
+-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 <signal.h>
++ 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 <signal.h>
+-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 <signal.h>
++ 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 <signal.h>
+- ],
+- [
+- 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 <signal.h>
+- #ifdef HAVE_ASM_SIGCONTEXT_H
+- #include <asm/sigcontext.h>
+- #endif
+- #ifdef HAVE_ASM_SIGNAL_H
+- #include <asm/signal.h>
+- #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 <signal.h>
++ ]],
++ [[
++ 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 <signal.h>
++ #ifdef HAVE_ASM_SIGCONTEXT_H
++ #include <asm/sigcontext.h>
++ #endif
++ #ifdef HAVE_ASM_SIGNAL_H
++ #include <asm/signal.h>
++ #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 <<EOF
++ if test -d "${TCL_CONFIG_PREFIX}" ; then true ; else
++
++ AC_CHECK_PROG(TCLSH,tclsh,tclsh,${TCLSH})
++
++ if test "${TCLSH}" = "" ; then true ; else
++
++ rm -f conftest.tcl
++ cat >> conftest.tcl <<EOF
+ [
+ puts [set tcl_version]
+ ]
+ EOF
+-
+- TCL_VERSION=`${TCLSH} < conftest.tcl`
+- fi
+-
+- if test -x /usr/lib/tcl$TCL_VERSION/tclConfig.sh ; then
+- TCL_CONFIG_PREFIX=/usr/lib/tcl$TCL_VERSION
+- fi
+-
+- fi
+-
+- if test -f ${TCL_CONFIG_PREFIX}/tclConfig.sh ; then . ${TCL_CONFIG_PREFIX}/tclConfig.sh ; fi
+-
+- if test -d "${TK_CONFIG_PREFIX}" ; then true ; else
+- if test -f ${TCL_CONFIG_PREFIX}/tkConfig.sh ; then
+- TK_CONFIG_PREFIX=${TCL_CONFIG_PREFIX}
+- else
+- if test -x `echo $TCL_CONFIG_PREFIX | sed 's,tcl,tk,g'`/tkConfig.sh ; then
+- TK_CONFIG_PREFIX=`echo $TCL_CONFIG_PREFIX | sed 's,tcl,tk,g'`
+- fi
+- fi
+- fi
+-
+- if test -f ${TK_CONFIG_PREFIX}/tkConfig.sh ; then . ${TK_CONFIG_PREFIX}/tkConfig.sh ; fi
+-
+- if test -d ${TCL_CONFIG_PREFIX}/tcl${TCL_VERSION} ; then
+- TCL_LIBRARY=${TCL_CONFIG_PREFIX}/tcl${TCL_VERSION}
+- else
+- if test -d ${TCL_CONFIG_PREFIX}/../tcl${TCL_VERSION} ; then
+- TCL_LIBRARY=${TCL_CONFIG_PREFIX}/../tcl${TCL_VERSION}
+- fi
+- fi
+-
+- if test -d ${TK_CONFIG_PREFIX}/tk${TK_VERSION} ; then
+- TK_LIBRARY=${TK_CONFIG_PREFIX}/tk${TK_VERSION}
+- else
+- if test -d ${TK_CONFIG_PREFIX}/../tk${TK_VERSION} ; then
+- TK_LIBRARY=${TK_CONFIG_PREFIX}/../tk${TK_VERSION}
+- fi
+- fi
+-
+- if test -f ${TCL_CONFIG_PREFIX}/../include/tcl.h ; then
+- TCL_INCLUDE=-I${TCL_CONFIG_PREFIX}/../include
+- else
+- if test -f /usr/include/tcl${TCL_VERSION}/tcl.h ; then
+- TCL_INCLUDE=-I/usr/include/tcl${TCL_VERSION}
+- fi
+- fi
+-
+- if test -f ${TK_CONFIG_PREFIX}/../include/tk.h ; then
+- TK_INCLUDE=-I${TK_CONFIG_PREFIX}/../include
+- else
+- if test -f /usr/include/tcl${TCL_VERSION}/tk.h ; then
+- TK_INCLUDE=-I/usr/include/tcl${TCL_VERSION}
+- fi
+- fi
+-
+- 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
+- AC_CHECK_LIB(lieee,main,have_ieee=1,have_ieee=0)
+- 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
+-
++
++ TCL_VERSION=`${TCLSH} < conftest.tcl`
++ fi
++
++ if test -x /usr/lib/tcl$TCL_VERSION/tclConfig.sh ; then
++ TCL_CONFIG_PREFIX=/usr/lib/tcl$TCL_VERSION
++ fi
++
++ fi
++
++ if test -f ${TCL_CONFIG_PREFIX}/tclConfig.sh ; then . ${TCL_CONFIG_PREFIX}/tclConfig.sh ; fi
++
++ if test -d "${TK_CONFIG_PREFIX}" ; then true ; else
++ if test -f ${TCL_CONFIG_PREFIX}/tkConfig.sh ; then
++ TK_CONFIG_PREFIX=${TCL_CONFIG_PREFIX}
++ else
++ if test -x `echo $TCL_CONFIG_PREFIX | sed 's,tcl,tk,g'`/tkConfig.sh ; then
++ TK_CONFIG_PREFIX=`echo $TCL_CONFIG_PREFIX | sed 's,tcl,tk,g'`
++ fi
++ fi
++ fi
++
++ if test -f ${TK_CONFIG_PREFIX}/tkConfig.sh ; then . ${TK_CONFIG_PREFIX}/tkConfig.sh ; fi
++
++ if test -d ${TCL_CONFIG_PREFIX}/tcl${TCL_VERSION} ; then
++ TCL_LIBRARY=${TCL_CONFIG_PREFIX}/tcl${TCL_VERSION}
++ else
++ if test -d ${TCL_CONFIG_PREFIX}/../tcl${TCL_VERSION} ; then
++ TCL_LIBRARY=${TCL_CONFIG_PREFIX}/../tcl${TCL_VERSION}
++ fi
++ fi
++
++ if test -d ${TK_CONFIG_PREFIX}/tk${TK_VERSION} ; then
++ TK_LIBRARY=${TK_CONFIG_PREFIX}/tk${TK_VERSION}
++ else
++ if test -d ${TK_CONFIG_PREFIX}/../tk${TK_VERSION} ; then
++ TK_LIBRARY=${TK_CONFIG_PREFIX}/../tk${TK_VERSION}
++ fi
++ fi
++
++ if test -f ${TCL_CONFIG_PREFIX}/../include/tcl.h ; then
++ TCL_INCLUDE=-I${TCL_CONFIG_PREFIX}/../include
++ else
++ if test -f /usr/include/tcl${TCL_VERSION}/tcl.h ; then
++ TCL_INCLUDE=-I/usr/include/tcl${TCL_VERSION}
++ fi
++ fi
++
++ if test -f ${TK_CONFIG_PREFIX}/../include/tk.h ; then
++ TK_INCLUDE=-I${TK_CONFIG_PREFIX}/../include
++ else
++ if test -f /usr/include/tcl${TCL_VERSION}/tk.h ; then
++ TK_INCLUDE=-I/usr/include/tcl${TCL_VERSION}
++ fi
++ fi
++
++ 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
++ AC_CHECK_LIB(lieee,main,have_ieee=1,have_ieee=0)
++ if test "$have_ieee" = "0" ; then
++ TCL_LIBS=`echo ${TCL_LIBS} | sed -e "s:-lieee::g" `
++ fi
++ TCL_STUB_LIBS=""
++ fi
++
+ fi
+
+ AC_SUBST(TK_CONFIG_PREFIX)
+@@ -2761,15 +2098,14 @@ AC_SUBST(TCL_LIBS)
+
+
+ if test -d "${TK_CONFIG_PREFIX}" ; then
+-AC_MSG_RESULT([using TK_VERSION=${TK_VERSION} in ${TK_CONFIG_PREFIX}])
++ AC_MSG_RESULT([using TK_VERSION=${TK_VERSION} of ${TK_CONFIG_PREFIX}])
+ else
+-AC_MSG_RESULT([not found])
++ AC_MSG_RESULT([not found])
+ fi
+
+-NOTIFY=$enable_notify
+-AC_SUBST(NOTIFY)
+-
+-
++AC_ARG_ENABLE([notify],[ --enable-notify=no will disable the automatic notification of gcl maintainers of successful builds/problems],
++ [NOTIFY=$enable_notify
++ AC_SUBST(NOTIFY)])
+
+
+ # for sgbc the mprotect capabilities.
+@@ -2779,76 +2115,37 @@ AC_CHECK_HEADERS(sys/mman.h,AC_CHECK_FUN
+ AC_CHECK_HEADERS(alloca.h)
+ AC_FUNC_ALLOCA
+
+-# 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..
+-
+-
+-
+
+-# 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.
+-dnl AC_MSG_CHECKING([Checking for buggy gcc version from redhat])
+-dnl if 2>&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 <string.h>
++
+ #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 <netinet/in.h>
+ # include <arpa/inet.h>
+ #else
+-# include <windows.h>
+ # include <winsock2.h>
++# include <windows.h>
+ #endif
+ #include <errno.h>
+
+@@ -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<ma || 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 <Windows.h>
++#include <windows.h>
+
+ 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<sizeof(FN1));
++ memcpy(FN1,command,r-command);
++ FN1[r-command]=0;
++
++ } else {
++
++ massert(snprintf(FN1,sizeof(FN1),"cmd /c %s",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 (;sym<sye;sym++) {
+
+@@ -173,10 +182,9 @@ relocate_symbols(struct syment *sym,stru
+
+ else if (!sym->n_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;sym<sye;sym++) {
+
+- s=sym->n.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 <netinet/in.h>
+ # include <arpa/inet.h>
+ #else
+-# include <windows.h>
+ # include <winsock2.h>
++# include <windows.h>
+ #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 <unistd.h>
+ #include <errno.h>
++#include <string.h>
+
+ #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)+2<sizeof(FN3));
+- memcpy(FN3,pwent->pw_dir,strlen(pwent->pw_dir));
+- FN3[strlen(pwent->pw_dir)]='/';
+- FN3[strlen(pwent->pw_dir)+1]=0;
++ massert((r=strlen(pwent->pw_dir))+2<sizeof(FN3));
++ memcpy(FN3,pwent->pw_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 <sys/types.h>
+@@ -198,7 +240,11 @@ DEFUN_NEW("READLINKAT",object,fSreadlink
+ massert(z1<sizeof(FN1));
+ memcpy(FN1,s->st.st_self,z1);
+ FN1[z1]=0;
++#ifndef __MINGW32__
+ massert((l=readlinkat(d ? dirfd((DIR *)d) : AT_FDCWD,FN1,FN2,sizeof(FN2)))>=0 && l<sizeof(FN2));
++#else
++ l=0;
++#endif
+ FN2[l]=0;
+ RETURN1(make_simple_string(FN2));
+
+@@ -237,13 +283,15 @@ DEFUN_NEW("SETENV",object,fSsetenv,SI,2,
+ DEFUN_NEW("OPENDIR",object,fSopendir,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") {
+ check_type_string(&x);
+ coerce_to_filename(x,FN1);
+- return (object)opendir(FN1);
++ return (object)opendir(strlen(FN1) ? FN1 : "./");
+ }
+
+-#ifdef HAVE_D_TYPE
+-
++
+ DEFUN_NEW("D-TYPE-LIST",object,fSd_type_list,SI,0,0,NONE,OI,OO,OO,OO,(void),"") {
+- RETURN1(list(8,
++ RETURN1(
++
++#ifdef HAVE_D_TYPE
++ list(8,
+ MMcons(make_fixnum(DT_BLK),make_keyword("BLOCK")),
+ MMcons(make_fixnum(DT_CHR),make_keyword("CHAR")),
+ MMcons(make_fixnum(DT_DIR),make_keyword("DIRECTORY")),
+@@ -252,11 +300,21 @@ DEFUN_NEW("D-TYPE-LIST",object,fSd_type_
+ MMcons(make_fixnum(DT_REG),make_keyword("FILE")),
+ MMcons(make_fixnum(DT_SOCK),make_keyword("SOCKET")),
+ MMcons(make_fixnum(DT_UNKNOWN),make_keyword("UNKNOWN"))
+- ));
+-}
++ )
+ #else
+ #define DT_UNKNOWN 0
++#define DT_REG 1
++#define DT_DIR 2
++ list(3,
++ MMcons(make_fixnum(DT_REG),make_keyword("FILE")),
++ MMcons(make_fixnum(DT_DIR),make_keyword("DIRECTORY")),
++ MMcons(make_fixnum(DT_UNKNOWN),make_keyword("UNKNOWN"))
++ )
+ #endif
++ );
++}
++
++
+
+ DEFUN_NEW("READDIR",object,fSreaddir,SI,3,3,NONE,OI,IO,OO,OO,(fixnum x,fixnum y,object s),"") {
+
+@@ -264,15 +322,21 @@ DEFUN_NEW("READDIR",object,fSreaddir,SI,
+ object z;
+ long tl;
+ size_t l;
++ long d_type=DT_UNKNOWN;
++#ifdef HAVE_D_TYPE
++#define get_d_type(e,s) e->d_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 <string.h>
+ #include <sys/stat.h>
+ #include <sys/types.h>
++#ifndef __MINGW32__
+ #include <sys/wait.h>
++#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(n<sizeof(FN1));
++ memcpy((z=FN1),command,n);
+ for (j=1,c=z;strtok(c,spc);c=NULL,j++);
+
+ memcpy(z,command,n);
+- p1=alloca(j*sizeof(*p1));
++ massert(j*sizeof(*p1)<sizeof(FN2));
++ p1=(void *)FN2;
+ for (pp=p1,c=z;(*pp=strtok(c,spc));c=NULL,pp++);
+
+ }
+@@ -68,6 +73,7 @@ vsystem(const char *command) {
+ return s;
+
+ }
++#endif
+
+
+ #ifdef ATT3B2
+@@ -104,104 +110,10 @@ char *command;
+ }
+ #endif
+
+-#ifdef _WIN32
+-
+-DEFVAR("*WINE-DETECTED*",sSAwine_detectedA,SI,Cnil,"");
+-
+-#include "windows.h"
+-
+-static int mpid;
+-
+-void
+-close_msys() {
+-
+- msystem("");
+-
+-}
+-
+-void
+-detect_wine() {
+-
+- char b[4096];
+- struct stat ss;
+- const char *s="/proc/self/status";
+- FILE *f;
+- object o;
+-
+- sSAwine_detectedA->s.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));
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-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 <camm@debian.org>
+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: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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)
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-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 <camm@debian.org>
+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: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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)
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-43) unstable; urgency=medium
+ .
+ * pathnames1.7
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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) {
+
+ \f
+
+-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("#<synonym stream to ");
+ write_object(x->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;i<narg;i++) {
++ vs_push(coerce_to_string(i ? va_arg(ap,object) : first));
++ l += vs_head->st.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;p<vs_top && (m=(*p)->st.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))
--- /dev/null
+Description: <short summary of the patch>
+ TODO: Put a short summary on the line above and replace this paragraph
+ with a longer explanation of this change. Complete the meta-information
+ with other relevant fields (see below for details). To make it easier, the
+ information below has been extracted from the changelog. Adjust it or drop
+ it.
+ .
+ gcl (2.6.12-56) unstable; urgency=medium
+ .
+ * list_order.12
+Author: Camm Maguire <camm@debian.org>
+
+---
+The information above should follow the Patch Tagging Guidelines, please
+checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
+are templates for supplementary fields that you might want to add:
+
+Origin: <vendor|upstream|other>, <url of original patch>
+Bug: <url in upstream bugtracker>
+Bug-Debian: https://bugs.debian.org/<bugnumber>
+Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
+Forwarded: <no|not-needed|url proving that it has been forwarded>
+Reviewed-By: <name and email of someone who approved the patch>
+Last-Update: 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<PRINTvs_limit;xp++)
++ sethash(*xp,vs_head,MMcons(make_fixnum(xp-PRINTvs_top),Cnil));
++ PRINTvs_top[0]=vs_head;
++ PRINTvs_limit=vs_top=PRINTvs_top+1;
++
+ }
+
+ void
--- /dev/null
+Version_2_6_13pre1
+Version_2_6_13pre1a
+Version_2_6_13pre1b
+Version_2_6_13pre2
+Version_2_6_13pre3
+Version_2_6_13pre3a
+Version_2_6_13pre4
+Version_2_6_13pre5
+Version_2_6_13pre6
+Version_2_6_13pre7
+Version_2_6_13pre8a
+Version_2_6_13pre8b
+Version_2_6_13pre12
+Version_2_6_13pre13
+Version_2_6_13pre16
+Version_2_6_13pre17
+Version_2_6_13pre18
+Version_2_6_13pre19
+Version_2_6_13pre20
+Version_2_6_13pre22
+Version_2_6_13pre25
+Version_2_6_13pre26
+Version_2_6_13pre27
+Version_2_6_13pre28
+Version_2_6_13pre29
+Version_2_6_13pre30
+Version_2_6_13pre31
+Version_2_6_13pre32
+Version_2_6_13pre33
+Version_2_6_13pre34
+Version_2_6_13pre35
+Version_2_6_13pre36
+Version_2_6_13pre38
+Version_2_6_13pre39
+data_bss_offset-in-unexec-sparc64-fix
+Version_2_6_13pre41
+Version_2_6_13pre45
+Version_2_6_13pre46
+Version_2_6_13pre47
+Version_2_6_13pre48
+Version_2_6_13pre49
+Version_2_6_13pre50
+pathnames1.1
+ansi-test-clean-target
+pathnames1.2
+pathnames1.3
+pathnames1.4
+pathnames1.5
+pathnames1.6
+pathnames1.7
+pathnames1.9
+pathnames1.11
+pathnames1.12
+pathnames1.13
+list_order.1
+list_order.5
+list_order.6
+defined_real_maxpage
+list_order.7
+list_order.8
+list_order.9
+list_order.11
+disable_gprof_aarch64
+list_order.12
+real_list_order.12
+list_order.13
+list_order.4
+list_order.16
+list_order.17
+list_order.18
+list_order.19
+list_order.20
+list_order.21
+list_order.22
+list_order.23
+list_order.24
+list_order.25
+Version_2_6_13pre52
+Version_2_6_13pre54
+Version_2_6_13pre55
+Version_2_6_13pre56
+Version_2_6_13pre57
+Version_2_6_13pre58
+Version_2_6_13pre59
+Version_2_6_13pre60
+Version_2_6_13pre61
+Version_2_6_13pre62
+Version_2_6_13pre63
+Version_2_6_13pre64
+Version_2_6_13pre65
+Version_2_6_13pre66
+Version_2_6_13pre67
+Version_2_6_13pre68
+Version_2_6_13pre69
+Version_2_6_13pre70
+Version_2_6_13pre71
+Version_2_6_13pre72
+Version_2_6_13pre73
+Version_2_6_13pre74
+Version_2_6_13pre76
+Version_2_6_13pre77
+Version_2_6_13pre78
+Version_2_6_13pre79
+Version_2_6_13pre80
+Version_2_6_13pre81
+Version_2_6_13pre82
+Version_2_6_13pre83
+Version_2_6_13pre84
+Version_2_6_13pre85
+Version_2_6_13pre86
+Version_2_6_13pre87
+Version_2_6_13pre88
+Version_2_6_13pre89
+Version_2_6_13pre90
+Version_2_6_13pre92
--- /dev/null
+[type: gettext/rfc822deb] gcl.templates
--- /dev/null
+#
+# 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.
+#
+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-24 13:21+0100\n"
+"Last-Translator: Miroslav Kure <kurem@debian.cz>\n"
+"Language-Team: Czech <debian-l10n-czech@lists.debian.org>\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."
--- /dev/null
+# 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 <joedalton2@yahoo.dk>\n"
+"Language-Team: Danish <debian-l10n-danish@lists.debian.org>\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."
--- /dev/null
+# Translation of gcl debconf templates to German
+# Copyright (C) Stefan Bauer <stefan.bauer@edv-fix.de>, 2007.
+# Copyright (C) Helge Kreutzmann <debian@helgefjell.de>, 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 <stefan.bauer@edv-fix.de>\n"
+"Language-Team: de <debian-l10n-german@lists.debian.org>\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 standardmig 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, zustzlich 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 fr eine kurze Beschreibung dieser "
+"Begriffe. Die Wahl dieser Option bestimmen, welches Image standardmig "
+"verwendet wird, wenn gcl@EXT@ ausgefhrt 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 fhrt zur ANSI-Erstellung, und die "
+"leere Zeichenkette fhrt 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 standardmig den Profiling-Build?"
+
+#. Type: boolean
+#. Description
+#: ../gcl.templates:3001
+msgid "GCL has optional support for profiling via gprof."
+msgstr "GCL besitzt optionale Untersttzung fr 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 fr si::gprof-start und si::gprof-quit fr "
+"Details. Da ein solches Programm langsamer ist als ein Programm ohne Gprof-"
+"Untersttzung, wird dies fr 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, fr Profiling-Untersttzung; 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 fr den "
+#~ "Produktiveinsatz zustzlich an der Bereitstellung eines kompatiblen ANSI-"
+#~ "Images. Bitte beachten Sie die README.Debian-Datei fr eine kurze "
+#~ "Beschreibung dieses Themas. Durch diese Variable definieren Sie, welches "
+#~ "Image voreingestellt bei der Ausfhrung von gcl@EXT@ verwendet wird. "
+#~ "Diese Auswahl kann lokal, durch einen nicht leeren Wert in der "
+#~ "Umgebungsvariable GCL_ANSI fr den ANSI-Build, bzw. einen leeren Wert "
+#~ "fr den CLtL1-Build, z.B. GCL_ANSI=t gcl@EXT@ definiert werden. Es "
+#~ "erfolgt eine Meldung ber die aktive Erstellung im einfhrenden 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 Untersttzung fr Profiling mit gprof. Bitte lesen "
+#~ "Sie hierzu die Dokumentation von si::gprof-start und si::gprof-quit fr "
+#~ "weiterfhrende Informationen. Da dieser Build langsamer ist als ohne "
+#~ "gprof-Untersttzung, wird dieser Weg nicht fr den endgltig produktiven "
+#~ "Einsatz empfohlen. Sie knnen die hier gemachten Angaben lokal ber die "
+#~ "GCL_PROF-Umgebungsvariable durch einen beliebigen Wert ndern, bzw. durch "
+#~ "einen leeren Wert fr das weitaus anpassungsfhigere Build, z.B. "
+#~ "GCL_PROF=t gcl@EXT@. Falls Profiling aktiviert ist, erfolgt eine Meldung "
+#~ "im einfhrenden Start-Banner."
--- /dev/null
+# 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 <cesar.gomez@gmail.com>, 2005
+#
+# - Updates
+# Rudy Godoy Guillén <rudyd@stone-head.org>, 2007
+# Francisco Javier Cuadrado <fcocuadrado@gmail.com>, 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 <fcocuadrado@gmail.com>\n"
+"Language-Team: Debian l10n spanish <debian-l10n-spanish@lists.debian.org>\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."
--- /dev/null
+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 <edu@iki.fi>\n"
+"Language-Team: Finnish <debian-l10n-finnish@lists.debian.org>\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."
--- /dev/null
+# Translation of gcl debconf templates to French
+# Copyright (C) 2007 Sylvain Archenault <sylvain.archenault@laposte.net>
+# This file is distributed under the same license as the iodine package.
+#
+# Sylvain Archenault <sylvain.archenault@laposte.net>, 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 <sylvain.archenault@laposte.net>\n"
+"Language-Team: French <debian-l10n-french@lists.debian.org>\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 dfaut?"
+
+#. 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 utilise 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 brve description de ces "
+"termes. Le choix de cette option dterminera quelle image sera utilise par "
+"dfaut en excutant 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 rglage peut tre chang en affectant la variable d'environnement "
+"GCL_ANSI une chane non vide pour la compilation ANSI, et une chane vide "
+"pour la compilation CLtL1, par exemple GCL_ANSI=t gcl@EXT@. Le type de "
+"compilation sera affich dans le bandeau de dmarrage."
+
+#. Type: boolean
+#. Description
+#: ../gcl.templates:3001
+msgid "Use the profiling build by default?"
+msgstr "Faut-il utiliser le profilage par dfaut?"
+
+#. 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 dtails. Comme cet excutable est plus lent que "
+"les excutables 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 chane vide la variable d'environnement GCL_PROF "
+"pour des compilations optimises, ou une chane 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 dmarrage."
+
+#~ 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 dfinition de "
+#~ "l'ANSI en plus de son image traditionnelle CLtL1 qui est toujours "
+#~ "utilise en production. Veuillez consulter le fichier README.Debian "
+#~ "pour plus d'informations sur ces normes. Ce choix dterminera quelle "
+#~ "norme vous allez utiliser par dfaut lors de l'excution de "
+#~ "gcl@EXT@. Vous pouvez localement modifier ce choix en "
+#~ "affectant une chane non vide la variable d'environnement GCL_ANSI "
+#~ "pour une compilation respectant la norme dfinie par l'ANSI, et une "
+#~ "chane 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 dmarrage."
+
+#~ 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 gre dsormais 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 consquent 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 chane non vide "
+#~ "pour activer le profilage, ou une chane vide pour une compilation "
+#~ "optimise, par exemple GCL_PROF=t gcl@EXT@. Si le profilage est "
+#~ "activ, cela sera affich dans le bandeau de dmarrage."
--- /dev/null
+# Galician translation of gclcvs's debconf templates
+# This file is distributed under the same license as the gclcvs package.
+# Jacobo Tarrio <jtarrio@debian.org>, 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 <jtarrio@debian.org>\n"
+"Language-Team: Galician <proxecto@trasno.net>\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."
--- /dev/null
+# 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 <vinz65@gmail.com>, 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 <vinz65@gmail.com>\n"
+"Language-Team: Italian <tp@lists.linux.it>\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."
--- /dev/null
+# SOME DESCRIPTIVE TITLE.
+# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER
+# This file is distributed under the same license as the gcl package.
+# victory <victory.deb@gmail.com>, 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 <victory.deb@gmail.com>\n"
+"Language-Team: Japanese <debian-japanese@lists.debian.org>\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 が有効な場合、初期の開始時バナーで報告されます。"
--- /dev/null
+# 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 <EMAIL@ADDRESS>, 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 <cobaco@skolelinux.no>\n"
+"Language-Team: debian-l10n-dutch <debian-l10n-dutch@lists.debian.org>\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 ."
--- /dev/null
+# 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 <a_monteiro@netcabo.pt>, 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 <a_monteiro@netcabo.pt>\n"
+"Language-Team: Portuguese <traduz@debianpt.org>\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."
--- /dev/null
+# 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 <adrianorg@arg.eti.br>, 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 <adrianorg@arg.eti.br>\n"
+"Language-Team: Brazilian Portuguese <debian-l10n-portuguese@lists.debian."
+"org>\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."
--- /dev/null
+# 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 <kozlov.y@gmail.com>, 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 <kozlov.y@gmail.com>\n"
+"Language-Team: Russian <debian-l10n-russian@lists.debian.org>\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@. Если профилирование включено, то об этом будет "
+"написано при первом запуске."
--- /dev/null
+# 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 <martin.agren@gmail.com>, 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 <martin.agren@gmail.com>\n"
+"Language-Team: Swedish <debian-l10n-swedish@lists.debian.org>\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 "Anvnd det nnu inte frdiga 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 tillhandahlla en ANSI-godknd bild frutom dess "
+"traditionella CLtL1-bild som fortfarande anvnds i produktionsmiljn."
+
+#. 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 fr en versiktlig beskrivning av dessa termer. Nr "
+"du vljer det hr alternativet avgrs vilken bild som kommer anvndas som "
+"standard nr 'gcl@EXT@' krs."
+
+#. 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 instllning kan verskridas genom att stta miljvariabeln GCL_ANSI "
+"till en icke-tom strng fr ANSI-bygget, och till den tomma strngen fr "
+"CLtL1-bygget, t. ex. GCL_ANSI=t gcl@EXT@. Det bygge som fr tillfllet "
+"anvnds kommer anges i uppstartsutskriften."
+
+#. Type: boolean
+#. Description
+#: ../gcl.templates:3001
+msgid "Use the profiling build by default?"
+msgstr "Anvnd profileringsbygget som standard?"
+
+#. Type: boolean
+#. Description
+#: ../gcl.templates:3001
+msgid "GCL has optional support for profiling via gprof."
+msgstr "GCL har valfritt std fr 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 fr si::gprof-start och si::gprof-quit fr detaljer. "
+"Eftersom detta bygge r lngsammare n byggen utan std fr gprof, "
+"rekommenderas det inte fr slutlig anvndning 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 ""
+"Stt miljvariabeln GCL_PROF till den tomma strngen fr mer optimiserade "
+"byggen, eller en icke-tom strng fr profileringsstd; t. ex. GCL_PROF=t "
+"gcl@EXT@. Om profilering r aktiverad, kommer denna rapporteras i den "
+"ursprungliga uppstartsutskriften."
--- /dev/null
+# 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 <EMAIL@ADDRESS>, 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 <EMAIL@ADDRESS>\n"
+"Language-Team: LANGUAGE <LL@li.org>\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 ""
--- /dev/null
+# Vietnamese translation for GCL.
+# Copyright © 2007 Free Software Foundation, Inc.
+# Clytie Siddall <clytie@riverland.net.au>, 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 <clytie@riverland.net.au>\n"
+"Language-Team: Vietnamese <vi-VN@googlegroups.com>\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."
--- /dev/null
+#!/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
+
+export GCL_MEM_MULTIPLE=0.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
--- /dev/null
+3.0 (quilt)
--- /dev/null
+info/gcl-si.pdf
+info/gcl-tk.pdf
+xgcl-2/dwdoc.pdf
+unixport/ff
--- /dev/null
+#!/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;
+}
--- /dev/null
+-----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-----
--- /dev/null
+version=2
+options=pasv,pgpsigurlmangle=s/$/.sig/ ftp://ftp.gnu.org/pub/gnu/gcl gcl-([0-9.]*).tar.gz debian uupdate
projects / gcl.git / commitdiff