--- /dev/null
++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
- Build-Depends: debhelper (>= 5 ), libreadline-dev, m4, tk8.6-dev, libgmp-dev, autotools-dev, libxmu-dev, libxaw7-dev, po-debconf, zlib1g-dev
- Standards-Version: 3.9.5
+Source: gcl
+Section: lisp
+Priority: optional
+Maintainer: Camm Maguire <camm@debian.org>
+Homepage: http://gnu.org/software/gcl
++Build-Depends: debhelper (>= 5), libreadline-dev, m4, tk8.6-dev, libgmp-dev, autotools-dev, libxmu-dev, libxaw7-dev, po-debconf, zlib1g-dev, tcl
++Standards-Version: 4.4.1
+
+Package: gcl
+Architecture: any
+Depends: ${shlibs:Depends}, ${misc:Depends}, ${gcc}, debconf (>= 1.2.0), emacs24 | emacsen, ucf
+Breaks: emacsen-common (<< 2.0.0)
+Suggests: gcl-doc
+Description: GNU Common Lisp compiler
+ GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter
+ implemented in C, and complying mostly with the standard set
+ forth in the book "Common Lisp, the Language I". It attempts
+ to strike a useful middle ground in performance and portability
+ from its design around C.
+ .
+ This package contains the Lisp system itself. Documentation
+ is provided in the gcl-doc package.
+
+Package: gcl-doc
+Section: doc
+Architecture: all
+Conflicts: gclinfo
+Replaces: gclinfo
+Depends: dpkg (>= 1.15.4) | install-info, ${misc:Depends}
+Description: Documentation for GNU Common Lisp
+ GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter
+ implemented in C, and complying mostly with the standard set
+ forth in the book "Common Lisp, the Language I". It attempts
+ to strike a useful middle ground in performance and portability
+ from its design around C.
+ .
+ This package contains Documentation in info format of both the
+ system internals, as well as the graphical interface currently
+ implemented in Tcl/Tk.
--- /dev/null
- Build-Depends: debhelper (>= 5 ), libreadline-dev, m4, tk8.6-dev, libgmp-dev, autotools-dev, libxmu-dev, libxaw7-dev, po-debconf, zlib1g-dev
- Standards-Version: 3.9.5
+Source: gcl
+Section: lisp
+Priority: optional
+Maintainer: Camm Maguire <camm@debian.org>
+Homepage: http://gnu.org/software/gcl
++Build-Depends: debhelper (>= 5), libreadline-dev, m4, tk8.6-dev, libgmp-dev, autotools-dev, libxmu-dev, libxaw7-dev, po-debconf, zlib1g-dev, tcl
++Standards-Version: 4.4.1
+
+Package: gcl
+Architecture: any
+Depends: ${shlibs:Depends}, ${misc:Depends}, ${gcc}, debconf (>= 1.2.0), emacs24 | emacsen, ucf
+Breaks: emacsen-common (<< 2.0.0)
+Suggests: gcl-doc
+Description: GNU Common Lisp compiler
+ GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter
+ implemented in C, and complying mostly with the standard set
+ forth in the book "Common Lisp, the Language I". It attempts
+ to strike a useful middle ground in performance and portability
+ from its design around C.
+ .
+ This package contains the Lisp system itself. Documentation
+ is provided in the gcl-doc package.
+
+Package: gcl-doc
+Section: doc
+Architecture: all
+Conflicts: gclinfo
+Replaces: gclinfo
+Depends: dpkg (>= 1.15.4) | install-info, ${misc:Depends}
+Description: Documentation for GNU Common Lisp
+ GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter
+ implemented in C, and complying mostly with the standard set
+ forth in the book "Common Lisp, the Language I". It attempts
+ to strike a useful middle ground in performance and portability
+ from its design around C.
+ .
+ This package contains Documentation in info format of both the
+ system internals, as well as the graphical interface currently
+ implemented in Tcl/Tk.
--- /dev/null
- Build-Depends: debhelper (>= 5 ), libreadline-dev, m4, tk8.6-dev, libgmp-dev, autotools-dev, libxmu-dev, libxaw7-dev, po-debconf, zlib1g-dev
- Standards-Version: 3.9.5
+Source: gclcvs
+Section: lisp
+Priority: optional
+Maintainer: Camm Maguire <camm@debian.org>
+Homepage: http://gnu.org/software/gcl
++Build-Depends: debhelper (>= 5), libreadline-dev, m4, tk8.6-dev, libgmp-dev, autotools-dev, libxmu-dev, libxaw7-dev, po-debconf, zlib1g-dev, tcl
++Standards-Version: 4.4.1
+
+Package: gclcvs
+Architecture: any
+Depends: ${shlibs:Depends}, ${misc:Depends}, ${gcc}, debconf (>= 1.2.0), emacs24 | emacsen, ucf
+Breaks: emacsen-common (<< 2.0.0)
+Suggests: gclcvs-doc
+Description: GNU Common Lisp compiler, CVS snapshot
+ GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter
+ implemented in C, and complying mostly with the standard set
+ forth in the book "Common Lisp, the Language I". It attempts
+ to strike a useful middle ground in performance and portability
+ from its design around C.
+ .
+ This package contains the Lisp system itself. Documentation
+ is provided in the gclcvs-doc package.
+
+Package: gclcvs-doc
+Section: doc
+Architecture: all
+Conflicts: gclinfo
+Replaces: gclinfo
+Depends: dpkg (>= 1.15.4) | install-info, ${misc:Depends}
+Description: Documentation for GNU Common Lisp, CVS snapshot
+ GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter
+ implemented in C, and complying mostly with the standard set
+ forth in the book "Common Lisp, the Language I". It attempts
+ to strike a useful middle ground in performance and portability
+ from its design around C.
+ .
+ This package contains Documentation in info format of both the
+ system internals, as well as the graphical interface currently
+ implemented in Tcl/Tk.
--- /dev/null
- gcl: unstripped-binary-or-object
- gcl: binary-compiled-with-profiling-enabled
++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
++
++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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /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
--- /dev/null
--- /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
- [ "$*" != "ansi" ] || FLAGS="--enable-ansi" ; \
- [ "$*" != "gprof" ] || FLAGS="--enable-gprof" ; \
- [ "$*" != "ansi-gprof" ] || FLAGS="--enable-ansi --enable-gprof" ; \
- eval `dpkg-buildflags --export=sh |sed -e 's,-O2,,g' -e 's,-g,,g'` && CC=$(MCC) ./configure \
+#!/usr/bin/make -f
+# Sample debian/rules that uses debhelper.
+# GNU copyright 1997 by Joey Hess.
+#
+# This version is for a hypothetical package that builds an
+# architecture-dependant package, as well as an architecture-independent
+# package.
+
+# Uncomment this to turn on verbose mode.
+#export DH_VERBOSE=1
+
+# This is the debhelper compatability version to use.
+ARCHT:=$(shell dpkg-architecture -qDEB_HOST_ARCH)
+
+MCC:=gcc
+# ifeq ($(ARCHT),alpha)
+# MCC:=gcc-4.6
+# endif
+# ifeq ($(ARCHT),mips)
+# MCC:=gcc-4.6
+# endif
+# ifeq ($(ARCHT),mipsel)
+# MCC:=gcc-4.6
+# endif
+# ifeq ($(ARCHT),ia64)
+# MCC:=gcc-4.6
+# endif
+# ifeq ($(ARCHT),armel)
+# MCC:=gcc-4.6
+# endif
+# ifeq ($(ARCHT),armhf)
+# MCC:=gcc-4.6
+# endif
+
+#RELOC=locbfd
+#RELOC?=statsysbfd
+RELOC?=custreloc
+ifeq ($(ARCHT),ia64)
+RELOC=dlopen
+endif
+# ifeq ($(ARCHT),ppc64)
+# RELOC=dlopen
+# endif
+#ifeq ($(ARCHT),hppa)
+#RELOC=dlopen
+#endif
+
+GMP?=
+
+DEBUG=
+
+#ifeq ($(ARCHT),hppa)
+#DEBUG=--enable-debug
+#endif
+
+VERS=$(shell echo $$(cat majvers).$$(cat minvers))
+#EXT:=cvs
+
+CFG:=$(addsuffix /config.,.)# gmp4/configfsf.
+# Bug in autoconf dependency on emacsen-common workaround
+#CFGS:=$(addsuffix .ori,configure $(addsuffix guess,$(CFG)) $(addsuffix sub,$(CFG)))
+CFGS:=$(addsuffix .ori,$(addsuffix guess,$(CFG)) $(addsuffix sub,$(CFG)))
+
+$(filter %.guess.ori,$(CFGS)): %.ori: /usr/share/misc/config.guess %
+ ! [ -e $* ] || [ -e $@ ] || cp $* $@
+ [ $$($< -t | tr -d '-') -le $$(./$* -t | tr -d '-') ] || cp $< $*
+ touch $@
+
+$(filter %.sub.ori,$(CFGS)): %.ori: /usr/share/misc/config.sub %
+ ! [ -e $* ] || [ -e $@ ] || cp $* $@
+ [ $$($< -t | tr -d '-') -le $$(./$* -t | tr -d '-') ] || cp $< $*
+ touch $@
+
+configure.ori: %.ori: configure.in
+ ! [ -e $* ] || [ -e $@ ] || cp $* $@
+ cd $(@D) && autoconf
+ touch $@
+
+configure-%-stamp: $(CFGS)
+
+ dh_testdir
+
+ ! [ -e unixport/saved_pre_gcl ] || $(MAKE) clean
+
+# chmod -R +x gmp4/*
+
- echo "(reset-sys-paths \"$$new/\")(si::save-system \"debian/tmp-image\")" | $$tmp/$$new/unixport/$$i &&\
++ [ "$*" != "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 ;\
- dh_clean -k
++ 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_strip -a -Xlibgcl -Xlibansi_gcl \
- -Xgcl-$(VERS)-prof/unixport/saved_gcl -Xgcl-$(VERS)-prof/unixport/saved_ansi_gcl
++# 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
+info/gcl-si.pdf
+info/gcl-tk.pdf
+xgcl-2/dwdoc.pdf
++unixport/ff
projects / gcl.git / commitdiff