From: Camm Maguire Date: Sat, 29 Aug 2020 16:23:07 +0000 (+0100) Subject: gcl (2.6.12-97) unstable; urgency=medium X-Git-Tag: archive/raspbian/2.6.12-97+rpi1^2~116 X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=711a3a3eda8fe2017636c3150bd4f02fe52e252e;p=gcl.git gcl (2.6.12-97) unstable; urgency=medium * Bug fix: "Removal of obsolete debhelper compat 5 and 6 in bookworm", thanks to Niels Thykier (Closes: #965543). * Version_2.6.13pre93 [dgit import unpatched gcl 2.6.12-97] --- 711a3a3eda8fe2017636c3150bd4f02fe52e252e diff --cc debian/changelog index 9561eb95,00000000..863de7cf mode 100644,000000..100644 --- a/debian/changelog +++ b/debian/changelog @@@ -1,3231 -1,0 +1,4026 @@@ ++gcl (2.6.12-97) unstable; urgency=medium ++ ++ * Bug fix: "Removal of obsolete debhelper compat 5 and 6 in bookworm", ++ thanks to Niels Thykier (Closes: #965543). ++ * Version_2.6.13pre93 ++ ++ -- Camm Maguire Sat, 29 Aug 2020 16:23:07 +0000 ++ ++gcl (2.6.12-96) unstable; urgency=high ++ ++ * Version_2.6.13pre92: Work around armhf strip bug producing undefined ++ instruction in .plt ++ ++ -- Camm Maguire Sun, 23 Aug 2020 17:53:14 +0000 ++ ++gcl (2.6.12-95) unstable; urgency=high ++ ++ * Version_2_6_13pre90 ++ * build under GCL_MEM_MULTIPLE=0.1 ++ * Bug fix: "FTBFS: Unrecoverable error: Segmentation violation..", ++ thanks to Lucas Nussbaum (Closes: #952334). ++ ++ -- Camm Maguire Fri, 01 May 2020 12:55:02 +0000 ++ ++gcl (2.6.12-94) unstable; urgency=medium ++ ++ * re-release to overcome hopefully transient buildd failure ++ ++ -- Camm Maguire Mon, 24 Feb 2020 20:02:52 +0000 ++ ++gcl (2.6.12-93) unstable; urgency=medium ++ ++ * Version_2_6_13pre90 ++ ++ -- Camm Maguire Fri, 21 Feb 2020 19:06:56 +0000 ++ ++gcl (2.6.12-92) unstable; urgency=medium ++ ++ * Version_2_6_13pre89 ++ ++ -- Camm Maguire Mon, 30 Dec 2019 15:46:22 +0000 ++ ++gcl (2.6.12-91) unstable; urgency=medium ++ ++ * Version_2_6_13pre88 ++ ++ -- Camm Maguire Wed, 18 Dec 2019 20:14:09 +0000 ++ ++gcl (2.6.12-90) unstable; urgency=medium ++ ++ * Version_2_6_13pre87 ++ * latest standards ++ ++ -- Camm Maguire Sun, 08 Dec 2019 19:27:24 +0000 ++ ++gcl (2.6.12-89) unstable; urgency=medium ++ ++ * Bug fix: "gcl - FTBFS on ppc64el - invalid relocation type 31", thanks ++ to thierry.fauck@fr.ibm.com; (Closes: #942312). ++ * Bug fix: "FTBFS on ppc64el", thanks to Ivo De Decker (Closes: ++ #944651). ++ ++ -- Camm Maguire Sat, 07 Dec 2019 23:27:53 +0000 ++ ++gcl (2.6.12-88) unstable; urgency=medium ++ ++ * Source only upload ++ ++ -- Camm Maguire Fri, 11 Oct 2019 19:18:44 +0000 ++ ++gcl (2.6.12-87) unstable; urgency=medium ++ ++ * Version_2_6_13pre84 ++ ++ -- Camm Maguire Sat, 06 Apr 2019 13:03:21 +0000 ++ ++gcl (2.6.12-86) unstable; urgency=medium ++ ++ * Version_2_6_13pre83 ++ ++ -- Camm Maguire Tue, 02 Apr 2019 19:57:15 +0000 ++ ++gcl (2.6.12-85) unstable; urgency=medium ++ ++ * Version_2_6_13pre82 ++ ++ -- Camm Maguire Thu, 28 Mar 2019 18:48:55 +0000 ++ ++gcl (2.6.12-84) unstable; urgency=medium ++ ++ * Version_2_6_13pre80 ++ ++ -- Camm Maguire Thu, 21 Mar 2019 18:59:40 +0000 ++ ++gcl (2.6.12-83) unstable; urgency=high ++ ++ * Version_2_6_13pre79 ++ * Fix acl2 arm builds (Closes: #919477). ++ ++ -- Camm Maguire Tue, 05 Feb 2019 21:54:42 +0000 ++ ++gcl (2.6.12-82) unstable; urgency=high ++ ++ * Version_2_6_13pre74 ++ ++ -- Camm Maguire Sat, 02 Feb 2019 17:40:20 +0000 ++ ++gcl (2.6.12-81) unstable; urgency=high ++ ++ * Version_2_6_13pre72 ++ * Fix to ppc64el for acl2 FTBFS bug ++ ++ -- Camm Maguire Mon, 21 Jan 2019 16:40:36 +0000 ++ ++gcl (2.6.12-80) unstable; urgency=medium ++ ++ * Version_2_6_13pre71 ++ * Bug fix: "FTBFS on hppa - segmentation fault assembling gbc.s", thanks ++ to John David Anglin (Closes: #912071). ++ ++ -- Camm Maguire Tue, 30 Oct 2018 17:20:43 +0000 ++ ++gcl (2.6.12-79) unstable; urgency=medium ++ ++ * Version_2_6_13pre70 ++ ++ -- Camm Maguire Mon, 29 Oct 2018 16:52:17 +0000 ++ ++gcl (2.6.12-78) unstable; urgency=medium ++ ++ * rebuild against latest compilers and tools ++ * Version_2_6_13pre69 ++ ++ -- Camm Maguire Thu, 11 Oct 2018 16:40:48 +0000 ++ ++gcl (2.6.12-77) unstable; urgency=medium ++ ++ * Version_2_6_13pre68 ++ * Bug fix: "GCL fails to load .o files it generates", thanks to Gong-Yi ++ Liao (Closes: #902475). Add support for R_X86_64_PLT32 relocs. ++ ++ -- Camm Maguire Tue, 24 Jul 2018 20:06:45 +0000 ++ ++gcl (2.6.12-76) unstable; urgency=medium ++ ++ * Version_2_6_13pre67 ++ ++ -- Camm Maguire Fri, 23 Mar 2018 19:25:22 +0000 ++ ++gcl (2.6.12-75) unstable; urgency=medium ++ ++ * Version_2_6_13pre65 ++ ++ -- Camm Maguire Wed, 21 Mar 2018 20:28:08 +0000 ++ ++gcl (2.6.12-74) unstable; urgency=medium ++ ++ * Version_2_6_13pre63 ++ ++ -- Camm Maguire Sat, 17 Mar 2018 11:56:05 +0000 ++ ++gcl (2.6.12-73) unstable; urgency=medium ++ ++ * Version_2_6_13pre62 ++ ++ -- Camm Maguire Wed, 14 Mar 2018 15:38:43 +0000 ++ ++gcl (2.6.12-72) unstable; urgency=medium ++ ++ * Version_2_6_13pre61 ++ ++ -- Camm Maguire Tue, 13 Mar 2018 15:32:44 +0000 ++ ++gcl (2.6.12-71) unstable; urgency=medium ++ ++ * Version_2_6_13pre60 ++ ++ -- Camm Maguire Mon, 12 Mar 2018 19:44:47 +0000 ++ ++gcl (2.6.12-70) unstable; urgency=medium ++ ++ * Version_2_6_13pre59 ++ ++ -- Camm Maguire Mon, 12 Mar 2018 16:19:00 +0000 ++ ++gcl (2.6.12-69) unstable; urgency=medium ++ ++ * Version_2_6_13pre58 ++ ++ -- Camm Maguire Fri, 09 Mar 2018 17:10:51 +0000 ++ ++gcl (2.6.12-68) unstable; urgency=medium ++ ++ * Version_2_6_13pre57 ++ ++ -- Camm Maguire Sun, 04 Mar 2018 13:21:00 +0000 ++ ++gcl (2.6.12-67) unstable; urgency=medium ++ ++ * Version_2_6_13pre55 ++ ++ -- Camm Maguire Sat, 03 Mar 2018 14:27:51 +0000 ++ ++gcl (2.6.12-66) unstable; urgency=medium ++ ++ * Version_2_6_13pre54 ++ ++ -- Camm Maguire Fri, 02 Mar 2018 21:19:03 +0000 ++ ++gcl (2.6.12-65) unstable; urgency=medium ++ ++ * Version_2_6_13pre52 ++ * Bug fix: "FTBFS on hurd-i386", thanks to svante.signell@gmail.com; ++ (Closes: #802593). ++ ++ -- Camm Maguire Fri, 23 Feb 2018 15:55:23 +0000 ++ ++gcl (2.6.12-64) unstable; urgency=medium ++ ++ * list_order.24 ++ ++ -- Camm Maguire Sun, 04 Feb 2018 13:26:27 +0000 ++ ++gcl (2.6.12-63) unstable; urgency=medium ++ ++ * list_order.23 ++ ++ -- Camm Maguire Thu, 01 Feb 2018 18:36:29 +0000 ++ ++gcl (2.6.12-62) unstable; urgency=medium ++ ++ * list_order.22 ++ ++ -- Camm Maguire Thu, 01 Feb 2018 01:05:10 +0000 ++ ++gcl (2.6.12-61) unstable; urgency=medium ++ ++ * list_order.21 ++ ++ -- Camm Maguire Tue, 30 Jan 2018 21:13:13 +0000 ++ ++gcl (2.6.12-60) unstable; urgency=medium ++ ++ * list_order.19 ++ ++ -- Camm Maguire Tue, 23 Jan 2018 18:11:59 +0000 ++ ++gcl (2.6.12-59) unstable; urgency=medium ++ ++ * list_order.16 ++ ++ -- Camm Maguire Fri, 12 Jan 2018 03:25:08 +0000 ++ ++gcl (2.6.12-58) unstable; urgency=medium ++ ++ * list_order.14 ++ ++ -- Camm Maguire Mon, 18 Sep 2017 15:45:10 +0000 ++ ++gcl (2.6.12-57) unstable; urgency=medium ++ ++ * list_order.13 ++ ++ -- Camm Maguire Fri, 25 Aug 2017 13:44:10 +0000 ++ ++gcl (2.6.12-56) unstable; urgency=medium ++ ++ * list_order.12 ++ ++ -- Camm Maguire Thu, 24 Aug 2017 19:12:50 +0000 ++ ++gcl (2.6.12-55) unstable; urgency=medium ++ ++ * disable gprof on aarch64 ++ * Bug fix: "gcl FTBFS on arm64: Unrecoverable error: Segmentation ++ violation..", thanks to Adrian Bunk (Closes: #873052). ++ ++ -- Camm Maguire Thu, 24 Aug 2017 16:37:07 +0000 ++ ++gcl (2.6.12-54) unstable; urgency=medium ++ ++ * list_order.11 ++ ++ -- Camm Maguire Wed, 23 Aug 2017 22:19:14 +0000 ++ ++gcl (2.6.12-53) unstable; urgency=medium ++ ++ * list_order.9 ++ ++ -- Camm Maguire Sun, 18 Jun 2017 18:32:30 +0000 ++ ++gcl (2.6.12-52) unstable; urgency=medium ++ ++ * list_order.8 ++ ++ -- Camm Maguire Thu, 15 Jun 2017 18:04:41 +0000 ++ ++gcl (2.6.12-51) unstable; urgency=medium ++ ++ * list_order.7 ++ ++ -- Camm Maguire Wed, 14 Jun 2017 18:30:46 +0000 ++ ++gcl (2.6.12-50) unstable; urgency=medium ++ ++ * list_order.6 ++ ++ -- Camm Maguire Tue, 13 Jun 2017 22:38:52 +0000 ++ ++gcl (2.6.12-49) unstable; urgency=medium ++ ++ * list_order.5 ++ ++ -- Camm Maguire Thu, 08 Jun 2017 17:21:01 +0000 ++ ++gcl (2.6.12-48) unstable; urgency=medium ++ ++ * list_order.1 ++ ++ -- Camm Maguire Sun, 28 May 2017 01:42:29 +0000 ++ ++gcl (2.6.12-47) unstable; urgency=high ++ ++ * pathnames1.13 ++ ++ -- Camm Maguire Tue, 22 Nov 2016 04:53:35 +0000 ++ ++gcl (2.6.12-46) unstable; urgency=high ++ ++ * pathnames1.12 ++ * Bug fix: "maintainer script(s) do not start on #!", thanks to ++ treinen@debian.org; (Closes: #843303). ++ ++ -- Camm Maguire Fri, 18 Nov 2016 18:27:53 +0000 ++ ++gcl (2.6.12-45) unstable; urgency=high ++ ++ * pathnames1.11 ++ ++ -- Camm Maguire Mon, 31 Oct 2016 22:57:27 +0000 ++ ++gcl (2.6.12-44) unstable; urgency=high ++ ++ * pathnames1.9 ++ ++ -- Camm Maguire Fri, 28 Oct 2016 17:04:38 +0000 ++ ++gcl (2.6.12-43) unstable; urgency=medium ++ ++ * pathnames1.7 ++ ++ -- Camm Maguire Thu, 27 Oct 2016 03:46:32 +0000 ++ ++gcl (2.6.12-42) unstable; urgency=medium ++ ++ * pathnames1.6 ++ * Bug fix: "FTBFS with bindnow and PIE enabled", thanks to Balint Reczey ++ (Closes: #837481). ++ * Bug fix: "FTBFS with compilers that default to -fPIE (patch ++ attached)", thanks to Adam Conrad (Closes: #822820). ++ ++ -- Camm Maguire Wed, 26 Oct 2016 23:04:57 +0000 ++ ++gcl (2.6.12-41) unstable; urgency=medium ++ ++ * pathnames1.4, kfreebsd fix ++ ++ -- Camm Maguire Fri, 14 Oct 2016 01:17:18 +0000 ++ ++gcl (2.6.12-40) unstable; urgency=medium ++ ++ * pathnames1.2 ++ * Bug fix: "popen arguments not quoted causes trouble and security ++ issues", thanks to axel (Closes: #802203). ++ ++ -- Camm Maguire Wed, 12 Oct 2016 18:09:26 +0000 ++ ++gcl (2.6.12-39) unstable; urgency=medium ++ ++ * pathnames1.1 ++ * ansi-test clean target ++ ++ -- Camm Maguire Wed, 12 Oct 2016 01:32:05 +0000 ++ ++gcl (2.6.12-38) unstable; urgency=medium ++ ++ * Version_2_6_13pre50 ++ ++ -- Camm Maguire Tue, 04 Oct 2016 19:45:38 +0000 ++ ++gcl (2.6.12-37) unstable; urgency=medium ++ ++ * Version_2_6_13pre49 ++ ++ -- Camm Maguire Mon, 03 Oct 2016 14:54:09 +0000 ++ ++gcl (2.6.12-36) unstable; urgency=medium ++ ++ * Version_2_6_13pre48 ++ ++ -- Camm Maguire Sat, 01 Oct 2016 12:10:25 +0000 ++ ++gcl (2.6.12-35) unstable; urgency=medium ++ ++ * Version_2_6_13pre47 ++ ++ -- Camm Maguire Fri, 30 Sep 2016 21:21:43 +0000 ++ ++gcl (2.6.12-34) unstable; urgency=medium ++ ++ * Version_2_6_13pre45 ++ ++ -- Camm Maguire Fri, 23 Sep 2016 19:42:37 +0000 ++ ++gcl (2.6.12-33) unstable; urgency=medium ++ ++ * Version_2_6_13pre43 ++ ++ -- Camm Maguire Tue, 03 May 2016 16:17:03 +0000 ++ ++gcl (2.6.12-32) unstable; urgency=medium ++ ++ * Version_2_6_13pre40 ++ * Bug fix: "[INTL:pt_BR] Brazilian Portuguese debconf templates ++ translation", thanks to Adriano Rafael Gomes (Closes: #811523). ++ ++ -- Camm Maguire Wed, 20 Apr 2016 15:18:35 +0000 ++ ++gcl (2.6.12-31) unstable; urgency=medium ++ ++ * Version_2_6_13pre39 ++ ++ -- Camm Maguire Mon, 11 Apr 2016 00:41:11 +0000 ++ ++gcl (2.6.12-30) unstable; urgency=medium ++ ++ * Version_2_6_13pre38 ++ ++ -- Camm Maguire Wed, 06 Apr 2016 00:20:15 +0000 ++ ++gcl (2.6.12-29) unstable; urgency=medium ++ ++ * Version_2_6_13pre35; support latest binutils ++ * Bug fix: "gcl ftbfs on amd64 and i386 with binutils from ++ experimental", thanks to Matthias Klose (Closes: #803214). ++ ++ -- Camm Maguire Thu, 29 Oct 2015 15:20:27 +0000 ++ ++gcl (2.6.12-28) unstable; urgency=medium ++ ++ * Version_2_6_13pre35; restore hppa build ++ ++ -- Camm Maguire Tue, 27 Oct 2015 20:00:46 +0000 ++ ++gcl (2.6.12-27) unstable; urgency=medium ++ ++ * Version_2_6_13pre34; mips64 relocs; stack saving tail-recursive equal. ++ ++ -- Camm Maguire Tue, 27 Oct 2015 16:35:06 +0000 ++ ++gcl (2.6.12-26) unstable; urgency=medium ++ ++ * Version_2_6_13pre32 ++ ++ -- Camm Maguire Fri, 23 Oct 2015 00:03:34 +0000 ++ ++gcl (2.6.12-25) unstable; urgency=medium ++ ++ * Version_2_6_13pre31, kfreebsd and mips64 FTBFS fix ++ ++ -- Camm Maguire Fri, 16 Oct 2015 15:03:03 +0000 ++ ++gcl (2.6.12-24) unstable; urgency=medium ++ ++ * Version_2_6_13pre30 ++ ++ -- Camm Maguire Fri, 16 Oct 2015 02:44:23 +0000 ++ ++gcl (2.6.12-23) unstable; urgency=medium ++ ++ * Version_2_6_13pre29 ++ ++ -- Camm Maguire Thu, 15 Oct 2015 18:09:59 +0000 ++ ++gcl (2.6.12-22) unstable; urgency=medium ++ ++ * Version_2_6_13pre27 ++ ++ -- Camm Maguire Tue, 13 Oct 2015 14:38:53 +0000 ++ ++gcl (2.6.12-21) unstable; urgency=medium ++ ++ * Version_2_6_13pre26 ++ ++ -- Camm Maguire Wed, 07 Oct 2015 15:14:27 +0000 ++ ++gcl (2.6.12-20) unstable; urgency=medium ++ ++ * Version_2_6_13pre25 ++ ++ -- Camm Maguire Thu, 01 Oct 2015 15:16:14 +0000 ++ ++gcl (2.6.12-19) unstable; urgency=medium ++ ++ * Use-dpkg-buidflags-opt-levels-in-debian-rules, -O3 has bug in 5.2.1 ++ * Version_2_6_13pre24 ++ ++ -- Camm Maguire Wed, 30 Sep 2015 15:45:20 +0000 ++ ++gcl (2.6.12-18) unstable; urgency=medium ++ ++ * Version_2_6_13pre22 ++ ++ -- Camm Maguire Tue, 29 Sep 2015 16:51:03 +0000 ++ ++gcl (2.6.12-17) unstable; urgency=medium ++ ++ * Version_2_6_13pre20 ++ ++ -- Camm Maguire Sat, 26 Sep 2015 10:34:23 -0400 ++ ++gcl (2.6.12-16) unstable; urgency=medium ++ ++ * Version_2_6_13pre19 ++ ++ -- Camm Maguire Fri, 25 Sep 2015 18:39:52 -0400 ++ ++gcl (2.6.12-15) unstable; urgency=medium ++ ++ * Version_2_6_13pre18 ++ ++ -- Camm Maguire Fri, 25 Sep 2015 15:08:50 +0000 ++ ++gcl (2.6.12-14) unstable; urgency=medium ++ ++ * Version_2_6_13pre17 ++ ++ -- Camm Maguire Thu, 28 May 2015 03:37:47 +0000 ++ ++gcl (2.6.12-13) unstable; urgency=medium ++ ++ * Version_2_6_13pre16 ++ ++ -- Camm Maguire Fri, 15 May 2015 18:09:38 +0000 ++ ++gcl (2.6.12-12) unstable; urgency=medium ++ ++ * Version_2_6_13pre13 ++ ++ -- Camm Maguire Fri, 01 May 2015 11:08:46 -0400 ++ ++gcl (2.6.12-11) unstable; urgency=medium ++ ++ * Version_2_6_13pre12 ++ ++ -- Camm Maguire Thu, 30 Apr 2015 12:49:16 -0400 ++ ++gcl (2.6.12-10) unstable; urgency=medium ++ ++ * rebuild in clean sid environment ++ ++ -- Camm Maguire Mon, 27 Apr 2015 15:34:15 -0400 ++ ++gcl (2.6.12-9) unstable; urgency=medium ++ ++ * Version_2_6_13pre8b ++ * Bug fix: "ftbfs with GCC-5", thanks to Matthias Klose (Closes: ++ #777866). ++ ++ -- Camm Maguire Mon, 27 Apr 2015 12:32:49 -0400 ++ ++gcl (2.6.12-8) unstable; urgency=medium ++ ++ * Version_2_6_13pre7 ++ ++ -- Camm Maguire Fri, 24 Apr 2015 13:38:30 -0400 ++ ++gcl (2.6.12-7) unstable; urgency=medium ++ ++ * Version_2_6_13pre6 ++ ++ -- Camm Maguire Thu, 23 Apr 2015 13:43:45 -0400 ++ ++gcl (2.6.12-6) unstable; urgency=medium ++ ++ * Version_2_6_13pre5 ++ ++ -- Camm Maguire Wed, 22 Apr 2015 17:14:16 -0400 ++ ++gcl (2.6.12-5) unstable; urgency=medium ++ ++ * Version_2_6_13pre4 ++ ++ -- Camm Maguire Wed, 22 Apr 2015 10:25:36 -0400 ++ ++gcl (2.6.12-4) unstable; urgency=medium ++ ++ * Version_2_6_13pre3a ++ ++ -- Camm Maguire Mon, 20 Apr 2015 13:26:36 -0400 ++ ++gcl (2.6.12-3) unstable; urgency=medium ++ ++ * Version_2_6_13pre2 ++ ++ -- Camm Maguire Fri, 17 Apr 2015 15:50:37 -0400 ++ ++gcl (2.6.12-2) unstable; urgency=medium ++ ++ * Version_2_6_13pre1 ++ ++ -- Camm Maguire Wed, 26 Nov 2014 11:12:46 -0500 ++ ++gcl (2.6.12-1) unstable; urgency=medium ++ ++ * New upstream release ++ ++ -- Camm Maguire Tue, 28 Oct 2014 09:56:15 -0400 ++ ++gcl (2.6.11-6) unstable; urgency=medium ++ ++ * 2.6.12pre5 ++ ++ -- Camm Maguire Thu, 23 Oct 2014 17:33:22 -0400 ++ ++gcl (2.6.11-5) unstable; urgency=medium ++ ++ * 2.6.12pre4 ++ ++ -- Camm Maguire Sat, 18 Oct 2014 09:46:34 -0400 ++ ++gcl (2.6.11-4) unstable; urgency=medium ++ ++ * 2.6.12pre3 ++ ++ -- Camm Maguire Thu, 16 Oct 2014 11:56:15 -0400 ++ ++gcl (2.6.11-3) unstable; urgency=medium ++ ++ * 2.6.12pre2 ++ ++ -- Camm Maguire Sun, 28 Sep 2014 20:56:18 -0400 ++ ++gcl (2.6.11-2) unstable; urgency=medium ++ ++ * 2.6.12pre1 ++ ++ -- Camm Maguire Fri, 19 Sep 2014 14:49:25 -0400 ++ ++gcl (2.6.11-1) unstable; urgency=medium ++ ++ * New upstream release ++ ++ -- Camm Maguire Sat, 06 Sep 2014 12:28:46 -0400 ++ ++gcl (2.6.10-54) unstable; urgency=medium ++ ++ * remove-debug-message-from-BUGGY_MAXIMUM_SSCANF_LENGTH-code ++ ++ -- Camm Maguire Fri, 05 Sep 2014 10:35:46 -0400 ++ ++gcl (2.6.10-53) unstable; urgency=medium ++ ++ * ppc64le-support-headers ++ ++ -- Camm Maguire Wed, 03 Sep 2014 15:02:12 -0400 ++ ++gcl (2.6.10-52) unstable; urgency=medium ++ ++ * accept-TMP-paths-with-types-versions ++ ++ -- Camm Maguire Fri, 29 Aug 2014 17:51:04 -0400 ++ ++gcl (2.6.10-51) unstable; urgency=medium ++ ++ * fix-match-function-proclaim-skew ++ ++ -- Camm Maguire Fri, 29 Aug 2014 16:40:30 +0000 ++ ++gcl (2.6.10-50) unstable; urgency=medium ++ ++ * trial_selinux_support ++ ++ -- Camm Maguire Thu, 21 Aug 2014 17:29:50 +0000 ++ ++gcl (2.6.10-49) unstable; urgency=medium ++ ++ * R_ARM_JUMP24 ++ ++ -- Camm Maguire Wed, 20 Aug 2014 17:08:23 +0000 ++ ++gcl (2.6.10-48) unstable; urgency=medium ++ ++ * try-SGC-for-aarch64 ++ ++ -- Camm Maguire Tue, 19 Aug 2014 18:35:22 +0000 ++ ++gcl (2.6.10-47) unstable; urgency=medium ++ ++ * set-stack_guard-after-alloc-setup ++ * Bug fix: "work around build failure on AArch64", thanks to Matthias ++ Klose (Closes: #758101). ++ ++ -- Camm Maguire Thu, 14 Aug 2014 19:36:48 +0000 ++ ++gcl (2.6.10-46) unstable; urgency=medium ++ ++ * R_AARCH64_LDST128_ABS_LO12_NC ++ ++ -- Camm Maguire Wed, 13 Aug 2014 21:39:50 +0000 ++ ++gcl (2.6.10-45) unstable; urgency=medium ++ ++ * fix sh4 CLEAR_CACHE ++ ++ -- Camm Maguire Sun, 10 Aug 2014 20:12:03 +0000 ++ ++gcl (2.6.10-44) unstable; urgency=medium ++ ++ * clear_protect_memory on all elf machines ++ ++ -- Camm Maguire Sat, 09 Aug 2014 00:55:17 +0000 ++ ++gcl (2.6.10-43) unstable; urgency=medium ++ ++ * mips uses builtin_clear_cache like mipsel ++ ++ -- Camm Maguire Fri, 08 Aug 2014 23:42:42 +0000 ++ ++gcl (2.6.10-42) unstable; urgency=medium ++ ++ * backport travel_push_new from master ++ ++ -- Camm Maguire Wed, 06 Aug 2014 20:14:14 +0000 ++ ++gcl (2.6.10-41) unstable; urgency=medium ++ ++ * protos and CFLAGS for axiom extensions ++ ++ -- Camm Maguire Wed, 06 Aug 2014 01:54:38 +0000 ++ ++gcl (2.6.10-40) unstable; urgency=medium ++ ++ * better solaris unexec fix ++ ++ -- Camm Maguire Mon, 04 Aug 2014 22:00:54 +0000 ++ ++gcl (2.6.10-39) unstable; urgency=medium ++ ++ * earlier prelink_init, phys_pages w/o malloc ++ ++ -- Camm Maguire Mon, 04 Aug 2014 16:52:09 +0000 ++ ++gcl (2.6.10-38) unstable; urgency=medium ++ ++ * error on overflow of array dimensions ++ ++ -- Camm Maguire Fri, 01 Aug 2014 14:35:44 +0000 ++ ++gcl (2.6.10-37) unstable; urgency=medium ++ ++ * FILE * casts for windows feof wrapper ++ ++ -- Camm Maguire Thu, 31 Jul 2014 02:17:11 +0000 ++ ++gcl (2.6.10-36) unstable; urgency=medium ++ ++ * better casts for frs_jmpbuf ++ ++ -- Camm Maguire Wed, 30 Jul 2014 17:00:06 +0000 ++ ++gcl (2.6.10-35) unstable; urgency=medium ++ ++ * find_sym_ptable typo fix ++ ++ -- Camm Maguire Tue, 29 Jul 2014 18:08:57 +0000 ++ ++gcl (2.6.10-34) unstable; urgency=medium ++ ++ * --enable-prelink configure arg; stack_chk_guard for 68k ++ ++ -- Camm Maguire Fri, 25 Jul 2014 20:39:10 +0000 ++ ++gcl (2.6.10-33) unstable; urgency=medium ++ ++ * hurd stack_guard, ppc64 C_GC_OFFSET ++ ++ -- Camm Maguire Thu, 24 Jul 2014 21:46:24 +0000 ++ ++gcl (2.6.10-32) unstable; urgency=medium ++ ++ * __stack_chk_guard fix for arm/sh4 ++ ++ -- Camm Maguire Wed, 23 Jul 2014 18:12:56 +0000 ++ +gcl (2.6.10-31) unstable; urgency=medium + + * dpkg-buildflags trial + + -- Camm Maguire Tue, 22 Jul 2014 20:06:10 +0000 + +gcl (2.6.10-30) unstable; urgency=medium + + * fix offsets ppc + + -- Camm Maguire Tue, 22 Jul 2014 17:12:27 +0000 + +gcl (2.6.10-29) unstable; urgency=medium + + * fix unexec file offsets + + -- Camm Maguire Tue, 22 Jul 2014 15:36:45 +0000 + +gcl (2.6.10-28) unstable; urgency=high + + * enable prelink + + -- Camm Maguire Fri, 18 Jul 2014 19:24:38 +0000 + +gcl (2.6.10-27) unstable; urgency=high + + * protect closure calls from gc + + -- Camm Maguire Wed, 16 Jul 2014 16:15:33 +0000 + +gcl (2.6.10-26) unstable; urgency=high + + * Bug fix: "packages should not build-depend on binutils-dev", thanks to + Matthias Klose (Closes: #754840). Please note that gcl has long + depended on binutils-dev for good reason -- happily it is no longer + necessary + + -- Camm Maguire Tue, 15 Jul 2014 16:04:04 +0000 + +gcl (2.6.10-25) unstable; urgency=high + + * rebuild to get gcc fixes on i386 + + -- Camm Maguire Fri, 11 Jul 2014 03:14:45 +0000 + +gcl (2.6.10-24) unstable; urgency=high + + * try default gcc 4.9 + * access libopcodes without link dependency via dlopen + * Bug fix: "please switch to emacs24", thanks to Gabriele Giacone + (Closes: #754012). + + -- Camm Maguire Wed, 09 Jul 2014 17:34:21 +0000 + +gcl (2.6.10-23) unstable; urgency=high + + * rebuild latest binutils + + -- Camm Maguire Sat, 05 Jul 2014 23:19:27 +0000 + +gcl (2.6.10-22) unstable; urgency=high + + * gcc-4.8 on i386, 4.9 has bugs at present + + -- Camm Maguire Fri, 04 Jul 2014 01:36:06 +0000 + +gcl (2.6.10-21) unstable; urgency=high + + * 2.6.11pre test 20 + + -- Camm Maguire Mon, 30 Jun 2014 22:43:27 +0000 + +gcl (2.6.10-20) unstable; urgency=high + + * 2.6.11pre test 19 + + -- Camm Maguire Sun, 29 Jun 2014 17:59:59 +0000 + +gcl (2.6.10-19) unstable; urgency=high + + * 2.6.11pre test 18 + + -- Camm Maguire Sun, 29 Jun 2014 16:00:07 +0000 + +gcl (2.6.10-18) unstable; urgency=high + + * 2.6.11pre test 17 + + -- Camm Maguire Sat, 28 Jun 2014 16:57:54 +0000 + +gcl (2.6.10-17) unstable; urgency=high + + * 2.6.11pre test 16 + + -- Camm Maguire Thu, 26 Jun 2014 18:06:42 +0000 + +gcl (2.6.10-16) unstable; urgency=high + + * 2.6.11pre test 15 + + -- Camm Maguire Wed, 18 Jun 2014 17:37:36 +0000 + +gcl (2.6.10-15) unstable; urgency=high + + * 2.6.11pre test 14 + + -- Camm Maguire Tue, 17 Jun 2014 00:39:35 +0000 + +gcl (2.6.10-14) unstable; urgency=high + + * 2.6.11pre test 13 + + -- Camm Maguire Sat, 14 Jun 2014 13:43:57 +0000 + +gcl (2.6.10-13) unstable; urgency=high + + * 2.6.11pre test 12 + + -- Camm Maguire Tue, 20 May 2014 16:00:22 +0000 + +gcl (2.6.10-12) unstable; urgency=high + + * 2.6.11pre test 11 + + -- Camm Maguire Fri, 16 May 2014 17:41:33 +0000 + +gcl (2.6.10-11) unstable; urgency=high + + * 2.6.11pre test 10 + + -- Camm Maguire Fri, 16 May 2014 13:18:07 +0000 + +gcl (2.6.10-10) unstable; urgency=high + + * 2.6.11pre test 9 + + -- Camm Maguire Wed, 07 May 2014 17:10:30 +0000 + +gcl (2.6.10-9) unstable; urgency=high + + * 2.6.11pre test 8 + + -- Camm Maguire Fri, 25 Apr 2014 19:53:10 +0000 + +gcl (2.6.10-8) unstable; urgency=high + + * 2.6.11pre test 7 + + -- Camm Maguire Mon, 21 Apr 2014 14:09:37 +0000 + +gcl (2.6.10-7) unstable; urgency=high + + * 2.6.11pre test 6 + + -- Camm Maguire Sat, 19 Apr 2014 17:52:17 +0000 + +gcl (2.6.10-6) unstable; urgency=high + + * 2.6.11pre test 5 + + -- Camm Maguire Fri, 18 Apr 2014 15:06:09 +0000 + +gcl (2.6.10-5) unstable; urgency=high + + * 2.6.11pre test 4 + + -- Camm Maguire Tue, 15 Apr 2014 20:30:13 +0000 + +gcl (2.6.10-4) unstable; urgency=high + + * 2.6.11pre test 3 + * Bug fix: "debian/rules uses DEB_BUILD_* macros instead of DEB_HOST_* + macros", thanks to Matthias Klose (Closes: #743520). + + -- Camm Maguire Wed, 09 Apr 2014 13:15:32 +0000 + +gcl (2.6.10-3) unstable; urgency=high + + * 2.6.11pre test 2 + + -- Camm Maguire Thu, 03 Apr 2014 14:24:23 +0000 + +gcl (2.6.10-2) unstable; urgency=high + + * 2.6.11pre test 1 + * Bug fix: "FTBFS: gcl_readline.d:472:39: error: 'CPPFunction' + undeclared (first use in this function)", thanks to David Suárez + (Closes: #741819). + + -- Camm Maguire Mon, 24 Mar 2014 15:47:01 +0000 + +gcl (2.6.10-1) unstable; urgency=high + + * New upstream release + + -- Camm Maguire Wed, 13 Nov 2013 18:39:19 +0000 + +gcl (2.6.9-17) unstable; urgency=high + + * 2.6.10pre test 17 + + -- Camm Maguire Mon, 11 Nov 2013 19:41:45 +0000 + +gcl (2.6.9-16) unstable; urgency=high + + * 2.6.10pre test 16 + * Bug fix: "gcl 2.6.7+dfsga-20 needs 1 GB disk space on amd64", thanks + to Edi Meier (Closes: #714507). + * Bug fix: "[INTL:ja] New Japanese translation", thanks to victory + (Closes: #718925). + + -- Camm Maguire Sat, 09 Nov 2013 13:34:32 +0000 + +gcl (2.6.9-15) unstable; urgency=high + + * 2.6.10pre test 15 + + -- Camm Maguire Sat, 02 Nov 2013 22:21:16 +0000 + +gcl (2.6.9-14) unstable; urgency=high + + * 2.6.10pre test 14 + + -- Camm Maguire Wed, 23 Oct 2013 17:44:14 +0000 + +gcl (2.6.9-13) unstable; urgency=high + + * environment allocation unrandomize.h + + -- Camm Maguire Mon, 21 Oct 2013 00:20:16 +0000 + +gcl (2.6.9-12) unstable; urgency=high + + * 2.6.10pre test 13 + + -- Camm Maguire Fri, 18 Oct 2013 14:18:17 +0000 + +gcl (2.6.9-11) unstable; urgency=high + + * 2.6.10pre test 12, s390, mingw cleanup, make_bignum bug fix + + -- Camm Maguire Tue, 15 Oct 2013 23:32:09 +0000 + +gcl (2.6.9-10) unstable; urgency=high + + * fast-fixnums + + -- Camm Maguire Fri, 11 Oct 2013 15:05:58 +0000 + +gcl (2.6.9-9) unstable; urgency=high + + * 2.6.10pre test 10 and 11 + + -- Camm Maguire Wed, 02 Oct 2013 19:12:36 +0000 + +gcl (2.6.9-8) unstable; urgency=high + + * 2.6.10pre test 8 and 9 + + -- Camm Maguire Tue, 01 Oct 2013 21:00:19 +0000 + +gcl (2.6.9-7) unstable; urgency=high + + * 2.6.10pre test 6 and 7 + + -- Camm Maguire Mon, 30 Sep 2013 19:34:38 +0000 + +gcl (2.6.9-6) unstable; urgency=high + + * 2.6.10pre test 5 + + -- Camm Maguire Tue, 24 Sep 2013 17:03:24 +0000 + +gcl (2.6.9-5) unstable; urgency=high + + * 2.6.10pre test 4 + + -- Camm Maguire Mon, 23 Sep 2013 19:27:36 +0000 + +gcl (2.6.9-4) unstable; urgency=high + + * 2.6.10pre test 3 + + -- Camm Maguire Mon, 23 Sep 2013 16:30:09 +0000 + +gcl (2.6.9-3) unstable; urgency=high + + * 2.6.10pre test 2 + + -- Camm Maguire Sun, 22 Sep 2013 03:27:10 +0000 + +gcl (2.6.9-2) unstable; urgency=high + + * 2.6.10pre test + + -- Camm Maguire Sat, 21 Sep 2013 04:14:55 +0000 + +gcl (2.6.9-1) unstable; urgency=high + + * New upstream release + + -- Camm Maguire Wed, 28 Aug 2013 16:49:18 +0000 + +gcl (2.6.7+dfsga-40) unstable; urgency=high + + * fix allocate functions + + -- Camm Maguire Tue, 06 Aug 2013 22:36:37 +0000 + +gcl (2.6.7+dfsga-39) unstable; urgency=high + + * lower initial contiguous and relblock allocations, set *ihs-top* + properly on startup, protect memory->cfd.cfd_start initialization from + gc + + -- Camm Maguire Mon, 05 Aug 2013 17:38:22 +0000 + +gcl (2.6.7+dfsga-38) unstable; urgency=high + + * robustify near oom handling to fix axiom compile of EXPEXPAN on mips + + -- Camm Maguire Fri, 02 Aug 2013 16:25:16 +0000 + +gcl (2.6.7+dfsga-37) unstable; urgency=high + + * ppc64 gprof fix + + -- Camm Maguire Fri, 26 Jul 2013 23:40:14 +0000 + +gcl (2.6.7+dfsga-36) unstable; urgency=high + + * min_pagewidth=14 on mips + + -- Camm Maguire Fri, 26 Jul 2013 02:20:56 +0000 + +gcl (2.6.7+dfsga-35) unstable; urgency=high + + * latest gcc on all platforms, no gprof ppc64, -O1 ia64, -O0 alpha + + -- Camm Maguire Thu, 25 Jul 2013 14:42:48 +0000 + +gcl (2.6.7+dfsga-34) unstable; urgency=high + + * sgc link_array mark fix;rb_end across save fix;more stable gcc on older arches + + -- Camm Maguire Tue, 23 Jul 2013 17:11:23 +0000 + +gcl (2.6.7+dfsga-33) unstable; urgency=high + + * fix mark_link_array for marked sLAlink_arrayA->s.s_dbind + + -- Camm Maguire Mon, 22 Jul 2013 19:00:43 +0000 + +gcl (2.6.7+dfsga-32) unstable; urgency=high + + * protect mark_link_array in sgc + + -- Camm Maguire Sat, 20 Jul 2013 00:16:07 +0000 + +gcl (2.6.7+dfsga-31) unstable; urgency=high + + * properly clean link array on gc + + -- Camm Maguire Fri, 19 Jul 2013 20:34:34 +0000 + +gcl (2.6.7+dfsga-30) unstable; urgency=high + + * fix gcl.script compiler::link, darwin compile warnings + + -- Camm Maguire Mon, 15 Jul 2013 20:35:03 +0000 + +gcl (2.6.7+dfsga-29) unstable; urgency=high + + * fix compiler::link in presence of gcl.script + + -- Camm Maguire Mon, 15 Jul 2013 16:23:33 +0000 + +gcl (2.6.7+dfsga-28) unstable; urgency=high + + * install unixport/gcl.script + + -- Camm Maguire Sat, 13 Jul 2013 18:42:28 +0000 + +gcl (2.6.7+dfsga-27) unstable; urgency=high + + * workaround for ia64 and hurd brk issues + + -- Camm Maguire Fri, 12 Jul 2013 21:44:54 +0000 + +gcl (2.6.7+dfsga-26) unstable; urgency=high + + * -- command line support, map-shared in unexec + + -- Camm Maguire Fri, 12 Jul 2013 00:52:35 +0000 + +gcl (2.6.7+dfsga-25) unstable; urgency=high + + * alpha, mips, 68k + + -- Camm Maguire Wed, 10 Jul 2013 18:29:37 +0000 + +gcl (2.6.7+dfsga-24) unstable; urgency=high + + * sgc and reloc fixes + + -- Camm Maguire Mon, 08 Jul 2013 13:56:33 +0000 + +gcl (2.6.7+dfsga-23) unstable; urgency=high + + * fix for maxima on kfbsd and sparc + + -- Camm Maguire Wed, 03 Jul 2013 19:19:16 +0000 + +gcl (2.6.7+dfsga-22) unstable; urgency=high + + * fix stack definition issues on i386 + + -- Camm Maguire Tue, 02 Jul 2013 18:27:54 +0000 + +gcl (2.6.7+dfsga-21) unstable; urgency=high + + * near out of memory robustification + + -- Camm Maguire Tue, 02 Jul 2013 15:32:58 +0000 + +gcl (2.6.7+dfsga-20) unstable; urgency=high + + * fix 3GB workaround for gprof + + -- Camm Maguire Fri, 21 Jun 2013 11:09:01 -0400 + +gcl (2.6.7+dfsga-19) unstable; urgency=high + + * work around 3GB personality/alloca/malloc bug + + -- Camm Maguire Fri, 21 Jun 2013 02:46:49 +0000 + +gcl (2.6.7+dfsga-18) unstable; urgency=high + + * alpha NULL_OR_ON_C_STACK, attempt to get 32 immfix space with + ADDR_LIMIT_3GB|ADDR_COMPAT_LAYOUT personality, clean compile with no + immfix + + -- Camm Maguire Thu, 20 Jun 2013 20:24:29 +0000 + +gcl (2.6.7+dfsga-17) unstable; urgency=high + + * small optimizations, #= nil fix + + -- Camm Maguire Wed, 19 Jun 2013 16:23:27 +0000 + +gcl (2.6.7+dfsga-16) unstable; urgency=high + + * no linker script on hurd;fix OBJ_ALIGN + + -- Camm Maguire Thu, 13 Jun 2013 15:35:00 +0000 + +gcl (2.6.7+dfsga-15) unstable; urgency=high + + * ia64 fix + + -- Camm Maguire Thu, 13 Jun 2013 02:38:47 +0000 + +gcl (2.6.7+dfsga-14) unstable; urgency=high + + * eliminate maxpage/dbegin, restore windows and macosx builds + + -- Camm Maguire Wed, 12 Jun 2013 21:42:29 +0000 + +gcl (2.6.7+dfsga-13) unstable; urgency=low + + * ia64/hurd/s390 and SGC + + -- Camm Maguire Sun, 09 Jun 2013 00:23:51 +0000 + +gcl (2.6.7+dfsga-12) unstable; urgency=low + + * ia64/hurd/s390 + + -- Camm Maguire Sat, 08 Jun 2013 15:24:46 +0000 + +gcl (2.6.7+dfsga-11) unstable; urgency=high + + * 2.6.9 test + + -- Camm Maguire Fri, 07 Jun 2013 21:46:41 +0000 + +gcl (2.6.7+dfsga-10) unstable; urgency=high + + * output mips make bug text to stderr + + -- Camm Maguire Sat, 25 May 2013 12:24:35 +0000 + +gcl (2.6.7+dfsga-9) unstable; urgency=high + + * mips make bug workaround + + -- Camm Maguire Wed, 22 May 2013 14:23:43 +0000 + +gcl (2.6.7+dfsga-8) unstable; urgency=high + + * revert doubled default maxpage + * export *read-eval* + + -- Camm Maguire Tue, 21 May 2013 14:42:05 +0000 + +gcl (2.6.7+dfsga-7) unstable; urgency=high + + * export ansi symbols + + -- Camm Maguire Sat, 11 May 2013 21:36:56 +0000 + +gcl (2.6.7+dfsga-6) unstable; urgency=high + + * fast hash-equal in compiler + + -- Camm Maguire Sat, 11 May 2013 19:11:42 +0000 + +gcl (2.6.7+dfsga-5) unstable; urgency=high + + * Bug fix: "FTBFS: cp: cannot stat + 'debian/tmp/usr/share/info/gcl-si.info': No such file or + directory", thanks to Lucas Nussbaum (Closes: #707490). + + -- Camm Maguire Fri, 10 May 2013 18:09:14 +0000 + +gcl (2.6.7+dfsga-4) unstable; urgency=high + + * sgc-on fix with latest gcc + + -- Camm Maguire Tue, 23 Apr 2013 18:45:11 +0000 + +gcl (2.6.7+dfsga-3) unstable; urgency=high + + * hash depth bug fix + * new s390 reloc + + -- Camm Maguire Thu, 24 Jan 2013 19:46:30 +0000 + +gcl (2.6.7+dfsga-2) unstable; urgency=high + + * more arm relocs supported;check default timezone dynamically;follow + bash ~ semantics in user-homedir-pathname + + -- Camm Maguire Mon, 21 Jan 2013 18:41:06 +0000 + +gcl (2.6.7+dfsga-1) unstable; urgency=high + + * Acknowledge Non-maintainer upload. + (thanks David Prévot ) + * Remove unused and non DFSG-compliant gmp3/gmp.* from source. + (Closes: #695721) + * Show translated debconf templates, thanks to Denis Barbier for the + analysis and the proposed fixes. (Closes: #691946) + * trim excess digits from printed floats + + -- Camm Maguire Tue, 15 Jan 2013 20:46:25 +0000 + +gcl (2.6.7-108) unstable; urgency=high + + * Depend on emacs23 | emacsen to allow wheezy propagation + + -- Camm Maguire Mon, 08 Oct 2012 18:08:36 +0000 + +gcl (2.6.7-107) unstable; urgency=high + + * mode 644 on ucf newfile + + -- Camm Maguire Wed, 03 Oct 2012 20:38:43 +0000 + +gcl (2.6.7-106) unstable; urgency=high + + * Bug fix: "modifies conffiles (policy 10.7.3): /etc/default/gcl", + thanks to Andreas Beckmann (Closes: #688201). + + -- Camm Maguire Wed, 03 Oct 2012 16:52:10 +0000 + +gcl (2.6.7-105) unstable; urgency=high + + * restore #DEBHELPER# to postinst and postrm scripts + + -- Camm Maguire Mon, 01 Oct 2012 17:31:43 +0000 + +gcl (2.6.7-104) unstable; urgency=high + + * Bug fix: "modifies conffiles (policy 10.7.3): /etc/default/gcl", + thanks to Andreas Beckmann (Closes: #688201). + + -- Camm Maguire Mon, 01 Oct 2012 15:32:52 +0000 + +gcl (2.6.7-103) unstable; urgency=high + + * sfaslelf.c: FIX_HIDDEN_SYMBOLS + + -- Camm Maguire Wed, 22 Aug 2012 15:13:12 +0000 + +gcl (2.6.7-102) unstable; urgency=high + + * Fix hash key distribution bug, bitvector equal bug + * distinguish car position in equal-hash of lists + + -- Camm Maguire Mon, 20 Aug 2012 17:33:26 +0000 + +gcl (2.6.7-101) unstable; urgency=high + + * add alpha, ppc, ppc64, and ia64 to __builtin__clear_cache exception + list as per gcc maintainers + * lintian cleanups + + -- Camm Maguire Sat, 05 May 2012 23:18:56 +0000 + +gcl (2.6.7-100) unstable; urgency=high + + * nil case keylist support + * Bug fix: "[INTL:da] Danish translation of the debconf templates gcl", + thanks to Joe Dalton (Closes: #666528). + + -- Camm Maguire Fri, 20 Apr 2012 02:25:26 +0000 + +gcl (2.6.7-99) unstable; urgency=low + + * case default error checking + + -- Camm Maguire Fri, 23 Mar 2012 14:14:44 +0000 + +gcl (2.6.7-98) unstable; urgency=low + + * restore traditional make-sequence,make-array, and coerce, and + optimize replace, as 2.6.8 compiler is still too weak re: inlines + + -- Camm Maguire Fri, 20 Jan 2012 19:55:45 +0000 + +gcl (2.6.7-97) unstable; urgency=low + + * evade __builtin___clear_cache on hppa + * make-array;make-sequence;replace;coerce + + -- Camm Maguire Fri, 20 Jan 2012 05:13:22 +0000 + +gcl (2.6.7-96) unstable; urgency=low + + * better XDR detection; no __builtin_clear_cache on sh4 + + -- Camm Maguire Wed, 18 Jan 2012 01:32:43 +0000 + +gcl (2.6.7-95) unstable; urgency=low + + * clear_cache after mprotect + + -- Camm Maguire Tue, 17 Jan 2012 03:54:56 +0000 + +gcl (2.6.7-94) unstable; urgency=low + + * optimize unwind at O0 to workaround gcc bug; centralize on + __builtin__clear_cache when available;arm_thm_call reloc support + + -- Camm Maguire Mon, 16 Jan 2012 20:10:07 +0000 + +gcl (2.6.7-93) unstable; urgency=low + + * remove C_GC_OFFSET for sparc64 + * remove ncurses dependency for readline + * Bug fix: "FTBFS: dpkg-buildpackage: error: dpkg-source -b gcl-2.6.7 + gave error exit status 2", thanks to Didier Raboud (Closes: #643131). + * Bug fix: "drops readline support if rebuilt", thanks to Sven Joachim + (Closes: #646735). + * lower opts on sparc64 asof gcc 4.6.1 + + -- Camm Maguire Wed, 11 Jan 2012 21:04:23 +0000 + +gcl (2.6.7-92) unstable; urgency=low + + * remove gprof on arm as mcount calls are 24/22bit -- marginally + accessible + + -- Camm Maguire Sat, 07 Jan 2012 02:42:06 +0000 + +gcl (2.6.7-91) unstable; urgency=low + + * s390x reloc support + * lower C optimization on ia64, arm and mips for now + + -- Camm Maguire Thu, 05 Jan 2012 17:30:01 +0000 + +gcl (2.6.7-90) unstable; urgency=low + + * libtirpc check for newest glibc + * read_preserving_whitespace fix + * armhf reloc support + * s390x support + * try C_GC_OFFSET for sparc64 + + -- Camm Maguire Wed, 04 Jan 2012 19:51:13 +0000 + +gcl (2.6.7-89) unstable; urgency=low + + * support new mips relocs + * lower opt to work around gcc 4.6 bug on arm + + -- Camm Maguire Wed, 11 May 2011 20:06:04 +0000 + +gcl (2.6.7-88) unstable; urgency=low + + * Bug fix: "FTBFS: gcl_arraylib.c:4:42: error: 'VV' undeclared + (first use in this function)", thanks to Lucas Nussbaum (Closes: + #625032). + + -- Camm Maguire Mon, 09 May 2011 16:00:21 +0000 + +gcl (2.6.7-87) unstable; urgency=low + + * mips reloc fix;configure default dlopen fix;clean rules and makefiles + + -- Camm Maguire Fri, 05 Nov 2010 13:29:05 +0000 + +gcl (2.6.7-86) unstable; urgency=low + + * remove binutils subdir, configure and make changes + + -- Camm Maguire Thu, 04 Nov 2010 17:55:48 +0000 + +gcl (2.6.7-85) unstable; urgency=low + + * fix mips relocs for non-static clines + + -- Camm Maguire Tue, 02 Nov 2010 13:56:40 +0000 + +gcl (2.6.7-84) unstable; urgency=low + + * better mips relocs, fix link on mingw32 + + -- Camm Maguire Sat, 30 Oct 2010 00:07:39 +0000 + +gcl (2.6.7-83) unstable; urgency=low + + * fix alpha stubs; fix sparc64 typo; print armhf relocs + + -- Camm Maguire Thu, 28 Oct 2010 13:43:16 +0000 + +gcl (2.6.7-82) unstable; urgency=low + + * mips64 fixes + + -- Camm Maguire Tue, 26 Oct 2010 18:20:04 +0000 + +gcl (2.6.7-81) unstable; urgency=low + + * sparc64;mips64 + + -- Camm Maguire Tue, 26 Oct 2010 03:33:52 +0000 + +gcl (2.6.7-80) unstable; urgency=low + + * alpha stubs; sgc mips kernel bug test; mips GPREL32 reloc + + -- Camm Maguire Mon, 25 Oct 2010 19:52:51 +0000 + +gcl (2.6.7-79) unstable; urgency=low + + * mips ld_bind_now, disable sgc workaround mips SIGBUS bug + + -- Camm Maguire Wed, 20 Oct 2010 15:31:59 +0000 + +gcl (2.6.7-78) unstable; urgency=low + + * mips local got relocs + + -- Camm Maguire Tue, 12 Oct 2010 17:15:35 +0000 + +gcl (2.6.7-77) unstable; urgency=low + + * workaround gcc alpha bug + * fix alpha reloc + + -- Camm Maguire Fri, 01 Oct 2010 21:25:11 +0000 + +gcl (2.6.7-76) unstable; urgency=low + + * fix page_multiple usage for runtime pagesize variance and stable mipsel builds + * sparc64 support + + -- Camm Maguire Fri, 01 Oct 2010 19:18:47 +0000 + +gcl (2.6.7-75) unstable; urgency=low + + * fix alpha bug + + -- Camm Maguire Tue, 28 Sep 2010 20:23:21 +0000 + +gcl (2.6.7-74) unstable; urgency=low + + * fix alpha relocs for axiom + + -- Camm Maguire Tue, 28 Sep 2010 16:07:38 +0000 + +gcl (2.6.7-73) unstable; urgency=low + + * sparc reloc updates + * fast-link fix + + -- Camm Maguire Fri, 24 Sep 2010 19:23:16 +0000 + +gcl (2.6.7-72) unstable; urgency=low + + * remove unused symbols from gcl_cmpopt.lsp + * reloc updates + * clear gcc warning + * default tilde expansion to HOME env in absence of passwd + * configure typo fix + + -- Camm Maguire Wed, 22 Sep 2010 19:32:52 +0000 + +gcl (2.6.7-71) unstable; urgency=low + + * print sparc64 relocs + + -- Camm Maguire Sat, 28 Aug 2010 14:50:00 +0000 + +gcl (2.6.7-70) unstable; urgency=low + + * sparc64/m68k + + -- Camm Maguire Fri, 27 Aug 2010 16:54:11 +0000 + +gcl (2.6.7-69) unstable; urgency=low + + * Bug fix: "non-standard gcc/g++ used for build (gcc-4.3)", thanks to + Matthias Klose (Closes: #594280). + + -- Camm Maguire Thu, 26 Aug 2010 19:08:39 +0000 + +gcl (2.6.7-68) unstable; urgency=low + + * ppc/mips elf reloc fixes + + -- Camm Maguire Mon, 23 Aug 2010 20:54:30 +0000 + +gcl (2.6.7-67) unstable; urgency=low + + * Fix compiler::link ansi combo + + -- Camm Maguire Sat, 21 Aug 2010 02:05:37 +0000 + +gcl (2.6.7-66) unstable; urgency=low + + * ppc autobuild fix + * Bug fix: "FTBFS: sfasli.c:139: error: invalid initializer", thanks to + Lucas Nussbaum (Closes: #593037). + * Bug fix: "FTBFS on powerpc: Error: The function TK::GET-AUTOLOADS is + undefined.", thanks to Mehdi Dogguy (Closes: #593191). + + -- Camm Maguire Fri, 20 Aug 2010 01:25:09 +0000 + +gcl (2.6.7-65) unstable; urgency=low + + * autobuilder fixes + + -- Camm Maguire Sat, 14 Aug 2010 11:30:46 +0000 + +gcl (2.6.7-64) unstable; urgency=low + + * configure fix + + -- Camm Maguire Fri, 13 Aug 2010 23:26:07 +0000 + +gcl (2.6.7-63) unstable; urgency=low + + * macosx support, ppc, i386 and x86_64 -- sfaslmacho.c + * windows/wine support -- sfaslcoff.c + * better custreloc support obviating my_plt -- sfaslelf.c + * debian default custreloc build where supported, all but ia64 and hppa + * fix mingw/wine path issues + + -- Camm Maguire Fri, 13 Aug 2010 16:08:49 +0000 + +gcl (2.6.7-62) unstable; urgency=high + + * more stable sgc detection via h/tsgc.h + * fix plt.h bug on hppa + * sublis1-inline fix for acl2 + + -- Camm Maguire Mon, 26 Jul 2010 16:03:54 +0000 + +gcl (2.6.7-61) unstable; urgency=high + + * mac osx support + * fix undef sgc bug in cmpinclude.h + + -- Camm Maguire Tue, 20 Jul 2010 14:50:19 +0000 + +gcl (2.6.7-60) unstable; urgency=high + + * fix sh4 support + + -- Camm Maguire Thu, 29 Apr 2010 18:09:04 +0000 + +gcl (2.6.7-59) unstable; urgency=high + + * fix hurd support + + -- Camm Maguire Fri, 23 Apr 2010 17:12:54 +0000 + +gcl (2.6.7-58) unstable; urgency=high + + * hurd support + * sh4 support + + -- Camm Maguire Fri, 23 Apr 2010 05:09:29 +0000 + +gcl (2.6.7-57) unstable; urgency=high + + * static function pointer wrapper for gcl_gmp_allocfun, stabilizing gmp + on hppa/ia64 + + -- Camm Maguire Mon, 12 Apr 2010 22:28:41 +0000 + +gcl (2.6.7-56) unstable; urgency=high + + * __builtin___clear_cache on arm + * gcc-4.3 on alpha + + -- Camm Maguire Thu, 28 Jan 2010 00:32:16 +0000 + +gcl (2.6.7-55) unstable; urgency=low + + * SGC fix, debian override fix, xgcl update + * SGC fix for relocatable and contiguous gmp storage + * configure fix for arm and hppa + + -- Camm Maguire Tue, 26 Jan 2010 19:43:08 +0000 + +gcl (2.6.7-54) unstable; urgency=low + + * robustify user_match, unrandomize, read-char-no-hang for sockets + * SA_SIGINFO for 386-linux + * if cmpinclude.h is not available, use *cmpinclude-string* in compiler-pass2 + + -- Camm Maguire Wed, 20 Jan 2010 19:02:28 +0000 + +gcl (2.6.7-53) unstable; urgency=low + + * revert round ratio to nearest + + -- Camm Maguire Tue, 05 Jan 2010 03:06:59 +0000 + +gcl (2.6.7-52) unstable; urgency=low + + * SIGINFO for kfreebsd-386 + + -- Camm Maguire Mon, 04 Jan 2010 17:49:05 +0000 + +gcl (2.6.7-51) unstable; urgency=low + + * user_match exscapes once only + + -- Camm Maguire Sun, 03 Jan 2010 05:31:20 +0000 + +gcl (2.6.7-50) unstable; urgency=low + + * gcc 4.4 warning cleanups + + -- Camm Maguire Thu, 31 Dec 2009 20:43:39 +0000 + +gcl (2.6.7-49) unstable; urgency=low + + * Bug fix: "/bin/sh: line 6: /bin/gcl: Permission denied", thanks to + Nobuhiro Iwamatsu (Closes: #561554). + + -- Camm Maguire Wed, 30 Dec 2009 23:04:39 +0000 + +gcl (2.6.7-48) unstable; urgency=low + + * round to nearest in ratio to double + + -- Camm Maguire Wed, 16 Dec 2009 15:01:55 +0000 + +gcl (2.6.7-47) unstable; urgency=low + + * Bug fix: "configure: error: Need zlib for bfd linking", thanks to + Cyril Brulebois (Closes: #560761). + * Bug fix: "Disfunctional maintainer address", thanks to Joerg Jaspert + (Closes: #560752). + + -- Camm Maguire Mon, 14 Dec 2009 19:06:45 +0000 + +gcl (2.6.7-46) unstable; urgency=low + + * support newer binutils with output_bfd element + * Fix 64bit interrupt bug + * reader error fix + * Ensure plt entries are not blank + * plt table reading fix + * Bug fix: "FTBFS: current binutils static libs need -lz", thanks to + Daniel Schepler (Closes: #521929). + * Bug fix: "replacing libreadline5-dev build dependency with + libreadline-dev", thanks to Matthias Klose (Closes: #553761). + * Bug fix: "crash after ctrl-C", thanks to Miroslaw Kwasniak (Closes: + #519903). + * Bug fix: "FTBFS with binutils-gold", thanks to Peter Fritzsche + (Closes: #554418). -ldl added to bfd linker args + * Bug fix: "[INTL:es] Spanish debconf template translation for gcl", + thanks to Francisco Javier Cuadrado (Closes: #508728). + * Bug fix: "[INTL:it] Italian translation", thanks to Vincenzo + Campanella (Closes: #560364). + * gcc error/warning cleanups + * fix plt table awk + + -- Camm Maguire Fri, 11 Dec 2009 17:45:14 +0000 + +gcl (2.6.7-45) unstable; urgency=high + + * proper word order detection macro, fixes armel + + -- Camm Maguire Mon, 01 Sep 2008 13:48:16 +0000 + +gcl (2.6.7-44) unstable; urgency=high + + * backoff on arm opts + * more careful handling of GCL_GPROF_START + + -- Camm Maguire Sat, 23 Aug 2008 21:28:52 +0000 + +gcl (2.6.7-43) unstable; urgency=low + + * redo unrandomize.h to enable compilation under -O2 -- FIXME; Closes: 494153 + + -- Camm Maguire Wed, 20 Aug 2008 21:18:43 +0000 + +gcl (2.6.7-42) unstable; urgency=low + + * more div/rem symbols for alpha + + -- Camm Maguire Sun, 03 Aug 2008 11:18:51 +0000 + +gcl (2.6.7-41) unstable; urgency=low + + * more div/rem symbols for arm and hppa + + -- Camm Maguire Sat, 02 Aug 2008 00:36:07 +0000 + +gcl (2.6.7-40) unstable; urgency=low + + * default gcc with pic enabled on mips/mipsel + + -- Camm Maguire Fri, 01 Aug 2008 13:28:00 -0400 + +gcl (2.6.7-39) unstable; urgency=high + + * gcc 4.2 for mips/mipsel for now + * __divdi3 et. al. symbols for ia64 and arm + * clean some compiler warnings + + -- Camm Maguire Fri, 01 Aug 2008 12:53:07 -0400 + +gcl (2.6.7-38) unstable; urgency=low + + * No infinite unrandomization loops + + -- Camm Maguire Thu, 31 Jul 2008 15:18:37 -0400 + +gcl (2.6.7-37) unstable; urgency=low + + * Non-maintainer upload to fix pending l10n issues + * Debconf templates and debian/control reviewed by the debian-l10n- + english team as part of the Smith review project. Closes: #457025 + * [Debconf translation updates] + - Portuguese. Closes: #457576 + - Czech. Closes: #457677 + - French. Closes: #458120 + - Finnish. Closes: #458255 + - Galician. Closes: #458529 + - Vietnamese. Closes: #459008 + - Russian. Closes: #459308 + - Dutch. Closes: #459541 + - German. Closes: #459887 + * [Lintian] Correct FSF address in debian/copyright + * [Lintian] Remove extra whitespaces at the end of + debian/in.gcl-doc.doc-base.tk + * [Lintian] Correct section in doc-base documents from Apps/Programming + to Programming + * Accept NMU + * Bug fix: "[INTL:sv] po-debconf file for gcl", thanks to Martin Ågren + (Closes: #492241). + * Bug fix: "gcl: FTBFS [amd64]: cannot trap sbrk", thanks to Daniel + Schepler (Closes: #487435). Modified and applied personality handling + patch. + * Bug fix: "gcl: Builds broken package with gcc-4.3", thanks to Daniel + Schepler (Closes: #467474). Added sincos to plttest.c + + -- Camm Maguire Thu, 31 Jul 2008 15:18:15 -0400 + +gcl (2.6.7-36) unstable; urgency=low + + * statsysbfd in Debian, incoporating modules into libgcl.a for + compiler::link support + + -- Camm Maguire Fri, 30 Nov 2007 12:03:31 -0500 + +gcl (2.6.7-35) unstable; urgency=low + + * drop gcc-3.4 on arm, Closes: #440421 + * Depend on emacs22 | emacsen, Closes: #440190 + * debconf translations Closes: #410683, Closes: #419736, Closes: #423706, Closes: #441408 + + -- Camm Maguire Fri, 23 Nov 2007 10:25:23 -0500 + +gcl (2.6.7-34) unstable; urgency=low + + * add read-byte,read-sequence,write-byte,write-sequence support + * fix some float parsing inaccuracies + * support GNU_HASH sections, Closes: #426135 + * safety 2 for certain low level functions in gcl_listlib.lsp, CLoses: + #415266 + + -- Camm Maguire Wed, 4 Jul 2007 16:23:25 -0400 + +gcl (2.6.7-33) unstable; urgency=low + + * Fix leading underscore behavior of my_plt + * add sqrt to plttest.c + * disable-nls added to the binutils subconfigures to avoid msgfmt + dependency + * remove -lintl from powerpc-macosx.defs + * update to make-user-init from cvs head to support hol88, fix link on + mingw + * solaris-i386 support + * fix read-char-no-hang on mingw + * fast compile without wrap-literals + * sigaltstack support + * fix cerror + + -- Camm Maguire Wed, 16 May 2007 12:45:40 -0400 + +gcl (2.6.7-32) unstable; urgency=low + + * static function pointers for hppa + + -- Camm Maguire Sun, 29 Oct 2006 02:15:13 -0500 + +gcl (2.6.7-31) unstable; urgency=low + + * no C optimization on hppa, gcc 4.x on hppa + * update cs.po, Closes: #389211 + + -- Camm Maguire Fri, 27 Oct 2006 13:06:55 -0400 + +gcl (2.6.7-30) unstable; urgency=low + + * make sure *tmp-dir* is set + * makeinfo is optional + + -- Camm Maguire Wed, 25 Oct 2006 17:37:54 -0400 + +gcl (2.6.7-29) unstable; urgency=low + + * Fix build issues on hppa and m68k + + -- Camm Maguire Sat, 21 Oct 2006 15:10:41 -0400 + +gcl (2.6.7-28) unstable; urgency=low + + * si::gettimeofday function for HOL88 build;macosx fixes + + -- Camm Maguire Wed, 18 Oct 2006 13:21:26 -0400 + +gcl (2.6.7-27) unstable; urgency=low + + * unrestricted gcc for alpha + * more default stack space + + -- Camm Maguire Tue, 17 Oct 2006 16:33:43 -0400 + +gcl (2.6.7-26) unstable; urgency=low + + * Fix large float read bug in c1constant-value + + -- Camm Maguire Mon, 16 Oct 2006 12:41:03 -0400 + +gcl (2.6.7-25) unstable; urgency=low + + * build-dep on gcc3.4 where appropriate + * Newer standards + + -- Camm Maguire Thu, 12 Oct 2006 09:37:08 -0400 + +gcl (2.6.7-24) unstable; urgency=low + + * build-dep on gcc3.4 where appropriate + * Newer standards + + -- Camm Maguire Thu, 12 Oct 2006 02:22:04 -0400 + +gcl (2.6.7-23) unstable; urgency=low + + * backoff to gcc-3.4 on alpha,arm,hppa, and m68k + + -- Camm Maguire Wed, 11 Oct 2006 10:16:59 -0400 + +gcl (2.6.7-22) unstable; urgency=low + + * HAVE_SYS_SOCKIO_H for solaris + * autolocbfd for solaris + * no -Wall when no gcc + * no -fomit-frame-pointer on m68k + * no profiling on mips + * $(AWK) instead of awk + * si::stat function + * fix 'the boolean type coersion error + * no varargs on cygwin + * while eval macro + * gensym counter fixes + * xgcl updates + + + -- Camm Maguire Fri, 15 Sep 2006 13:48:28 -0400 + +gcl (2.6.7-21) unstable; urgency=low + + * Fix socket write error + + -- Camm Maguire Wed, 6 Sep 2006 09:59:50 -0400 + +gcl (2.6.7-20) unstable; urgency=low + + * fix ia64 build + + -- Camm Maguire Thu, 31 Aug 2006 15:14:18 -0400 + +gcl (2.6.7-19) unstable; urgency=low + + * xgcl upgrade + * parse_number from cvs head with *read-base* fixes + * fix object_to_string + * install xgcl-2/sysdef.lisp + * fix info dir and emacs site lisp dir installation + * New xgcl readme + * Remove bashism from debian/rules, Closes: #376806, Closes: #385176. + * Fix dwdoc doc-base error, Closes: #385126 + + -- Camm Maguire Wed, 30 Aug 2006 12:13:46 -0400 + +gcl (2.6.7-18) unstable; urgency=low + + * remove emacs build dependency + * synch xgcl-2 with Novak edits + * fix build errors + * Remove power of two limit to MAXPAGE;fix X lib paths + * configure cleanup + * delete-file works on directories;build xgcl the old way;latest xgcl + from Gordon Novak + + -- Camm Maguire Wed, 23 Aug 2006 14:19:51 -0400 + +gcl (2.6.7-17) unstable; urgency=low + + * Bug fix: "gcl: [INTL:sv] Swedish debconf templates translation", + thanks to Daniel Nylander (Closes: #343695). + * Bug fix: "gcl: French debconf templates translation update", thanks to + Sylvain Archenault (Closes: #344629). + * clean xgcl-2/gmon.out + * cleanup latest gcc type-punning warnings + * defentry C proclamations and xgcl cleanup + + -- Camm Maguire Mon, 26 Jun 2006 16:45:09 +0000 + +gcl (2.6.7-16) unstable; urgency=high + + * Add missing build dependencies, omit html generation to avoid non-free + dependencies, CLoses: #372574. + + -- Camm Maguire Mon, 19 Jun 2006 14:05:59 +0000 + +gcl (2.6.7-15) unstable; urgency=low + + * Use internal gettext for bfd + * Restore xgcl2 + * Set compiler::*tmp-dir* at runtime + * report tmp-dir setting with system-banner to enable clean -eval - + batch operation; fix listen on socket streams; use (abs (getpid)) in + tmp names for Windows + * fix configure unbalanced quotes + * support for bignums in nth et.al. + * Fix branch cut of atanh + * Fix typep on simple-arrays + * prevent nested free errors + * revert atanh branch cut change + * Fix function documentation wrapping by compile + * cond evalmacro from cvs head + * Fix fixnum declarations in new smallnthcdr/bignthcdr + * fix simple-array typep + * updates for lsp/sys-proclaim + * xgcl integration + + -- Camm Maguire Fri, 9 Jun 2006 17:52:22 +0000 + +gcl (2.6.7-14) unstable; urgency=low + + * Add mount declaration to plt.c + + -- Camm Maguire Sun, 18 Dec 2005 12:56:51 +0000 + +gcl (2.6.7-13) unstable; urgency=low + + * Add feof to plttest.c for macosx + * plt related fixes for macosx + * fix configure + * Cleanup LEADING_UNDERSCORE case in plt.c et.al for macosx et.al. + * pass devices if present in compiler::get-temp-dir, fix disassemble + for new gazonk name pattern + + -- Camm Maguire Sat, 17 Dec 2005 15:22:40 +0000 + +gcl (2.6.7-12) unstable; urgency=low + + * Fix read-char-no-hang + * Strip emacs warnings when finding site-lisp directory + * mach-o update for latest binutils + * Latext bfd mach-o support from Aurelien + * revert to locbfd default on ppc-macosx + * More ppc macosx fixes from Aurelien + * revert a few macosx changes + * default to void * prototype on my_sbrk for latest macosx pending + Aureliens #ifdef + * Fix plt.h parsing on macosx + * Fix leading_underscore detection on mac + * macosx name mangling fixes + * multi-process safe gazonk names in compiler::*tmp-dir* + * Add underscore-mangled setjmp calls to plttest.c for macosx + * Fix POTFILES.in, Closes: #336207. + * Update templates, Closes: #324636 + * New French and Swedish translations, Closes: #333654, Closes: #336757. + + -- Camm Maguire Wed, 14 Dec 2005 18:52:49 +0000 + +gcl (2.6.7-11) unstable; urgency=low + + * Remove gcc-3.3 for arm in debian/rules + * make default maxpage depend on SIZEOF_LONG and PAGEWIDTH in a sane + fashion + + -- Camm Maguire Thu, 20 Oct 2005 00:08:37 +0000 + +gcl (2.6.7-10) unstable; urgency=low + + * Fix long-call gcc configure bug for ppc, add fdollars in + identifiers on arm + * remove gcc restrictions on arm + * revert 64bit coersion (gmp_big.c, maybe_replace_big) and replace with + code in siLnani (main.c) to get addresses from bignums. 2.7.0 will + have 64bit fixnums on 64bit machines, but this should not be + backported to 2.6.x + + -- Camm Maguire Wed, 12 Oct 2005 23:11:12 +0000 + +gcl (2.6.7-9) unstable; urgency=low + + * 64bit fixnum fasd data format fix from cvs head + + -- Camm Maguire Wed, 5 Oct 2005 18:49:50 +0000 + +gcl (2.6.7-8) unstable; urgency=low + + * Fix 64bit fixnum coersion bug using code from cvs HEAD + + -- Camm Maguire Fri, 30 Sep 2005 22:14:38 +0000 + +gcl (2.6.7-7) unstable; urgency=high + + * Scan .o file for init name when using dlopen + * Set init name using .o file instead of source file by default + * wrap-literals function from cvs head to allow optimizations using + compile or compile-file + * ADDR_NO_RANDOMIZE fix + + -- Camm Maguire Thu, 29 Sep 2005 17:50:56 +0000 + +gcl (2.6.7-6) unstable; urgency=high + + * Build bfd snapshot locally, Closes: #318681 + + -- Camm Maguire Tue, 20 Sep 2005 17:53:17 +0000 + +gcl (2.6.7-5) unstable; urgency=high + + * gcc-3.3 for arm + + -- Camm Maguire Thu, 15 Sep 2005 20:33:00 +0000 + +gcl (2.6.7-4) unstable; urgency=high + + * gcc 3.4 on arm to work around reserved '$' identifiers. + * gcl: French translation update + * French translation added, Closes: #325214 + * Czech translation added, Closes: #325869 + + -- Camm Maguire Thu, 15 Sep 2005 13:45:11 +0000 + +gcl (2.6.7-3) unstable; urgency=low + + * static wraper for compiled_regexp for ia64 + + -- Camm Maguire Sat, 10 Sep 2005 11:26:37 +0000 + +gcl (2.6.7-2) unstable; urgency=high + + * rebuild against libgmp3c2, Closes: #323765 + * 2.6.7 fixes all gcc 4.0 issues. Closes: #323979 + + -- Camm Maguire Wed, 24 Aug 2005 00:44:48 +0000 + +gcl (2.6.7-1) unstable; urgency=high + + * Fix (listen) with readline on + * fix control-d with readline + * libreadline5 support for Debian + * Support for pre-compiled regexps and new texinfo format + * Reenable run-process + * Push function 'accept into lisp, use select for 'listen on socket + streams + * New Upstream release version + * Native-reloc feature + * Add daemon capabilities to server sockets, document socket and + accept + * Some gcl-tk fixes + * Update wrapt-literals strategy to be consistent with CVS head -- + wrap evreything but symbols and integers, don't wrap when keeping + the gazonk files for linking in different images, this is really a + compile-file operation + * gcltk demo cleanups + * Probe-file, open_stream, and the like fail on directories + * Resolve symlinks in truename + * Place prototypes for defcfun in header files + * Support for unique init names for compiler::link and the like + * libreadline5 for Debian + * remove _o from init-names + * gcc-4.0 fixups + * Bug fix: "gcl: depends on binutils-dev <<= 2.1.5-999), so + uninstallable in unstable", thanks to Steve Langasek (Closes: + #318681). Rebuild with new release to autocompute this dep + * Bug fix: "gcl: Please switch to po-debconf", thanks to Lucas Wall + (Closes: #295930). Apply po-debconf patch + * Newer standards + + -- Camm Maguire Thu, 11 Aug 2005 15:00:26 +0000 + +gcl (2.6.6-1) unstable; urgency=high + + * New upstream release + * Allow .data section to be first in executable, as on solaris. Also + allow for new bfd section size semantics + * Don't try to write map file when not using GNU ld. Also allow + compile-file to process pathnames with whitespace on Windows + * Fix corner case fixnum arithmetic on 64bit machines + * Rework gmp_wrappers semantics for older gcc + * Explicitly mprotect loaded code pages PROT_EXEC on x86 Linux, as FC3 + now requires it. + * lisp-implementation-version is GCL + * Reader extension patch allowing for foo::(bar foobar) semantics + * a shell script variable fix in "unixport/makefile" for MSYS + * __MINGW32__ malloc initialisation fix in "o/alloc.c" + * Windows file/directory fixes in "o/unixfsys.c" + * MinGW32 -march in configure - removes deprecation warnings + * MinGW32 directory fix - "o/mingfile.c". + * Allow for sysconf to determine clock granularity at compile time to + fix time errors on the Itanium + * Disable SGC on macosx until the sgc/save problem can be fixed. + * Fix fixnum print bug on 64bit + * Fix nil types in room report + * 64bit fixes to fixnum_add and fixnum_sub + * Fix Mac SGC/save bug, at least in part + + -- Camm Maguire Sun, 16 Jan 2005 02:28:50 +0000 + +gcl (2.6.5-1) unstable; urgency=high + + * New gmp_wrappers.{c,h} files that prevent all GBC within gmp, + obviating the need for gmp patches and a local gmp configure. FIXME + -- extend to all gmp functions in a systematic way, and write header + information for future use in the compiler, making sure that plt.c + carries the needed gmp symbols at this point + * Build support for gmp_wrappers + * Support for gmp_wrappers in alloc_relblock/alloc_contblock;Support + for GCL_GPROF_START define in gprof functions + * dynsysgmp on by default; configure backs off to local gmp configure + and build automatically if needed either because gmp not present or + patched symbols are needed; autodetect and set the _start symbol + when using gprof + * Fix (setf (get ...) ...) return bug when interpreted + * Fix overwrite end of sgc_type_map bug + * Versioned depends on binutils-dev manually installed by Debian build + process + * New upstream release + * Proper binutils dependency for Debian + * head -1l -> head -n 1 for freebsd + * Cleanup gmp_wrapper code, check for in-place calls as write in one + step is not guaranteed in gmp according to its developers + * Rebuild against binutils 2.15, Closes: #266253, Closes: #263983 + + -- Camm Maguire Tue, 17 Aug 2004 18:22:27 +0000 + +gcl (2.6.4-1) unstable; urgency=high + + * New upstream release + * Make disassemble work when original system directory is gone + * New debian/support files for debconf image default selection support + * More descriptive compiled C function names for use in gprof when + profiling is compiled in + * Compiler fix for proclaimed vararg functions + * Allow sharp numbers to be bignums + * lintian fix in string-match + * Prototype for alloca for lint + * Improve gprof support + * Improve sgc page allocation which optimize-maximum-pages is in + effect and the hole is overrun + * Build a profiling set of images as well for Debian, toggle between + all four by default via debconf + * reset-sys-paths lisp function for moving image installation + directories, show profiling support in banner if present + * Fix typo in sys docs + * reset sys paths on installation + + -- Camm Maguire Thu, 5 Aug 2004 22:48:56 +0000 + +gcl (2.6.3-1) unstable; urgency=high + + * Correctly parse gcc version strings in gmp3 subconfigure on arm + * Fix variable capture error in dotimes macro + * Better sed separator for LI-CC in unixport/makefile + * Fix segfault in string-match + * vs_top=sup -> (reset-top) where possible in compiler. FIXME: a few + items of a different form which need to set *sup-used* too. + * Correct room report to show proper percentages when sgc is on + * Read in RELOC environment variable if set as default in debian/rules + * Remove local bfd libraries from libs variables as their objects are + incorporated into libgcl and as the source directory may not be + available at runtime + * Remove pcl/pcl_gazonk*lsp build-generated files from source + + -- Camm Maguire Thu, 15 Jul 2004 14:26:44 -0400 + +gcl (2.6.2-3) unstable; urgency=low + + * Fix value stack leak in rare compiled call sequence + + -- Camm Maguire Tue, 13 Jul 2004 10:17:02 -0400 + +gcl (2.6.2-2) unstable; urgency=low + + * New upstream point release + + -- Camm Maguire Tue, 13 Jul 2004 10:08:53 -0400 + +gcl (2.6.2-1) unstable; urgency=low + + * gcc-3.4 support + * Proper isnormal default courtesy of Magnus Henoch + * gclclean makefile target and other small makefile changes + * Proper check for C stack array body address in gbc.c and sgbc.c + * New upstream release + * acconfig.h update for isnormal default + * Fix bug in setting elements (si::aset) of 0 rank arrays uncovered by + the random tester + * No -fomit-frame-pointer on mingw + * Backport minimal ansi-test patches from HEAD to enable running of + the random tester + * installed tcl/tk patch for mingw + * Fix banner license detection code in lsp/gcl_mislib.lsp as + 8features* entries are now keywords + * o/makefile changes to work around trailing slash -I arguments gcc + bug on mingw + * Patch to mingwin.c:fix_filename to close long standing 'maxima + ignore-errors filename corruption' bug on mingw + * Check for too large rank supplied to make-array1 + * Fix potential stack overwrite bug in quick_call_sfun/eval.c + * Add -mprferred-stack-boundary=8 on amd64, as constant integers used + in a call must be retrievable with va_arg(,fixnum) + * Revert preferred-stack-boundary option on amd64 as it does not play + well with external libraries, also eliminate -m64 to allow for user + settings. Cast fixnum constant C arguments in gcl_cmploc.lsp + explicitly to (long) to ensure they can be extracted via + va_arg(,fixnum) + * reenable SA_SIGINFO on amd64 to restore SGC there + * Include elf.h in FreeBSD.h + * Allow for elf_abi.h in FreeBSD.h + * Add README.openbsd file + * readme.mingw updates + * solaris.h updates for custreloc option + * Close possibility of malloc failure due to intervening gbc arising + from the misordering of allocation calls + * C_GC_OFFSET is 2 on m68k-linux + * Add release notes, remove gcl document presumably based on dpANS for + now + * Fixup bad extern declaration of signals_handled in usig.c + + -- Camm Maguire Fri, 25 Jun 2004 22:43:52 +0000 + +gcl (2.6.1-39) unstable; urgency=high + + * Fix segfault in referencing (sgc_)type_map out of bounds which can + occurr when C stack is below heap, as on alpha. + * Cleanup compiler warnings on bcmp.c bzero.c and bcopy.c + * Clean up compiler warning in file.d + * Ensure set TLDFLAGS are used in finding DBEGIN in copnfigure.in, for + OpenBSD + + -- Camm Maguire Fri, 7 May 2004 21:50:03 +0000 + +gcl (2.6.1-38) unstable; urgency=low + + * Make *features* entries keywords -- add canonical host cpu and + kernel-system to *features*, disable h files specific + ADDITIONAL_FEATURES macro in main.c + * Fix merge-pathanames bug in concatenating default and supplied + directory lists + * Minor pathname and *features* fixes + * Fix recently introduced configure.in syntax bug + * Minor patches to support big gcl images -- all page integers must be + long ints, need stack space limits that scale with MAXPAGES at least + to allow free_map stack array in sgc_start. FIXME -- right now can + handle situations where page numbers are ints, but npage*PAGESIZE is + a long, need to handle npage >MAX_INT later. This is to support the + 'billion cons element acl2 image' requested by a gcl user + * Revert winnt features and debugging aids in configure.in + * OpenBSD support, gcc warning cleanups for long page integers + + -- Camm Maguire Mon, 3 May 2004 21:34:57 +0000 + +gcl (2.6.1-37) unstable; urgency=high + + * mprotect pages PROT_EXEC as CLEAR_CACHE step on amd64-linux + * Prevent recursive malloc calls for OpenBSD error reporting + * Push dummy 0 time for child runtime on windows to be compatible with + other platforms for now + * Make sure pages are mprotected PROT_EXEC for amd64 support + + -- Camm Maguire Tue, 13 Apr 2004 21:00:22 +0000 + +gcl (2.6.1-36) unstable; urgency=low + + * Improve optimize-maximum-pages algorithm + + -- Camm Maguire Tue, 6 Apr 2004 03:23:40 +0000 + +gcl (2.6.1-35) unstable; urgency=low + + * Fix sigcontext autodetection on sparc + + -- Camm Maguire Sun, 4 Apr 2004 19:26:48 +0000 + +gcl (2.6.1-34) unstable; urgency=low + + * Fix GNU_LD autodetection in configure.in + * Eliminate C_INCLUDE_PATH from shell script wrapper + * Use lisp rather than 'system touch' to make empty map file in + compiler::link + * fix small bug when info is passed bad second argument + * Don't try to open map file if doesn't stat (macosx) + * Add earlier forgotten branch patch to sfaslbfd.c for macosx + * Backport new eval-when keyword support from 2.7 to run random tester + * Perhormance improvement to gcl_seqlib.lsp -- no inner loop over + bignums + * Proper contblock/relblock determination when expanding string + streams + * Proper string type determination for *link-array* + * .ini files depend on plt.h + * plttest.c cannot depend on include.h + * Address longstanding FIXmE in gensym, so that two strings are not + allocated for each gensym + * Fix rare infinite loop bug in array.c + * Import si::info into 'user + * , -> # as sed separator + * Minro warning removals and fixups + * Binary searches through ordered arrays of referred and changed + variables for dramatic compiler performance improvement in the large + case -- support declarations and thereby optimizations of the form + (declare ((vector t) foo)), etc. + * Better 'time macro + * rebuild pcl_gaz* files + * cleanup room report and give more space to modern large heaps + * room report formatting + * Properly gensymmed time macro + * Allow for white space chars in compiled filenames + * Autodetect and work around sbrk randomization, e.g. on Fedora 1 + * Probe for sbrk before probing for randomized sbrk + * Openbsd changes -- maximize data seg resource if possible, avoid + mallocing error message when allocation routines fails + * Fix sigcontext configure tests + * Rename loop-finish -> sloop-finish in sloop package so that sloop + and ansi loop can be used simultaneously + * Handle arguments which are zero in LCM + * Fix typo in configure.in + * Improved dotimes macro which avoids unnecessary fixnum garbage + generation + * Backport of ignorable declaration keyword for new dotimes macro + * si::*OPTIMIZE-MAXIMUM-PAGES* support + * rebuild pcl generated lisp files + + -- Camm Maguire Sat, 3 Apr 2004 19:27:18 +0000 + +gcl (2.6.1-33) unstable; urgency=low + + * Remove extraneous symbols from plt.h, autodetect and correct for + leading underscore in object symbols + * complete readline version detection commit + * Backport support for new eval-when keywords + * Autodetect GNU ld and add -Wl,-Map only when appropriate + + -- Camm Maguire Wed, 10 Mar 2004 22:51:44 +0000 + +gcl (2.6.1-32) unstable; urgency=low + + * Try to automatically determine the form used for the explicitly + compiled in external function addresses in plt.c + * No need to explicitly write cr-lf on windows + * Autodetection of machine on FreeBSD + * Updated defs and h files for FreeBSD courtesy of Mark Murray + * Minor ifdefs needed for FreeBSD + * Refer to exported non-static C stub of fSmake_vector1 in plt.c + (needed on ia64) + * Readline 4.1/4.3 configure magic + + -- Camm Maguire Tue, 9 Mar 2004 01:58:43 +0000 + +gcl (2.6.1-31) unstable; urgency=low + + * Adjustments to vs_top reset logic to clear (hopefully last) + remaining bug found by the random-tester + * Allow args-info-referred-vars to match replaced vars, clearing bug + report submitted by Matt Kauffman + * Rework plt code yet again to be compatible with compiler::link for + axiom, and mingw32 + + -- Camm Maguire Mon, 8 Mar 2004 12:16:46 +0000 + +gcl (2.6.1-30) unstable; urgency=low + + * Fix rsym generated symbol tables for 64 bit platforms + * Make sure 'unwind' in frame.c does nt go below frs_org + * Do not define symbols with no value, either in bfd/rsym, or in + plt.c. Generates a clear and explicit error of an undefined symbol + when we've missed an address + * Define the external symbols known to be written at present in plt.c + * fix some more compiler errors found by the random tester -- all + related to proper unwinding of temporary reductions of vs_top from + te local supremum + + -- Camm Maguire Sat, 6 Mar 2004 02:05:59 +0000 + +gcl (2.6.1-29) unstable; urgency=low + + * Remove implicit dependency on gawk, optimize plt.c a little + + -- Camm Maguire Wed, 3 Mar 2004 16:08:30 +0000 + +gcl (2.6.1-28) unstable; urgency=low + + * make sure bfd fasload initializes dum.sm.sm_object1 for + read_fasl_vector + * When a tagbody contains ccb reference tags, and hence i itself + marked ccb, mark all the clb tags therein ccb too, as the tagbody + environment will be consed in c2tagbody-ccb. FIXME -- review this + logic carefully + * fix typoe in o/sfaslbfd.c + * Add code to unwind redefinitions of the stack supremum in c2expr-top + (used in c2multiple-value-prog1 and c2multiple-value-call in + evaluating arguments) on non-local exit + * Use new temporarry variables holding lisp stack supremum for lint + * Eliminate extraneous warning message when allocating fewer pages + than already allocated + * Rework internal plt symbol address capture + * Cleanup sfaslelf compiler warning + + -- Camm Maguire Wed, 3 Mar 2004 00:27:08 +0000 + +gcl (2.6.1-27) unstable; urgency=low + + * Modify default banner slightly + * Homebrew plt-like mechanism for ensuring that valid internal + addresses exist to which undefined symbols in compiled lisp objects + referring to external shared libraries can be relocated + * Make configure demand gettext when choosing --enable-locbfd + * Make sure references to ldb1, a stub conventionally optimized away, + can be resonled when optimization is turned off + * completion_matches -> rl_completion_matches in gcl_readline.d, + which is what is exported in the headers + + -- Camm Maguire Fri, 27 Feb 2004 23:50:49 +0000 + +gcl (2.6.1-26) unstable; urgency=low + + * Rework compiler::*ld-libs*, compiler::link, and unixport/makefile to + accomodate mingw need for firstfile.o and lastfile.o + * Remove incompatible -fomit-frame-pointer when compiling with -pg + profiling + * Load sys-proclaim.lisp files forimproved linking and smaller object + size across the board, install same for use with compiler::link + * Use pathnames instead of strings in compiler::link, also in image + init files, for Windows + * small mod to unixport/makefile re filtering of firstfile and + lastfile + * Backport zero divisor error cnditions from HEAD for + floor,ceiling,truncate + * Default to debug mode on hppa to work around gcc compiler + optimization bugs + * Add missing m4 and automake files in binutils directory to enable + automake and autoconf here + * Add mach-o specific files from cvs head to local bfd tree + * Add bfd/po makefiles + * Macosx defaults in configure.in + * bfd make and configure file changes to handle mach-o backend + * *gcl-version* -> *gcl-minor-version*,*gcl-extra-version* + * Support for more informative banner reading features list + * Support for both sigbus and sigsegv in sgbc.c as is customary in .h + files + * mach-o compatible changes in sfaslbfd.c + * Support for new debugging section names in sfaslelf.c + * powerpc-macosx h and defs files from cvs head + + -- Camm Maguire Wed, 25 Feb 2004 23:08:59 +0000 + +gcl (2.6.1-25) unstable; urgency=low + + * rl_putc_em a carriage return after invoking readline to ensure the + prompt in rl_putc_em_line is cleared. + * use standard sgc fault recovery element for hppa as recommended by + hppa kernel experts + * Store banner in si::*system-banner* for possible modification + in compatibly licensed programs + * exit with -1 when standard in ends in lisp debug mode + * Backport macosx files from cvs HEAD + * Document system return codes + + -- Camm Maguire Fri, 13 Feb 2004 20:44:54 +0000 + +gcl (2.6.1-24) unstable; urgency=low + + * Revert unixport/makefile link order fix for windows, breaks + compiler::link, find another way + * runtime SGC fault recovery test + * Protect read/fread in case SGC is enabled with safe (restartable) + versions + * SGC on for arm and hppa + * remove fast-link workaround now fixed for windows + * Backport HEAD makefile changes to clean .{c,h,data} files and + new_decl.h, remove said from repository (generated files) + + -- Camm Maguire Thu, 12 Feb 2004 05:56:29 +0000 + +gcl (2.6.1-23) unstable; urgency=low + + * Remove calls to init-readline with new automatic readline setup + + -- Camm Maguire Tue, 27 Jan 2004 20:27:20 +0000 + +gcl (2.6.1-22) unstable; urgency=low + + * Build depend on emacs21 | emacsen + + -- Camm Maguire Fri, 23 Jan 2004 22:01:15 +0000 + +gcl (2.6.1-21) unstable; urgency=low + + * Automatic readline initialization + * Add watch file + * Prevent circular error loops + * Prevent automatic optimization added to CFLAGS by autoconf + * Rework documentation installation in and outside of Debian + * Support user deined predicates at an elementary level in the form + '(satisfies foop) in gcl_predlib.lsp + * Install binary gcd algorithm for ~10% performance increase + * Rescale some default allocation parameters -- bignum allocation by + relblocks by default, default growth parameters are 1 (min), + 0.1*MAXPAGE (max), 0.5 (increase), 0.3 (percent free), holepage is + 4*MAXPAGE/1024, INIT_HOLEPAGE, INIT_NRBPAGE and RB_GETA scale + accordingly + * Clean windows/sysdir.bat + * Check for zero args in new gcd code + * Default hole is maxpages/10, holesize configure option added + * Fix syntax errors in older reloaction code: sfaslelf.c + + -- Camm Maguire Fri, 16 Jan 2004 16:57:50 +0000 + +gcl (2.6.1-20) unstable; urgency=low + + * Fix gcl-doc doc-base files + + -- Camm Maguire Tue, 30 Dec 2003 22:30:39 +0000 + +gcl (2.6.1-19) unstable; urgency=low + + * Fix bug in compiler::c2labels in which *ccb-vs* was missing a ocal + rebind + * Remove duplicate tags from compiled C switch statements + * Minor merges for DARWIN support + * Path to configure to make --enable-emacsdir work + * Check for readline/readline.h header before configuring for readline + * Improve system bfd library location detection + * Make sure external gmp lib is compatible via __GNU_MP_VERSION, else + backoff to local gmp build; prepend externally defined CFLAGS into + output CFLAGS, FINAL_CFLAGS, and NIFLAGS + * Remove --enable-gmp configure option; gmp is required for GCL + * Use --enable-emacsdir in debian/rules, make sure --enable-emacsdir + and --enable-infodir work when arg contains ${prefix} + * Fix typo in chap-6.texi + * Make sure to export SGC define from config.h to cmpinclude.h -- Now + that we used optimized structures in the compiler, we need at least + the definition of SGC_TOUCH there to prevent GBC errors. FIXME -- + handle header dependencies more robustly. Thanks to Robert Boyer + for the report + * Improve SGC define extraction for cmpinclude.h + * Fix variable reference errors which were occurring for compiled + local functions defined within closure-generating or other + environment stack pushing functions when safety is set to 3 (thanks + Paul Dietz for the report.). When constructing local functions and + closures within a 'mother' function, *ccb-vs* will hold the number + of closure environments stacked at the point of each closure + creation or call to a local function. This value is stored as the + cadr of a list pushed onto *local-funs*, and is read when writing + out the C code for the local function or closure, where it is used + to initialize *ccb-vs* and *initial-ccb-vs* for subsequent + processing. The latter is used as the reference point when + addressing variables in wt-ccb-vs, as the former could be still + further incremented within the closure or local function itself. + Local functions as opposed to closures do not increment *ccb-vs* and + do not push the environment. When a local function is defined + within a closure-generating flet/labels, or a tagbody or block which + pushes the environment, the value of *ccb-vs* written to the list + corresponding to the local function can be erroneously incremented + beyond the *initial-ccb-vs* value established before any environment + pushing operations were processed. It is this latter value which is + appropriate for use in wt-ccb-vs, as the local functions, unlike the + closures, receive an environment level with the mother generating + function. We therefore push *initial-ccb-vs* onto the end the list + pushed onto *local-funs* only when defining a local function, and use + it to initialize an added optional variable initialize-ccb-vs in + t3local-fun and t3local-dcfun, which default to the original ccb-vs. + We then bind *initial-ccb-vs* to this new optional parameter instead + of the former *ccb-vs, which was only appropriate for closures. + * Put in rudimentary logic for the selection of stack vs. heap storage + for bignums depending on the frame context. FIXME, this logic is + too conservative at present. SETQ_II and SETQ_IO take an additional + parameter which is malloc when *unwind-exit* is bound and contains + 'frame and alloca otherwise. New macro bignum-expansion-storage. + FIXME, ensure that IDECL does not need similar modification. + * Cleanup a few compiler warnings in the compiler + * Cleanup compiler warning in alloc.c + * Eliminate unneeded transformatio of contniguous pages to other pages + on save-system. + * malloc -> gcl_gmp_alloc in recent setjmp frame protected bignum + allocation + * Add -Wa,--execstack if on an exec-shield enabled system, can be + explicitly added otherwise by setting the CFLAGS variable before the + configure step + * Better execstack flag handling in configure + * Allow for commas in CFLAGS in sed command writing *cc* + * Preliminary gprof profiling support + * Rework html documentation generation and installation, Closes: + #221774 + * Remove parentheses from setf class-name info node in chap-7.texi + + -- Camm Maguire Tue, 30 Dec 2003 16:26:45 +0000 + +gcl (2.6.1-18) unstable; urgency=low + + * Portability patches to makefiles to support non-GNU grep (no -q), + and non-bash sh, C_INCLUDE_PATH=...;export C_INCLUDE_PATH + * copy the global *info* parameter in c1flet and c1labels to prevent + accumulation of old data -- FIXME -- make sure there are no other + copies required, and eventually replace this global parameter with + local variables + * Turn on some optimization on hppa, -O only + * Make all C defined functions installed into lisp static functions to + work around dynamic function descriptors on ia64, Closes: #217484, + Closes: #204789, (STATIC_FUNCTION_POINTERS define in config.h) + + -- Camm Maguire Thu, 6 Nov 2003 15:40:25 +0000 + +gcl (2.6.1-17) unstable; urgency=low + + * Repair weak symbol addition to the bfd symbol table in sfasli.c + * Be more thorough about adding fun-info to call-local info in + gcl_cmpflet.lsp, accompanying simplifications in gcl_cmpeval.lsp + (call-global lists have info updated by args already in (c1args args + info)), small changes in add-info in gcl_cmpinline.lsp, FIXME -- + study rational for *info* special variable in certain places as + opposed to more common copy-info + + -- Camm Maguire Thu, 30 Oct 2003 20:03:22 -0500 + +gcl (2.6.1-16) unstable; urgency=low + + * Fix sh syntax in debian/gcl.sh + * init_or_load1 -> gcl_init_or_load1 in xgcl-2/sysinit.lsp + * Load weak symbols as well as undefined symbols in + bfd_build_symbol_table, for the purposes of the static build + possibility + * Map t and nil stream indicators properly in optimized compiled + references to read_char1 and read_byte1 (in read.d) + + -- Camm Maguire Thu, 23 Oct 2003 16:43:15 +0000 + +gcl (2.6.1-15) unstable; urgency=low + + * Remove imod/ifloor functions in cmpaux.c and directly inline their + fixed equivalents in gcl_cmpopt.lsp + + -- Camm Maguire Mon, 13 Oct 2003 15:04:24 +0000 + +gcl (2.6.1-14) unstable; urgency=low + + * generate less garbage in add-info (gcl_cmpinline.lsp), enabling + maxima compile to complete in a finite time :-) + + -- Camm Maguire Fri, 10 Oct 2003 22:14:04 +0000 + +gcl (2.6.1-13) unstable; urgency=low + + * Fix compiler optimization bug in gcl_cmpopt.lsp -- missing parens + around inliner for max and min + * collect info structures for local functions in flet and labels + processing (gcl_cmpflet.lsp), and pass upwards to call-local and + call-global (gcl_cmpeval.lsp) to fix certain inlining bugs in via + more proper operation of args-info-changed-vars (gcl_cmpinline.lsp, + inline-args, gcl_cmplet.lsp, c2let) + * Fix an obviou int overflow in ifloor (o/cmpaux.c), handle more + proper fixnum/integer determination from declarations later + + -- Camm Maguire Fri, 10 Oct 2003 02:34:11 +0000 + +gcl (2.6.1-12) unstable; urgency=low + + * Restore mpz_to_mpz{1} in gmp_big.c, can be written by compiler + * tk8.4 patches + * Prevent destructive modification of bignum arguments in log_op/mp_op + in gmp_big.c + * Make sure to push stack variables onto newly allocated C variable + when inlining args and args cause side effects, in inline-args, + gcl_cmpinline.lsp + * Fix bug related to gcc-3.3 fixes in set_exponent in num_co.c + * Remove pcl_methods.c patch. as is apparently no longer needed, TODO + -- make sure VOL modifier is inserted where needed to prevent + longjmp clobbers + + -- Camm Maguire Thu, 2 Oct 2003 14:26:43 +0000 + +gcl (2.6.1-11) unstable; urgency=low + + * Add compilation step of compiling all lsp and cmpnew .lsp files from + an interpreted only saved_pre_gcl before the creation of saved_gcl - + - this enables us to use full optimization on these files while + getting the STREF constants right on 32bit and 64bit + * remove 'attic' from comment in gcl_loop.lsp + * configure changes for sizeof(struct contblock) detection + + -- Camm Maguire Wed, 24 Sep 2003 16:09:44 +0000 + +gcl (2.6.1-10) unstable; urgency=low + + * Mac OSX GET_FULL_PATH_SELF + * Preliminary subtypep checking for 'satisfies + * preliminary 'satisfies support in subtypep, more predicate type + pairs and reverse checking + * small compiler change to remove unused C variables from optimized + compiled macros + * Optional compiler init file is called gcl_cmpinit + * fasdmacros.lsp -> gcl_fasdmacros.lsp + * All cmpinit.lsp files named gcl_cmpinit.lsp; allow full lisp + optimization in all directories + * collectfn -> gcl_collectfn in lsp/gcl_auto.lsp + * collectfn -> gcl_collectfn in cmpnew/gcl_make-fn.lsp + * Make sure makefiles can generate sys-proclaim.lsp, regenerate these + files and recompile from lsp + * Rebuild with opts enabled + * Iterate sys-proclaim/rebuild generation once more + * Iterate sys-proclaim/rebuild for pcl and clcs + + -- Camm Maguire Tue, 23 Sep 2003 19:33:27 +0000 + +gcl (2.6.1-9) unstable; urgency=low + + * Close streams in fasldlsym.c + + -- Camm Maguire Tue, 16 Sep 2003 14:57:20 +0000 + +gcl (2.6.1-8) unstable; urgency=low + + * Add processor flag variable to flags in configure.in + * Autoadd full path to kcl_self to enable save-system when user moves + executable and calls without script wrapper + * Add special variables si::*collect-binary-modules* and si::*binary- + modules* as a facility for discovering the list of fasloaded objects + preceding a save-system is required for a subsequent compiler::link + * Add collectfn.lsp to distro + * Rename some files and init_ functions to eliminate namespace + conflicts when building images with compiler::link + * Enable compressed info reading + * Make sure no opt flags are set when enable debug is specified + * Use NIFlAGS to compile new_init with lower opts on ppc to work + around gcc bug, restore full opts to other files + + -- Camm Maguire Sun, 14 Sep 2003 02:18:28 +0000 + +gcl (2.6.1-7) unstable; urgency=low + + * Fix permissions bug in temporary gzipped file handling + * Propagate control changes correctly with package extension + * Newer standards + + -- Camm Maguire Tue, 9 Sep 2003 17:06:56 +0000 + +gcl (2.6.1-6) unstable; urgency=low + + * Remove build-dependency on autoconf as a temporary work around to + Debian autoconf's dependency bug on emacsen-common + + -- Camm Maguire Tue, 9 Sep 2003 15:29:06 +0000 + +gcl (2.6.1-5) unstable; urgency=low + + * Redefine temporary files in elisp/makefile + + -- Camm Maguire Mon, 8 Sep 2003 21:49:09 +0000 + +gcl (2.6.1-4) unstable; urgency=low + + * Fix to sfasli.c to avoid defining symbols in other than *UND* + sections + * Remove some 64 bit warnings + * Turn off def_static on ia64 for now -- its broken + + -- Camm Maguire Sat, 6 Sep 2003 17:22:10 +0000 + +gcl (2.6.1-3) unstable; urgency=low + + * Fix static detection fr ia64; contblock size detection on arm + * Fix gcc verion checking in gmp3 subconfigure, esp. for arm + * Escape all sgc code with #ifdef SGC + + -- Camm Maguire Fri, 5 Sep 2003 21:32:47 +0000 + +gcl (2.6.1-2) unstable; urgency=low + + * Add windows/install.lsp to clean target + * Add in macosx files to stable and cvs head + * Fix bad debelper postinst, Closes: #208765 + + -- Camm Maguire Fri, 5 Sep 2003 13:15:11 +0000 + +gcl (2.6.1-1) unstable; urgency=low + + * New upstream release + * Type-punning warning fixes + * small_fixnum overflow fixes + * off by one fix in cerror + * Fix compiler error which had not recognized defpackage as a package + operation + * Fix tkl.lisp call to open-named-socket + * Make values-list and nreconc signal errors when they should on + dotted lists. + * Avoid use of windows.h types as macros. + * New config.{sub,guess} + * Windows installer updates from CVS HEAD + * fix potential longjmp clobber in read.d;add some windows files to + main makefile clean target; + * Darwin revealed fixes to usig.c and unixtime.c + * Fix gbc time calculation in case of recursive gbc calls + * Run patch_sharp in LSharp_exclamation_reader to handle new case of + defpackage ops at head of fasl vector, required for maxima build + * Special symbol Dotnil has ordinary list Cnil for plist and hpack + * Small fixes for profiling support + * Restore pp() function for debugging; print out undefined symbol + names + * Small patch for fix xgcl demo (thanks Michael Koehne) + * Better bfd symbol table strategy + * Fix bfd table symbol counting for combined_table profiling + * amd64 linux support + * O6 -> O3 + * static linking on ia64 to work around current mechanism for runtime + generated function descriptors + * enable-static configure option + * Fix debian/gcl-doc.docs for latest texinfo file splitting policy, + Closes: #206017 + * Fix typo in o/sfasli.c + * Rework debian package structure to handle stable and cvs packages + simultaneously + * Add gazonk*.lsp to clean target + * syntax fix to lsp/gprof.hc + * Add support for SGC contblock pages + * Fixes to debian/rules + * Remove unused definitions of Vcs + * Increase default maxpages and stack sizes + * Maintain a persisten *system-directory* binding + * Push installed /h directory onto -I flags on cc command line + * Escape old in-package behavior with #ifdef ANSI_COMMON_LISP + * define HAVE_XDR in linux.h + * reduce resolution of contblock mark_table in gbc.c to match new + minimum granularity introduced via CPTR_ALIGN + * Remove exit function in main.c + + -- Camm Maguire Thu, 4 Sep 2003 02:20:52 +0000 + +gcl (2.5.3-2) unstable; urgency=low + + * gcc-3.3 all platforms + + -- Camm Maguire Mon, 7 Jul 2003 16:10:25 +0000 + +gcl (2.5.3-1) unstable; urgency=low + + * New upstream release + * Restore object_to_float and object_to_double, cmpaux.c, Closes: #195470. + * Remove obsolete functiion multiply-bignum-stack from documentation, + si-defs.texi + * Unstatic object_to_float, object_to_double + + -- Camm Maguire Mon, 2 Jun 2003 12:38:03 -0400 + +gcl (2.5.2-1) unstable; urgency=low + + * New upstream release + * Cleanup xdrfuns.c for Axiom + * Reenable xgcl build + + -- Camm Maguire Thu, 20 Mar 2003 09:15:54 -0500 + +gcl (2.5.1-1) unstable; urgency=high + + * some optimization now on hppa + * Add RELEASE-2.5.1 file + * Add dedication notice to the memory of W. Schelter + + -- Camm Maguire Sun, 2 Mar 2003 10:20:26 -0500 + +gcl (2.5.0.cvs20020625-80) unstable; urgency=low + + * enable japi configure flag, defaults to no + * enable -mlongcall on ppc when using gcc 3.3 or higher + * int -> fixnum in DEFUN function arguments for safety -- ensures + pointers and integers passed by lisp are of same size + * MYmake_fixnum macro simplification + * ufixnum typedef + * Prototypes for cmod et.al. -- restoring maxima build on ia64 + * Fix unaligned access message on ia64 generated by DFLT_aet_fix + * Integer va_arg uses fixnum + * Define __*i3 symbols used by GCL, supplied by libc, and written into + some GCL compiled objects, restores ARM build with ANSI image + * num_log.c miscompilation on ia64 apparently fixed, Closes: #156291 + * Ensure cmpinclude.h up to date in main makefile + + -- Camm Maguire Sat, 1 Mar 2003 17:33:29 -0500 + +gcl (2.5.0.cvs20020625-79) unstable; urgency=low + + * Fix Debian package install bug + + -- Camm Maguire Thu, 27 Feb 2003 23:17:55 -0500 + +gcl (2.5.0.cvs20020625-78) unstable; urgency=low + + * Add config.log config.status and config.cache to clean target + * Remove xgcl-2/debian directory + * Update clcs/sys-proclaim.lisp + + -- Camm Maguire Thu, 27 Feb 2003 18:48:38 -0500 + +gcl (2.5.0.cvs20020625-77) unstable; urgency=low + + * Lintian cleanups + * Don't strip libansi_gcl.a, need .data at end of .o, as with libgcl.a + * Take newlines out of doc string for init-cmp-anon + * Cleanup gcc-3.2 compiler warning + * 64 bit STREF fixes + * pcl and clcs need to have C rebuilt afresh, as 64 bit machines write + different STREF offsets into the C files + * Rework Debian package build a bit + * README.Debian explaining the toggling of the ANSI image + * Typo in debian/rules + * Remove debian/gcl.conffiles + + -- Camm Maguire Thu, 27 Feb 2003 15:56:11 -0500 + +gcl (2.5.0.cvs20020625-76) unstable; urgency=low + + * Debian Priority is optional + * Configure lowest common denominator on m68k to m68020 -- gcc-3.2 + can't handle m68000 -- no __mulsi3 + * Fix bit array bug + * Add upgraded-array-element-type + * Misc typep and subtypep fixes + * Proper error handling in certain array.c functions + * First needs exactly one arg + * Proper error handlin in LAST + * bit array allocation fixes in num_log.c + * eliminate Iapply_fun_n1 + * Dummy system find-class in traditional image, overwritten by pcl + version in ANSI + * Invalid variable is a program error, not a symbol is a type error + * Attempt at uninterned symbol support as slot names + * defstruct changes for ANSI conc-name handling + * Rework ansi build to follow existing pattern for traditional image, + enabling preliminary ansi support on dlopen systems + * Fix broken mingw probe in main makefile + * Rename pcl and clcs files to avoid init name conflict on dlopen + systems + * sys-proclaim for clcs + * Compiler goto indentation + * Compiler pointer cast in call_or_link_closure + * *keep-gaz* compiler variable to save anonymously generated lisp + * si::init-cmp-anon function to initialize anonymously generated and + compiled lisp from .text section of running executable + * Debian/rules builds and ships both images + * Check for small fixnum in make_fixnum macro + * Pass real integers to array functions to minimize fixnum garbage + * Larger SHARP_EQ_CONTEXT_SIZE in read.d + * Shadowing-import instead of import dummy symbols into common-lisp in + ansi_cl.lisp + * Rework object definition in makefiles + * Remove old gmp directory + * Remove old tests directory + * Reinsert JAPI configuration + * Spruce up clean target + * Use saved_gcl to recompile cmpnew files + * Toggle ansi image with GCL_ANSI environment variable + * Version 2.5.1 + + -- Camm Maguire Wed, 26 Feb 2003 21:31:04 -0500 + +gcl (2.5.0.cvs20020625-75) unstable; urgency=low + + * Export truename for dlopen systems + + -- Camm Maguire Fri, 14 Feb 2003 23:31:15 -0500 + +gcl (2.5.0.cvs20020625-74) unstable; urgency=low + + * Remove duplicates in apropos a la clisp + * Use static where possible, remove unused functions, decrease global + symbol count by about 1/3 (~ 600 global functions) + * Inline optimize cmod,cplus,ctimes and cdifference like maxima + * eliminate make-pure-array from lfun_list.lsp, not defined + * Prototypes for all possible compiler generated function calls + * relative symlink for cmpinclude.h in Debian package + + -- Camm Maguire Fri, 14 Feb 2003 20:17:31 -0500 + +gcl (2.5.0.cvs20020625-73) unstable; urgency=low + + * typep fixes for class types + * m68k Build-depend on gcc-2.95 as a temporary work around to bug + 179807 + * gcc-3.2 warning cleanups + * bfd_boolean syntax support for newer binutils + * gcc-3.2 on powerpc can't yet handle -O2 and higher + * Reenable gcc-3.2 for m68k and do some guesswork in configure + + -- Camm Maguire Mon, 10 Feb 2003 13:47:00 -0500 + +gcl (2.5.0.cvs20020625-72) unstable; urgency=high + + * Fix to siLbit_array_op for 0 dimension arrays + * Fixed aref of short-float vector + * nconc can take dotted lists + * tailp returns t if first arg is nil + * Repair nconc and tailp fixes + * varargs->stdarg for gcc 3.3 and higher + + -- Camm Maguire Sun, 9 Feb 2003 16:57:33 -0500 + +gcl (2.5.0.cvs20020625-71) unstable; urgency=high + + * ansi changes to sloop.lsp and conditions.lisp to fix symbol tests + * :definition-before-pcl -> definition-before-pcl + * Allow spaces in pathnames + * Significant fixes to gmp_num_log.c affecting bitwise ops on bignums + * Fix test segfault arising from faulty structure-type-included-type- + name in gcl-low.lisp ; Thanks Peter + * aref1 -> row-major-aref + * Fixes to certain numerical functions to handle denormalized floating + point numbers + * Number of argument check in IapplyVector + * Print offset bit vectors correctly + * Correct precision for formatting short and long doubles + * Added si::modf + * Do not trigger error in IapplyVector if max args is zero + * Fixes to with-package-iterator to cleanup compiler warnings + * :invalid-variable is a type error + * No max arg checking if &key or &rest present + * proper defun declarations in listlib.lsp + * class specifiers in typep, subtypep and coerce + * Corrections to allow-other-key processing in bind.c + * eval sfuns with argument error checking (in one place) + * copy-structure takes only one arg + * si::classp, si::class-of, and si::class-precedence-list overwritten + by pcl analogs when compiling ansi + * recompiled core lsp and compiler files + * restore dvi and html doc build for non-mingw + + -- Camm Maguire Fri, 24 Jan 2003 13:55:11 -0500 + +gcl (2.5.0.cvs20020625-70) unstable; urgency=high + + * loop fixes + * configure fixes + * :common-lisp in *features* + * :definition-before-clcs -> definition-before-clcs + * protect against sgc segfault within fread in fasdump.c -- fixes m68k + acl2 build + * SGC for s390 + + -- Camm Maguire Thu, 5 Dec 2002 08:02:17 -0500 + +gcl (2.5.0.cvs20020625-69) unstable; urgency=high + + * eval fix + * \-mlong-calls for arm + + -- Camm Maguire Mon, 25 Nov 2002 08:35:27 -0500 + +gcl (2.5.0.cvs20020625-68) unstable; urgency=high + + * enable emacsdir configure option + * reordered configure X lib detection for solaris + * redo integer declarations for gmp bignums to avoid compiler warnings + * Clear large and negative count errors for remove/delete + * Loop error fixes + * cache flush with page granularity on m68k + + -- Camm Maguire Thu, 21 Nov 2002 17:44:30 -0500 + +gcl (2.5.0.cvs20020625-67) unstable; urgency=high + + * Align cache flushes for powerpc and m68k on 32 byte boundaries, + should fix acl2 build + * Removed diagnostic SIGILL trapping in cmpaux.c + + -- Camm Maguire Tue, 12 Nov 2002 23:25:49 -0500 + +gcl (2.5.0.cvs20020625-66) unstable; urgency=high + + * Fix SIGILL trap in cmpaux.c + + -- Camm Maguire Mon, 11 Nov 2002 11:14:07 -0500 + +gcl (2.5.0.cvs20020625-65) unstable; urgency=high + + * Miscellaneous Freebsd patches + * non-recursive with-package-iterator + * map-into fill-pointer fixes + * changes to the user-init mechanism for portable acl2 build + + -- Camm Maguire Sun, 10 Nov 2002 12:33:59 -0500 + +gcl (2.5.0.cvs20020625-64) unstable; urgency=low + + * Fix epsilon calculations again to reenable arm build + + -- Camm Maguire Fri, 1 Nov 2002 07:08:33 -0500 + +gcl (2.5.0.cvs20020625-63) unstable; urgency=low + + * Add versioned dependency on the gcc used to build gcl + + -- Camm Maguire Tue, 29 Oct 2002 16:20:22 -0500 + +gcl (2.5.0.cvs20020625-62) unstable; urgency=low + + * with-package-iterator modifications + * with-package-iterator uses labels to correctly provide for recursion + * Fix doc directory problem with install target in info/makefile + * Fix info dir setting in configure + * Priority extra + + -- Camm Maguire Mon, 28 Oct 2002 23:45:07 -0500 + +gcl (2.5.0.cvs20020625-61) unstable; urgency=low + + * Placeholder support for optional condition in find-restart + * defpackage error on importing non-existent symbols + * working with-package-iterator macro + * various package errors reported as :package-error + * Destructuring-bind fixes + * delete-package error fix + * pcl functions use pcl-destructuring-bind for now -- fix later + * Trigger error if function calls use too many 'values' + * Maximum values increased to 50 + * Enable previously failing tests in multiple-value-{setq,prog1}.lsp + * prototype for system_time_zone_helper + * Initial changes for solaris support + * make -> $(MAKE) in makefiles + * Incorporated main GCL (ANSI) Lisp Documentation in distribution + + -- Camm Maguire Mon, 28 Oct 2002 04:31:33 -0500 + +gcl (2.5.0.cvs20020625-60) unstable; urgency=low + + * Still better acosh, courtesy of Barton Willis + * Better epsilon contant determination in ieee case + * Implicit tagbody in do-symbols and do-all-symbols + * Better epsilon handling in ieee case + * Add setf (values ... support + * invalid-function errors are type errors + * ecase and ccase take t and otherwise clauses + * ECASE/CCASE test fixes + * setf values fixes to use setf instead of setq when target value is + not a symbol + * ETYPECASE/CTYPECASE can take t and otherwise + * Backout of restart-clusters export + * fix handler.lisp + * Fix to bfd/GBC interaction + + -- Camm Maguire Wed, 23 Oct 2002 08:38:08 -0400 + +gcl (2.5.0.cvs20020625-59) unstable; urgency=low + + * wrong number of arguments, keyword errors in lambda list bindings, + are program errors + * acosh fix at -1.0 + * New config.sub and config.guess files and automatic updates in + binutils, gmp, and gmp3 subdirs + + -- Camm Maguire Wed, 16 Oct 2002 11:38:56 -0400 + +gcl (2.5.0.cvs20020625-58) unstable; urgency=low + + * GENSYM fixes + * add complement and constantly + * import certain symbols into common-lisp package + * Fix makefile bug in install target + * Prepend instead of overwrite C_INCLUDE_PATH in shell wrapper + * More shell variable fixes in main makefile + * Corrected order of push and pushnew + * Set bfd_error appropriately + * Report function for package-error in condition-definitions.lisp;fix + internal-package-error deinition and handling;export *restart- + clusters* to user error code specified in handler-case;package-error + error formatting changes;dummy optional argument added to compute- + restarts (for now);Paul Dietz patch to defpackage.lsp fixing several + tests (thanks);export/unexport error handling fixes + * Recompile c,h and data files + * Fix number of argument errors in debug.lsp;documentation support for + packages in defpackage.lsp and module.lsp;do-symbols loops over + inherited symbols too in packlib.lsp + * Reworked EXTRAS variable handling in unixport/makefile + * Build-depend on autotools-dev and automatic update of config.sub and + config.guess;newer config.sub and config.guess in cvs tree; Closes: + #164526 + * Remove stray comments in package.d + * elt errors of type type error + * bad-sequence limit returns type error + + -- Camm Maguire Tue, 15 Oct 2002 15:39:19 -0400 + +gcl (2.5.0.cvs20020625-57) unstable; urgency=low + + * Capitalization changes to names of special characters;graphic-char-p + fix + * fix shadowing of existing symbols in package.d + * (simple-)base-string not a subtype of (simple-)vector + * add package-error condition(preliminary);hash conditions only by the + error name, not the format string;pass error types for both + correctable and non-correctable situations;eliminate duplicate + loading of clcs/package.lisp;Allow t doc-types in documentation + (returning nil) for now;fix final type errors in predlib.lsp + (regarding base-string);other error functions to pass continuable + errors (needs cleaning up);package designators can be + characters;delete-package added;make-package doesn't :use lisp by + default;in-package returns error if package does not exist instead + of making the package(relatively big change -- need to address + instances of in-package in .lsp code);call make-package on relevant + packages in init_gcl.lsp.in and pcl/sys-package.lisp; + * \-ffunction-sections for hppa with no-optimization -- enables first + maxima build here + * separate lisp variables to specify optimization flags for level 2 + and 3 + * symbol-name throws a type error on bad input + * tk8.2 -> tk8.3 + * Fix bug in main makefile + * Newlines at end of test files + + -- Camm Maguire Wed, 9 Oct 2002 15:04:41 -0400 + +gcl (2.5.0.cvs20020625-56) unstable; urgency=high + + * ansi-test corrections; extra-libs option to LINK function; LINK doc + change; subtypep and string changes to pass more tests + * Add method-combination and structure-object symbols for ansi;remove + unused variables in debug.lsp;remove in-package system from + defstruct.lsp;make-keyword and defmacro temporary function + placeholders in destructuring_bind.lsp;predlib changes to fix ansi- + test type errors;break-call takes 2 args (sys-proclaim.lisp);char + and char-set protected by string dimension not fillpointer in + string.d;fix bug in string.d:member_char for vector types;redefine + slot reader and writer functions in pcl/impl/gcl/gcl-low.lisp + + -- Camm Maguire Sat, 5 Oct 2002 14:33:46 -0400 + +gcl (2.5.0.cvs20020625-55) unstable; urgency=high + + * Add LINK documentation to info pages + * 0 length last support + * make-sequence error check for 'null type and non-zero size + * Dotted-list support in member + * Reworked dotnil definitions and support macros + * add compile-file-pathname + * setup C_INCLUDE_PATH env variable in gcl shell wrapper + * POSITIVE-FIXNUM variable type,simple-error->type error where + indicated by various ansi tests, eq->eql in ldiff and tailp;proper + lists only in member et. al. + * rev keyword for member1 to reverse test arguments + * specific-error function to pass a given type of error from lisp + * set-exclusive-or preserves order of test arguments + * type-errors where appropriate in make-sequence + * nil keys accepted in remove/delete et.al. + * Reworked linking command line to ensure that certain symbols are + resolved in libgcl.a as opposed to certain system libraries, e.g. + gmp + * new gmp for m68k;no -ffloat-store for m68k a requested by user due + to performance impact (will alter test results in maxima + accordingly) + * libgclp.a for objects to be overriden by the C library if necessary + * readably support + * boolean type + * Missing ansi type support + * subtype code for boolean + * add missing ansi types as known types + * other preliminary subtype code for missing ansi types + * rework result-type check in make-sequence + * :element-type support in make-string (preliminary) + * (char ignores fill-pointer + * remove -O4 from debian/rules + + -- Camm Maguire Thu, 3 Oct 2002 01:52:45 -0400 + +gcl (2.5.0.cvs20020625-54) unstable; urgency=high + + * Fix delete et. al. :from-end error; typo in gbc.c + * character and string-char equal in type hierarchy + * concatenate/make-sequence fixes + * merge takes nil key argument + * make-sequence checks size against result type + * install endp macro for dotted list support + + -- Camm Maguire Tue, 24 Sep 2002 14:57:44 -0400 + +gcl (2.5.0.cvs20020625-53) unstable; urgency=high + + * Sleep with (in principle) microsecond precision + * nth-value macro added + * \-ffloat\-store and warning cleanups for m68k + * Compile hppa with debugging, will get a build but a broken one, ok + for now, Closes: #159591 + + -- Camm Maguire Fri, 20 Sep 2002 09:48:35 -0400 + +gcl (2.5.0.cvs20020625-52) unstable; urgency=high + + * Fixed gcc version bug in debian/rules + + -- Camm Maguire Thu, 12 Sep 2002 18:00:50 -0400 + +gcl (2.5.0.cvs20020625-51) unstable; urgency=high + + * static gmp for m68k + + -- Camm Maguire Thu, 12 Sep 2002 09:33:03 -0400 + +gcl (2.5.0.cvs20020625-50) unstable; urgency=high + + * Reworked static gmp target for new libgcl.a;gcc-3.2 for + hppa,ia64,and arm;libgmp2-dev for m68k;no rsym with + dynsysbfd;build_symbol_table earlier to shrink table size; + + -- Camm Maguire Thu, 12 Sep 2002 00:39:17 -0400 + +gcl (2.5.0.cvs20020625-49) unstable; urgency=high + + * Use old gmp for m68k until can pin down test failure with gmp3 + + -- Camm Maguire Tue, 10 Sep 2002 00:36:10 -0400 + +gcl (2.5.0.cvs20020625-48) unstable; urgency=high + + * Rework build and install so that custom images can be made without + the source tree, even when using dlopen + + -- Camm Maguire Mon, 9 Sep 2002 23:26:47 -0400 + +gcl (2.5.0.cvs20020625-47) unstable; urgency=high + + * Install cmpinclude.h in system include directory + + -- Camm Maguire Thu, 29 Aug 2002 23:31:55 -0400 + +gcl (2.5.0.cvs20020625-46) unstable; urgency=high + + * Keep a *much* smaller piece of gmp.h in cmpinclude.h, reducing image + size by almost 100k + * Check for _SHORT_LIMB and _LONG_LONG_LIMB in configure + * Remove build specific include directories from compile command in + final executable + * Include local regexp.h explicitly in cmpinclude.h, to eliminate + intereference with system regexp.h, and to fix bug in which gcl + compilation depended on existing build directories + * Correctly add directory paths to extra gmp file targets in + unixport/makefile for m68k + + -- Camm Maguire Thu, 29 Aug 2002 21:56:28 -0400 + +gcl (2.5.0.cvs20020625-45) unstable; urgency=high + + * Fix typo in rshift target for m68k + + -- Camm Maguire Wed, 28 Aug 2002 18:02:00 -0400 + +gcl (2.5.0.cvs20020625-44) unstable; urgency=high + + * Handle second argument to last; treat dotted lists correctly in + ldiff et. al., tailp fix + * optional key argument for assoc-if et.al.;eval getf deflt if in setf + * Fix infinite loop in assoc-if et.al. + * X_LIBS and X_CFLAGS determination in configure script + + -- Camm Maguire Wed, 21 Aug 2002 18:22:37 -0400 + +gcl (2.5.0.cvs20020625-43) unstable; urgency=high + + * Larger ihs stack;fix array-total-size-limit;check negative + fillp;allow #P + * don't make common_lisp package when not configuring with --enable- + ansi + * Patch gmp3/mpn/m68k/{l,r}shift.asm, restore gmp3 to m68k build + * Dynamic libgmp support, overriding with patched functions from local + source where necessary + + -- Camm Maguire Sun, 18 Aug 2002 12:10:55 -0400 + +gcl (2.5.0.cvs20020625-42) unstable; urgency=high + + * copy ansidecl.h and symcat.h in h/ for local bfd builds + * localize bfd.h includes to sfaslbfd.c + * take bfd/po out of the build loop + * import xgcl-2, but don't build by default + * oldgmp configure option, and made default for m68k as temporary + workaround + + -- Camm Maguire Mon, 12 Aug 2002 23:49:09 -0400 + +gcl (2.5.0.cvs20020625-41) unstable; urgency=high + + * Minor rules revision for i164 + + -- Camm Maguire Sun, 11 Aug 2002 13:49:03 -0400 + +gcl (2.5.0.cvs20020625-40) unstable; urgency=high + + * revamp CONST configure test for certain bfd versions + + -- Camm Maguire Sun, 11 Aug 2002 12:31:35 -0400 + +gcl (2.5.0.cvs20020625-39) unstable; urgency=high + + * gcc-3.1 for ia64 fixes a compilation bug in num_co.c for -O3 and + higher -- code takes address of a variable kept in a register + * compile num_log.c with -O only on ia64 to work around compiler bug + + -- Camm Maguire Sun, 11 Aug 2002 08:53:03 -0400 + +gcl (2.5.0.cvs20020625-38) unstable; urgency=high + + * check for long c statck addresses, fixing NULL_OR_ON_C_STACK macro + for ia64 + * Remove error in clean target + + -- Camm Maguire Sat, 10 Aug 2002 13:20:08 -0400 + +gcl (2.5.0.cvs20020625-37) unstable; urgency=high + + * Replace tmpnam and mktemp with less dangerous mkstemp + + -- Camm Maguire Fri, 9 Aug 2002 19:45:52 -0400 + +gcl (2.5.0.cvs20020625-36) unstable; urgency=high + + * Fix rsym compilation when not using bfd + + -- Camm Maguire Fri, 9 Aug 2002 19:10:16 -0400 + +gcl (2.5.0.cvs20020625-35) unstable; urgency=high + + * Don't build bfd/po subdir + * Build-depend on automake and gettext + + -- Camm Maguire Fri, 9 Aug 2002 14:36:58 -0400 + +gcl (2.5.0.cvs20020625-34) unstable; urgency=high + + * fix zero length array support + * reverse configure order for bfd and libiberty + + -- Camm Maguire Fri, 9 Aug 2002 11:52:38 -0400 + +gcl (2.5.0.cvs20020625-33) unstable; urgency=high + + * chmod +x for subconfigures + * dlopen for appropriate arches in debian/rules + * add custreloc configure option + + -- Camm Maguire Fri, 9 Aug 2002 10:16:55 -0400 + +gcl (2.5.0.cvs20020625-32) unstable; urgency=high + + * Local bfd build option to prepare for arch-specific patches + * Try default gmp3 build on m68k + * Fix merge-pathnames + + -- Camm Maguire Fri, 9 Aug 2002 00:13:16 -0400 + +gcl (2.5.0.cvs20020625-31) unstable; urgency=high + + * #undef bool in object.h for some gcc-3.1 installations + * New number_tan implementation using real tan, so optimized compiled + code will find symbol in -lm + + -- Camm Maguire Tue, 6 Aug 2002 18:37:52 -0400 + +gcl (2.5.0.cvs20020625-30) unstable; urgency=high + + * fix bug in cmpif.lsp and recompile compiler + * \-O6 \-fomit\-frame\-pointer for Linux, speed gain of ~ 10% + * clean saved_gcl_pcl + + -- Camm Maguire Mon, 5 Aug 2002 16:34:33 -0400 + +gcl (2.5.0.cvs20020625-29) unstable; urgency=high + + * Back out of hppa assembler register flush for hppa, apparently issue + is cleared by long/object function declaration fix + * Remove ansi2knr.1 man page, Closes: #155067 + * hppa still has gc leak, possibly due to faulty setjmp. Try Lamont + Jones' latest assembler to flush regs + + -- Camm Maguire Fri, 2 Aug 2002 20:50:21 -0400 + +gcl (2.5.0.cvs20020625-28) unstable; urgency=high + + * SGC support for alpha + * generic gmp3 build for m68k + * compiler changes to declare all functions as returning object, with + functions that actually return long being cast appropriately + * back out of m68k hack in eval.c and funlink.c + + -- Camm Maguire Fri, 2 Aug 2002 18:22:04 -0400 + +gcl (2.5.0.cvs20020625-27) unstable; urgency=high + + * Use generic lshift.c in gmp3 for m68k + * use SGC for ia64 + * m68k workaround, cast (object(*)()) to (long(*)()) in funlink.c and + eval.c + * GBC register spiil asm for hppa + * fix hash_equal declaration error in hash.d + + -- Camm Maguire Thu, 1 Aug 2002 18:12:49 -0400 + +gcl (2.5.0.cvs20020625-26) unstable; urgency=high + + * Remove extra load of tkl.o in install target of main makefile + * gcc-3.1 for hppa + * Remove gcc version spec for m68k + * \-fPIC for hppa, needed for dlopen + * cleanup gcc 3.1 warning in funlink.c + * cc instead of ld for -shared linking in fasldlsym.c (needed for + hppa) + + -- Camm Maguire Wed, 31 Jul 2002 18:46:54 -0400 + +gcl (2.5.0.cvs20020625-25) unstable; urgency=high + + * Move chmod +x gmp3/* into debian/rules + * Remove gclm.bat from Debian package + * Build-Depend on autoconf, Closes: #154909 + + -- Camm Maguire Wed, 31 Jul 2002 09:44:20 -0400 + +gcl (2.5.0.cvs20020625-24) unstable; urgency=high + + * chmod +x gmp3/configure + + -- Camm Maguire Wed, 31 Jul 2002 07:55:17 -0400 + +gcl (2.5.0.cvs20020625-23) unstable; urgency=high + + * 64bit SGC support + * SGC on by default for sparc-linux and mips(el)-linux + * Optimized logxor funtion + * Check for MP_LIMB_SIZE in fasdump.c, for 64bit support + * gbc fix for ia64 + * gmp3 import for ia64 + * system bzero, bcmp, and bcopy function prototypes + + -- Camm Maguire Tue, 30 Jul 2002 23:11:58 -0400 + +gcl (2.5.0.cvs20020625-22) unstable; urgency=high + + * ElfW macros in rsym*.c for 64bit + * Allow for 8 byte gmp mp_limbs + + -- Camm Maguire Thu, 25 Jul 2002 18:52:37 -0400 + +gcl (2.5.0.cvs20020625-21) unstable; urgency=high + + * Support for dlopen object loading where bfd is not yet working -- + ./configure --enable-dlopen + + -- Camm Maguire Thu, 25 Jul 2002 15:08:05 -0400 + +gcl (2.5.0.cvs20020625-20) unstable; urgency=high + + * Cleanups for --disable-bfd option + + -- Camm Maguire Wed, 24 Jul 2002 15:05:28 -0400 + +gcl (2.5.0.cvs20020625-19) unstable; urgency=high + + * 64bit fixes + + -- Camm Maguire Wed, 24 Jul 2002 12:16:42 -0400 + +gcl (2.5.0.cvs20020625-18) unstable; urgency=high + + * misc. lintian cleanups, mostly for 64 bit + + -- Camm Maguire Tue, 23 Jul 2002 23:35:03 -0400 + +gcl (2.5.0.cvs20020625-17) unstable; urgency=high + + * Fixed typeo in error.c preventing arm compilation + + -- Camm Maguire Mon, 22 Jul 2002 17:18:18 -0400 + +gcl (2.5.0.cvs20020625-16) unstable; urgency=high + + * Fix bad on_stack_list_vector args + + -- Camm Maguire Mon, 22 Jul 2002 16:10:16 -0400 + +gcl (2.5.0.cvs20020625-15) unstable; urgency=high + + * More lint changes for sundry arches + * Fixed bug in Iapply_ap + + -- Camm Maguire Sat, 20 Jul 2002 23:40:33 -0400 + +gcl (2.5.0.cvs20020625-14) unstable; urgency=high + + * include stdarg.h when defining _GNU_SOURCE + + -- Camm Maguire Sat, 20 Jul 2002 18:47:43 -0400 + +gcl (2.5.0.cvs20020625-13) unstable; urgency=high + + * Proper va_dcl declarations + + -- Camm Maguire Sat, 20 Jul 2002 10:40:02 -0400 + +gcl (2.5.0.cvs20020625-12) unstable; urgency=high + + * cvs updates for missing ptrdiff_t + + -- Camm Maguire Sat, 20 Jul 2002 08:41:37 -0400 + +gcl (2.5.0.cvs20020625-11) unstable; urgency=high + + * cvs changes to compile cleanly with -Wall + + -- Camm Maguire Sat, 20 Jul 2002 02:59:33 -0400 + +gcl (2.5.0.cvs20020625-10) unstable; urgency=high + + * Architecture any, though still have some issues + + -- Camm Maguire Fri, 12 Jul 2002 19:02:09 -0400 + +gcl (2.5.0.cvs20020625-9) unstable; urgency=high + + * cvs commits for 64bit support + + -- Camm Maguire Fri, 12 Jul 2002 18:01:21 -0400 + +gcl (2.5.0.cvs20020625-8) unstable; urgency=high + + * NULL_OR_ON_C_STACK macro correction for m68k + + -- Camm Maguire Fri, 12 Jul 2002 14:37:48 -0400 + +gcl (2.5.0.cvs20020625-7) unstable; urgency=high + + * arm is bigendian + + -- Camm Maguire Wed, 10 Jul 2002 18:04:22 -0400 + +gcl (2.5.0.cvs20020625-6) unstable; urgency=high + + * cvs updates for arm build + + -- Camm Maguire Tue, 9 Jul 2002 16:09:26 -0400 + +gcl (2.5.0.cvs20020625-5) unstable; urgency=high + + * CC environment variable setting in debian/rules to aid in porting + * gcc 2.95 for m68k + + -- Camm Maguire Sat, 6 Jul 2002 23:00:23 -0400 + +gcl (2.5.0.cvs20020625-4) unstable; urgency=high + + * gcc 3.0 for arm + * cachectl header for m68k + + -- Camm Maguire Mon, 1 Jul 2002 15:47:53 -0400 + +gcl (2.5.0.cvs20020625-3) unstable; urgency=high + + * Better libbfd detection for arm/alpha + + -- Camm Maguire Wed, 26 Jun 2002 17:27:21 -0400 + +gcl (2.5.0.cvs20020625-2) unstable; urgency=high + + * s390 support + + -- Camm Maguire Tue, 25 Jun 2002 21:25:35 -0400 + +gcl (2.5.0.cvs20020625-1) unstable; urgency=high + + * CVS updates, new s390 arch + + -- Camm Maguire Tue, 25 Jun 2002 19:26:36 -0400 + +gcl (2.5.0.cvs20020610-2) unstable; urgency=high + + * cvs updates + + -- Camm Maguire Thu, 13 Jun 2002 08:42:32 -0400 + +gcl (2.5.0.cvs20020610-1) unstable; urgency=high + + * cvs updates + + -- Camm Maguire Wed, 12 Jun 2002 23:04:57 -0400 + +gcl (2.5.0.cvs20020523-2) unstable; urgency=high + + * configure updates for better tk detection + + -- Camm Maguire Fri, 24 May 2002 18:50:22 -0400 + +gcl (2.5.0.cvs20020523-1) unstable; urgency=high + + * New upstream release + + -- Camm Maguire Fri, 24 May 2002 18:50:22 -0400 + +gcl (2.5.0.cvs20020429-1) unstable; urgency=high + + * Build-Depend on tk8.2-dev, Closes: #144330 + * New cvs updates + * Added sparc to arch list, Closes: #143465 + + -- Camm Maguire Mon, 29 Apr 2002 23:07:36 -0400 + +gcl (2.5.0.cvs20020219-2) unstable; urgency=medium + + * flavor ->debian-emacs-flavor in emacsen-startup + + -- Camm Maguire Mon, 4 Mar 2002 14:29:59 -0500 + +gcl (2.5.0.cvs20020219-1) unstable; urgency=medium + + * Updated package descriptions, Closes: #134402 + * Static linking of libbfd, Closes: #134647 + * Gcl currently only available on i386, arm and m68k as specified in + the Architecture control field, Closes: #133912 + + -- Camm Maguire Tue, 19 Feb 2002 12:04:29 -0500 + +gcl (2.5.0.cvs-3) unstable; urgency=medium + + * Build-depend on texi2html, Closes: #133699 + + -- Camm Maguire Wed, 13 Feb 2002 16:22:35 -0500 + +gcl (2.5.0.cvs-2) unstable; urgency=medium + + * Put in versioned dependency on binutils for libbfd support, rebuilt + with latest binutils, Closes: #133004 + + -- Camm Maguire Tue, 12 Feb 2002 13:19:12 -0500 + +gcl (2.5.0.cvs-1) unstable; urgency=medium + + * Latest patches from CVS, enabling libbfd relocations, among other + things + * /etc/emacs/site-start.d/50gcl.el as conffile, Closes: #132137 + * limited arm and m68k support + + -- Camm Maguire Mon, 4 Feb 2002 09:32:29 -0500 + +gcl (2.5.0-1) unstable; urgency=medium + + * New maintainer + * New upstream release + * New release so far builds only on i386, Closes: #116070, Closes: + #123371 + * New release so far builds only on i386, Closes: #115041 + * Gcl must currently use its own copy of gmp, as the upstream version + of gmp uses malloc, which interferes with gcl's garbage collection + and relocation scheme. The change from malloc to alloca has been + suggested to upstream gmp developers. Closes: #108910 + * Tcl/Tk support now in. Closes: #113197 + + -- Camm Maguire Fri, 21 Dec 2001 00:03:43 -0500 + +gcl (2.4.0-3) unstable; urgency=medium + + * Make gcl use libgmp3 package. (closes: #108910) + * Remove tk support. (closes: #108909) + * Fix stupid missing dependency line. (closes: #108907, #108908) + * Removed readme.mingw from the debian package, this package is not compiled under + mingw (windows gcc port). + * Close ITA bug. (closes: #112312) + + -- Baruch Even Sat, 22 Sep 2001 00:27:14 +0300 + +gcl (2.4.0-2) unstable; urgency=low + + * Change tclsh Build-Depends to tcl8.0 because apt is broken. (closes: #99261) + + -- JP Sugarbroad Wed, 30 May 2001 14:34:53 -0500 + +gcl (2.4.0-1) unstable; urgency=low + + * New upstream release + + -- JP Sugarbroad Sun, 13 May 2001 20:31:01 -0500 + +gcl (2.3.7+beta3-3) unstable; urgency=low + + * Move gcl-doc to section doc (closes: #78666) + + -- JP Sugarbroad Sun, 13 May 2001 20:26:28 -0500 + +gcl (2.3.7+beta3-2) unstable; urgency=low + + * Remove alpha from arch list + * Move tcl/tk from Depends to Suggests + + -- JP Sugarbroad Fri, 4 May 2001 16:24:11 -0500 + +gcl (2.3.7+beta3-1) unstable; urgency=low + + * New maintainer + * Repackaged with debhelper (closes: #42045, #86097, #91475, #91478) + * New upstream release (closes: #59577, #71096) + * Added sparc+alpha, removed m68k (closes: #87407) + + -- JP Sugarbroad Mon, 30 Apr 2001 19:07:49 -0500 + +gcl (2.2.1-6) unstable; urgency=low + + * Disable stripping of "saved_gcl" binary. (#45778) + + -- Steve Dunham Fri, 24 Sep 1999 14:39:15 -0400 + +gcl (2.2.1-5) unstable; urgency=low + + * Fix m68k build + + -- Steve Dunham Tue, 6 Jul 1999 09:45:09 -0400 + +gcl (2.2.1-4) unstable; urgency=low + + * Fix bug #31718 + + -- Steve Dunham Fri, 2 Jul 1999 11:11:12 -0400 + +gcl (2.2.1-3) unstable; urgency=low + + * Add m68k patches + + -- Steve Dunham Wed, 16 Dec 1998 14:25:46 -0500 + +gcl (2.2.1-2) unstable; urgency=low + + * Compile against libc6. New maintainer. + + -- Steve Dunham Wed, 5 Nov 1997 10:09:12 -0500 + +gcl (2.2.1-1) unstable; urgency=low + + * New upstream release; suggests tcl76, tk42. + * gcl-doc contains gcl-si and gcl-tk info pages. + * debian/rules: clean target removes temporary files from h and o + subdirectories (bug #5984). + + -- Karl Sackett Fri, 3 Jan 1997 10:16:40 -0600 + +gcl (2.2-5) unstable; urgency=low + + * Converted package to 2.1.1.0 standard. + * Stripped gcltkaux (bug #5074). + * gcl-si and gcl-tk info pages converted to HTML. + + -- Karl Sackett Tue, 5 Nov 1996 13:30:30 -0600 + +2.2-4 + * add-defs: patched locates for tk.tcl, init.tcl + * gcl-tk/tkAppInit.c: patched for tk4.1 support + * gcl-tk/tkMain.c: patched for tk4.1 support +2.2-3 + * Debian support files now partily architecture independent. + There are, however, no add-defs files except for 386-linux. + * Rebuilt package to correct corrupted upload problem. +2.2-2 + * Removed tk support from distribution. This was written to + use tk-3.6 and doesn't support tk-4.0 or tk-4.1. I am not aware + of any plans to upgrade the code. (Closes bug #2865) +2.2-1 + * Added Debian support files + * h/386-linux.defs: set OFLAG = -O2 + * h/386-linux.h: undid patch that swaped signal.h for sigcontext.h diff --cc debian/compat index 7ed6ff82,00000000..b1bd38b6 mode 100644,000000..100644 --- a/debian/compat +++ b/debian/compat @@@ -1,1 -1,0 +1,1 @@@ - 5 ++13 diff --cc debian/control index 7cf8eb64,00000000..e70945c4 mode 100644,000000..100644 --- a/debian/control +++ b/debian/control @@@ -1,39 -1,0 +1,39 @@@ +Source: gcl +Section: lisp +Priority: optional +Maintainer: Camm Maguire +Homepage: http://gnu.org/software/gcl - Build-Depends: debhelper (>= 5 ), libreadline-dev, m4, tk8.6-dev, libgmp-dev, autotools-dev, libxmu-dev, libxaw7-dev, po-debconf, zlib1g-dev - Standards-Version: 3.9.5 ++Build-Depends: debhelper (>= 13), libreadline-dev, m4, tk8.6-dev, libgmp-dev, libxmu-dev, libxaw7-dev, po-debconf, zlib1g-dev, tcl ++Standards-Version: 4.4.1 + +Package: gcl +Architecture: any +Depends: ${shlibs:Depends}, ${misc:Depends}, ${gcc}, debconf (>= 1.2.0), emacs24 | emacsen, ucf +Breaks: emacsen-common (<< 2.0.0) +Suggests: gcl-doc +Description: GNU Common Lisp compiler + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains the Lisp system itself. Documentation + is provided in the gcl-doc package. + +Package: gcl-doc +Section: doc +Architecture: all +Conflicts: gclinfo +Replaces: gclinfo +Depends: dpkg (>= 1.15.4) | install-info, ${misc:Depends} +Description: Documentation for GNU Common Lisp + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains Documentation in info format of both the + system internals, as well as the graphical interface currently + implemented in Tcl/Tk. diff --cc debian/control. index 7cf8eb64,00000000..e70945c4 mode 100644,000000..100644 --- a/debian/control. +++ b/debian/control. @@@ -1,39 -1,0 +1,39 @@@ +Source: gcl +Section: lisp +Priority: optional +Maintainer: Camm Maguire +Homepage: http://gnu.org/software/gcl - Build-Depends: debhelper (>= 5 ), libreadline-dev, m4, tk8.6-dev, libgmp-dev, autotools-dev, libxmu-dev, libxaw7-dev, po-debconf, zlib1g-dev - Standards-Version: 3.9.5 ++Build-Depends: debhelper (>= 13), libreadline-dev, m4, tk8.6-dev, libgmp-dev, libxmu-dev, libxaw7-dev, po-debconf, zlib1g-dev, tcl ++Standards-Version: 4.4.1 + +Package: gcl +Architecture: any +Depends: ${shlibs:Depends}, ${misc:Depends}, ${gcc}, debconf (>= 1.2.0), emacs24 | emacsen, ucf +Breaks: emacsen-common (<< 2.0.0) +Suggests: gcl-doc +Description: GNU Common Lisp compiler + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains the Lisp system itself. Documentation + is provided in the gcl-doc package. + +Package: gcl-doc +Section: doc +Architecture: all +Conflicts: gclinfo +Replaces: gclinfo +Depends: dpkg (>= 1.15.4) | install-info, ${misc:Depends} +Description: Documentation for GNU Common Lisp + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains Documentation in info format of both the + system internals, as well as the graphical interface currently + implemented in Tcl/Tk. diff --cc debian/control.cvs index 9b44298a,00000000..49527ff1 mode 100644,000000..100644 --- a/debian/control.cvs +++ b/debian/control.cvs @@@ -1,39 -1,0 +1,39 @@@ +Source: gclcvs +Section: lisp +Priority: optional +Maintainer: Camm Maguire +Homepage: http://gnu.org/software/gcl - Build-Depends: debhelper (>= 5 ), libreadline-dev, m4, tk8.6-dev, libgmp-dev, autotools-dev, libxmu-dev, libxaw7-dev, po-debconf, zlib1g-dev - Standards-Version: 3.9.5 ++Build-Depends: debhelper (>= 13), libreadline-dev, m4, tk8.6-dev, libgmp-dev, libxmu-dev, libxaw7-dev, po-debconf, zlib1g-dev, tcl ++Standards-Version: 4.4.1 + +Package: gclcvs +Architecture: any +Depends: ${shlibs:Depends}, ${misc:Depends}, ${gcc}, debconf (>= 1.2.0), emacs24 | emacsen, ucf +Breaks: emacsen-common (<< 2.0.0) +Suggests: gclcvs-doc +Description: GNU Common Lisp compiler, CVS snapshot + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains the Lisp system itself. Documentation + is provided in the gclcvs-doc package. + +Package: gclcvs-doc +Section: doc +Architecture: all +Conflicts: gclinfo +Replaces: gclinfo +Depends: dpkg (>= 1.15.4) | install-info, ${misc:Depends} +Description: Documentation for GNU Common Lisp, CVS snapshot + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains Documentation in info format of both the + system internals, as well as the graphical interface currently + implemented in Tcl/Tk. diff --cc debian/gcl.lintian-overrides index df94ce97,00000000..35cdb234 mode 100644,000000..100644 --- a/debian/gcl.lintian-overrides +++ b/debian/gcl.lintian-overrides @@@ -1,2 -1,0 +1,9 @@@ - 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 diff --cc debian/in.gcl.postrm index a36b2407,00000000..5360f7dc mode 100644,000000..100644 --- a/debian/in.gcl.postrm +++ b/debian/in.gcl.postrm @@@ -1,18 -1,0 +1,22 @@@ ++#!/bin/sh ++ ++set -e ++ +case "$1" in + purge) + for ext in '~' '%' .bak .ucf-new .ucf-old .ucf-dist; do + rm -f /etc/default/gcl@EXT@$ext + done + + rm -f /etc/default/gcl@EXT@ + + if which ucf >/dev/null; then + ucf --purge /etc/default/gcl@EXT@ + fi + if which ucfr >/dev/null; then + ucfr --purge gcl@EXT@ /etc/default/gcl@EXT@ + fi + ;; +esac + +#DEBHELPER# diff --cc debian/patches/Version_2_6_13pre1 index 00000000,00000000..2599262b new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre1 @@@ -1,0 -1,0 +1,13167 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-2) unstable; urgency=medium ++ . ++ * Version_2_6_13pre1 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/clcs/package.lisp +++++ gcl-2.6.12/clcs/package.lisp ++@@ -20,3 +20,4 @@ ++ (defvar *this-package* (find-package :conditions)) ++ ++ +++(import 'si::(clines defentry defcfun object void int double)) ++--- gcl-2.6.12.orig/clcs/sys-proclaim.lisp +++++ gcl-2.6.12/clcs/sys-proclaim.lisp ++@@ -1,45 +1,46 @@ ++ ++-(IN-PACKAGE "CONDITIONS") ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T) T) CONDITION-CLASS-P IS-WARNING CONDITIONP ++- IS-CONDITION ESCAPE-SPECIAL-CASES-REPLACE ++- SIMPLE-CONDITION-CLASS-P INTERNAL-SIMPLE-CONDITION-CLASS-P)) ++-(PROCLAIM '(FTYPE (FUNCTION (*) *) CLCS-COMPILE)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T) T) ASSERT-REPORT SYMCAT COERCE-TO-FN ++- SLOT-SYM)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T *) *) CLCS-LOAD CLCS-OPEN CLCS-COMPILE-FILE ++- MAKE-CONDITION)) ++-(PROCLAIM '(FTYPE (FUNCTION (T) (*)) SIMPLE-ASSERTION-FAILURE)) ++-(PROCLAIM '(FTYPE (FUNCTION (T T T) T) ACCUMULATE-CASES)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T) T) ++- |(PCL::FAST-METHOD PRINT-OBJECT (CONDITION T))|)) ++-(PROCLAIM '(FTYPE (FUNCTION (T T) *) ASSERT-PROMPT)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T) *) ++- |(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-WARNING T))| ++- |(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-SLOT T))| ++- |(PCL::FAST-METHOD PRINT-OBJECT (END-OF-FILE T))| ++- |(PCL::FAST-METHOD PRINT-OBJECT (FILE-ERROR T))| ++- |(PCL::FAST-METHOD PRINT-OBJECT (ARITHMETIC-ERROR T))| ++- |(PCL::FAST-METHOD PRINT-OBJECT (SIMPLE-CONDITION T))| ++- |(PCL::FAST-METHOD PRINT-OBJECT (ABORT-FAILURE T))| ++- |(PCL::FAST-METHOD PRINT-OBJECT (CASE-FAILURE T))| ++- |(PCL::FAST-METHOD PRINT-OBJECT (UNDEFINED-FUNCTION T))| ++- |(PCL::FAST-METHOD PRINT-OBJECT (PRINT-NOT-READABLE T))| ++- |(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-ERROR T))| ++- |(PCL::FAST-METHOD PRINT-OBJECT (PACKAGE-ERROR T))| ++- |(PCL::FAST-METHOD PRINT-OBJECT (CELL-ERROR T))| ++- |(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-CONDITION T))| ++- |(PCL::FAST-METHOD PRINT-OBJECT (STREAM-ERROR T))| ++- COERCE-TO-CONDITION ++- |(PCL::FAST-METHOD PRINT-OBJECT (TYPE-ERROR T))| ++- |(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-VARIABLE T))|)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION NIL T) REVERT-CLCS-SYMBOLS INSTALL-CLCS-SYMBOLS ++- READ-EVALUATED-FORM)) ++-(MAPC (LAMBDA (COMPILER::X) ++- (SETF (GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE) T)) ++- '(INSTALL-SYMBOL REVERT-SYMBOL)) ++\ No newline at end of file +++(COMMON-LISP::IN-PACKAGE "CONDITIONS") +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +++ CONDITIONS::IS-WARNING CONDITIONS::DEFAULT-REPORT +++ CONDITIONS::IS-CONDITION CONDITIONS::CONDITIONP)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) +++ COMMON-LISP::*) +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ARITHMETIC-ERROR T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PACKAGE-ERROR T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-CONDITION T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNDEFINED-FUNCTION T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-SLOT T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-VARIABLE T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CASE-FAILURE T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PRINT-NOT-READABLE T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (SIMPLE-CONDITION T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ABORT-FAILURE T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (TYPE-ERROR T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CELL-ERROR T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (FILE-ERROR T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (END-OF-FILE T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (STREAM-ERROR T))|)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) +++ COMMON-LISP::T) +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CONDITION T))| +++ CONDITIONS::|(PCL::FAST-METHOD MAKE-LOAD-FORM (CONDITION))|)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ CONDITIONS::COERCE-TO-FN CONDITIONS::SLOT-SYM)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ COMMON-LISP::MAKE-CONDITION)) ++\ No newline at end of file ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpbind.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpbind.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (si:putprop 'bds-bind 'set-bds-bind 'set-loc) ++ ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpblock.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpblock.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (si:putprop 'block 'c1block 'c1special) ++ (si:putprop 'block 'c2block 'c2) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpcall.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpcall.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (defvar *ifuncall* nil) ++ ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpcatch.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpcatch.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (si:putprop 'catch 'c1catch 'c1special) ++ (si:putprop 'catch 'c2catch 'c2) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpenv.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpenv.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (defvar *safe-compile* nil) ++ (defvar *compiler-check-args* nil) ++@@ -337,7 +337,7 @@ ++ readtable sequence short-float simple-array simple-bit-vector ++ simple-string simple-vector single-float standard-char stream string ++ dynamic-extent :dynamic-extent ++- string-char symbol t vector signed-byte unsigned-byte) +++ symbol t vector signed-byte unsigned-byte) ++ (proclaim-var (car decl) (cdr decl))) ++ (otherwise ++ (unless (member (car decl) *alien-declarations*) ++@@ -366,6 +366,12 @@ ++ (t ++ (warn "The variable name ~s is not a symbol." var))))) ++ +++(defun mexpand-deftype (tp &aux (l (listp tp))(i (when l (cdr tp)))(tp (if l (car tp) tp))) +++ (when (symbolp tp) +++ (let ((fn (get tp 'si::deftype-definition))) +++ (when fn +++ (apply fn i))))) +++ ++ (defun c1body (body doc-p &aux (ss nil) (is nil) (ts nil) (others nil) ++ doc form) ++ (loop ++@@ -383,10 +389,8 @@ ++ ;;; 20040320 CM ++ (cmpck (not (consp decl)) ++ "The declaration ~s is illegal." decl) ++- (let* ((dtype (car decl))) ++-;; Can process user deftypes here in the future -- 20040318 CM ++-;; (dft (and (symbolp dtype) (get dtype 'si::deftype-definition))) ++-;; (dtype (or (and dft (funcall dft)) dtype))) +++ (let* ((dtype (car decl)) +++ (dtype (or (mexpand-deftype dtype) dtype))) ++ (if (consp dtype) ++ (let ((stype (car dtype))) ++ (cmpck (or (not (symbolp stype)) (cdddr dtype)) "The declaration ~s is illegal." decl) ++@@ -449,7 +453,7 @@ ++ integer keyword list long-float nil null number package pathname ++ random-state ratio rational readtable sequence simple-array ++ simple-bit-vector simple-string simple-base-string simple-vector single-float ++- standard-char stream string string-char symbol t vector +++ standard-char stream string symbol t vector ++ signed-byte unsigned-byte) ++ (let ((type (type-filter stype))) ++ (when type ++@@ -667,7 +671,7 @@ ++ readtable sequence short-float simple-array simple-bit-vector ++ simple-string simple-vector single-float standard-char stream string ++ dynamic-extent :dynamic-extent ++- string-char symbol t vector signed-byte unsigned-byte) +++ symbol t vector signed-byte unsigned-byte) ++ (let ((type (type-filter (car decl)))) ++ (dolist** (var (cdr decl) t) ++ (if (symbolp var) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpeval.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpeval.lsp ++@@ -23,9 +23,9 @@ ++ ++ (export '(si::define-compiler-macro ++ si::undef-compiler-macro ++- si::define-inline-function) 'system) +++ si::define-inline-function) :system) ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (si:putprop 'progn 'c1progn 'c1special) ++ (si:putprop 'progn 'c2progn 'c2) ++@@ -180,9 +180,8 @@ ++ ++ ++ (defun result-type-from-args(f args &aux tem) ++- (when (and (setq tem (get f 'return-type)) ++- (not (eq tem '*)) ++- (not (consp tem))) +++ (when (if (setq tem (get f 'return-type)) +++ (and (not (eq tem '*)) (not (consp tem))) t) ++ (dolist (v '(inline-always inline-unsafe)) ++ (dolist (w (get f v)) ++ (fix-opt w) ++@@ -486,19 +485,22 @@ ++ ++ (defun c1structure-ref1 (form name index &aux (info (make-info))) ++ ;;; Explicitly called from c1expr and c1structure-ref. ++- (declare (special *aet-types*)) ++ (cond (*safe-compile* (c1expr `(si::structure-ref ,form ',name ,index))) ++- (t ++- (let* ((sd (get name 'si::s-data)) ++- (aet-type (aref (si::s-data-raw sd) index)) ++- ) ++- (setf (info-type info) (type-filter (aref *aet-types* aet-type))) ++- (list 'structure-ref info ++- (c1expr* form info) ++- (add-symbol name) ++- index sd) ++- ++- )))) +++ ((let* ((sd (get name 'si::s-data)) +++ (aet-type (aref (si::s-data-raw sd) index)) +++ (sym (find-symbol (si::string-concatenate +++ (or (si::s-data-conc-name sd) "") +++ (car (nth index (si::s-data-slot-descriptions sd)))))) +++ (tp (if sym (get-return-type sym) '*)) +++ (tp (type-filter (type-and tp (aref *aet-types* aet-type))))) +++ +++ (setf (info-type info) (if (and (eq name 'si::s-data) (= index 2));;FIXME -- this belongs somewhere else. CM 20050106 +++ '(vector unsigned-char) +++ tp)) +++ (list 'structure-ref info +++ (c1expr* form info) +++ (add-symbol name) +++ index sd))))) ++ ++ (defun coerce-loc-structure-ref (arg type-wanted &aux (form (cdr arg))) ++ (let* ((sd (fourth form)) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpflet.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpflet.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (si:putprop 'flet 'c1flet 'c1special) ++ (si:putprop 'flet 'c2flet 'c2) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpfun.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpfun.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (si:putprop 'princ 'c1princ 'c1) ++ (si:putprop 'princ 'c2princ 'c2) ++@@ -565,7 +565,7 @@ ++ (equal (third type) '(*))))) ++ (setq tem (si::best-array-element-type ++ (second type))) ++- (cond ((eq tem 'string-char) `(stringp ,x)) +++ (cond ((eq tem 'character) `(stringp ,x)) ++ ((eq tem 'bit) `(bit-vector-p ,x)) ++ ((setq tem (position tem *aet-types*)) ++ `(the boolean (vector-type ,x ,tem))))) ++@@ -803,7 +803,7 @@ ++ ++ ++ (defvar *aet-types* ++- #(T STRING-CHAR SIGNED-CHAR FIXNUM SHORT-FLOAT LONG-FLOAT +++ #(T CHARACTER SIGNED-CHAR FIXNUM SHORT-FLOAT LONG-FLOAT ++ SIGNED-CHAR ++ UNSIGNED-CHAR SIGNED-SHORT UNSIGNED-SHORT)) ++ ++@@ -811,7 +811,7 @@ ++ (defun aet-c-type (type) ++ (ecase type ++ ((t) "object") ++- ((string-char signed-char) "char") +++ ((character signed-char) "char") ++ (fixnum "fixnum") ++ (unsigned-char "unsigned char") ++ (unsigned-short "unsigned short") ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpif.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpif.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (si:putprop 'if 'c1if 'c1special) ++ (si:putprop 'if 'c2if 'c2) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpinline.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpinline.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ ;;; Pass 1 generates the internal form ++ ;;; ( id info-object . rest ) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmplabel.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmplabel.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (defvar *last-label* 0) ++ (defvar *exit*) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmplam.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmplam.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ ;;; During Pass1, a lambda-list ++ ;;; ++--- gcl-2.6.12.orig/cmpnew/gcl_cmplet.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmplet.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ (eval-when (compile) ++ (or (fboundp 'write-block-open) (load "cmplet.lsp"))) ++ ++--- gcl-2.6.12.orig/cmpnew/gcl_cmploc.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmploc.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (defvar *value-to-go*) ++ ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp ++@@ -24,7 +24,7 @@ ++ ;;; ***************** ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ ++ (export '(*compile-print* *compile-verbose*)) ++@@ -49,7 +49,11 @@ ++ (defvar *cmpinclude* "\"cmpinclude.h\"") ++ ;;If the following is a string, then it is inserted instead of ++ ;; the include file cmpinclude.h, EXCEPT for system-p calls. ++-(defvar *cmpinclude-string* t) +++(defvar *cmpinclude-string* +++ (si::file-to-string +++ (namestring +++ (make-pathname :directory (append (pathname-directory si::*system-directory*) (list :parent "h")) +++ :name "cmpinclude" :type "h")))) ++ ++ ++ ;; Let the user write dump c-file etc to /dev/null. ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpmap.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpmap.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (si:putprop 'mapcar 'c1mapcar 'c1) ++ (si:putprop 'maplist 'c1maplist 'c1) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpmulti.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpmulti.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (si:putprop 'multiple-value-call 'c1multiple-value-call 'c1special) ++ (si:putprop 'multiple-value-call 'c2multiple-value-call 'c2) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpopt.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpopt.lsp ++@@ -1,4 +1,4 @@ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ ;; The optimizers have been redone to allow more flags ++ ;; The old style optimizations correspond to the first 2 ++@@ -136,8 +136,11 @@ ++ (get 'system:aset 'inline-unsafe)) ++ (push '(((array t) fixnum t) t #.(flags set)"(#0)->v.v_self[#1]= (#2)") ++ (get 'system:aset 'inline-unsafe)) ++-(push '(((array string-char) fixnum character) character #.(flags rfa set)"(#0)->ust.ust_self[#1]= (#2)") +++(push '(((array character) fixnum character) character #.(flags rfa set)"(#0)->ust.ust_self[#1]= (#2)") ++ (get 'system:aset 'inline-unsafe)) +++(push '(((array bit) fixnum fixnum) fixnum #.(flags rfa) +++ "({object _o=(#0);fixnum _i=(#1)+_o->bv.bv_offset;char _c=1<bv.bv_self+(_i>>3);bool _b=(#2);if (_b) *_d|=_c; else *_d&=~_c;_b;})") +++ (get 'si::aset 'inline-unsafe)) ++ (push '(((array fixnum) fixnum fixnum) fixnum #.(flags set rfa)"(#0)->fixa.fixa_self[#1]= (#2)") ++ (get 'system:aset 'inline-unsafe)) ++ (push '(((array signed-short) fixnum fixnum) fixnum #.(flags rfa set)"((short *)(#0)->ust.ust_self)[#1]=(#2)") ++@@ -159,7 +162,7 @@ ++ (push '(((array t) fixnum fixnum t) t #.(flags set) ++ "@0;(#0)->a.a_self[(#1)*(#0)->a.a_dims[1]+#2]= (#3)") ++ (get 'system:aset 'inline-unsafe)) ++-(push '(((array string-char) fixnum fixnum character) character +++(push '(((array character) fixnum fixnum character) character ++ #.(flags rfa set) ++ "@0;(#0)->ust.ust_self[(#1)*(#0)->a.a_dims[1]+#2]= (#3)") ++ (get 'system:aset 'inline-unsafe)) ++@@ -433,7 +436,9 @@ ++ (get 'aref 'inline-unsafe)) ++ (push '(((array t) fixnum) t #.(flags)"(#0)->v.v_self[#1]") ++ (get 'aref 'inline-unsafe)) ++-(push '(((array string-char) fixnum) character #.(flags rfa)"(#0)->ust.ust_self[#1]") +++(push '(((array character) fixnum) character #.(flags rfa)"(#0)->ust.ust_self[#1]") +++ (get 'aref 'inline-unsafe)) +++(push '(((array bit) fixnum) fixnum #.(flags rfa)"({object _o=(#0);fixnum _i=(#1)+(_o)->bv.bv_offset;(_o->bv.bv_self[_i>>3]>>BIT_ENDIAN(_i&0x7))&0x1;})") ++ (get 'aref 'inline-unsafe)) ++ (push '(((array fixnum) fixnum) fixnum #.(flags rfa)"(#0)->fixa.fixa_self[#1]") ++ (get 'aref 'inline-unsafe)) ++@@ -456,7 +461,7 @@ ++ (push '(((array t) fixnum fixnum) t #.(flags ) ++ "@0;(#0)->a.a_self[(#1)*(#0)->a.a_dims[1]+#2]") ++ (get 'aref 'inline-unsafe)) ++-(push '(((array string-char) fixnum fixnum) character #.(flags rfa) +++(push '(((array character) fixnum fixnum) character #.(flags rfa) ++ "@0;(#0)->ust.ust_self[(#1)*(#0)->a.a_dims[1]+#2]") ++ (get 'aref 'inline-unsafe)) ++ (push '(((array fixnum) fixnum fixnum) fixnum #.(flags rfa) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpspecial.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpspecial.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (si:putprop 'quote 'c1quote 'c1special) ++ (si:putprop 'function 'c1function 'c1special) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmptag.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmptag.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ (import 'si::switch) ++ (import 'si::switch-finish) ++ ++--- gcl-2.6.12.orig/cmpnew/gcl_cmptest.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmptest.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (defun self-compile () ++ (with-open-file (log "lsplog" :direction :output) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmptop.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmptop.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (defvar *objects* (make-hash-table :test 'eq)) ++ ;(defvar *objects* nil) ++@@ -572,7 +572,7 @@ ++ (defun make-inline-string (cfun args fname) ++ (if (null args) ++ (format nil "~d()" (c-function-name "LI" cfun fname)) ++- (let ((o (make-array 100 :element-type 'string-char :fill-pointer 0 +++ (let ((o (make-array 100 :element-type 'character :fill-pointer 0 ++ :adjustable t ))) ++ (format o "~d(" (c-function-name "LI" cfun fname)) ++ (do ((l args (cdr l)) ++@@ -696,7 +696,7 @@ ++ ))) ++ ++ (defun si::add-debug (fname x) ++- (si::putprop fname x 'si::debug)) +++ (si::putprop fname x 'si::debugger)) ++ ++ (defun t3init-fun (fname cfun lambda-expr doc) ++ ++@@ -1237,10 +1237,10 @@ ++ (si::fixnump (cdr (var-ref va)))) ++ (setf (nth (cdr (var-ref va)) locals) ++ (var-name va)))) ++- (setf (get fname 'si::debug) locals) ++- (let ((locals (get fname 'si::debug))) +++ (setf (get fname 'si::debugger) locals) +++ (let ((locals (get fname 'si::debugger))) ++ (if (and locals (or (cdr locals) (not (null (car locals))))) ++- (add-init `(si::debug ',fname ',locals) ) +++ (add-init `(debug ',fname ',locals) ) ++ )) ++ )))) ++ ++@@ -1406,7 +1406,7 @@ ++ ((and (consp form) ++ (symbolp (car form)) ++ (or (eq (car form) 'setq) ++- (not (special-form-p (car form)))) +++ (not (special-operator-p (car form)))) ++ (do ((v (cdr form) (and (consp v) (cdr v))) ++ (i 1 (the fixnum (+ 1 i)))) ++ ((or (>= i 1000) ++@@ -1457,7 +1457,7 @@ ++ (setf (get 'si::define-structure 't1) 't1define-structure) ++ ++ (defun t1define-structure (args) ++- (maybe-eval t `(si::define-structure ,@args ,(not (maybe-eval nil nil)))) +++ (maybe-eval t `(si::define-structure ,@(copy-tree args) ,(not (maybe-eval nil nil))));FIXME ++ (t1ordinary (cons 'si::define-structure args))) ++ ++ ++@@ -1484,7 +1484,7 @@ ++ (cond ((stringp s) (push s body)) ++ ((consp s) ++ (cond ((symbolp (car s)) ++- (cmpck (special-form-p (car s)) +++ (cmpck (special-operator-p (car s)) ++ "Special form ~s is not allowed in defCfun." (car s)) ++ (push (list (cons (car s) (parse-cvspecs (cdr s)))) body)) ++ ((and (consp (car s)) (symbolp (caar s)) ++@@ -1493,7 +1493,7 @@ ++ (not (endp (cddar s))) ++ (endp (cdr s)) ++ (not (endp (cddr s)))) ++- (special-form-p (caar s))))) +++ (special-operator-p (caar s))))) ++ (push (cons (cons (caar s) ++ (if (eq (caar s) 'quote) ++ (list (add-object (cadar s))) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmptype.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmptype.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ ;;; CL-TYPE is any valid type specification of Common Lisp. ++ ;;; ++@@ -51,7 +51,7 @@ ++ (let ((type (type-of thing))) ++ (case type ++ ((fixnum short-float long-float) type) ++- ((string-char standard-char character) 'character) +++ ((standard-char character) 'character) ++ ((string bit-vector) type) ++ (vector (list 'vector (array-element-type thing))) ++ (array (list 'array (array-element-type thing))) ++@@ -82,7 +82,7 @@ ++ (and (consp (caddr type)) ++ (= (length (caddr type)) 1)))) ++ (case element-type ++- (string-char 'string) +++ (character 'string) ++ (bit 'bit-vector) ++ (t (list 'vector element-type)))) ++ (t (list 'array element-type)))) ++@@ -109,8 +109,8 @@ ++ ((subtypep type '(vector long-float)) ++ '(vector long-float)) ++ ((subtypep type '(array t)) '(array t)) ++- ((subtypep type '(array string-char)) ++- '(array string-char)) +++ ((subtypep type '(array character)) +++ '(array character)) ++ ((subtypep type '(array bit)) '(array bit)) ++ ((subtypep type '(array fixnum)) '(array fixnum)) ++ ((subtypep type '(array short-float)) ++@@ -142,11 +142,13 @@ ++ ((eq type1 t) type2) ++ ((eq type2 'object) type1) ++ ((eq type2 t) type1) ++- ((consp type1) +++ ((subtypep type2 type1) type2) +++ ((subtypep type1 type2) type1) +++ ((consp type1) ++ (case (car type1) ++ (array ++ (case (cadr type1) ++- (string-char (if (eq type2 'string) type2 nil)) +++ (character (if (eq type2 'string) type2 nil)) ++ (bit (if (eq type2 'bit-vector) type2 nil)) ++ (t (if (and (consp type2) ++ (eq (car type2) 'vector) ++@@ -160,7 +162,7 @@ ++ (t (case type1 ++ (string ++ (if (and (consp type2) (eq (car type2) 'array) ++- (eq (cadr type2) 'string-char)) +++ (eq (cadr type2) 'character)) ++ type1 nil)) ++ (bit-vector ++ (if (and (consp type2) (eq (car type2) 'array) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmputil.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmputil.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (export '(*suppress-compiler-warnings* ++ *suppress-compiler-notes* ++@@ -204,7 +204,7 @@ ++ (do-macro-expansion '(macroexpand-1) form) ++ form)) ++ ++-(defun cmp-expand-macro (fd fname args &aux env (form (cons fname args))) +++(defun cmp-expand-macro (fd fname args &aux (form (cons fname args))) ++ (if (macro-def-p form) ++ (do-macro-expansion `(funcall *macroexpand-hook* ',fd) form) ++ form)) ++@@ -214,7 +214,7 @@ ++ (defun cmp-toplevel-eval (form) ++ (let* ((si::*ihs-base* si::*ihs-top*) ++ (si::*ihs-top* (1- (si::ihs-top))) ++- (*break-enable* *compiler-break-enable*) +++ (si::*break-enable* *compiler-break-enable*) ++ (si::*break-hidden-packages* ++ (cons (find-package 'compiler) ++ si::*break-hidden-packages*))) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpvar.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpvar.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (si:putprop 'var 'c2var 'c2) ++ (si:putprop 'location 'c2location 'c2) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpvs.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpvs.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (si:putprop 'vs 'set-vs 'set-loc) ++ (si:putprop 'vs 'wt-vs 'wt-loc) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpwt.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpwt.lsp ++@@ -19,7 +19,7 @@ ++ ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (eval-when (compile eval) ++ (require 'FASDMACROS "../cmpnew/gcl_fasdmacros.lsp") ++--- gcl-2.6.12.orig/cmpnew/gcl_collectfn.lsp +++++ gcl-2.6.12/cmpnew/gcl_collectfn.lsp ++@@ -13,7 +13,7 @@ ++ ;; Additionally cross reference information about functions in the system is ++ ;; collected. ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ (import 'sloop::sloop) ++ ++ (defstruct fn ++--- gcl-2.6.12.orig/cmpnew/gcl_lfun_list.lsp +++++ gcl-2.6.12/cmpnew/gcl_lfun_list.lsp ++@@ -3,7 +3,7 @@ ++ ;; and making the arglists correct if they have optional args. ++ ;; ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (DEFSYSFUN 'GENSYM "Lgensym" '(*) 'T NIL NIL) ++ (DEFSYSFUN 'SUBSEQ "Lsubseq" '(T T *) 'T NIL NIL) ++@@ -129,7 +129,7 @@ ++ (DEFSYSFUN 'STRING-NOT-GREATERP "Lstring_not_greaterp" '(T T *) 'T NIL NIL) ++ (DEFSYSFUN 'STRING> "Lstring_g" '(T T *) 'T NIL NIL) ++ (DEFSYSFUN 'FINISH-OUTPUT "Lfinish_output" '(*) 'T NIL NIL) ++-(DEFSYSFUN 'SPECIAL-FORM-P "Lspecial_form_p" '(T) 'T NIL T) +++(DEFSYSFUN 'SPECIAL-OPERATOR-P "Lspecial_operator_p" '(T) 'T NIL T) ++ (DEFSYSFUN 'STRINGP "Lstringp" '(T) 'T NIL T) ++ (DEFSYSFUN 'GET-INTERNAL-RUN-TIME "Lget_internal_run_time" 'NIL 'T NIL ++ NIL) ++@@ -303,7 +303,7 @@ ++ (DEFSYSFUN '= "Lall_the_same" '(T *) 'T NIL T) ++ (DEFSYSFUN 'GENTEMP "Lgentemp" '(*) 'T NIL NIL) ++ (DEFSYSFUN 'RENAME-PACKAGE "Lrename_package" '(T T *) 'T NIL NIL) ++-(DEFSYSFUN 'COMMONP "Lcommonp" '(T) 'T NIL T) +++(DEFSYSFUN 'COMMONP "siLcommonp" '(T) 'T NIL T) ++ (DEFSYSFUN 'NUMBERP "Lnumberp" '(T) 'T NIL T) ++ (DEFSYSFUN 'COPY-READTABLE "Lcopy_readtable" '(*) 'T NIL NIL) ++ (DEFSYSFUN 'RANDOM-STATE-P "Lrandom_state_p" '(T) 'T NIL T) ++@@ -365,7 +365,7 @@ ++ (DEFSYSFUN 'ASSOC-IF "Lassoc_if" '(T T) 'T NIL NIL) ++ (DEFSYSFUN 'GET-PROPERTIES "Lget_properties" '(T T) '* NIL NIL) ++ (DEFSYSFUN 'STRING<= "Lstring_le" '(T T *) 'T NIL NIL) ++-(DEFSYSFUN 'EVALHOOK "Levalhook" '(T T T *) 'T NIL NIL) +++(DEFSYSFUN 'EVALHOOK "siLevalhook" '(T T T *) 'T NIL NIL) ++ (DEFSYSFUN 'FILE-WRITE-DATE "Lfile_write_date" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'LOGCOUNT "Llogcount" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'MERGE-PATHNAMES "Lmerge_pathnames" '(T *) 'T NIL NIL) ++--- gcl-2.6.12.orig/cmpnew/gcl_make_ufun.lsp +++++ gcl-2.6.12/cmpnew/gcl_make_ufun.lsp ++@@ -20,13 +20,13 @@ ++ ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (defvar gazonk (make-package 'symbol-table :use nil)) ++ (defvar eof (cons nil nil)) ++ (defvar *Ufun-out*) ++ ++-(defvar *str* (make-array 128 :element-type 'string-char :fill-pointer 0)) +++(defvar *str* (make-array 128 :element-type 'character :fill-pointer 0)) ++ ++ (defun make-Ufun (in-files &key (out-file "Ufun_list.lsp")) ++ (with-open-file (*Ufun-out* out-file :direction :output) ++--- gcl-2.6.12.orig/cmpnew/gcl_nocmpinc.lsp +++++ gcl-2.6.12/cmpnew/gcl_nocmpinc.lsp ++@@ -1,6 +1,6 @@ ++ ++ ++-(in-package 'compiler) +++(in-package :compiler) ++ ++ (defvar *cmpinclude-string* nil) ++ ++@@ -20,4 +20,4 @@ ++ ++ ++ ++- ++\ No newline at end of file +++ ++--- gcl-2.6.12.orig/cmpnew/sys-proclaim.lisp +++++ gcl-2.6.12/cmpnew/sys-proclaim.lisp ++@@ -1,168 +1,377 @@ ++ ++-(IN-PACKAGE "COMPILER") ++-(MAPC (LAMBDA (X) (SETF (GET X 'PROCLAIMED-CLOSURE) T)) ++- '(CMP-TMP-MACRO COMPILE DISASSEMBLE CMP-ANON)) ++-(PROCLAIM '(FTYPE (FUNCTION (STRING *) T) TS)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T) T) VAR-REP-LOC C1FUNOB C1STRUCTURE-REF ++- T1PROGN GET-RETURN-TYPE ADD-REG1 C1VAR C1ECASE ++- C1SHARP-COMMA C1ASH LTVP CTOP-WRITE C2FUNCTION ++- DECLARATION-TYPE C1TERPRI C1FUNCALL VAR-REGISTER C1ASSOC ++- CONS-TO-LISTA WT-LIST C1NTHCDR-CONDITION ++- C1MULTIPLE-VALUE-CALL CHECK-DOWNWARD TYPE-FILTER ++- C2TAGBODY-LOCAL BLK-NAME C1FSET T1DEFENTRY C1MEMBER ++- C1GETHASH C2GO-CCB SCH-LOCAL-FUN C1RPLACD C1RPLACA-NTHCDR ++- INLINE-POSSIBLE C1MAPC C2VAR WT-FUNCALL-C C1ADD-GLOBALS ++- FUN-NAME SAVE-FUNOB FUN-CFUN PROCLAIM TAG-REF-CCB ++- FIXNUM-LOC-P UNWIND-NO-EXIT WT-H1 MAXARGS C1GO INFO-P TAG-P ++- C1AND INLINE-TYPE VAR-REF-CCB C1MULTIPLE-VALUE-BIND C1THE ++- C2DM-RESERVE-VL WT-DOWNWARD-CLOSURE-MACRO VAR-NAME C1THROW ++- INFO-TYPE C1ASH-CONDITION LTVP-EVAL CHARACTER-LOC-P ++- C2DOWNWARD-FUNCTION C1EXPR C1TAGBODY BLK-REF INFO-VOLATILE ++- VAR-REF CONSTANT-FOLD-P WT-DATA-PACKAGE-OPERATION FUN-P ++- VAR-LOC C1PROGN C1NTHCDR VOLATILE TAG-UNWIND-EXIT ++- REPLACE-CONSTANT NAME-TO-SD SET-TOP C1GET PUSH-ARGS ++- FUN-REF-CCB INLINE-BOOLE3-STRING C1SETQ C1LOCAL-CLOSURE ++- CLINK GET-INCLUDED SET-PUSH-CATCH-FRAME FUNCTION-ARG-TYPES ++- T2DECLARE OBJECT-TYPE CHECK-VREF COPY-INFO ++- T1DEFINE-STRUCTURE C1BOOLE3 FUN-LEVEL C1NTH C2GET FIX-OPT ++- C1OR FUNCTION-RETURN-TYPE T1DEFUN T1CLINES FLAGS-POS ++- SAVE-AVMA WT-DOWN C2GO-CLB C1SWITCH WT-SWITCH-CASE ++- C1FUNCTION C2RPLACD C1LABELS C1MULTIPLE-VALUE-SETQ WT-VV ++- C2TAGBODY-CLB WT-CADR C1MAPCAR MACRO-DEF-P T1DEFMACRO ++- SET-RETURN THE-PARAMETER BLK-REF-CCB AET-C-TYPE ++- PUSH-ARGS-LISPCALL WRITE-BLOCK-OPEN SET-UP-VAR-CVS TAG-VAR ++- INFO-SP-CHANGE ADD-LOOP-REGISTERS C1MULTIPLE-VALUE-PROG1 ++- WT-VS C2LOCATION C1COMPILER-LET T3CLINES RESULT-TYPE ++- PROCLAMATION C1MAPL C1PRINC TAG-LABEL C2FUNCALL-AUX BLK-VAR ++- TAG-REF-CLB C2TAGBODY-CCB VERIFY-DATA-VECTOR C1MAPCAN ++- BLK-EXIT WT-VS-BASE REGISTER UNDEFINED-VARIABLE ++- SYSTEM:UNDEF-COMPILER-MACRO C1BLOCK C1MAPLIST ++- ARGS-CAUSE-SIDE-EFFECT C2BIND C1LET WT-SYMBOL-FUNCTION ++- CMP-MACRO-FUNCTION WT1 C1MEMQ BLK-REF-CLB ADD-ADDRESS ++- GET-LOCAL-ARG-TYPES C1UNWIND-PROTECT REP-TYPE ADD-CONSTANT ++- C1IF C1QUOTE C1FMLA-CONSTANT WT-DATA1 NAME-SD1 BLK-P ++- C1CATCH CMP-MACROEXPAND SHORT-FLOAT-LOC-P T3ORDINARY ++- C1LENGTH NEED-TO-SET-VS-POINTERS C1DOWNWARD-FUNCTION C1FLET ++- TAG-SWITCH TAG-REF PARSE-CVSPECS TAG-NAME VAR-P VAR-KIND ++- C1VREF C2GETHASH LONG-FLOAT-LOC-P C1MAPCON C1NTH-CONDITION ++- WT-FUNCTION-LINK WT-VAR-DECL C1STACK-LET ADD-SYMBOL T1DEFLA ++- C2EXPR* C1LOAD-TIME-VALUE C1DM-BAD-KEY C1PROGV FSET-FN-NAME ++- C2VALUES FUN-REF C2VAR-KIND C1PSETQ VARARG-P T1ORDINARY ++- C2GO-LOCAL C1LET* C2DM-RESERVE-V PUSH-DATA-INCF ++- C1DEFINE-STRUCTURE DEFAULT-INIT MDELETE-FILE ++- C1BOOLE-CONDITION C2RPLACA C1VALUES GET-ARG-TYPES WT-CAR ++- FUN-INFO C1DECLARE C1STRUCTURE-SET WT-VS* CMP-MACROEXPAND-1 ++- SCH-GLOBAL GET-LOCAL-RETURN-TYPE C1EVAL-WHEN C2TAGBODY-BODY ++- C1APPLY C1LOCAL-FUN C1MACROLET ADD-OBJECT C1RETURN-FROM ++- SAFE-SYSTEM RESET-INFO-TYPE T1DEFCFUN C1RPLACA WT-CDR ++- VAR-TYPE T1MACROLET C1LIST-NTH INFO-CHANGED-ARRAY ++- INFO-REFERRED-ARRAY BLK-VALUE-TO-GO ADD-OBJECT2 WT-CCB-VS)) ++-(PROCLAIM '(FTYPE (FUNCTION (*) *) INLINE-BOOLE3)) ++-(PROCLAIM '(FTYPE (FUNCTION (T) FIXNUM) F-TYPE)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T (VECTOR T) FIXNUM T) FIXNUM) PUSH-ARRAY)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T (VECTOR T) FIXNUM FIXNUM T) FIXNUM) ++- BSEARCHLEQ)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T) *) C2EXPR WT-FIXNUM-LOC WT-LONG-FLOAT-LOC ++- C2OR WT-SHORT-FLOAT-LOC CMP-EVAL C2PROGN WT-TO-STRING ++- SET-LOC CMP-TOPLEVEL-EVAL VV-STR T1EXPR T1EVAL-WHEN WT-LOC ++- C2AND WT-CHARACTER-LOC)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (*) T) FCALLN-INLINE MAKE-BLK MAKE-FUN ++- LIST*-INLINE WT-CLINK COMPILE-FILE C2FSET MAKE-TAG CS-PUSH ++- LIST-INLINE MAKE-VAR COMPILER-COMMAND MAKE-INFO)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (STRING FIXNUM FIXNUM) T) DASH-TO-UNDERSCORE-INT)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T) *) C2COMPILER-LET C2FLET C2LABELS C2IF ++- WT-INLINE)) ++-(PROCLAIM '(FTYPE (FUNCTION (T T *) *) T3DEFUN-AUX)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T) *) C1DM-V C2RETURN-FROM C2DM C1DM-VL ++- C2APPLY-OPTIMIZE)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T) T) C2APPLY C2RETURN-CCB C2BIND-INIT ++- PROCLAIM-VAR PRIN1-CMP C2LAMBDA-EXPR-WITH-KEY ++- SYSTEM::ADD-DEBUG C2LAMBDA-EXPR-WITHOUT-KEY C2STACK-LET ++- MULTIPLE-VALUE-CHECK C1DECL-BODY COMPILER-CC C1EXPR* ++- C2MULTIPLE-VALUE-PROG1 CO1VECTOR-PUSH ++- ARGS-INFO-CHANGED-VARS C2DM-BIND-INIT C1PROGN* ++- CO1WRITE-CHAR COERCE-LOC WT-FIXNUM-VALUE IS-REP-REFERRED ++- C2MULTIPLE-VALUE-CALL CO1SPECIAL-FIX-DECL INLINE-PROC ++- WT-CHARACTER-VALUE SET-VS C2PSETQ T3SHARP-COMMA ++- STRUCT-TYPE-OPT WT-MAKE-DCLOSURE C2DM-BIND-VL SET-JUMP-TRUE ++- DO-MACRO-EXPANSION CO1SCHAR C2BLOCK-CLB ++- C2LIST-NTH-IMMEDIATE C2DM-BIND-LOC WT-LONG-FLOAT-VALUE ++- CO1CONS COMPILER-CLEAR-COMPILER-PROPERTIES C2EXPR-TOP ++- ARGS-INFO-REFERRED-VARS C2MEMBER!2 C2MULTIPLE-VALUE-SETQ ++- C2SETQ ADD-DEBUG-INFO GET-INLINE-LOC RESULT-TYPE-FROM-ARGS ++- C2BIND-LOC CO1STRUCTURE-PREDICATE C1ARGS SHIFT<< UNWIND-BDS ++- MAYBE-EVAL C2UNWIND-PROTECT TYPE-AND C2CALL-LOCAL C2THROW ++- CO1TYPEP SET-BDS-BIND C1SETQ1 C2CATCH TYPE>= C1LAMBDA-FUN ++- NEED-TO-PROTECT C2ASSOC!2 CO1READ-BYTE CO1LDB ++- CONVERT-CASE-TO-SWITCH FAST-READ MAKE-USER-INIT ++- CO1CONSTANT-FOLD C1FMLA CHECK-FNAME-ARGS ++- COERCE-LOC-STRUCTURE-REF WT-SHORT-FLOAT-VALUE C2BLOCK-CCB ++- ADD-INFO CAN-BE-REPLACED CO1READ-CHAR C2CALL-LAMBDA ++- CFAST-WRITE PUSH-CHANGED-VARS SHIFT>> JUMPS-TO-P CO1SUBLIS ++- C1CONSTANT-VALUE C2RETURN-CLB WT-VAR CHECK-END C2EXPR-TOP* ++- WT-V*-MACROS SET-JUMP-FALSE CMPFIX-ARGS SET-DBIND ++- CO1WRITE-BYTE CO1EQL COMPILER-DEF-HOOK WT-REQUIREDS)) ++-(PROCLAIM '(FTYPE (FUNCTION (T *) *) COMPILE-FILE1)) ++-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM FIXNUM) T) MLIN)) ++-(PROCLAIM '(FTYPE (FUNCTION (STRING) T) DASH-TO-UNDERSCORE)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T) FIXNUM) PROCLAIMED-ARGD ANALYZE-REGS1 ++- ANALYZE-REGS)) ++-(PROCLAIM '(FTYPE (FUNCTION (T FIXNUM) T) MEMOIZED-HASH-EQUAL)) ++-(PROCLAIM '(FTYPE (FUNCTION ((VECTOR T)) T) COPY-ARRAY)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T) *) C2BLOCK-LOCAL C1SYMBOL-FUN C1BODY ++- C2BLOCK C2DECL-BODY C2RETURN-LOCAL NCONC-FILES ++- WT-INLINE-LOC COMPILER-BUILD)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T *) T) WT-CVAR C1LAMBDA-EXPR UNWIND-EXIT ++- CMPWARN WT-COMMENT WT-INTEGER-LOC CMPERR ADD-INIT ++- FAST-LINK-PROCLAIMED-TYPE-P CMPNOTE C1CASE INIT-NAME)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T) T) T3DEFUN-VARARG C2STRUCTURE-REF ++- C2CALL-UNKNOWN-GLOBAL C1MAKE-VAR C2SWITCH WT-GLOBAL-ENTRY ++- C2CALL-GLOBAL T3INIT-FUN MY-CALL T3DEFUN-NORMAL)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T) T) CJT WT-INLINE-INTEGER CMP-EXPAND-MACRO ++- CHECK-FORM-TYPE SET-VAR C2CASE ADD-FUNCTION-PROCLAMATION ++- INLINE-TYPE-MATCHES T3DEFCFUN C2MAPCAN AND-FORM-TYPE ++- C2PROGV C1DM WT-INLINE-CHARACTER C2MULTIPLE-VALUE-BIND ++- C2FUNCALL-SFUN C2LET MYSUB C-FUNCTION-NAME WT-MAKE-CCLOSURE ++- C2GO WT-INLINE-COND ADD-FAST-LINK C1STRUCTURE-REF1 C2MAPCAR ++- BOOLE3 TOO-FEW-ARGS FIX-DOWN-ARGS COMPILER-PASS2 ++- GET-INLINE-INFO C2LET* WT-INLINE-SHORT-FLOAT ++- WT-IF-PROCLAIMED C2PRINC ASSIGN-DOWN-VARS ++- WT-INLINE-LONG-FLOAT C2TAGBODY C1MAP-FUNCTIONS CHECK-VDECL ++- MAKE-INLINE-STRING WT-INLINE-FIXNUM C2MAPC CAN-BE-REPLACED* ++- SUBLIS1-INLINE TOO-MANY-ARGS ADD-FUNCTION-DECLARATION CJF)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T T *) T) T3LOCAL-DCFUN T3LOCAL-FUN)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T T) T) T2DEFUN T3DEFUN C2STRUCTURE-SET ++- C1APPLY-OPTIMIZE T3DEFUN-LOCAL-ENTRY)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T *) T) WT-SIMPLE-CALL GET-OUTPUT-PATHNAME)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T *) T) INLINE-ARGS C2FUNCALL C2LAMBDA-EXPR ++- LINK)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T T T) T) T3DEFMACRO DEFSYSFUN T2DEFENTRY ++- T2DEFMACRO T3DEFENTRY)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION NIL T) WT-DATA-BEGIN PRINT-COMPILER-INFO ++- GAZONK-NAME CCB-VS-PUSH INC-INLINE-BLOCKS ++- PRINT-CURRENT-FORM C1NIL WT-DATA-FILE ++- ADD-LOAD-TIME-SHARP-COMMA CVS-PUSH RESET-TOP WT-CVARS ++- BABOON WT-FASD-DATA-FILE WT-DATA-END INIT-ENV ++- TAIL-RECURSION-POSSIBLE WFS-ERROR C1T VS-PUSH ++- WT-NEXT-VAR-ARG WT-FIRST-VAR-ARG WT-C-PUSH ++- CLOSE-INLINE-BLOCKS)) ++\ No newline at end of file +++(COMMON-LISP::IN-PACKAGE "COMPILER") +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::STRING COMMON-LISP::*) +++ COMMON-LISP::T) +++ COMPILER::TS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +++ COMPILER::C1MULTIPLE-VALUE-BIND COMPILER::C1VALUES +++ COMPILER::C1RPLACA COMPILER::FUN-P +++ COMPILER::FUNCTION-ARG-TYPES COMPILER::C1STRUCTURE-REF +++ COMPILER::GET-RETURN-TYPE COMPILER::WT-FUNCALL-C +++ COMPILER::MACRO-DEF-P COMPILER::T1DEFUN COMPILER::C1ASSOC +++ COMPILER::SET-UP-VAR-CVS COMPILER::C2FUNCTION +++ COMPILER::C1DM-BAD-KEY COMPILER::ADD-OBJECT +++ COMPILER::WT-SWITCH-CASE COMPILER::VARARG-P +++ COMPILER::C1TAGBODY COMPILER::C2GET COMPILER::VAR-REF +++ COMPILER::SCH-LOCAL-FUN COMPILER::ADD-SYMBOL +++ COMPILER::TAG-UNWIND-EXIT COMPILER::C1MULTIPLE-VALUE-SETQ +++ COMPILER::C1PRINC COMPILER::WT-VAR-DECL COMPILER::C1QUOTE +++ COMPILER::C2RPLACD COMPILER::CHECK-VREF +++ COMPILER::PUSH-ARGS-LISPCALL COMPILER::C1MAPLIST +++ COMPILER::ADD-REG1 COMPILER::C1OR COMPILER::WT-SYMBOL-FUNCTION +++ COMPILER::TAG-P COMPILER::SAFE-SYSTEM COMPILER::C1ECASE +++ COMPILER::LTVP COMPILER::GET-INCLUDED COMPILER::INFO-P +++ COMPILER::FUN-INFO COMPILER::C1LOAD-TIME-VALUE +++ COMPILER::GET-LOCAL-ARG-TYPES COMPILER::BLK-P +++ COMPILER::BLK-EXIT COMPILER::C2VAR-KIND COMPILER::C2LOCATION +++ COMPILER::WT1 COMPILER::WT-CCB-VS +++ COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::BLK-REF-CCB +++ COMPILER::UNDEFINED-VARIABLE COMPILER::C1MULTIPLE-VALUE-CALL +++ COMPILER::VAR-LOC COMPILER::C1SETQ COMPILER::C1NTH-CONDITION +++ COMPILER::C2RPLACA COMPILER::FUN-REF COMPILER::C2VAR +++ COMPILER::WT-CAR COMPILER::WT-LIST COMPILER::WRITE-BLOCK-OPEN +++ COMPILER::INFO-VOLATILE COMPILER::GET-LOCAL-RETURN-TYPE +++ COMPILER::AET-C-TYPE COMPILER::PUSH-ARGS COMPILER::TAG-REF-CLB +++ COMPILER::BLK-REF COMPILER::VAR-P COMPILER::C1ADD-GLOBALS +++ COMPILER::T3ORDINARY COMPILER::ADD-OBJECT2 COMPILER::SET-TOP +++ COMPILER::T1DEFLA COMPILER::C1FUNCTION COMPILER::T3CLINES +++ COMPILER::T1DEFCFUN COMPILER::C1VREF COMPILER::C1ASH +++ COMPILER::BLK-NAME COMPILER::WT-CADR COMPILER::WT-DOWN +++ COMPILER::C1TERPRI COMPILER::C2GETHASH COMPILER::C2GO-CCB +++ COMPILER::SAVE-FUNOB COMPILER::T2DECLARE COMPILER::FUN-REF-CCB +++ COMPILER::C1MAPCAR COMPILER::T1DEFMACRO +++ COMPILER::C2TAGBODY-LOCAL COMPILER::C1STACK-LET +++ COMPILER::INFO-TYPE COMPILER::T1MACROLET COMPILER::C1LET* +++ COMPILER::C1RPLACD COMPILER::DECLARATION-TYPE +++ COMPILER::T1ORDINARY COMPILER::C2EXPR* COMPILER::C1LOCAL-FUN +++ COMPILER::WT-DATA-PACKAGE-OPERATION +++ COMPILER::C1BOOLE-CONDITION SYSTEM::UNDEF-COMPILER-MACRO +++ COMPILER::C2TAGBODY-BODY COMPILER::C1NTHCDR COMPILER::C1VAR +++ COMPILER::C1MULTIPLE-VALUE-PROG1 COMPILER::C1NTHCDR-CONDITION +++ COMPILER::CONSTANT-FOLD-P COMPILER::C1UNWIND-PROTECT +++ COMPILER::PROCLAMATION COMPILER::C1NTH COMPILER::C1RETURN-FROM +++ COMPILER::INFO-SP-CHANGE COMPILER::C1LENGTH +++ COMPILER::CMP-MACRO-FUNCTION COMPILER::BLK-REF-CLB +++ COMPILER::NAME-TO-SD COMPILER::CTOP-WRITE COMPILER::C1MAPCON +++ COMPILER::C1FUNOB COMPILER::FIX-OPT COMPILER::C1RPLACA-NTHCDR +++ COMPILER::C1FLET COMPILER::RESULT-TYPE COMPILER::C1CATCH +++ COMPILER::C2DM-RESERVE-V COMPILER::VAR-NAME +++ COMPILER::CMP-MACROEXPAND COMPILER::VERIFY-DATA-VECTOR +++ COMPILER::T1CLINES COMPILER::C1MAPL COMPILER::T1DEFENTRY +++ COMPILER::TAG-REF-CCB COMPILER::WT-VS +++ COMPILER::LONG-FLOAT-LOC-P COMPILER::C1MAPCAN +++ COMPILER::OBJECT-TYPE COMPILER::ADD-ADDRESS +++ COMPILER::RESET-INFO-TYPE COMPILER::C1BOOLE3 COMPILER::C1MEMQ +++ COMPILER::C1DEFINE-STRUCTURE COMPILER::TYPE-FILTER +++ COMPILER::UNWIND-NO-EXIT COMPILER::C1FMLA-CONSTANT +++ COMPILER::C2DM-RESERVE-VL COMPILER::C1FSET COMPILER::LTVP-EVAL +++ COMPILER::C1GO COMPILER::WT-VV COMPILER::INFO-CHANGED-ARRAY +++ COMPILER::C1FUNCALL COMPILER::C2TAGBODY-CCB +++ COMPILER::TAG-LABEL COMPILER::VAR-KIND COMPILER::WT-VS* +++ COMPILER::VAR-TYPE COMPILER::C2GO-LOCAL COMPILER::REGISTER +++ COMPILER::T1PROGN COMPILER::C1BLOCK COMPILER::TAG-SWITCH +++ COMPILER::VAR-REP-LOC COMPILER::C2BIND +++ COMPILER::SET-PUSH-CATCH-FRAME COMPILER::COPY-INFO +++ COMPILER::C1LIST-NTH COMPILER::CONS-TO-LISTA +++ COMPILER::FUN-LEVEL COMPILER::C1DOWNWARD-FUNCTION +++ COMPILER::THE-PARAMETER COMPILER::C2VALUES COMPILER::C1LABELS +++ COMPILER::MAXARGS COMPILER::VAR-REF-CCB COMPILER::MDELETE-FILE +++ COMPILER::WT-FUNCTION-LINK COMPILER::SAVE-AVMA +++ COMPILER::VOLATILE COMPILER::ADD-CONSTANT COMPILER::C1APPLY +++ COMPILER::C1GETHASH COMPILER::FUN-NAME COMPILER::DEFAULT-INIT +++ COMPILER::CLINK COMPILER::WT-CDR COMPILER::PARSE-CVSPECS +++ COMPILER::REP-TYPE COMPILER::C2GO-CLB +++ COMPILER::ARGS-CAUSE-SIDE-EFFECT COMPILER::PUSH-DATA-INCF +++ COMPILER::SCH-GLOBAL COMPILER::C1STRUCTURE-SET +++ COMPILER::TAG-NAME COMPILER::INFO-REFERRED-ARRAY +++ COMPILER::C1EXPR COMPILER::C1GET COMPILER::BLK-VAR +++ COMPILER::TAG-REF COMPILER::C1MAPC COMPILER::SET-RETURN +++ COMPILER::SHORT-FLOAT-LOC-P COMPILER::C1DECLARE +++ COMPILER::WT-DATA1 COMPILER::FLAGS-POS +++ COMPILER::BLK-VALUE-TO-GO COMPILER::NAME-SD1 +++ COMPILER::C2DOWNWARD-FUNCTION COMPILER::C1SHARP-COMMA +++ COMPILER::INLINE-POSSIBLE COMPILER::WT-H1 +++ COMPILER::FIXNUM-LOC-P COMPILER::C1LET COMPILER::C1IF +++ COMPILER::C1THE COMPILER::FUNCTION-RETURN-TYPE +++ COMPILER::GET-ARG-TYPES COMPILER::INLINE-TYPE +++ COMPILER::FUN-CFUN COMPILER::TAG-VAR COMPILER::CHARACTER-LOC-P +++ COMPILER::CHECK-DOWNWARD COMPILER::C1PSETQ +++ COMPILER::INLINE-BOOLE3-STRING COMPILER::C1THROW +++ COMPILER::FSET-FN-NAME COMPILER::T1DEFINE-STRUCTURE +++ COMPILER::NEED-TO-SET-VS-POINTERS COMPILER::C1PROGN +++ COMPILER::C2FUNCALL-AUX COMPILER::C1MACROLET COMPILER::C1AND +++ COMPILER::WT-VS-BASE COMPILER::ADD-LOOP-REGISTERS +++ COMPILER::VAR-REGISTER COMPILER::C1PROGV COMPILER::C1SWITCH +++ COMPILER::C1MEMBER COMPILER::C2TAGBODY-CLB +++ COMPILER::CMP-MACROEXPAND-1 COMMON-LISP::PROCLAIM +++ COMPILER::C1ASH-CONDITION COMPILER::C1EVAL-WHEN +++ COMPILER::C1LOCAL-CLOSURE COMPILER::REPLACE-CONSTANT)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) +++ COMPILER::INLINE-BOOLE3)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) +++ COMMON-LISP::*) +++ COMPILER::C2DM COMPILER::C1DM-V COMPILER::C1DM-VL +++ COMPILER::C2RETURN-FROM COMPILER::C2APPLY-OPTIMIZE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ COMPILER::WT-INLINE COMPILER::C2IF COMPILER::C2LABELS +++ COMPILER::C2FLET)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ COMPILER::T3DEFUN-AUX)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) +++ COMPILER::F-TYPE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::STRING) COMMON-LISP::T) +++ COMPILER::DASH-TO-UNDERSCORE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ COMPILER::INIT-NAME COMPILER::ADD-INIT COMPILER::C1LAMBDA-EXPR +++ COMPILER::WT-CVAR COMPILER::C1CASE COMPILER::WT-COMMENT +++ COMPILER::CMPERR COMPILER::WT-INTEGER-LOC COMPILER::CMPNOTE +++ COMPILER::FAST-LINK-PROCLAIMED-TYPE-P COMPILER::UNWIND-EXIT +++ COMPILER::CMPWARN)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ COMPILER::C2RETURN-LOCAL COMPILER::C2BLOCK-LOCAL +++ COMPILER::NCONC-FILES COMPILER::C1SYMBOL-FUN COMPILER::C2BLOCK +++ COMPILER::C1BODY COMPILER::COMPILER-BUILD +++ COMPILER::C2DECL-BODY COMPILER::WT-INLINE-LOC)) +++(COMMON-LISP::MAPC +++ (COMMON-LISP::LAMBDA (COMPILER::X) +++ (COMMON-LISP::SETF +++ (COMMON-LISP::GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE) +++ COMMON-LISP::T)) +++ '(COMPILER::CMP-ANON COMMON-LISP::COMPILE COMPILER::CMP-TMP-MACRO +++ COMMON-LISP::DISASSEMBLE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T (COMMON-LISP::VECTOR COMMON-LISP::T) +++ COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM +++ COMMON-LISP::T) +++ COMMON-LISP::FIXNUM) +++ COMPILER::BSEARCHLEQ)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T (COMMON-LISP::VECTOR COMMON-LISP::T) +++ COMMON-LISP::FIXNUM COMMON-LISP::T) +++ COMMON-LISP::FIXNUM) +++ COMPILER::PUSH-ARRAY)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ COMPILER::AND-FORM-TYPE COMPILER::SET-VAR COMPILER::C2LET* +++ COMPILER::COMPILER-PASS2 COMPILER::ADD-FUNCTION-DECLARATION +++ COMPILER::BOOLE3 COMPILER::C1MAP-FUNCTIONS +++ COMPILER::TOO-MANY-ARGS COMPILER::CHECK-FORM-TYPE +++ COMPILER::C2LET COMPILER::C-FUNCTION-NAME +++ COMPILER::WT-INLINE-SHORT-FLOAT COMPILER::FIX-DOWN-ARGS +++ COMPILER::C2PRINC COMPILER::WT-IF-PROCLAIMED +++ COMPILER::ADD-FAST-LINK COMPILER::C2MULTIPLE-VALUE-BIND +++ COMPILER::C2MAPCAN COMPILER::CJT COMPILER::CHECK-VDECL +++ COMPILER::INLINE-TYPE-MATCHES COMPILER::WT-INLINE-LONG-FLOAT +++ COMPILER::C2GO COMPILER::CAN-BE-REPLACED* COMPILER::MYSUB +++ COMPILER::ASSIGN-DOWN-VARS COMPILER::C2MAPC +++ COMPILER::WT-INLINE-INTEGER COMPILER::GET-INLINE-INFO +++ COMPILER::CJF COMPILER::TOO-FEW-ARGS COMPILER::T3DEFCFUN +++ COMPILER::CMP-EXPAND-MACRO COMPILER::WT-MAKE-CCLOSURE +++ COMPILER::C2FUNCALL-SFUN COMPILER::C1DM +++ COMPILER::WT-INLINE-COND COMPILER::C2TAGBODY +++ COMPILER::WT-INLINE-CHARACTER COMPILER::C2PROGV +++ COMPILER::C2MAPCAR COMPILER::C1STRUCTURE-REF1 COMPILER::C2CASE +++ COMPILER::ADD-FUNCTION-PROCLAMATION +++ COMPILER::MAKE-INLINE-STRING COMPILER::SUBLIS1-INLINE +++ COMPILER::WT-INLINE-FIXNUM)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL COMPILER::LINK +++ COMPILER::INLINE-ARGS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) +++ COMMON-LISP::T) +++ COMPILER::C2STRUCTURE-REF COMPILER::WT-GLOBAL-ENTRY +++ COMPILER::T3DEFUN-VARARG COMPILER::T3DEFUN-NORMAL +++ COMPILER::C2CALL-GLOBAL COMPILER::C1MAKE-VAR +++ COMPILER::C2CALL-UNKNOWN-GLOBAL COMPILER::C2SWITCH +++ COMPILER::T3INIT-FUN COMPILER::MY-CALL)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ COMPILER::DEFSYSFUN COMPILER::T2DEFMACRO COMPILER::T2DEFENTRY +++ COMPILER::T3DEFMACRO COMPILER::T3DEFENTRY)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ COMPILER::T2DEFUN COMPILER::C1APPLY-OPTIMIZE COMPILER::T3DEFUN +++ COMPILER::C2STRUCTURE-SET COMPILER::T3DEFUN-LOCAL-ENTRY)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::T) +++ COMPILER::WT-SIMPLE-CALL COMPILER::GET-OUTPUT-PATHNAME)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ COMPILER::T3LOCAL-FUN COMPILER::T3LOCAL-DCFUN)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) +++ COMPILER::C2PROGN COMPILER::WT-LONG-FLOAT-LOC COMPILER::C2EXPR +++ COMPILER::WT-FIXNUM-LOC COMPILER::WT-CHARACTER-LOC +++ COMPILER::C2AND COMPILER::T1EXPR COMPILER::CMP-TOPLEVEL-EVAL +++ COMPILER::WT-SHORT-FLOAT-LOC COMPILER::C2OR COMPILER::WT-LOC +++ COMPILER::CMP-EVAL COMPILER::T1EVAL-WHEN COMPILER::SET-LOC +++ COMPILER::VV-STR COMPILER::WT-TO-STRING)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +++ COMPILER::MAKE-FUN COMPILER::MAKE-BLK +++ COMMON-LISP::COMPILE-FILE COMPILER::FCALLN-INLINE +++ COMPILER::MAKE-INFO COMPILER::CS-PUSH COMPILER::MAKE-VAR +++ COMPILER::LIST-INLINE COMPILER::C2FSET COMPILER::WT-CLINK +++ COMPILER::COMPILER-COMMAND COMPILER::MAKE-TAG +++ COMPILER::LIST*-INLINE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION ((COMMON-LISP::VECTOR COMMON-LISP::T)) +++ COMMON-LISP::T) +++ COMPILER::COPY-ARRAY)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ COMPILER::C2EXPR-TOP COMPILER::CO1SUBLIS +++ COMPILER::C2CALL-LAMBDA COMPILER::GET-INLINE-LOC +++ COMPILER::CHECK-END COMPILER::C2PSETQ COMPILER::TYPE-AND +++ COMPILER::TYPE>= COMPILER::C2MULTIPLE-VALUE-PROG1 +++ COMPILER::CO1SCHAR SYSTEM::ADD-DEBUG COMPILER::C2BLOCK-CCB +++ COMPILER::C2DM-BIND-VL COMPILER::MAKE-USER-INIT +++ COMPILER::NEED-TO-PROTECT COMPILER::FAST-READ +++ COMPILER::RESULT-TYPE-FROM-ARGS COMPILER::C2BIND-INIT +++ COMPILER::JUMPS-TO-P COMPILER::C2MEMBER!2 +++ COMPILER::C2CALL-LOCAL COMPILER::C2BLOCK-CLB +++ COMPILER::ARGS-INFO-CHANGED-VARS COMPILER::INLINE-PROC +++ COMPILER::C2THROW COMPILER::C1DECL-BODY +++ COMPILER::WT-MAKE-DCLOSURE COMPILER::CO1WRITE-CHAR +++ COMPILER::C1SETQ1 COMPILER::SET-JUMP-FALSE COMPILER::CO1CONS +++ COMPILER::CO1VECTOR-PUSH COMPILER::SET-VS COMPILER::SHIFT>> +++ COMPILER::COERCE-LOC-STRUCTURE-REF COMPILER::WT-FIXNUM-VALUE +++ COMPILER::C2CATCH COMPILER::C2RETURN-CCB COMPILER::MAYBE-EVAL +++ COMPILER::C2ASSOC!2 COMPILER::C2DM-BIND-INIT +++ COMPILER::C2STACK-LET COMPILER::C2LAMBDA-EXPR-WITH-KEY +++ COMPILER::ARGS-INFO-REFERRED-VARS +++ COMPILER::C2MULTIPLE-VALUE-SETQ COMPILER::C1PROGN* +++ COMPILER::WT-LONG-FLOAT-VALUE COMPILER::C2MULTIPLE-VALUE-CALL +++ COMPILER::WT-SHORT-FLOAT-VALUE COMPILER::CO1CONSTANT-FOLD +++ COMPILER::C1CONSTANT-VALUE COMPILER::C1EXPR* +++ COMPILER::CO1SPECIAL-FIX-DECL COMPILER::C2RETURN-CLB +++ COMPILER::CMPFIX-ARGS COMPILER::PROCLAIM-VAR COMPILER::C2APPLY +++ COMPILER::DO-MACRO-EXPANSION COMPILER::CFAST-WRITE +++ COMPILER::PRIN1-CMP COMPILER::SHIFT<< COMPILER::WT-REQUIREDS +++ COMPILER::C2EXPR-TOP* COMPILER::UNWIND-BDS +++ COMPILER::MULTIPLE-VALUE-CHECK COMPILER::COERCE-LOC +++ COMPILER::STRUCT-TYPE-OPT COMPILER::CO1READ-CHAR +++ COMPILER::ADD-DEBUG-INFO COMPILER::C2LIST-NTH-IMMEDIATE +++ COMPILER::WT-VAR COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY +++ COMPILER::CHECK-FNAME-ARGS COMPILER::CAN-BE-REPLACED +++ COMPILER::WT-CHARACTER-VALUE COMPILER::C2UNWIND-PROTECT +++ COMPILER::SET-DBIND COMPILER::T3SHARP-COMMA +++ COMPILER::IS-REP-REFERRED COMPILER::C1FMLA +++ COMPILER::WT-V*-MACROS COMPILER::C2DM-BIND-LOC +++ COMPILER::C2BIND-LOC +++ COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES +++ COMPILER::ADD-INFO COMPILER::C2SETQ +++ COMPILER::PUSH-CHANGED-VARS COMPILER::CO1STRUCTURE-PREDICATE +++ COMPILER::SET-BDS-BIND COMPILER::SET-JUMP-TRUE +++ COMPILER::CO1READ-BYTE COMPILER::C1LAMBDA-FUN +++ COMPILER::CO1TYPEP COMPILER::CONVERT-CASE-TO-SWITCH +++ COMPILER::COMPILER-DEF-HOOK COMPILER::CO1LDB COMPILER::C1ARGS +++ COMPILER::CO1WRITE-BYTE COMPILER::CO1EQL +++ COMPILER::COMPILER-CC)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM) COMMON-LISP::T) +++ COMPILER::MLIN)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ COMPILER::COMPILE-FILE1)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +++ COMPILER::WT-DATA-BEGIN COMPILER::WT-C-PUSH COMPILER::WT-CVARS +++ COMPILER::C1T COMPILER::CVS-PUSH COMPILER::WT-DATA-FILE +++ COMPILER::ADD-LOAD-TIME-SHARP-COMMA +++ COMPILER::CLOSE-INLINE-BLOCKS COMPILER::WT-FASD-DATA-FILE +++ COMPILER::GAZONK-NAME COMPILER::WFS-ERROR +++ COMPILER::WT-NEXT-VAR-ARG COMPILER::WT-FIRST-VAR-ARG +++ COMPILER::C1NIL COMPILER::WT-DATA-END COMPILER::RESET-TOP +++ COMPILER::TAIL-RECURSION-POSSIBLE +++ COMPILER::PRINT-COMPILER-INFO COMPILER::CCB-VS-PUSH +++ COMPILER::BABOON COMPILER::INIT-ENV +++ COMPILER::PRINT-CURRENT-FORM COMPILER::VS-PUSH +++ COMPILER::INC-INLINE-BLOCKS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::FIXNUM) +++ COMMON-LISP::T) +++ COMPILER::MEMOIZED-HASH-EQUAL)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::FIXNUM) +++ COMPILER::PROCLAIMED-ARGD COMPILER::ANALYZE-REGS1 +++ COMPILER::ANALYZE-REGS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::STRING COMMON-LISP::FIXNUM +++ COMMON-LISP::FIXNUM) +++ COMMON-LISP::T) +++ COMPILER::DASH-TO-UNDERSCORE-INT)) ++\ No newline at end of file ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -7569,9 +7569,6 @@ fi ++ ++ if test "$enable_ansi" = "yes" ; then ++ SYSTEM=ansi_gcl ++- ++-$as_echo "#define ANSI_COMMON_LISP 1" >>confdefs.h ++- ++ CLSTANDARD=ANSI ++ else ++ SYSTEM=gcl ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -2112,7 +2112,6 @@ AC_ARG_ENABLE(ansi,[--enable-ansi builds ++ ++ if test "$enable_ansi" = "yes" ; then ++ SYSTEM=ansi_gcl ++- AC_DEFINE(ANSI_COMMON_LISP,1,[compile ansi compliant image]) ++ CLSTANDARD=ANSI ++ else ++ SYSTEM=gcl ++--- gcl-2.6.12.orig/h/amd64-linux.h +++++ gcl-2.6.12/h/amd64-linux.h ++@@ -21,3 +21,4 @@ ++ #define C_GC_OFFSET 4 ++ ++ #define RELOC_H "elf64_i386_reloc.h" +++#define MAX_CODE_ADDRESS (1L<<31)/*large memory model broken gcc 4.8*/ ++--- gcl-2.6.12.orig/h/att_ext.h +++++ gcl-2.6.12/h/att_ext.h ++@@ -145,8 +145,8 @@ object simple_lispcall(); ++ object simple_lispcall_no_event(); ++ object simple_symlispcall(); ++ object simple_symlispcall_no_event(); ++-EXTER object Vevalhook; ++-EXTER object Vapplyhook; +++EXTER object siVevalhook; +++EXTER object siVapplyhook; ++ object ieval(); ++ object ifuncall(object,int,...); ++ object ifuncall1(); ++@@ -301,13 +301,13 @@ EXTER object sLquote; ++ ++ EXTER object sLlambda; ++ ++-EXTER object sLlambda_block; ++-EXTER object sLlambda_closure; ++-EXTER object sLlambda_block_closure; +++EXTER object sSlambda_block; +++EXTER object sSlambda_closure; +++EXTER object sSlambda_block_closure; ++ ++ EXTER object sLfunction; ++-EXTER object sLmacro; ++-EXTER object sLtag; +++EXTER object sSmacro; +++EXTER object sStag; ++ EXTER object sLblock; ++ ++ ++@@ -359,9 +359,6 @@ object shift_integer(); ++ /* package.d */ ++ EXTER object lisp_package; ++ EXTER object user_package; ++-#ifdef ANSI_COMMON_LISP ++-EXTER object common_lisp_package; ++-#endif ++ EXTER object keyword_package; ++ EXTER object system_package; ++ EXTER object sLApackageA; ++@@ -565,15 +562,13 @@ EXTER object sSfunction_documentation; ++ /* typespec.c */ ++ EXTER object sLcommon,sLnull,sLcons,sLlist,sLsymbol,sLarray,sLvector,sLbit_vector,sLstring; ++ EXTER object sLsequence,sLsimple_array,sLsimple_vector,sLsimple_bit_vector,sLsimple_string; ++-EXTER object sLcompiled_function,sLpathname,sLcharacter,sLnumber,sLrational,sLfloat,sLstring_char; +++EXTER object sLcompiled_function,sLpathname,sLcharacter,sLnumber,sLrational,sLfloat; ++ EXTER object sLinteger,sLreal,sLratio,sLshort_float,sLstandard_char,sLfixnum,sLpositive_fixnum, sLcomplex; ++ EXTER object sLsingle_float,sLpackage,sLbignum,sLrandom_state,sLdouble_float,sLstream,sLbit,sLreadtable; ++ EXTER object sLlong_float,sLhash_table,sLstructure,sLboolean; ++ EXTER object sLdivision_by_zero,sLfloating_point_inexact,sLfloating_point_invalid_operation; ++ EXTER object sLfloating_point_overflow,sLfloating_point_underflow; ++ ++-/* #ifdef ANSI_COMMON_LISP */ ++-/* new ansi types */ ++ EXTER object sLarithmetic_error,sLbase_char,sLbase_string,sLbroadcast_stream,sLbuilt_in_class; ++ EXTER object sLcell_error,sLclass,sLconcatenated_stream,sLcondition,sLcontrol_error; ++ EXTER object sLecho_stream,sLend_of_file,sLerror,sLextended_char,sLfile_error,sLfile_stream; ++@@ -584,7 +579,6 @@ EXTER object sLstandard_generic_function ++ EXTER object sLstream_error,sLstring_stream,sLstructure_class,sLstyle_warning,sLsynonym_stream; ++ EXTER object sLtwo_way_stream,sLtype_error,sLunbound_slot,sLunbound_variable,sLundefined_function,sLwarning; ++ EXTER object sLmethod_combination,sLstructure_object; ++-/* #endif */ ++ ++ EXTER object sLsatisfies; ++ EXTER object sLmember; ++@@ -595,10 +589,10 @@ EXTER object sLvalues; ++ EXTER object sLmod; ++ EXTER object sLsigned_byte; ++ EXTER object sLunsigned_byte; ++-EXTER object sLsigned_char; ++-EXTER object sLunsigned_char; ++-EXTER object sLsigned_short; ++-EXTER object sLunsigned_short; +++EXTER object sSsigned_char; +++EXTER object sSunsigned_char; +++EXTER object sSsigned_short; +++EXTER object sSunsigned_short; ++ EXTER object sLA; ++ EXTER object sLplusp; ++ EXTER object TSor_symbol_string; ++--- gcl-2.6.12.orig/h/compdefs.h +++++ gcl-2.6.12/h/compdefs.h ++@@ -114,3 +114,4 @@ stp_ordinary ++ SIGNED_CHAR(x) ++ FEerror(x,y...) ++ FEwrong_type_argument(x,y) +++BIT_ENDIAN(x) ++--- gcl-2.6.12.orig/h/elf64_i386_reloc.h +++++ gcl-2.6.12/h/elf64_i386_reloc.h ++@@ -8,5 +8,6 @@ ++ add_val(where,~0L,s+a); ++ break; ++ case R_X86_64_PC32: +++ massert(ovchks(s+a-p,~MASK(32))); ++ add_val(where,MASK(32),s+a-p); ++ break; ++--- gcl-2.6.12.orig/h/lu.h +++++ gcl-2.6.12/h/lu.h ++@@ -94,12 +94,12 @@ struct symbol { ++ object s_dbind; ++ void (*s_sfdef) (); ++ char *s_self; +++ short s_stype; +++ short s_mflag; ++ int s_fillp; ++ object s_gfdef; ++ object s_plist; ++ object s_hpack; ++- short s_stype; ++- short s_mflag; ++ SPAD; ++ ++ }; ++@@ -142,6 +142,7 @@ struct hashtable { ++ int ht_nent; ++ int ht_size; ++ short ht_test; +++ short ht_static; ++ SPAD; ++ ++ }; ++@@ -152,10 +153,10 @@ struct array { ++ short a_rank; ++ short a_elttype; ++ object *a_self; ++- short a_adjustable; ++- short a_offset; ++ int a_dim; ++ int *a_dims; +++ short a_adjustable; +++ short a_offset; ++ SPAD; ++ ++ }; ++@@ -168,8 +169,8 @@ struct vector { ++ short v_hasfillp; ++ short v_elttype; ++ object *v_self; ++- int v_fillp; ++ int v_dim; +++ int v_fillp; ++ short v_adjustable; ++ short v_offset; ++ SPAD; ++@@ -181,8 +182,8 @@ struct string { ++ short st_hasfillp; ++ short st_adjustable; ++ char *st_self; ++- int st_fillp; ++ int st_dim; +++ int st_fillp; ++ }; ++ ++ struct ustring { ++@@ -191,8 +192,8 @@ struct ustring { ++ short ust_hasfillp; ++ short ust_adjustable; ++ unsigned char *ust_self; ++- int ust_fillp; ++ int ust_dim; +++ int ust_fillp; ++ }; ++ ++ struct bitvector { ++@@ -201,8 +202,8 @@ struct bitvector { ++ short bv_hasfillp; ++ short bv_elttype; ++ char *bv_self; ++- int bv_fillp; ++ int bv_dim; +++ int bv_fillp; ++ short bv_adjustable; ++ short bv_offset; ++ SPAD; ++@@ -214,10 +215,10 @@ struct fixarray { ++ short fixa_rank; ++ short fixa_elttype; ++ fixnum *fixa_self; ++- short fixa_adjustable; ++- short fixa_offset; ++ int fixa_dim; ++ int *fixa_dims; +++ short fixa_adjustable; +++ short fixa_offset; ++ SPAD; ++ }; ++ ++@@ -227,10 +228,10 @@ struct sfarray { ++ short sfa_rank; ++ short sfa_elttype; ++ shortfloat *sfa_self; ++- short sfa_adjustable; ++- short sfa_offset; ++ int sfa_dim; ++ int *sfa_dims; +++ short sfa_adjustable; +++ short sfa_offset; ++ SPAD; ++ }; ++ ++@@ -240,10 +241,10 @@ struct lfarray { ++ short lfa_rank; ++ short lfa_elttype; ++ longfloat *lfa_self; ++- short lfa_adjustable; ++- short lfa_offset; ++ int lfa_dim; ++ int *lfa_dims; +++ short lfa_adjustable; +++ short lfa_offset; ++ SPAD; ++ }; ++ ++--- gcl-2.6.12.orig/h/notcomp.h +++++ gcl-2.6.12/h/notcomp.h ++@@ -22,9 +22,6 @@ void segmentation_catcher(); ++ EXTER int gc_enabled, saving_system; ++ ++ EXTER object lisp_package,user_package; ++-#ifdef ANSI_COMMON_LISP ++-EXTER object common_lisp_package; ++-#endif ++ EXTER char *core_end; ++ EXTER int catch_fatal; ++ EXTER long real_maxpage; ++@@ -105,6 +102,7 @@ void old(void) \ ++ #define make_function(a_,b_) make_function_internal(a_,FFN(b_)) ++ #define make_si_function(a_,b_) make_si_function_internal(a_,FFN(b_)) ++ #define make_special_form(a_,b_) make_special_form_internal(a_,FFN(b_)) +++#define make_si_special_form(a_,b_) make_si_special_form_internal(a_,FFN(b_)) ++ #define make_si_sfun(a_,b_,c_) make_si_sfun_internal(a_,FFN(b_),c_) ++ #define STATD static ++ #else ++@@ -114,6 +112,7 @@ void old(void) \ ++ #define make_function(a_,b_) make_function_internal(a_,b_) ++ #define make_si_function(a_,b_) make_si_function_internal(a_,b_) ++ #define make_special_form(a_,b_) make_special_form_internal(a_,b_) +++#define make_si_special_form(a_,b_) make_si_special_form_internal(a_,b_) ++ #define make_si_sfun(a_,b_,c_) make_si_sfun_internal(a_,b_,c_) ++ #define STATD ++ #endif ++--- gcl-2.6.12.orig/h/object.h +++++ gcl-2.6.12/h/object.h ++@@ -77,7 +77,7 @@ Foundation, 675 Mass Ave, Cambridge, MA ++ Definition of the type of LISP objects. ++ */ ++ typedef union int_object iobject; ++-union int_object {object o; fixnum i;}; +++union int_object {object *o; fixnum i;}; ++ ++ #define SMALL_FIXNUM_LIMIT 1024 ++ ++@@ -150,6 +150,12 @@ enum aelttype { /* array element type ++ #define SET_BV_OFFSET(x,val) ((type_of(x)==t_bitvector ? x->bv.bv_offset = val : \ ++ type_of(x)== t_array ? x->a.a_offset=val : (abort(),0))) ++ +++#if !defined(DOUBLE_BIGENDIAN) +++#define BIT_ENDIAN(a_) (7-(a_)) +++#else +++#define BIT_ENDIAN(a_) (a_) +++#endif +++ ++ ++ #define S_DATA(x) ((struct s_data *)((x)->str.str_self)) ++ #define SLOT_TYPE(def,i) (((S_DATA(def))->raw->ust.ust_self[i])) ++@@ -304,9 +310,9 @@ EXTER struct typemanager tm_table[ 32 / ++ /* ++ Contiguous block header. ++ */ ++-EXTER bool prefer_low_mem_contblock; +++EXTER ufixnum contblock_lim; ++ struct contblock { /* contiguous block header */ ++- int cb_size; /* size in bytes */ +++ ufixnum cb_size; /* size in bytes */ ++ struct contblock ++ *cb_link; /* contiguous block link */ ++ }; ++@@ -324,7 +330,6 @@ EXTER struct contblock *old_cb_pointer; ++ /* ++ Variables for memory management. ++ */ ++-EXTER long ncb; /* number of contblocks */ ++ #define ncbpage tm_table[t_contiguous].tm_npage ++ #define maxcbpage tm_table[t_contiguous].tm_maxpage ++ #define cbgbccount tm_table[t_contiguous].tm_gbccount ++@@ -337,15 +342,12 @@ EXTER long holepage; /* hole pages * ++ EXTER long new_holepage,starting_hole_div,starting_relb_heap_mult; ++ ++ ++-#ifdef SGC ++-EXTER char *old_rb_start; /* read-only relblock start */ ++-#endif ++ EXTER char *rb_start; /* relblock start */ ++ EXTER char *rb_end; /* relblock end */ ++ EXTER char *rb_limit; /* relblock limit */ ++ EXTER char *rb_pointer; /* relblock pointer */ ++-EXTER char *rb_start1; /* relblock start in copy space */ ++-EXTER char *rb_pointer1; /* relblock pointer in copy space */ +++/* EXTER char *rb_start1; /\* relblock start in copy space *\/ */ +++/* EXTER char *rb_pointer1; /\* relblock pointer in copy space *\/ */ ++ ++ EXTER char *heap_end; /* heap end */ ++ EXTER char *core_end; /* core end */ ++--- gcl-2.6.12.orig/h/page.h +++++ gcl-2.6.12/h/page.h ++@@ -21,9 +21,6 @@ ++ #define PTR_ALIGN SIZEOF_LONG ++ #endif ++ ++-#define ROUND_UP_PTR(n) (((long)(n) + (PTR_ALIGN-1)) & ~(PTR_ALIGN-1)) ++-#define ROUND_DOWN_PTR(n) (((long)(n) & ~(PTR_ALIGN-1))) ++- ++ /* minimum size required for contiguous pointers */ ++ #if PTR_ALIGN < SIZEOF_CONTBLOCK ++ #define CPTR_SIZE SIZEOF_CONTBLOCK ++@@ -31,9 +28,10 @@ ++ #define CPTR_SIZE PTR_ALIGN ++ #endif ++ ++-#define ROUND_UP_PTR_CONT(n) (((long)(n) + (CPTR_SIZE-1)) & ~(CPTR_SIZE-1)) ++-#define ROUND_DOWN_PTR_CONT(n) (((long)(n) & ~(CPTR_SIZE-1))) ++- +++#define FLR(x,r) (((x))&~(r-1)) +++#define CEI(x,r) FLR((x)+(r-1),r) +++#define PFLR(x,r) ((void *)FLR((ufixnum)x,r)) +++#define PCEI(x,r) ((void *)CEI((ufixnum)x,r)) ++ ++ #ifdef SGC ++ ++@@ -47,33 +45,25 @@ ++ ++ #define SGC_WRITABLE (SGC_PERM_WRITABLE | SGC_PAGE_FLAG) ++ ++-#define WRITABLE_PAGE_P(p) IS_WRITABLE(p) ++-#define ON_WRITABLE_PAGE(x) WRITABLE_PAGE_P(page(x)) ++- ++-#define IF_WRITABLE(x,if_code) ({if (IS_WRITABLE(page(x))) {if_code;}})/*FIXME maxpage*/ ++- ++-#define sgc_mark_object(x) IF_WRITABLE(x,if(!is_marked(x)) sgc_mark_object1(x)) ++- ++ /* When not 0, the free lists in the type manager are freelists ++ on SGC_PAGE's, for those types supporting sgc. ++ Marking and sweeping is done specially */ ++ ++ int sgc_on; ++ +++#define SGC_WHOLE_PAGE /* disallow old data on sgc pages*/ ++ +++#ifndef SGC_WHOLE_PAGE ++ /* for the S field of the FIRSTWORD */ ++ enum sgc_type { SGC_NORMAL, /* not allocated since the last sgc */ ++ SGC_RECENT /* allocated since last sgc */ ++ }; ++- +++#define SGC_OR_M(x) (!TYPEWORD_TYPE_P(pageinfo(x)->type) ? pageinfo(x)->sgc_flags&SGC_PAGE_FLAG : ((object)x)->d.s) +++#endif ++ ++ #define TM_BASE_TYPE_P(i) (tm_table[i].tm_type == i) ++ ++-/* check if a relblock address is new relblock */ ++-#define SGC_RELBLOCK_P(x) ((char *)(x) >= rb_start) ++- ++ /* is this an sgc cell? encompasses all free cells. Used where cell cannot yet be marked */ ++-#define SGC_OR_M(x) (!TYPEWORD_TYPE_P(pageinfo(x)->type) ? pageinfo(x)->sgc_flags&SGC_PAGE_FLAG : ((object)x)->d.s) ++ ++ #ifndef SIGPROTV ++ #define SIGPROTV SIGSEGV ++@@ -107,28 +97,26 @@ extern fixnum writable_pages; ++ ++ #define CLEAR_WRITABLE(i) set_writable(i,0) ++ #define SET_WRITABLE(i) set_writable(i,1) ++-#define IS_WRITABLE(i) is_writable(i) +++#define WRITABLE_PAGE_P(i) is_writable(i) +++#define CACHED_WRITABLE_PAGE_P(i) is_writable_cached(i) +++#define ON_WRITABLE_PAGE(x) WRITABLE_PAGE_P(page(x)) +++#define ON_WRITABLE_PAGE_CACHED(x) CACHED_WRITABLE_PAGE_P(page(x)) +++ ++ ++ ++ EXTER long first_data_page,real_maxpage,phys_pages,available_pages; ++-EXTER void *data_start; +++EXTER void *data_start,*initial_sbrk; ++ ++ #if !defined(IN_MAIN) && defined(SGC) ++ #include "writable.h" ++ #endif ++ ++-#ifdef SGC ++-#define REAL_RB_START (sgc_enabled ? old_rb_start : rb_start) ++-#else ++-#define REAL_RB_START rb_start ++-#endif ++- ++ #define CB_BITS CPTR_SIZE*CHAR_SIZE ++ #define ceil(a_,b_) (((a_)+(b_)-1)/(b_)) ++ #define npage(m_) ceil(m_,PAGESIZE) ++ #define cpage(m_) ({ufixnum _m=(m_);ceil(sizeof(struct pageinfo)+_m+2*ceil(_m,(CB_BITS-2)),PAGESIZE);}) ++ #define mbytes(p_) ceil((p_)*PAGESIZE-sizeof(struct pageinfo),CB_BITS) ++-#define tpage(tm_,m_) (tm_->tm_type==t_relocatable ? npage(m_-(rb_limit-rb_pointer)) : (tm_->tm_type==t_contiguous ? cpage(m_) : npage(m_))) +++#define tpage(tm_,m_) (tm_->tm_type==t_relocatable ? npage(m_-(rb_limit-rb_pointer)+1) : (tm_->tm_type==t_contiguous ? cpage(m_) : npage(m_))) ++ ++ #define CB_DATA_SIZE(z_) ({fixnum _z=(z_);_z*PAGESIZE-2*mbytes(_z)-sizeof(struct pageinfo);}) ++ #define CB_MARK_START(pi_) ((void *)(pi_)+sizeof(struct pageinfo)) ++--- gcl-2.6.12.orig/h/protoize.h +++++ gcl-2.6.12/h/protoize.h ++@@ -7,7 +7,7 @@ ++ /* alloc.c:364:OF */ extern object on_stack_cons (object x, object y); /* (x, y) object x; object y; */ ++ /* alloc.c:376:OF */ extern object fSallocated (object typ); /* (typ) object typ; */ ++ /* alloc.c:401:OF */ extern object fSreset_number_used (object typ); /* (typ) object typ; */ ++-/* alloc.c:480:OF */ extern void insert_contblock (char *p, int s); /* (p, s) char *p; int s; */ +++/* alloc.c:480:OF */ extern void insert_contblock (void *p, ufixnum s); /* (p, s) char *p; int s; */ ++ /* alloc.c:480:OF */ extern void insert_maybe_sgc_contblock (char *p, int s); /* (p, s) char *p; int s; */ ++ /* alloc.c:611:OF */ extern void set_maxpage (void); /* () */ ++ /* alloc.c:635:OF */ extern void gcl_init_alloc (void *); /* () */ ++@@ -124,6 +124,7 @@ struct key {short n,allow_other_keys; ++ /* cfun.c:299:OF */ extern object make_si_sfun_internal (char *s, object (*f)(), int argd); /* (s, f, argd) char *s; int (*f)(); int argd; */ ++ /* cfun.c:322:OF */ extern object make_si_function_internal (char *s, void (*f) ()); /* (s, f) char *s; int (*f)(); */ ++ /* cfun.c:341:OF */ extern object make_special_form_internal (char *s, void (*f)()); /* (s, f) char *s; int (*f)(); */ +++/* cfun.c:341:OF */ extern object make_si_special_form_internal (char *s, void (*f)()); /* (s, f) char *s; int (*f)(); */ ++ /* cfun.c:352:OF */ extern object fScompiled_function_name (object fun); /* (fun) object fun; */ ++ /* cfun.c:371:OF */ extern void turbo_closure (object fun); /* (fun) object fun; */ ++ /* cfun.c:392:OF */ extern object fSturbo_closure (object funobj); /* (funobj) object funobj; */ ++@@ -467,7 +468,7 @@ typedef void (*funcvoid)(void); ++ /* regexp.c:1588:OF */ extern void regerror (char *s); /* (s) char *s; */ ++ /* regexpr.c:48:OF */ extern object fSmatch_beginning (fixnum i); /* (i) int i; */ ++ /* regexpr.c:57:OF */ extern object fSmatch_end (fixnum i); /* (i) int i; */ ++-/* save.c:17:OF */ extern void Lsave (void); /* () */ +++/* save.c:17:OF */ extern void siLsave (void); /* () */ ++ #include ++ /* sbrk.c:9:OF */ /* extern void * sbrk (int n); */ /* (n) int n; */ ++ /* strcspn.c:3:OF */ /* extern size_t strcspn (const char *s1, const char *s2); */ /* (s1, s2) char *s1; char *s2; */ ++@@ -862,9 +863,6 @@ void ++ Lstandard_char_p(void); ++ ++ void ++-Lstring_char_p(void); ++- ++-void ++ Lchar_code(void); ++ ++ void ++@@ -955,9 +953,6 @@ void ++ Lstandard_char_p(void); ++ ++ void ++-Lstring_char_p(void); ++- ++-void ++ Lcharacter(void); ++ ++ void ++@@ -1405,7 +1400,6 @@ void Lforce_output(void); ++ void Lnthcdr(void); ++ void Llogior(void); ++ void Lchar_downcase(void); ++-void Lstring_char_p(void); ++ void Lstream_element_type(void); ++ void Lpackage_used_by_list(void); ++ void Ldivide(void); ++@@ -1923,3 +1917,21 @@ rl_stream_p(FILE *f); ++ ++ void ++ sigint(void); +++ +++void +++allocate_code_block_reserve(void); +++ +++inline void +++resize_hole(ufixnum,enum type); +++ +++inline void * +++alloc_contblock_no_gc(size_t); +++ +++inline void +++reset_contblock_freelist(void); +++ +++inline void +++empty_relblock(void); +++ +++fixnum +++check_avail_pages(void); ++--- gcl-2.6.12.orig/h/symbol.h +++++ gcl-2.6.12/h/symbol.h ++@@ -23,6 +23,6 @@ object sLquote; ++ ++ object sLlambda; ++ ++-object sLlambda_block; ++-object sLlambda_closure; ++-object sLlambda_block_closure; +++object sSlambda_block; +++object sSlambda_closure; +++object sSlambda_block_closure; ++--- gcl-2.6.12.orig/h/writable.h +++++ gcl-2.6.12/h/writable.h ++@@ -1,11 +1,16 @@ +++EXTER fixnum last_page; +++EXTER int last_result; +++ ++ EXTER inline int ++-set_writable(fixnum i,fixnum m) { +++set_writable(fixnum i,bool m) { ++ ++ fixnum j; ++ object v; ++ ++- if (i=page(core_end)) ++- error("out of core in set_writable"); +++ last_page=last_result=0; +++ +++ if (i=page(heap_end)) +++ error("out of heap in set_writable"); ++ ++ if ((v=sSAwritableA ? sSAwritableA->s.s_dbind : Cnil)==Cnil) ++ error("no wrimap in set_writable"); ++@@ -16,13 +21,13 @@ set_writable(fixnum i,fixnum m) { ++ if ((void *)wrimap!=(void *)v->v.v_self) ++ error("set_writable called in gc"); ++ +++ writable_pages+=m-((wrimap[j/8]>>(j%8))&0x1); +++ ++ if (m) ++ wrimap[j/8]|=(1<<(j%8)); ++ else ++ wrimap[j/8]&=~(1<<(j%8)); ++ ++- writable_pages+=m ? 1 : -1; ++- ++ return 0; ++ ++ } ++@@ -35,13 +40,24 @@ is_writable(fixnum i) { ++ ++ if (i=page(core_end)) ++ return 0; ++- +++ ++ if ((v=sSAwritableA ? sSAwritableA->s.s_dbind : Cnil)==Cnil) ++ return 1; ++- +++ ++ if ((j=i-first_data_page)<0 || j>=v->v.v_dim) ++ return 1; ++- +++ ++ return (wrimap[j/8]>>(j%8))&0x1; +++ +++} +++ +++EXTER inline int +++is_writable_cached(fixnum i) { +++ +++ if (last_page==i) +++ return last_result; +++ +++ last_page=i; +++ return last_result=is_writable(i); ++ ++ } ++--- gcl-2.6.12.orig/info/form.texi +++++ gcl-2.6.12/info/form.texi ++@@ -8,18 +8,6 @@ List of all the lambda-list keywords use ++ ++ @end defvr ++ ++-@defun GET-SETF-METHOD (form) ++-Package:LISP ++- ++-Returns the five values (or five 'gangs') constituting the SETF method for ++-FORM. See the doc of DEFINE-SETF-METHOD for the meanings of the gangs. It ++-is an error if the third value (i.e., the list of store variables) is not a ++-one-element list. See the doc of GET-SETF-METHOD-MULTIPLE-VALUE for ++-comparison. ++- ++- ++-@end defun ++- ++ @deffn {Special Form} THE ++ Package:LISP ++ ++--- gcl-2.6.12.orig/lsp/gcl_arraylib.lsp +++++ gcl-2.6.12/lsp/gcl_arraylib.lsp ++@@ -22,23 +22,7 @@ ++ ;;;; array routines ++ ++ ++-(in-package 'lisp) ++- ++- ++-(export '(make-array array-displacement vector ++- array-element-type array-rank array-dimension ++- array-dimensions ++- array-in-bounds-p array-row-major-index ++- adjustable-array-p ++- bit sbit ++- bit-and bit-ior bit-xor bit-eqv bit-nand bit-nor ++- bit-andc1 bit-andc2 bit-orc1 bit-orc2 bit-not ++- array-has-fill-pointer-p fill-pointer ++- vector-push vector-push-extend vector-pop ++- adjust-array upgraded-array-element-type)) ++- ++-(in-package 'system) ++- +++(in-package :si) ++ ++ (proclaim '(optimize (safety 2) (space 3))) ++ ++@@ -47,7 +31,7 @@ ++ (or (gethash type *baet-hash*) ++ (setf (gethash type *baet-hash*) ++ (if type ++- (car (member type '(string-char bit signed-char unsigned-char signed-short unsigned-short +++ (car (member type '(character bit signed-char unsigned-char signed-short unsigned-short ++ fixnum short-float long-float t) ++ :test 'subtypep)) t))))) ++ ++--- gcl-2.6.12.orig/lsp/gcl_auto.lsp +++++ gcl-2.6.12/lsp/gcl_auto.lsp ++@@ -1,4 +1,4 @@ ++-(in-package 'si) +++(in-package :si) ++ ;;; Autoloaders. ++ ++ ++--- gcl-2.6.12.orig/lsp/gcl_auto_new.lsp +++++ gcl-2.6.12/lsp/gcl_auto_new.lsp ++@@ -1,4 +1,4 @@ ++-(in-package 'si) +++(in-package :si) ++ ;;; Autoloaders. ++ ++ ++@@ -67,8 +67,7 @@ ++ (autoload 'ftruncate '|gcl_numlib|) ++ #-unix (autoload 'get-decoded-time '|gcl_mislib|) ++ #+aosvs (autoload 'get-universal-time '|gcl_mislib|) ++-(autoload 'get-setf-method '|gcl_setf|) ++-(autoload 'get-setf-method-multiple-value '|gcl_setf|) +++(autoload 'get-setf-expansion '|gcl_setf|) ++ (autoload 'inspect '|gcl_describe|) ++ (autoload 'intersection '|gcl_listlib|) ++ (autoload 'isqrt '|gcl_numlib|) ++--- gcl-2.6.12.orig/lsp/gcl_autoload.lsp +++++ gcl-2.6.12/lsp/gcl_autoload.lsp ++@@ -21,8 +21,9 @@ ++ ;;;; AUTOLOAD ++ ++ ++-;;; Go into LISP. ++-(in-package 'lisp) +++(in-package :si) +++ +++(export '(clines defentry defcfun object void int double)) ++ ++ ;(defvar *features*) ++ ++@@ -127,13 +128,13 @@ ++ ++ ;;; Allocator. ++ ++-(import 'si::allocate) ++-(export '(allocate +++;(import 'si::allocate) +++;(export '(allocate ++ ;allocated-pages maximum-allocatable-pages ++ ;allocate-contiguous-pages ++ ;allocated-contiguous-pages maximum-contiguous-pages ++ ;allocate-relocatable-pages allocated-relocatable-pages ++- sfun gfun cfun cclosure spice structure)) +++; sfun gfun cfun cclosure spice structure)) ++ ++ ;(defvar type-character-alist ++ ; '((cons . #\.) ++@@ -279,12 +280,12 @@ ++ ncbpage maxcbpage (if (zerop cbgbccount) nil cbgbccount) ncb) ++ (format t "~9T~D~35Thole~%" holepage) ++ (format t "~8D/~D~19T~6,1F%~@[~8D~]~35Trelocatable~%~%" ++- nrbpage maxrbpage (/ rbused 0.01 (+ rbused rbfree)) +++ nrbpage maxrbpage (if (zerop (+ rbused rbfree)) 0.0 (/ rbused 0.01 (+ rbused rbfree))) ++ (if (zerop rbgbccount) nil rbgbccount)) ++ (format t "~10D pages for cells~%~%" npage) ++ (format t "~10D total pages in core~%" (+ npage ncbpage nrbpage)) ++ (format t "~10D current core maximum pages~%" (+ maxnpage maxcbpage maxrbpage)) ++- (format t "~10D pages reserved for gc~%" maxrbpage) +++ (format t "~10D pages reserved for gc~%" nrbpage) ++ (format t "~10D pages available for adding to core~%" leftpage) ++ (format t "~10D pages reserved for core exhaustion~%~%" (- maxpage (+ maxnpage maxcbpage (ash maxrbpage 1) leftpage))) ++ (format t "~10D maximum pages~%" maxpage) ++@@ -411,8 +412,8 @@ Good luck! The GCL Development Team" ++ (setf (get 'with-output-to-string 'si:pretty-print-format) 1) ++ ++ ++-(in-package 'si) +++(in-package :si) ++ ++ (defvar *lib-directory* (namestring (truename "../"))) ++ ++-(import '(*lib-directory* *load-path* *system-directory*) 'si::user) +++(import '(*lib-directory* *load-path* *system-directory*) :user) ++--- gcl-2.6.12.orig/lsp/gcl_debug.lsp +++++ gcl-2.6.12/lsp/gcl_debug.lsp ++@@ -1,8 +1,8 @@ ++ ;;Copyright William F. Schelter 1990, All Rights Reserved ++ ++ ++-(In-package "SYSTEM") ++-(import 'sloop::sloop) +++(In-package :si) +++(import '(sloop::sloop)) ++ ++ (eval-when (compile eval) ++ (proclaim '(optimize (safety 2) (space 3))) ++@@ -98,7 +98,7 @@ ++ (cond ((compiled-function-p fun) ++ (setq name (compiled-function-name fun))) ++ (t (setq name fun))) ++- (if (symbolp name)(setq args (get name 'debug))) +++ (if (symbolp name)(setq args (get name 'debugger))) ++ (let ((next (ihs-vs (f + 1 *current-ihs*)))) ++ (cond (next ++ (format *debug-io* ">> ~a():" name) ++@@ -583,7 +583,7 @@ ++ ;; in other common lisps this should be a string output stream. ++ ++ (defvar *display-string* ++- (make-array 100 :element-type 'string-char :fill-pointer 0 :adjustable t)) +++ (make-array 100 :element-type 'character :fill-pointer 0 :adjustable t)) ++ ++ (defun display-env (n env) ++ (do ((v (reverse env) (cdr v))) ++@@ -625,7 +625,7 @@ ++ (mv-values nil j)) ++ (let ++ ((na (ihs-fname j))) ++- (cond ((special-form-p na)) +++ (cond ((special-operator-p na)) ++ ((get na 'dbl-invisible)) ++ ((fboundp na)(return (mv-values na j))))))) ++ ++@@ -677,7 +677,7 @@ ++ (vs (1+ k)) ++ (vs (+ k 2))) ++ ))))))) ++- ((special-form-p na) nil) +++ ((special-operator-p na) nil) ++ ((get na 'dbl-invisible)) ++ ((fboundp na) ++ (mv-values i na nil nil ++@@ -717,7 +717,7 @@ ++ (end (min (ihs-vs (1+ ihs)) (vs-top)))) ++ (format *display-string* "") ++ (do ((i base ) ++- (v (get (ihs-fname ihs) 'debug) (cdr v))) +++ (v (get (ihs-fname ihs) 'debugger) (cdr v))) ++ ((or (fb >= i end)(fb > (fill-pointer *display-string*) plength))) ++ (format *display-string* "~a~@[~d~]=~s~@[,~]" ++ (or (car v) 'loc) (if (not (car v)) (f - i base)) (vs i) ++--- gcl-2.6.12.orig/lsp/gcl_defmacro.lsp +++++ gcl-2.6.12/lsp/gcl_defmacro.lsp ++@@ -22,11 +22,7 @@ ++ ;;;; defines SI:DEFMACRO*, the defmacro preprocessor ++ ++ ++-(in-package 'lisp) ++-(export '(&whole &environment &body)) ++- ++- ++-(in-package 'system) +++(in-package :si) ++ ++ ++ (eval-when (compile) (proclaim '(optimize (safety 2) (space 3)))) ++--- gcl-2.6.12.orig/lsp/gcl_defstruct.lsp +++++ gcl-2.6.12/lsp/gcl_defstruct.lsp ++@@ -22,21 +22,13 @@ ++ ;;;; The structure routines. ++ ++ ++-(in-package 'lisp) ++-(export 'defstruct) ++- ++- ++-(in-package 'system) +++(in-package :si) ++ ++ ++ (proclaim '(optimize (safety 2) (space 3))) ++ ++ ++ ++-;(in-package 'system) ++- ++- ++- ++ (defvar *accessors* (make-array 10 :adjustable t)) ++ (defvar *list-accessors* (make-array 2 :adjustable t)) ++ (defvar *vector-accessors* (make-array 2 :adjustable t)) ++@@ -99,7 +91,10 @@ ++ (setq dont-overwrite t) ++ ) ++ (t (setf (get access-function 'structure-access) ++- (cons (if type type name) offset))))))) +++ (cons (if type type name) offset)) +++ (when slot-type +++ (proclaim `(ftype (function (,name) ,slot-type) ,access-function))) +++ ))))) ++ nil)) ++ ++ ++@@ -504,7 +499,7 @@ ++ ;bootstrapping code! ++ (setq def (make-s-data-structure ++ (make-array (* leng (size-of t)) ++- :element-type 'string-char :static t) +++ :element-type 'character :static t) ++ (make-t-type leng nil slot-descriptions) ++ *standard-slot-positions* ++ slot-descriptions ++@@ -569,9 +564,7 @@ ++ (setf (symbol-function predicate) ++ #'(lambda (x) ++ (si::structure-subtype-p x name)))) ++- (setf (get predicate 'compiler::co1) ++- 'compiler::co1structure-predicate) ++- (setf (get predicate 'struct-predicate) name) +++ (proclaim `(ftype (function (,name) t) ,predicate));FIXME boolean is unboxed ++ ) ++ ) nil) ++ ++--- gcl-2.6.12.orig/lsp/gcl_describe.lsp +++++ gcl-2.6.12/lsp/gcl_describe.lsp ++@@ -22,12 +22,7 @@ ++ ;;;; DESCRIBE and INSPECT ++ ++ ++-(in-package 'lisp) ++- ++-(export '(describe inspect)) ++- ++- ++-(in-package 'system) +++(in-package :si) ++ ++ ++ (proclaim '(optimize (safety 2) (space 3))) ++@@ -191,7 +186,6 @@ ++ (defun inspect-character (character) ++ (format t ++ (cond ((standard-char-p character) "~S - standard character") ++- ((string-char-p character) "~S - string character") ++ (t "~S - character")) ++ character) ++ (inspect-print "code: #x~X" (char-code character)) ++@@ -353,7 +347,7 @@ ++ (find-package "SYSTEM") ++ *package*))) ++ ++- (cond ((special-form-p symbol) +++ (cond ((special-operator-p symbol) ++ (doc1 (or (documentation symbol 'function) "") ++ (if (macro-function symbol) ++ "[Special form and Macro]" ++--- gcl-2.6.12.orig/lsp/gcl_destructuring_bind.lsp +++++ gcl-2.6.12/lsp/gcl_destructuring_bind.lsp ++@@ -8,9 +8,7 @@ ++ ;;; in DEFMACRO are the reason this isn't as easy as it sounds. ++ ;;; ++ ++-(in-package 'lisp) ++- ++-(export '(destructuring-bind)) +++(in-package :si) ++ ++ (defvar *arg-tests* () ++ "A list of tests that do argument counting at expansion time.") ++--- gcl-2.6.12.orig/lsp/gcl_doc-file.lsp +++++ gcl-2.6.12/lsp/gcl_doc-file.lsp ++@@ -13,7 +13,7 @@ ++ for w in-package v ++ when (setq doc (documentation w 'function)) ++ do (format st "F~a~%~ain ~a package:~a" w ++- (cond ((special-form-p w) "Special Form ") +++ (cond ((special-operator-p w) "Special Form ") ++ ((functionp w) "Function ") ++ ((macro-function w) "Macro ") ++ (t "")) ++--- gcl-2.6.12.orig/lsp/gcl_evalmacros.lsp +++++ gcl-2.6.12/lsp/gcl_evalmacros.lsp ++@@ -20,11 +20,7 @@ ++ ;;;; evalmacros.lsp ++ ++ ++-(in-package "LISP") ++- ++-(export '(defvar defparameter defconstant)) ++- ++-(in-package "SYSTEM") +++(in-package :si) ++ ++ ++ (eval-when (compile) (proclaim '(optimize (safety 2) (space 3)))) ++--- gcl-2.6.12.orig/lsp/gcl_export.lsp +++++ gcl-2.6.12/lsp/gcl_export.lsp ++@@ -21,313 +21,468 @@ ++ ;;;; ++ ;;;; Exporting external symbols of LISP package ++ ++- ++-(in-package 'lisp) ++- +++(in-package :common-lisp) ++ ++ (export '( ++- ++-&whole ++-&environment ++-&body ++-* ++-** ++-*** ++-*break-enable* ++-*break-on-warnings* ++-*features* ++-*modules* ++-+ ++-++ ++-+++ ++-- ++-/ ++-// ++-/// ++-COMMON ++-KYOTO ++-KCL ++-abs ++-acos ++-acosh ++-adjust-array ++-adjustable-array-p ++-apropos ++-apropos-list ++-array-dimension ++-array-dimensions ++-array-element-type ++-array-has-fill-pointer-p ++-array-in-bounds-p ++-array-rank ++-array-row-major-index ++-asin ++-asinh ++-assert ++-atanh ++-bit ++-bit-and ++-bit-andc1 ++-bit-andc2 ++-bit-eqv ++-bit-ior ++-bit-nand ++-bit-nor ++-bit-not ++-bit-orc1 ++-bit-orc2 ++-bit-xor ++-break ++-byte ++-byte-position ++-byte-size ++-ccase ++-cerror ++-check-type ++-cis ++-coerce ++-compile ++-compile-file ++-concatenate ++-cosh ++-count ++-count-if ++-count-if-not ++-ctypecase ++-decf ++-declaim ++-decode-universal-time ++-defconstant ++-define-modify-macro ++-define-setf-method ++-defparameter ++-defsetf ++-defstruct ++-deftype ++-defvar ++-delete ++-delete-duplicates ++-delete-if ++-delete-if-not ++-deposit-field ++-describe ++-disassemble ++-do* ++-do-all-symbols ++-do-external-symbols ++-do-symbols ++-documentation ++-dolist ++-dotimes ++-dpb ++-dribble ++-ecase ++-ed ++-eighth ++-encode-universal-time ++-error ++-etypecase ++-eval-when ++-every ++-fceiling ++-ffloor ++-fifth ++-fill ++-fill-pointer ++-find ++-find-all-symbols ++-find-if ++-find-if-not ++-first ++-format ++-fourth ++-fround ++-ftruncate ++-get-decoded-time ++-get-setf-method ++-get-setf-method-multiple-value ++-get-universal-time ++-getf ++-ignore ++-ignorable ++-incf ++-inspect ++-intersection ++-isqrt ++-ldb ++-ldb-test ++-lisp-implementation-type ++-logandc1 ++-logandc2 ++-lognand ++-lognor ++-lognot ++-logorc1 ++-logorc2 ++-logtest ++-long-site-name ++-machine-instance ++-machine-type ++-machine-version ++-make-array ++-make-sequence ++-map ++-mask-field ++-merge ++-mismatch ++-mod ++-multiple-value-setq ++-nintersection ++-ninth ++-notany ++-notevery ++-nset-difference ++-nset-exclusive-or ++-nsubstitute ++-nsubstitute-if ++-nsubstitute-if-not ++-nunion ++-phase ++-pop ++-position ++-position-if ++-position-if-not ++-prin1-to-string ++-princ-to-string ++-prog* ++-provide ++-psetf ++-push ++-pushnew ++-rational ++-rationalize ++-real ++-read-from-string ++-reduce ++-rem ++-remf ++-remove ++-remove-duplicates ++-remove-if ++-remove-if-not ++-replace ++-require ++-rotatef ++-room ++-sbit ++-search ++-second ++-set-difference ++-set-exclusive-or ++-setf ++-seventh ++-shiftf ++-short-site-name ++-signum ++-sinh ++-sixth ++-software-type ++-software-version ++-some ++-sort ++-stable-sort ++-step ++-structure ++-subsetp ++-substitute ++-substitute-if ++-substitute-if-not ++-subtypep ++-tanh ++-tenth ++-third ++-time ++-trace ++-type ++-typecase ++-typep ++-union ++-untrace ++-variable ++-vector ++-vector-pop ++-vector-push ++-vector-push-extend ++-warn ++-with-input-from-string ++-with-open-file ++-with-open-stream ++-with-output-to-string ++-write-to-string ++-y-or-n-p ++-yes-or-no-p ++- ++-proclaim ++-proclamation ++-special ++-type ++-ftype ++-function ++-inline ++-notinline ++-ignore ++-optimize ++-speed ++-space ++-safety ++-compilation-speed ++-declaration ++- ++-*eval-when-compile* ++- ++-clines ++-defcfun ++-defentry ++-defla ++- ++-void ++-object ++-char ++-int ++-float ++-double ++- ++-define-compiler-macro ++-compiler-macro ++-compiler-macro-function ++- ++-with-compilation-unit ++-with-standard-io-syntax ++-*print-lines* ++-*print-miser-width* ++-*print-pprint-dispatch* ++-*print-right-margin* ++- ++-*read-eval* ++- ++-dynamic-extent ++- ++-loop ++-check-type assert typecase etypecase ctypecase case ecase ccase ++- ++-restart-bind restart-case with-condition-restarts muffle-warning continue abort ++- store-value use-value ++- restart restart-name restart-function restart-report-function ++- restart-interactive-function restart-test-function ++- compute-restarts find-restart invoke-restart invoke-restart-interactively ++- with-simple-restart signal ++- ++-simple-condition simple-error simple-warning invoke-debugger *debugger-hook* *break-on-signals* ++- ++-handler-case handler-bind ignore-errors define-condition make-condition ++- condition warning serious-condition simple-condition-format-control simple-condition-format-arguments ++- storage-condition stack-overflow storage-exhausted type-error ++- type-error-datum type-error-expected-type simple-type-error ++- program-error control-error stream-error stream-error-stream ++- end-of-file file-error file-error-pathname cell-error cell-error-name ++- unbound-variable undefined-function arithmetic-error ++- arithmetic-error-operation arithmetic-error-operands ++- package-error package-error-package ++- division-by-zero floating-point-overflow floating-point-underflow ++- ++-)) +++ &allow-other-keys *print-miser-width* +++ &aux *print-pprint-dispatch* +++ &body *print-pretty* +++ &environment *print-radix* +++ &key *print-readably* +++ &optional *print-right-margin* +++ &rest *query-io* +++ &whole *random-state* +++ * *read-base* +++ ** *read-default-float-format* +++ *** *read-eval* +++ *break-on-signals* *read-suppress* +++ *compile-file-pathname* *readtable* +++ *compile-file-truename* *standard-input* +++ *compile-print* *standard-output* +++ *compile-verbose* *terminal-io* +++ *debug-io* *trace-output* +++ *debugger-hook* + +++ *default-pathname-defaults* ++ +++ *error-output* +++ +++ *features* - +++ *gensym-counter* / +++ *load-pathname* // +++ *load-print* /// +++ *load-truename* /= +++ *load-verbose* 1+ +++ *macroexpand-hook* 1- +++ *modules* < +++ *package* <= +++ *print-array* = +++ *print-base* > +++ *print-case* >= +++ *print-circle* abort +++ *print-escape* abs +++ *print-gensym* acons +++ *print-length* acos +++ *print-level* acosh +++ *print-lines* add-method +++ +++ adjoin atom boundp +++ adjust-array base-char break +++ adjustable-array-p base-string broadcast-stream +++ allocate-instance bignum broadcast-stream-streams +++ alpha-char-p bit built-in-class +++ alphanumericp bit-and butlast +++ and bit-andc1 byte +++ append bit-andc2 byte-position +++ apply bit-eqv byte-size +++ apropos bit-ior caaaar +++ apropos-list bit-nand caaadr +++ aref bit-nor caaar +++ arithmetic-error bit-not caadar +++ arithmetic-error-operands bit-orc1 caaddr +++ arithmetic-error-operation bit-orc2 caadr +++ array bit-vector caar +++ array-dimension bit-vector-p cadaar +++ array-dimension-limit bit-xor cadadr +++ array-dimensions block cadar +++ array-displacement boole caddar +++ array-element-type boole-1 cadddr +++ array-has-fill-pointer-p boole-2 caddr +++ array-in-bounds-p boole-and cadr +++ array-rank boole-andc1 call-arguments-limit +++ array-rank-limit boole-andc2 call-method +++ array-row-major-index boole-c1 call-next-method +++ array-total-size boole-c2 car +++ array-total-size-limit boole-clr case +++ arrayp boole-eqv catch +++ ash boole-ior ccase +++ asin boole-nand cdaaar +++ asinh boole-nor cdaadr +++ assert boole-orc1 cdaar +++ assoc boole-orc2 cdadar +++ assoc-if boole-set cdaddr +++ assoc-if-not boole-xor cdadr +++ atan boolean cdar +++ atanh both-case-p cddaar +++ +++ cddadr clear-input copy-tree +++ cddar clear-output cos +++ cdddar close cosh +++ cddddr clrhash count +++ cdddr code-char count-if +++ cddr coerce count-if-not +++ cdr compilation-speed ctypecase +++ ceiling compile debug +++ cell-error compile-file decf +++ cell-error-name compile-file-pathname declaim +++ cerror compiled-function declaration +++ change-class compiled-function-p declare +++ char compiler-macro decode-float +++ char-code compiler-macro-function decode-universal-time +++ char-code-limit complement defclass +++ char-downcase complex defconstant +++ char-equal complexp defgeneric +++ char-greaterp compute-applicable-methods define-compiler-macro +++ char-int compute-restarts define-condition +++ char-lessp concatenate define-method-combination +++ char-name concatenated-stream define-modify-macro +++ char-not-equal concatenated-stream-streams define-setf-expander +++ char-not-greaterp cond define-symbol-macro +++ char-not-lessp condition defmacro +++ char-upcase conjugate defmethod +++ char/= cons defpackage +++ char< consp defparameter +++ char<= constantly defsetf +++ char= constantp defstruct +++ char> continue deftype +++ char>= control-error defun +++ character copy-alist defvar +++ characterp copy-list delete +++ check-type copy-pprint-dispatch delete-duplicates +++ cis copy-readtable delete-file +++ class copy-seq delete-if +++ class-name copy-structure delete-if-not +++ class-of copy-symbol delete-package +++ +++ denominator eq +++ deposit-field eql +++ describe equal +++ describe-object equalp +++ destructuring-bind error +++ digit-char etypecase +++ digit-char-p eval +++ directory eval-when +++ directory-namestring evenp +++ disassemble every +++ division-by-zero exp +++ do export +++ do* expt +++ do-all-symbols extended-char +++ do-external-symbols fboundp +++ do-symbols fceiling +++ documentation fdefinition +++ dolist ffloor +++ dotimes fifth +++ double-float file-author +++ double-float-epsilon file-error +++ double-float-negative-epsilon file-error-pathname +++ dpb file-length +++ dribble file-namestring +++ dynamic-extent file-position +++ ecase file-stream +++ echo-stream file-string-length +++ echo-stream-input-stream file-write-date +++ echo-stream-output-stream fill +++ ed fill-pointer +++ eighth find +++ elt find-all-symbols +++ encode-universal-time find-class +++ end-of-file find-if +++ endp find-if-not +++ enough-namestring find-method +++ ensure-directories-exist find-package +++ ensure-generic-function find-restart +++ +++ find-symbol get-internal-run-time +++ finish-output get-macro-character +++ first get-output-stream-string +++ fixnum get-properties +++ flet get-setf-expansion +++ float get-universal-time +++ float-digits getf +++ float-precision gethash +++ float-radix go +++ float-sign graphic-char-p +++ floating-point-inexact handler-bind +++ floating-point-invalid-operation handler-case +++ floating-point-overflow hash-table +++ floating-point-underflow hash-table-count +++ floatp hash-table-p +++ floor hash-table-rehash-size +++ fmakunbound hash-table-rehash-threshold +++ force-output hash-table-size +++ format hash-table-test +++ formatter host-namestring +++ fourth identity +++ fresh-line if +++ fround ignorable +++ ftruncate ignore +++ ftype ignore-errors +++ funcall imagpart +++ function import +++ function-keywords in-package +++ function-lambda-expression incf +++ functionp initialize-instance +++ gcd inline +++ generic-function input-stream-p +++ gensym inspect +++ gentemp integer +++ get integer-decode-float +++ get-decoded-time integer-length +++ get-dispatch-macro-character integerp +++ get-internal-real-time interactive-stream-p +++ +++ intern lisp-implementation-type +++ internal-time-units-per-second lisp-implementation-version +++ intersection list +++ invalid-method-error list* +++ invoke-debugger list-all-packages +++ invoke-restart list-length +++ invoke-restart-interactively listen +++ isqrt listp +++ keyword load +++ keywordp load-logical-pathname-translations +++ labels load-time-value +++ lambda locally +++ lambda-list-keywords log +++ lambda-parameters-limit logand +++ last logandc1 +++ lcm logandc2 +++ ldb logbitp +++ ldb-test logcount +++ ldiff logeqv +++ least-negative-double-float logical-pathname +++ least-negative-long-float logical-pathname-translations +++ least-negative-normalized-double-float logior +++ least-negative-normalized-long-float lognand +++ least-negative-normalized-short-float lognor +++ least-negative-normalized-single-float lognot +++ least-negative-short-float logorc1 +++ least-negative-single-float logorc2 +++ least-positive-double-float logtest +++ least-positive-long-float logxor +++ least-positive-normalized-double-float long-float +++ least-positive-normalized-long-float long-float-epsilon +++ least-positive-normalized-short-float long-float-negative-epsilon +++ least-positive-normalized-single-float long-site-name +++ least-positive-short-float loop +++ least-positive-single-float loop-finish +++ length lower-case-p +++ let machine-instance +++ let* machine-type +++ +++ machine-version mask-field +++ macro-function max +++ macroexpand member +++ macroexpand-1 member-if +++ macrolet member-if-not +++ make-array merge +++ make-broadcast-stream merge-pathnames +++ make-concatenated-stream method +++ make-condition method-combination +++ make-dispatch-macro-character method-combination-error +++ make-echo-stream method-qualifiers +++ make-hash-table min +++ make-instance minusp +++ make-instances-obsolete mismatch +++ make-list mod +++ make-load-form most-negative-double-float +++ make-load-form-saving-slots most-negative-fixnum +++ make-method most-negative-long-float +++ make-package most-negative-short-float +++ make-pathname most-negative-single-float +++ make-random-state most-positive-double-float +++ make-sequence most-positive-fixnum +++ make-string most-positive-long-float +++ make-string-input-stream most-positive-short-float +++ make-string-output-stream most-positive-single-float +++ make-symbol muffle-warning +++ make-synonym-stream multiple-value-bind +++ make-two-way-stream multiple-value-call +++ makunbound multiple-value-list +++ map multiple-value-prog1 +++ map-into multiple-value-setq +++ mapc multiple-values-limit +++ mapcan name-char +++ mapcar namestring +++ mapcon nbutlast +++ maphash nconc +++ mapl next-method-p +++ maplist nil +++ +++ nintersection package-error +++ ninth package-error-package +++ no-applicable-method package-name +++ no-next-method package-nicknames +++ not package-shadowing-symbols +++ notany package-use-list +++ notevery package-used-by-list +++ notinline packagep +++ nreconc pairlis +++ nreverse parse-error +++ nset-difference parse-integer +++ nset-exclusive-or parse-namestring +++ nstring-capitalize pathname +++ nstring-downcase pathname-device +++ nstring-upcase pathname-directory +++ nsublis pathname-host +++ nsubst pathname-match-p +++ nsubst-if pathname-name +++ nsubst-if-not pathname-type +++ nsubstitute pathname-version +++ nsubstitute-if pathnamep +++ nsubstitute-if-not peek-char +++ nth phase +++ nth-value pi +++ nthcdr plusp +++ null pop +++ number position +++ numberp position-if +++ numerator position-if-not +++ nunion pprint +++ oddp pprint-dispatch +++ open pprint-exit-if-list-exhausted +++ open-stream-p pprint-fill +++ optimize pprint-indent +++ or pprint-linear +++ otherwise pprint-logical-block +++ output-stream-p pprint-newline +++ package pprint-pop +++ +++ pprint-tab read-char +++ pprint-tabular read-char-no-hang +++ prin1 read-delimited-list +++ prin1-to-string read-from-string +++ princ read-line +++ princ-to-string read-preserving-whitespace +++ print read-sequence +++ print-not-readable reader-error +++ print-not-readable-object readtable +++ print-object readtable-case +++ print-unreadable-object readtablep +++ probe-file real +++ proclaim realp +++ prog realpart +++ prog* reduce +++ prog1 reinitialize-instance +++ prog2 rem +++ progn remf +++ program-error remhash +++ progv remove +++ provide remove-duplicates +++ psetf remove-if +++ psetq remove-if-not +++ push remove-method +++ pushnew remprop +++ quote rename-file +++ random rename-package +++ random-state replace +++ random-state-p require +++ rassoc rest +++ rassoc-if restart +++ rassoc-if-not restart-bind +++ ratio restart-case +++ rational restart-name +++ rationalize return +++ rationalp return-from +++ read revappend +++ read-byte reverse +++ +++ room simple-bit-vector +++ rotatef simple-bit-vector-p +++ round simple-condition +++ row-major-aref simple-condition-format-arguments +++ rplaca simple-condition-format-control +++ rplacd simple-error +++ safety simple-string +++ satisfies simple-string-p +++ sbit simple-type-error +++ scale-float simple-vector +++ schar simple-vector-p +++ search simple-warning +++ second sin +++ sequence single-float +++ serious-condition single-float-epsilon +++ set single-float-negative-epsilon +++ set-difference sinh +++ set-dispatch-macro-character sixth +++ set-exclusive-or sleep +++ set-macro-character slot-boundp +++ set-pprint-dispatch slot-exists-p +++ set-syntax-from-char slot-makunbound +++ setf slot-missing +++ setq slot-unbound +++ seventh slot-value +++ shadow software-type +++ shadowing-import software-version +++ shared-initialize some +++ shiftf sort +++ short-float space +++ short-float-epsilon special +++ short-float-negative-epsilon special-operator-p +++ short-site-name speed +++ signal sqrt +++ signed-byte stable-sort +++ signum standard +++ simple-array standard-char +++ simple-base-string standard-char-p +++ +++ standard-class sublis +++ standard-generic-function subseq +++ standard-method subsetp +++ standard-object subst +++ step subst-if +++ storage-condition subst-if-not +++ store-value substitute +++ stream substitute-if +++ stream-element-type substitute-if-not +++ stream-error subtypep +++ stream-error-stream svref +++ stream-external-format sxhash +++ streamp symbol +++ string symbol-function +++ string-capitalize symbol-macrolet +++ string-downcase symbol-name +++ string-equal symbol-package +++ string-greaterp symbol-plist +++ string-left-trim symbol-value +++ string-lessp symbolp +++ string-not-equal synonym-stream +++ string-not-greaterp synonym-stream-symbol +++ string-not-lessp t +++ string-right-trim tagbody +++ string-stream tailp +++ string-trim tan +++ string-upcase tanh +++ string/= tenth +++ string< terpri +++ string<= the +++ string= third +++ string> throw +++ string>= time +++ stringp trace +++ structure translate-logical-pathname +++ structure-class translate-pathname +++ structure-object tree-equal +++ style-warning truename +++ +++ truncate values-list +++ two-way-stream variable +++ two-way-stream-input-stream vector +++ two-way-stream-output-stream vector-pop +++ type vector-push +++ type-error vector-push-extend +++ type-error-datum vectorp +++ type-error-expected-type warn +++ type-of warning +++ typecase when +++ typep wild-pathname-p +++ unbound-slot with-accessors +++ unbound-slot-instance with-compilation-unit +++ unbound-variable with-condition-restarts +++ undefined-function with-hash-table-iterator +++ unexport with-input-from-string +++ unintern with-open-file +++ union with-open-stream +++ unless with-output-to-string +++ unread-char with-package-iterator +++ unsigned-byte with-simple-restart +++ untrace with-slots +++ unuse-package with-standard-io-syntax +++ unwind-protect write +++ update-instance-for-different-class write-byte +++ update-instance-for-redefined-class write-char +++ upgraded-array-element-type write-line +++ upgraded-complex-part-type write-sequence +++ upper-case-p write-string +++ use-package write-to-string +++ use-value y-or-n-p +++ user-homedir-pathname yes-or-no-p +++ values zerop)) ++--- gcl-2.6.12.orig/lsp/gcl_fpe.lsp +++++ gcl-2.6.12/lsp/gcl_fpe.lsp ++@@ -1,8 +1,8 @@ ++-(in-package :fpe :use '(:lisp)) +++(in-package :fpe) ++ ++ (import 'si::(disassemble-instruction feenableexcept fedisableexcept fld *fixnum *float *double ++ +fe-list+ +mc-context-offsets+ floating-point-error ++- function-by-address)) +++ function-by-address clines defentry)) ++ (export '(break-on-floating-point-exceptions read-instruction)) ++ ++ (eval-when ++--- gcl-2.6.12.orig/lsp/gcl_info.lsp +++++ gcl-2.6.12/lsp/gcl_info.lsp ++@@ -1,4 +1,4 @@ ++-(in-package "SI" ) +++(in-package :si) ++ ++ (eval-when (compile eval) ++ (defmacro while (test &body body) ++@@ -11,7 +11,7 @@ ++ (eval-when (compile eval load) ++ (defun sharp-u-reader (stream subchar arg) ++ subchar arg ++- (let ((tem (make-array 10 :element-type 'string-char :fill-pointer 0))) +++ (let ((tem (make-array 10 :element-type 'character :fill-pointer 0))) ++ (or (eql (read-char stream) #\") ++ (error "sharp-u-reader reader needs a \" right after it")) ++ (loop ++@@ -44,7 +44,7 @@ ++ (or (and (<= 0 start ) (<= start len)) ++ (error "illegal file start ~a" start)) ++ (let ((tem (make-array (- len start) ++- :element-type 'string-char))) +++ :element-type 'character))) ++ (if (> start 0) (file-position st start)) ++ (si::fread tem 0 (length tem) st) tem))) ++ ++@@ -105,7 +105,7 @@ ++ ((> extra 0) ++ (setq tem ++ (make-array (f + (length x) extra) ++- :element-type 'string-char :fill-pointer 0)) +++ :element-type 'character :fill-pointer 0)) ++ (setq i 0) ++ (go AGAIN)) ++ (t (setq tem x))) ++--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp +++++ gcl-2.6.12/lsp/gcl_iolib.lsp ++@@ -22,21 +22,7 @@ ++ ;;;; The IO library. ++ ++ ++-(in-package 'lisp) ++- ++- ++-(export '(with-open-stream with-input-from-string with-output-to-string ++- ensure-directories-exist wild-pathname-p ++- read-byte write-byte read-sequence write-sequence)) ++-(export '(read-from-string)) ++-(export '(write-to-string prin1-to-string princ-to-string)) ++-(export 'with-open-file) ++-(export '(y-or-n-p yes-or-no-p)) ++-(export 'dribble) ++- ++- ++-(in-package 'system) ++- +++(in-package :si) ++ ++ (proclaim '(optimize (safety 2) (space 3))) ++ ++--- gcl-2.6.12.orig/lsp/gcl_listlib.lsp +++++ gcl-2.6.12/lsp/gcl_listlib.lsp ++@@ -25,13 +25,7 @@ ++ ; rather than recursion, as needed for large data sets. ++ ++ ++-(in-package 'lisp) ++- ++-(export '(union nunion intersection nintersection ++- set-difference nset-difference set-exclusive-or nset-exclusive-or ++- subsetp nth nth-value nthcdr first second third fourth fifth sixth seventh eighth ninth tenth)) ++- ++-(in-package 'system) +++(in-package :si) ++ ++ (eval-when (compile) ++ (proclaim '(optimize (safety 0) (space 3))) ++--- gcl-2.6.12.orig/lsp/gcl_mislib.lsp +++++ gcl-2.6.12/lsp/gcl_mislib.lsp ++@@ -20,15 +20,7 @@ ++ ;;;; This file is IMPLEMENTATION-DEPENDENT. ++ ++ ++-(in-package 'lisp) ++- ++- ++-(export 'time) ++-(export '(reset-sys-paths decode-universal-time encode-universal-time compile-file-pathname complement constantly)) ++- ++- ++-(in-package 'system) ++- +++(in-package :si) ++ ++ (proclaim '(optimize (safety 2) (space 3))) ++ ++@@ -37,13 +29,13 @@ ++ (let ((real-start (gensym)) (real-end (gensym)) (gbc-time-start (gensym)) ++ (gbc-time (gensym)) (x (gensym)) (run-start (gensym)) (run-end (gensym)) ++ (child-run-start (gensym)) (child-run-end (gensym))) ++- `(let (,real-start ,real-end (,gbc-time-start (si::gbc-time)) ,gbc-time ,x) +++ `(let (,real-start ,real-end (,gbc-time-start (gbc-time)) ,gbc-time ,x) ++ (setq ,real-start (get-internal-real-time)) ++ (multiple-value-bind (,run-start ,child-run-start) (get-internal-run-time) ++- (si::gbc-time 0) +++ (gbc-time 0) ++ (setq ,x (multiple-value-list ,form)) ++- (setq ,gbc-time (si::gbc-time)) ++- (si::gbc-time (+ ,gbc-time-start ,gbc-time)) +++ (setq ,gbc-time (gbc-time)) +++ (gbc-time (+ ,gbc-time-start ,gbc-time)) ++ (multiple-value-bind (,run-end ,child-run-end) (get-internal-run-time) ++ (setq ,real-end (get-internal-real-time)) ++ (fresh-line *trace-output*) ++@@ -139,7 +131,7 @@ x)) ++ *gcl-major-version* *gcl-minor-version* *gcl-extra-version* ++ (if (member :ansi-cl *features*) "ANSI" "CLtL1") ++ (if (member :gprof *features*) "profiling" "") ++- (si::gcl-compile-time) +++ (gcl-compile-time) ++ "Source License: LGPL(gcl,gmp), GPL(unexec,bfd,xgcl)" ++ "Binary License: " ++ (if gpled-modules (format nil "GPL due to GPL'ed components: ~a" gpled-modules) ++@@ -150,13 +142,13 @@ x)) ++ ++ (defun lisp-implementation-version nil ++ (format nil "GCL ~a.~a.~a" ++- si::*gcl-major-version* ++- si::*gcl-minor-version* ++- si::*gcl-extra-version*)) +++ *gcl-major-version* +++ *gcl-minor-version* +++ *gcl-extra-version*)) ++ ++ (defun objlt (x y) ++ (declare (object x y)) ++- (let ((x (si::address x)) (y (si::address y))) +++ (let ((x (address x)) (y (address y))) ++ (declare (fixnum x y)) ++ (if (< y 0) ++ (if (< x 0) (< x y) t) ++@@ -164,10 +156,10 @@ x)) ++ ++ (defun reset-sys-paths (s) ++ (declare (string s)) ++- (setq si::*lib-directory* s) ++- (setq si::*system-directory* (si::string-concatenate s "unixport/")) +++ (setq *lib-directory* s) +++ (setq *system-directory* (string-concatenate s "unixport/")) ++ (let (nl) ++ (dolist (l '("cmpnew/" "gcl-tk/" "lsp/" "xgcl-2/")) ++- (push (si::string-concatenate s l) nl)) ++- (setq si::*load-path* nl)) +++ (push (string-concatenate s l) nl)) +++ (setq *load-path* nl)) ++ nil) ++--- gcl-2.6.12.orig/lsp/gcl_module.lsp +++++ gcl-2.6.12/lsp/gcl_module.lsp ++@@ -22,13 +22,7 @@ ++ ;;;; module routines ++ ++ ++-(in-package 'lisp) ++- ++-(export '(*modules* provide require)) ++-(export 'documentation) ++-(export '(variable function structure type setf)) ++- ++-(in-package 'system) +++(in-package :si) ++ ++ ++ (eval-when (compile) (proclaim '(optimize (safety 2) (space 3)))) ++--- gcl-2.6.12.orig/lsp/gcl_numlib.lsp +++++ gcl-2.6.12/lsp/gcl_numlib.lsp ++@@ -22,20 +22,7 @@ ++ ;;;; number routines ++ ++ ++-(in-package 'lisp) ++-(export ++- '(isqrt abs phase signum cis asin acos sinh cosh tanh ++- asinh acosh atanh ++- rational rationalize ++- ffloor fround ftruncate fceiling ++- lognand lognor logandc1 logandc2 logorc1 logorc2 ++- lognot logtest ++- byte byte-size byte-position ++- ldb ldb-test mask-field dpb deposit-field ++- )) ++- ++- ++-(in-package 'system) +++(in-package :si) ++ ++ ++ (proclaim '(optimize (safety 2) (space 3))) ++--- gcl-2.6.12.orig/lsp/gcl_packlib.lsp +++++ gcl-2.6.12/lsp/gcl_packlib.lsp ++@@ -22,14 +22,7 @@ ++ ;;;; package routines ++ ++ ++-(in-package 'lisp) ++- ++- ++-(export '(find-all-symbols do-symbols do-external-symbols do-all-symbols with-package-iterator)) ++-(export '(apropos apropos-list)) ++- ++- ++-(in-package 'system) +++(in-package :si) ++ ++ ++ (proclaim '(optimize (safety 2) (space 3))) ++@@ -121,7 +114,7 @@ ++ (defun print-symbol-apropos (symbol) ++ (prin1 symbol) ++ (when (fboundp symbol) ++- (if (special-form-p symbol) +++ (if (special-operator-p symbol) ++ (princ " Special form") ++ (if (macro-function symbol) ++ (princ " Macro") ++--- gcl-2.6.12.orig/lsp/gcl_predlib.lsp +++++ gcl-2.6.12/lsp/gcl_predlib.lsp ++@@ -22,9 +22,7 @@ ++ ;;;; predicate routines ++ ++ ++-(in-package 'system) ++- ++-(export '(lisp::deftype lisp::typep lisp::subtypep lisp::coerce) 'lisp) +++(in-package :si) ++ ++ (eval-when (compile) ++ (proclaim '(optimize (safety 2) (space 3))) ++@@ -87,7 +85,7 @@ ++ (deftype vector (&optional element-type size) ++ `(array ,element-type (,size))) ++ (deftype string (&optional size) ++- `(vector string-char ,size)) +++ `(vector character ,size)) ++ (deftype base-string (&optional size) ++ `(vector base-char ,size)) ++ (deftype bit-vector (&optional size) ++@@ -96,7 +94,7 @@ ++ (deftype simple-vector (&optional size) ++ `(simple-array t (,size))) ++ (deftype simple-string (&optional size) ++- `(simple-array string-char (,size))) +++ `(simple-array character (,size))) ++ (deftype simple-base-string (&optional size) ++ `(simple-array base-char (,size))) ++ (deftype simple-bit-vector (&optional size) ++@@ -206,8 +204,8 @@ ++ (ratio (eq (type-of object) 'ratio)) ++ (standard-char ++ (and (characterp object) (standard-char-p object))) ++- ((base-char string-char) ++- (and (characterp object) (string-char-p object))) +++ ((base-char character) +++ (characterp object)) ++ (integer ++ (and (integerp object) (in-interval-p object i))) ++ (rational ++@@ -309,7 +307,7 @@ ++ signed-char unsigned-char signed-short unsigned-short ++ number integer bignum rational ratio float method-combination ++ short-float single-float double-float long-float complex ++- character standard-char string-char real +++ character standard-char character real ++ package stream pathname readtable hash-table random-state ++ structure array simple-array function compiled-function ++ arithmetic-error base-char base-string broadcast-stream ++@@ -583,23 +581,23 @@ ++ (if (sub-interval-p '(* *) i2) (values t t) (values nil t))) ++ (t (values nil ntp2)))) ++ (standard-char ++- (if (member t2 '(base-char string-char character)) +++ (if (member t2 '(base-char character character)) ++ (values t t) ++ (values nil ntp2))) ++ (base-char ++- (if (member t2 '(character string-char)) +++ (if (member t2 '(character character)) ++ (values t t) ++ (values nil ntp2))) ++ (extended-char ++- (if (member t2 '(character string-char)) +++ (if (member t2 '(character character)) ++ (values t t) ++ (values nil ntp2))) ++- (string-char +++ (character ++ (if (eq t2 'character) ++ (values t t) ++ (values nil ntp2))) ++ (character ++- (if (eq t2 'string-char) +++ (if (eq t2 'character) ++ (values t t) ++ (values nil ntp2))) ++ (integer ++@@ -635,7 +633,7 @@ ++ (unless (or (equal (car i1) (car i2)) ++ ; FIXME ++ (and (eq (car i1) 'base-char) ++- (eq (car i2) 'string-char))) +++ (eq (car i2) 'character))) ++ ;; Unless the element type matches, ++ ;; return NIL T. ++ ;; Is this too strict? ++@@ -658,7 +656,7 @@ ++ (unless (or (equal (car i1) (car i2)) ++ ; FIXME ++ (and (eq (car i1) 'base-char) ++- (eq (car i2) 'string-char))) +++ (eq (car i2) 'character))) ++ (return-from subtypep ++ (values nil t))))) ++ (when (or (endp (cdr i1)) (eq (cadr i1) '*)) ++--- gcl-2.6.12.orig/lsp/gcl_profile.lsp +++++ gcl-2.6.12/lsp/gcl_profile.lsp ++@@ -1,5 +1,5 @@ ++ ++-(in-package 'si) +++(in-package :si) ++ (use-package "SLOOP") ++ ++ ;; Sample Usage: ++--- gcl-2.6.12.orig/lsp/gcl_seq.lsp +++++ gcl-2.6.12/lsp/gcl_seq.lsp ++@@ -22,11 +22,7 @@ ++ ;;;; sequence routines ++ ++ ++-(in-package 'lisp) ++- ++-(export '(make-sequence concatenate map some every notany notevery)) ++- ++-(in-package 'system) +++(in-package :si) ++ ++ ++ (proclaim '(optimize (safety 2) (space 3))) ++@@ -40,7 +36,7 @@ ++ (if iesp ++ (make-list size :initial-element initial-element) ++ (make-list size)))) ++- ((or (eq type 'simple-string) (eq type 'string)) 'string-char) +++ ((or (eq type 'simple-string) (eq type 'string)) 'character) ++ ((or (eq type 'simple-bit-vector) (eq type 'bit-vector)) 'bit) ++ ((or (eq type 'simple-vector) (eq type 'vector)) t) ++ (t ++--- gcl-2.6.12.orig/lsp/gcl_seqlib.lsp +++++ gcl-2.6.12/lsp/gcl_seqlib.lsp ++@@ -22,24 +22,7 @@ ++ ;;;; sequence routines ++ ++ ++-(in-package 'lisp) ++- ++- ++-(export '(reduce fill replace ++- remove remove-if remove-if-not ++- delete delete-if delete-if-not ++- count count-if count-if-not ++- substitute substitute-if substitute-if-not ++- nsubstitute nsubstitute-if nsubstitute-if-not ++- find find-if find-if-not ++- position position-if position-if-not ++- remove-duplicates delete-duplicates ++- mismatch search ++- with-hash-table-iterator ++- sort stable-sort merge map-into)) ++- ++- ++-(in-package 'system) +++(in-package :si) ++ ++ ++ (proclaim '(optimize (safety 2) (space 3))) ++--- gcl-2.6.12.orig/lsp/gcl_serror.lsp +++++ gcl-2.6.12/lsp/gcl_serror.lsp ++@@ -100,6 +100,8 @@ ++ args)))) ++ ("unknown error"))) ++ +++(defvar *break-on-warnings* nil) +++ ++ (defun warn (datum &rest arguments) ++ (declare (optimize (safety 2))) ++ (let ((c (process-error datum arguments 'simple-warning))) ++--- gcl-2.6.12.orig/lsp/gcl_setf.lsp +++++ gcl-2.6.12/lsp/gcl_setf.lsp ++@@ -22,16 +22,7 @@ ++ ;;;; setf routines ++ ++ ++-(in-package 'lisp) ++- ++- ++-(export '(setf psetf shiftf rotatef ++- define-modify-macro defsetf ++- getf remf incf decf push pushnew pop ++- define-setf-method get-setf-method get-setf-method-multiple-value)) ++- ++- ++-(in-package 'system) +++(in-package :si) ++ ++ ++ (eval-when (compile) (proclaim '(optimize (safety 2) (space 3)))) ++@@ -86,10 +77,10 @@ ++ ',access-fn)) ++ ++ ++-;;; GET-SETF-METHOD. +++;;; GET-SETF-EXPANSION. ++ ;;; It just calls GET-SETF-METHOD-MULTIPLE-VALUE ++ ;;; and checks the number of the store variable. ++-(defun get-setf-method (form &optional env) +++(defun get-setf-expansion (form &optional env) ++ (multiple-value-bind (vars vals stores store-form access-form) ++ (get-setf-method-multiple-value form env) ++ (unless (= (list-length stores) 1) ++@@ -218,7 +209,7 @@ ++ ++ (define-setf-method getf (&environment env place indicator &optional default) ++ (multiple-value-bind (vars vals stores store-form access-form) ++- (get-setf-method place env) +++ (get-setf-expansion place env) ++ (let ((itemp (gensym)) (store (gensym))) ++ (values `(,@vars ,itemp) ++ `(,@vals ,indicator) ++@@ -234,7 +225,7 @@ ++ ++ (define-setf-method the (&environment env type form) ++ (multiple-value-bind (vars vals stores store-form access-form) ++- (get-setf-method form env) +++ (get-setf-expansion form env) ++ (let ((store (gensym))) ++ (values vars vals (list store) ++ `(let ((,(car stores) (the ,type ,store))) ,store-form) ++@@ -246,7 +237,7 @@ ++ (null (cddr fn))) ++ (error "Can't get the setf-method of ~S." fn)) ++ (multiple-value-bind (vars vals stores store-form access-form) ++- (get-setf-method (cons (cadr fn) rest) env) +++ (get-setf-expansion (cons (cadr fn) rest) env) ++ (unless (eq (car (last store-form)) (car (last vars))) ++ (error "Can't get the setf-method of ~S." fn)) ++ (values vars vals stores ++@@ -261,7 +252,7 @@ ++ (null (cddr fn))) ++ (error "Can't get the setf-method of ~S." fn)) ++ (multiple-value-bind (vars vals stores store-form access-form) ++- (get-setf-method (cons (cadr fn) rest) env) +++ (get-setf-expansion (cons (cadr fn) rest) env) ++ (cond ((eq (car (last store-form)) (car (last vars))) ++ (values vars vals stores ++ `(apply #',(car store-form) ,@(cdr store-form)) ++@@ -277,7 +268,7 @@ ++ ++ (define-setf-method char-bit (&environment env char name) ++ (multiple-value-bind (temps vals stores store-form access-form) ++- (get-setf-method char env) +++ (get-setf-expansion char env) ++ (let ((ntemp (gensym)) ++ (store (gensym)) ++ (stemp (first stores))) ++@@ -290,7 +281,7 @@ ++ ++ (define-setf-method ldb (&environment env bytespec int) ++ (multiple-value-bind (temps vals stores store-form access-form) ++- (get-setf-method int env) +++ (get-setf-expansion int env) ++ (let ((btemp (gensym)) ++ (store (gensym)) ++ (stemp (first stores))) ++@@ -303,7 +294,7 @@ ++ ++ (define-setf-method mask-field (&environment env bytespec int) ++ (multiple-value-bind (temps vals stores store-form access-form) ++- (get-setf-method int env) +++ (get-setf-expansion int env) ++ (let ((btemp (gensym)) ++ (store (gensym)) ++ (stemp (first stores))) ++@@ -346,7 +337,7 @@ ++ (setf-structure-access (cadr place) (car g) (cdr g) newvalue)))) ++ ++ (multiple-value-bind (vars vals stores store-form access-form) ++- (get-setf-method place env) +++ (get-setf-expansion place env) ++ (declare (ignore access-form)) ++ `(let* ,(mapcar #'list ++ (append vars stores) ++@@ -397,7 +388,7 @@ ++ nil)) ++ (when (endp (cdr r)) (error "~S is an illegal PSETF form." rest)) ++ (multiple-value-bind (vars vals stores store-form access-form) ++- (get-setf-method (car r) env) +++ (get-setf-expansion (car r) env) ++ (declare (ignore access-form)) ++ (setq store-forms (cons store-form store-forms)) ++ (setq pairs ++@@ -426,7 +417,7 @@ ++ ,@store-forms ++ ,g)) ++ (multiple-value-bind (vars vals stores1 store-form access-form) ++- (get-setf-method (car r) env) +++ (get-setf-expansion (car r) env) ++ (setq pairs (nconc pairs (mapcar #'list vars vals))) ++ (setq stores (cons (car stores1) stores)) ++ (setq store-forms (cons store-form store-forms)) ++@@ -451,7 +442,7 @@ ++ nil ++ )) ++ (multiple-value-bind (vars vals stores1 store-form access-form) ++- (get-setf-method (car r) env) +++ (get-setf-expansion (car r) env) ++ (setq pairs (nconc pairs (mapcar #'list vars vals))) ++ (setq stores (cons (car stores1) stores)) ++ (setq store-forms (cons store-form store-forms)) ++@@ -480,7 +471,7 @@ ++ (let ((access-form reference)) ++ (list 'setq reference ,update-form)))) ++ (multiple-value-bind (vars vals stores store-form access-form) ++- (get-setf-method reference env) +++ (get-setf-expansion reference env) ++ (list 'let* ++ (mapcar #'list ++ (append vars stores) ++@@ -492,7 +483,7 @@ ++ ++ (defmacro remf (&environment env place indicator) ++ (multiple-value-bind (vars vals stores store-form access-form) ++- (get-setf-method place env) +++ (get-setf-expansion place env) ++ `(let* ,(mapcar #'list vars vals) ++ (multiple-value-bind (,(car stores) flag) ++ (si:rem-f ,access-form ,indicator) ++@@ -508,7 +499,7 @@ ++ (return-from push `(let* ((,myitem ,item)) ++ (setq ,place (cons ,myitem ,place))))) ++ (multiple-value-bind (vars vals stores store-form access-form) ++- (get-setf-method place env) +++ (get-setf-expansion place env) ++ `(let* ,(mapcar #'list ++ (append (list myitem) vars stores) ++ (append (list item) vals (list (list 'cons myitem access-form)))) ++@@ -520,7 +511,7 @@ ++ (return-from pushnew `(let* ((,myitem ,item)) ++ (setq ,place (adjoin ,myitem ,place ,@rest)))))) ++ (multiple-value-bind (vars vals stores store-form access-form) ++- (get-setf-method place env) +++ (get-setf-expansion place env) ++ `(let* ,(mapcar #'list ++ (append (list myitem) vars stores) ++ (append (list item) vals ++@@ -535,7 +526,7 @@ ++ (setq ,place (cdr ,place)) ++ ,temp)))) ++ (multiple-value-bind (vars vals stores store-form access-form) ++- (get-setf-method place env) +++ (get-setf-expansion place env) ++ `(let* ,(mapcar #'list ++ (append vars stores) ++ (append vals (list (list 'cdr access-form)))) ++--- gcl-2.6.12.orig/lsp/gcl_sloop.lsp +++++ gcl-2.6.12/lsp/gcl_sloop.lsp ++@@ -71,7 +71,7 @@ ++ ;;; some other package. ++ ++ ++-(in-package "SLOOP" :use '(LISP)) +++(in-package "SLOOP" :use '(:LISP)) ++ (eval-when (compile eval load) ++ ++ (export '(loop-return sloop def-loop-collect def-loop-map ++--- gcl-2.6.12.orig/lsp/gcl_stack-problem.lsp +++++ gcl-2.6.12/lsp/gcl_stack-problem.lsp ++@@ -1,4 +1,4 @@ ++-(in-package 'si) +++(in-package :si) ++ ++ (defvar *old-handler* #'si::universal-error-handler) ++ ++--- gcl-2.6.12.orig/lsp/gcl_top.lsp +++++ gcl-2.6.12/lsp/gcl_top.lsp ++@@ -24,24 +24,14 @@ ++ ;;;; Revised on July 11, by Carl Hoffman. ++ ++ ++-(in-package "LISP") ++-;(export 'lisp) ++-(export '(+ ++ +++ - * ** *** / // ///)) ++-(export '(break warn)) ++-(export '*break-on-warnings*) ++-(export '*break-enable*) ++- ++-(in-package 'system) +++(in-package :si) ++ ++ (export '*break-readtable*) ++ (export '(loc *debug-print-level*)) ++ ++ (export '(vs ihs-vs ihs-fun frs-vs frs-bds frs-ihs bds-var bds-val super-go)) ++ ++-(eval-when ++- (compile) ++- (proclaim '(optimize (safety 2) (space 3))) ++- (defvar *command-args* nil)) +++(defvar *command-args* nil) ++ ++ (defvar +) ++ (defvar ++) ++@@ -75,8 +65,6 @@ ++ (defvar *break-enable* t) ++ (defvar *break-message* "") ++ ++-(defvar *break-on-warnings* nil) ++- ++ (defvar *break-readtable* nil) ++ ++ (defvar *top-level-hook* nil) ++@@ -330,7 +318,7 @@ ++ (lambda-block-closure (cddddr fun)) ++ (t (cond ++ ((and (symbolp (car fun)) ++- (or (special-form-p(car fun)) +++ (or (special-operator-p(car fun)) ++ (fboundp (car fun)))) ++ (car fun)) ++ (t '(:zombi)))))) ++@@ -384,7 +372,7 @@ ++ (lambda-block-closure (nth 4 fun)) ++ (lambda-closure 'lambda-closure) ++ (t (if (and (symbolp (car fun)) ++- (or (special-form-p (car fun)) +++ (or (special-operator-p (car fun)) ++ (fboundp (car fun)))) ++ (car fun) :zombi) ++ ))) ++--- gcl-2.6.12.orig/lsp/gcl_trace.lsp +++++ gcl-2.6.12/lsp/gcl_trace.lsp ++@@ -27,13 +27,7 @@ ++ ;; If you are working in another package you should (import 'si::arglist) ++ ;; to avoid typing the si:: ++ ++-(in-package 'lisp) ++- ++-(export '(trace untrace)) ++-(export 'step) ++- ++- ++-(in-package 'system) +++(in-package :si) ++ ++ ;;(proclaim '(optimize (safety 2) (space 3))) ++ ++@@ -169,7 +163,7 @@ ++ (when (null (fboundp fname)) ++ (format *trace-output* "The function ~S is not defined.~%" fname) ++ (return-from trace-one nil)) ++- (when (special-form-p fname) +++ (when (special-operator-p fname) ++ (format *trace-output* "~S is a special form.~%" fname) ++ (return-from trace-one nil)) ++ (when (macro-function fname) ++--- gcl-2.6.12.orig/lsp/sys-proclaim.lisp +++++ gcl-2.6.12/lsp/sys-proclaim.lisp ++@@ -1,294 +1,522 @@ ++ ++-(IN-PACKAGE "SYSTEM") ++-(MAPC (LAMBDA (COMPILER::X) ++- (SETF (GET COMPILER::X 'PROCLAIMED-CLOSURE) T)) ++- '(SI-CLASS-PRECEDENCE-LIST BREAK-ON-FLOATING-POINT-EXCEPTIONS ++- SI-FIND-CLASS AUTOLOAD SI-CLASS-NAME TRACE-ONE SI-CLASSP ++- SIMPLE-CONDITION-CLASS-P CONDITIONP MAKE-ACCESS-FUNCTION ++- UNTRACE-ONE WARNINGP DEFINE-STRUCTURE CONDITION-CLASS-P ++- SI-CLASS-OF AUTOLOAD-MACRO)) ++-(PROCLAIM '(FTYPE (FUNCTION (T) (VALUES T T)) LISP::MAKE-KEYWORD)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T) T) S-DATA-HAS-HOLES CONSTANTLY ++- COMPUTING-ARGS-P ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS ++- ANSI-LOOP::LOOP-COLLECTOR-NAME FIRST INSPECT-SYMBOL ++- CONTEXT-P ANSI-LOOP::LOOP-MAKE-PSETQ TENTH ++- COMPILER-MACRO-FUNCTION ANSI-LOOP::LOOP-COLLECTOR-DATA ++- ARRAY-DIMENSIONS ASINH FPE::XMM-LOOKUP KNOWN-TYPE-P ++- CONTEXT-VEC CONTEXT-HASH SHOW-ENVIRONMENT ++- CHECK-DECLARATIONS BKPT-FILE-LINE PROVIDE ++- ANSI-LOOP::LOOP-PATH-P DWIM RESTART-P FPE::LOOKUP ACOSH ++- PRINT-SYMBOL-APROPOS SIGNUM ANSI-LOOP::LOOP-UNIVERSE-ANSI ++- IHS-NOT-INTERPRETED-ENV BYTE-SIZE THIRD RESTART-FUNCTION ++- ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS DO-F ++- ANSI-LOOP::LOOP-EMIT-BODY COSH S-DATA-CONC-NAME ++- INSTREAM-STREAM-NAME PATCH-SHARP INSPECT-STRING ++- S-DATA-INCLUDES SHOW-BREAK-POINT FPE::GREF ++- FIND-KCL-TOP-RESTART RESTART-REPORT-FUNCTION S-DATA-NAMED ++- S-DATA-CONSTRUCTORS S-DATA-P SLOOP::PARSE-LOOP ++- INSPECT-STRUCTURE BKPT-FORM PHASE SETUP-INFO ++- ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS ++- RESET-TRACE-DECLARATIONS SLOOP::SLOOP-SLOOP-MACRO EIGHTH ++- SECOND SLOOP::TRANSLATE-NAME ++- ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE NINTH ++- ANSI-LOOP::LOOP-COLLECTOR-P MAKE-KCL-TOP-RESTART ++- SEARCH-STACK ANSI-LOOP::LOOP-COLLECTOR-DTYPE ACOS ++- ANSI-LOOP::LOOP-MAXMIN-COLLECTION MAKE-DEFPACKAGE-FORM ++- INSPECT-NUMBER SINH ANSI-LOOP::LOOP-HACK-ITERATION ++- INSTREAM-STREAM WALK-THROUGH PRINT-IHS SIXTH S-DATA-FROZEN ++- INSPECT-CHARACTER SLOOP::RETURN-SLOOP-MACRO ++- FREEZE-DEFSTRUCT NEXT-STACK-FRAME ++- SLOOP::LOOP-COLLECT-KEYWORD-P DM-BAD-KEY ++- COMPILE-FILE-PATHNAME SEVENTH ++- ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD ++- SLOOP::PARSE-LOOP-INITIALLY TERMINAL-INTERRUPT ++- ANSI-LOOP::LOOP-EMIT-FINAL-VALUE FRS-KIND CHECK-TRACE-SPEC ++- CONTEXT-SPICE ANSI-LOOP::DESTRUCTURING-SIZE ++- ANSI-LOOP::LOOP-MINIMAX-OPERATIONS INSPECT-VECTOR ATANH ++- ANSI-LOOP::LOOP-PATH-NAMES S-DATA-OFFSET ++- SLOOP::REPEAT-SLOOP-MACRO FIND-ALL-SYMBOLS ++- ANSI-LOOP::LOOP-PATH-FUNCTION REWRITE-RESTART-CASE-CLAUSE ++- ANSI-LOOP::LOOP-COLLECTOR-CLASS ++- RESTART-INTERACTIVE-FUNCTION DM-KEY-NOT-ALLOWED ++- INSPECT-PACKAGE S-DATA-PRINT-FUNCTION NODE-OFFSET ++- RESTART-NAME RATIONAL NORMALIZE-TYPE ++- SLOOP::SUBSTITUTE-SLOOP-BODY FIFTH INFO-GET-TAGS S-DATA-RAW ++- RE-QUOTE-STRING SHORT-NAME LOGNOT INSPECT-ARRAY ++- TRACE-ONE-PREPROCESS SIMPLE-ARRAY-P FIND-DOCUMENTATION ++- BKPT-FUNCTION ANSI-LOOP::LOOP-PATH-USER-DATA EVAL-FEATURE ++- ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA ABS S-DATA-STATICP ++- ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE INSERT-BREAK-POINT ++- S-DATA-DOCUMENTATION PRINT-FRS IHS-VISIBLE GET-INSTREAM ++- INFO-GET-FILE GET-NEXT-VISIBLE-FUN DBL-EVAL FOURTH ++- ANSI-LOOP::LOOP-COLLECTOR-HISTORY BYTE-POSITION ++- ANSI-LOOP::LOOP-TYPED-INIT ASIN ++- ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS FIX-LOAD-PATH BKPT-FILE ++- VECTOR-POP IDESCRIBE UNIQUE-ID ++- ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS ++- ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED ++- SLOOP::POINTER-FOR-COLLECT FPE::ST-LOOKUP ++- ANSI-LOOP::LOOP-CONSTANTP ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS ++- ADD-TO-HOTLIST ANSI-LOOP::LOOP-DO-THEREIS ++- ANSI-LOOP::LOOP-LIST-COLLECTION S-DATA-TYPE ++- SLOOP::LOOP-LET-BINDINGS ++- ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED ++- BREAK-FORWARD-SEARCH-STACK ISQRT S-DATA-SLOT-POSITION ++- BREAK-BACKWARD-SEARCH-STACK ++- ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE RESTART-TEST-FUNCTION ++- INVOKE-DEBUGGER SLOOP::PARSE-NO-BODY ++- ANSI-LOOP::LOOP-MAKE-DESETQ ++- ANSI-LOOP::LOOP-CONSTRUCT-RETURN COMPLEMENT ++- ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS TANH INSTREAM-P ++- NODES-FROM-INDEX ANSI-LOOP::LOOP-PSEUDO-BODY ++- S-DATA-INCLUDED ANSI-LOOP::LOOP-MINIMAX-TYPE ++- NUMBER-OF-DAYS-FROM-1900 INFO-NODE-FROM-POSITION ++- ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE ++- ANSI-LOOP::LOOP-MINIMAX-P BEST-ARRAY-ELEMENT-TYPE ++- S-DATA-NAME SLOOP::AVERAGING-SLOOP-MACRO ++- ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS CIS SEQTYPE ++- LEAP-YEAR-P GET-BYTE-STREAM-NCHARS IHS-FNAME ++- ANSI-LOOP::LOOP-UNIVERSE-P INSPECT-CONS ++- S-DATA-SLOT-DESCRIPTIONS)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (*) *) INFO-ERROR BREAK-PREVIOUS BREAK-NEXT ++- CONTINUE BREAK-LOCAL SHOW-BREAK-VARIABLES BREAK-BDS ++- MUFFLE-WARNING DBL-BACKTRACE ANSI-LOOP::LOOP-OPTIONAL-TYPE ++- IHS-BACKTRACE BREAK-QUIT BREAK-VS)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (FIXNUM) FIXNUM) FPE::FE-ENABLE DBL-WHAT-FRAME)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T) FIXNUM) INSTREAM-LINE FPE::REG-LOOKUP ++- S-DATA-SIZE S-DATA-LENGTH THE-START)) ++-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM) T) PUSH-CONTEXT GET-CONTEXT)) ++-(PROCLAIM '(FTYPE (FUNCTION (STRING FIXNUM) FIXNUM) ATOI)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (*) T) ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE ++- MAYBE-CLEAR-INPUT ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL ++- DRIBBLE ANSI-LOOP::MAKE-LOOP-COLLECTOR ++- ANSI-LOOP::MAKE-LOOP-UNIVERSE Y-OR-N-P COMPUTE-RESTARTS ++- DESCRIBE-ENVIRONMENT TRANSFORM-KEYWORDS ++- SLOOP::PARSE-LOOP-DECLARE MAKE-RESTART MAKE-INSTREAM ++- ANSI-LOOP::LOOP-GENTEMP DBL-READ LOC CURRENT-STEP-FUN ++- VECTOR YES-OR-NO-P BREAK ++- ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL STEP-INTO MAKE-CONTEXT ++- ANSI-LOOP::MAKE-LOOP-PATH MAKE-S-DATA BREAK-LOCALS ABORT ++- SLOOP::PARSE-LOOP-WITH STEP-NEXT)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T) *) PRINC-TO-STRING GET-&ENVIRONMENT DESCRIBE ++- INSPECT ANSI-LOOP::NAMED-VARIABLE WAITING ++- ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES PRIN1-TO-STRING ++- BREAK-LEVEL-INVOKE-RESTART END-WAITING ++- ANSI-LOOP::LOOP-LIST-STEP ALOAD INSTREAM-NAME ++- INVOKE-RESTART-INTERACTIVELY FIND-DECLARATIONS BREAK-GO ++- INSPECT-OBJECT INFO-SUBFILE)) ++-(PROCLAIM '(FTYPE (FUNCTION (T FIXNUM T T) T) BIGNTHCDR)) ++-(PROCLAIM '(FTYPE (FUNCTION (T FIXNUM FIXNUM T T) T) QUICK-SORT)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T) *) SHARP-S-READER SHARP---READER ++- ANSI-LOOP::LOOP-GET-COLLECTION-INFO SHARP-+-READER ++- LIST-MERGE-SORT LISP::VERIFY-KEYWORDS READ-INSPECT-COMMAND ++- RESTART-PRINT)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T *) *) REDUCE SUBTYPEP SORT ++- SLOOP::FIND-IN-ORDERED-LIST STABLE-SORT LISP::PARSE-BODY)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T T *) *) LISP::PARSE-DEFMACRO-LAMBDA-LIST ++- LISP::PARSE-DEFMACRO)) ++-(PROCLAIM '(FTYPE (FUNCTION (T T T *) *) MASET)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T T T T T) *) LISP::PUSH-OPTIONAL-BINDING)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T *) *) DECODE-UNIVERSAL-TIME STEPPER USE-VALUE ++- FROUND INFO SHOW-INFO INVOKE-RESTART FCEILING ++- PARSE-BODY-HEADER ENSURE-DIRECTORIES-EXIST PRINT-DOC ++- APROPOS-DOC WRITE-TO-STRING FFLOOR NLOAD BREAK-FUNCTION ++- REQUIRE APROPOS GET-SETF-METHOD APROPOS-LIST ++- ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE STORE-VALUE ++- GET-SETF-METHOD-MULTIPLE-VALUE READ-FROM-STRING ++- WILD-PATHNAME-P FTRUNCATE)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T) T) QUOTATION-READER ++- SLOOP::IN-PACKAGE-SLOOP-MAP SLOOP::NEVER-SLOOP-COLLECT ++- MATCH-DIMENSIONS OBJLT ANSI-LOOP::LOOP-TEQUAL DBL-UP ++- GET-INFO-CHOICES NTHCDR ANSI-LOOP::LOOP-DECLARE-VARIABLE ++- ANSI-LOOP::MAKE-LOOP-MINIMAX LDB ++- OVERWRITE-SLOT-DESCRIPTIONS GET-LINE-OF-FORM DOCUMENTATION ++- DM-NTH ANSI-LOOP::LOOP-LOOKUP-KEYWORD DM-NTH-CDR ++- SLOOP::=-SLOOP-FOR LIST-DELQ SET-DIR LOGANDC2 ++- SLOOP::IN-FRINGE-SLOOP-MAP DISPLAY-COMPILED-ENV SET-BACK ++- SLOOP::LOGXOR-SLOOP-COLLECT LEFT-PARENTHESIS-READER ++- ANSI-LOOP::LOOP-DO-IF FPE::%-READER LDB-TEST ++- COMPILER::COMPILER-DEF-HOOK BYTE ++- SLOOP::IN-CAREFULLY-SLOOP-FOR INCREMENT-CURSOR ++- IN-INTERVAL-P LISP::LOOKUP-KEYWORD SUPER-GO WRITE-BYTE ++- ANSI-LOOP::LOOP-DO-WHILE READ-INSTRUCTION LOGANDC1 ++- SLOOP::THEREIS-SLOOP-COLLECT COERCE-TO-STRING LOGORC2 ++- SEQUENCE-CURSOR LOGNOR FPE::READ-OPERANDS ++- SLOOP::MAXIMIZE-SLOOP-COLLECT ALL-MATCHES ++- SLOOP::IN-TABLE-SLOOP-MAP SLOOP::COLLATE-SLOOP-COLLECT ++- CHECK-SEQ-START-END BREAK-STEP-NEXT FPE::RF ++- SLOOP::PARSE-LOOP-MAP VECTOR-PUSH FPE::PAREN-READER ++- FPE::0-READER ANSI-LOOP::LOOP-TASSOC SETF-HELPER ++- SETF-EXPAND SLOOP::MINIMIZE-SLOOP-COLLECT ADD-FILE LOGORC1 ++- SLOOP::COUNT-SLOOP-COLLECT SLOOP::MAKE-VALUE ++- PARSE-SLOT-DESCRIPTION SLOOP::DESETQ1 ++- ANSI-LOOP::LOOP-DO-ALWAYS SLOOP::L-EQUAL GET-MATCH ++- SLOOP::SUM-SLOOP-COLLECT DM-V BREAK-STEP-INTO LOGNAND NTH ++- SUBSTRINGP INFO-AUX SUB-INTERVAL-P *BREAK-POINTS* SAFE-EVAL ++- ANSI-LOOP::HIDE-VARIABLE-REFERENCES COERCE ++- ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION CONDITION-PASS ++- GET-NODES ANSI-LOOP::LOOP-TMEMBER ++- SLOOP::ALWAYS-SLOOP-COLLECT DISPLAY-ENV SLOOP::THE-TYPE ++- ANSI-LOOP::LOOP-MAYBE-BIND-FORM ITERATE-OVER-BKPTS LOGTEST ++- LISP::KEYWORD-SUPPLIED-P)) ++-(PROCLAIM '(FTYPE (FUNCTION (T T T T T T T) *) TRACE-CALL)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION NIL *) GCL-TOP-LEVEL SIMPLE-BACKTRACE ++- BREAK-CURRENT BREAK-MESSAGE ANSI-LOOP::LOOP-DO-FOR ++- BREAK-HELP)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (STRING) T) RESET-SYS-PATHS ++- COERCE-SLASH-TERMINATED)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T) FIXNUM) RELATIVE-LINE GET-NODE-INDEX ++- ANSI-LOOP::DUPLICATABLE-CODE-P THE-END)) ++-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM T) T) SMALLNTHCDR)) ++-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM FIXNUM) FIXNUM) ROUND-UP)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T *) T) ++- ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES SBIT ++- INFO-SEARCH PROCESS-ARGS LIST-MATCHES ARRAY-ROW-MAJOR-INDEX ++- FIND-RESTART SLOOP::LOOP-ADD-TEMPS ANSI-LOOP::LOOP-WARN ++- ANSI-LOOP::LOOP-ERROR BAD-SEQ-LIMIT ARRAY-IN-BOUNDS-P ++- MAKE-ARRAY SIGNAL BIT PROCESS-SOME-ARGS CONCATENATE ERROR ++- REMOVE-DUPLICATES SLOOP::ADD-FROM-DATA READ-BYTE ++- FILE-SEARCH FILE-TO-STRING UPGRADED-ARRAY-ELEMENT-TYPE WARN ++- BREAK-LEVEL BIT-NOT NTH-STACK-FRAME DELETE-DUPLICATES)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T) *) ANSI-LOOP::ESTIMATE-CODE-SIZE-1 NEWLINE ++- FIND-DOC RESTART-REPORT ANSI-LOOP::ESTIMATE-CODE-SIZE ++- NEW-SEMI-COLON-READER)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T *) T) NOTANY BIT-ORC1 ++- ANSI-LOOP::LOOP-CHECK-DATA-TYPE REMOVE BIT-ANDC1 ++- INTERNAL-COUNT-IF-NOT READ-SEQUENCE SUBSETP ++- VECTOR-PUSH-EXTEND TYPEP CERROR REPLACE COUNT-IF ++- NSET-DIFFERENCE DELETE REMOVE-IF NSET-EXCLUSIVE-OR ++- PROCESS-ERROR INTERNAL-COUNT SLOOP::IN-ARRAY-SLOOP-FOR ++- SEARCH MAKE-SEQUENCE ADJUST-ARRAY BIT-NAND FIND-IF ++- NINTERSECTION FILL BIT-ORC2 BIT-XOR UNION DELETE-IF-NOT ++- SLOOP::PARSE-LOOP-MACRO WRITE-SEQUENCE SOME COUNT-IF-NOT ++- MAP-INTO FIND FIND-IF-NOT BIT-NOR BIT-ANDC2 POSITION-IF ++- NOTEVERY NUNION SET-DIFFERENCE INTERSECTION POSITION-IF-NOT ++- EVERY POSITION FIND-IHS BIT-EQV REMOVE-IF-NOT MISMATCH ++- BIT-AND INTERNAL-COUNT-IF DELETE-IF COUNT BREAK-CALL ++- SET-EXCLUSIVE-OR SLOOP::LOOP-ADD-BINDING BIT-IOR)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T) T) ANSI-LOOP::LOOP-FOR-IN ++- FLOATING-POINT-ERROR CHECK-TRACE-ARGS ++- ANSI-LOOP::HIDE-VARIABLE-REFERENCE SETF-EXPAND-1 ++- MAKE-BREAK-POINT FPE::REF SHARP-A-READER SHARP-U-READER DPB ++- DM-VL CHECK-S-DATA ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE ++- APPLY-DISPLAY-FUN ANSI-LOOP::LOOP-STANDARD-EXPANSION ++- ANSI-LOOP::LOOP-TRANSLATE DEPOSIT-FIELD ++- ANSI-LOOP::LOOP-ANSI-FOR-EQUALS ++- SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS ++- ANSI-LOOP::LOOP-FOR-ON GET-SLOT-POS ++- ANSI-LOOP::PRINT-LOOP-UNIVERSE DEFMACRO* WARN-VERSION ++- RESTART-CASE-EXPRESSION-CONDITION MAKE-T-TYPE ++- ANSI-LOOP::LOOP-SUM-COLLECTION ANSI-LOOP::LOOP-FOR-BEING ++- ANSI-LOOP::LOOP-FOR-ACROSS)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T *) T) CHECK-TYPE-SYMBOL ++- ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH NSUBSTITUTE-IF ++- SUBSTITUTE-IF ++- ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH NSUBSTITUTE ++- ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH ++- LISP::PUSH-LET-BINDING ANSI-LOOP::ADD-LOOP-PATH ++- SUBSTITUTE-IF-NOT MAP SLOOP::LOOP-DECLARE-BINDING ++- SUBSTITUTE ANSI-LOOP::LOOP-MAKE-VARIABLE NSUBSTITUTE-IF-NOT ++- COMPLETE-PROP)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T T T) T) LISP::DO-ARG-COUNT-ERROR ++- LISP::PUSH-SUB-LIST-BINDING)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T T) T) MAKE-CONSTRUCTOR MAKE-PREDICATE ++- DO-BREAK-LEVEL)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T *) T) PRINT-STACK-FRAME MERGE ++- SLOOP::DEF-LOOP-INTERNAL)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T FIXNUM) T) SHARP-EQ-READER ++- SHARP-SHARP-READER)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T) T) CALL-TEST COERCE-TO-CONDITION ++- FIND-LINE-IN-FUN ANSI-LOOP::LOOP-FOR-ARITHMETIC MAYBE-BREAK ++- SLOOP::FIRST-USE-SLOOP-FOR SLOOP::FIRST-SLOOP-FOR ++- SETF-STRUCTURE-ACCESS)) ++-(PROCLAIM '(FTYPE (FUNCTION (T T T T T T *) T) ENCODE-UNIVERSAL-TIME)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T T T T T T T) T) ++- ANSI-LOOP::LOOP-SEQUENCER)) ++-(PROCLAIM '(FTYPE (FUNCTION (T T T T T *) T) UNIVERSAL-ERROR-HANDLER)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION NIL T) ANSI-LOOP::LOOP-DO-NAMED ++- SLOOP::LOOP-UN-POP ANSI-LOOP::LOOP-DO-INITIALLY ++- SLOOP::PARSE-LOOP-WHEN SLOOP::LOOP-POP SLOOP::LOOP-PEEK ++- SLOOP::PARSE-LOOP-DO SET-ENV ANSI-LOOP::LOOP-DO-REPEAT ++- READ-EVALUATED-FORM ANSI-LOOP::LOOP-DO-RETURN ++- ANSI-LOOP::LOOP-GET-FORM ANSI-LOOP::LOOP-DO-FINALLY ++- SET-CURRENT DEFAULT-SYSTEM-BANNER DM-TOO-FEW-ARGUMENTS ++- ANSI-LOOP::LOOP-DO-DO SLOOP::PARSE-ONE-WHEN-CLAUSE ++- DEFAULT-INFO-HOTLIST KCL-TOP-RESTARTS TYPE-ERROR ++- SET-UP-TOP-LEVEL INSPECT-INDENT GET-INDEX-NODE ++- ALL-TRACE-DECLARATIONS DBL ANSI-LOOP::LOOP-GET-PROGN ++- INIT-BREAK-POINTS STEP-READ-LINE ++- ANSI-LOOP::LOOP-ITERATION-DRIVER GET-SIG-FN-NAME ++- SETUP-LINEINFO CLEANUP ANSI-LOOP::LOOP-WHEN-IT-VARIABLE ++- ANSI-LOOP::LOOP-DO-WITH SHOW-RESTARTS ++- SLOOP::PARSE-LOOP-COLLECT INSPECT-READ-LINE ++- DM-TOO-MANY-ARGUMENTS INSPECT-INDENT-1 ++- ANSI-LOOP::LOOP-POP-SOURCE TEST-ERROR SLOOP::PARSE-LOOP1 ++- ANSI-LOOP::LOOP-CONTEXT ANSI-LOOP::LOOP-BIND-BLOCK ++- WINE-TMP-REDIRECT ILLEGAL-BOA SLOOP::PARSE-LOOP-FOR ++- TOP-LEVEL LISP-IMPLEMENTATION-VERSION GET-TEMP-DIR)) ++\ No newline at end of file +++(COMMON-LISP::IN-PACKAGE "SYSTEM") +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +++ ANSI-LOOP::LOOP-EMIT-FINAL-VALUE SYSTEM::INSPECT-CHARACTER +++ SYSTEM::INSPECT-STRUCTURE SYSTEM::PRINT-IHS +++ SYSTEM::RESTART-FUNCTION COMMON-LISP::TANH COMMON-LISP::FIFTH +++ SLOOP::PARSE-LOOP-INITIALLY SYSTEM::NEXT-STACK-FRAME +++ SYSTEM::IDESCRIBE SYSTEM::PROCESS-ARGS SYSTEM::LEAP-YEAR-P +++ SLOOP::AVERAGING-SLOOP-MACRO SYSTEM::FIX-LOAD-PATH +++ SLOOP::SUBSTITUTE-SLOOP-BODY SYSTEM::RESTART-REPORT-FUNCTION +++ COMMON-LISP::NINTH SLOOP::SLOOP-SLOOP-MACRO +++ SYSTEM::S-DATA-CONSTRUCTORS SYSTEM::FREEZE-DEFSTRUCT +++ COMMON-LISP::EIGHTH SYSTEM::FIND-DOCUMENTATION +++ ANSI-LOOP::LOOP-PSEUDO-BODY COMMON-LISP::RATIONAL +++ ANSI-LOOP::LOOP-EMIT-BODY COMMON-LISP::ASIN +++ COMMON-LISP::COMPILE-FILE-PATHNAME SYSTEM::S-DATA-P +++ SYSTEM::BKPT-FUNCTION SYSTEM::TRACE-ONE-PREPROCESS +++ COMMON-LISP::LOGNOT SYSTEM::SIMPLE-ARRAY-P SYSTEM::BKPT-FILE +++ SYSTEM::S-DATA-STATICP COMMON-LISP::ISQRT SYSTEM::INSTREAM-P +++ COMMON-LISP::SEVENTH SYSTEM::S-DATA-NAMED +++ ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS SYSTEM::INSPECT-NUMBER +++ COMMON-LISP::ATANH SYSTEM::RESTART-TEST-FUNCTION +++ SYSTEM::S-DATA-INCLUDES SYSTEM::S-DATA-HAS-HOLES +++ SYSTEM::CONTEXT-VEC FPE::XMM-LOOKUP SYSTEM::S-DATA-RAW +++ ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS +++ SYSTEM::RESTART-INTERACTIVE-FUNCTION +++ ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS +++ ANSI-LOOP::LOOP-COLLECTOR-NAME ANSI-LOOP::LOOP-PATH-NAMES +++ ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE +++ SYSTEM::S-DATA-INCLUDED SYSTEM::S-DATA-SLOT-DESCRIPTIONS +++ SYSTEM::S-DATA-OFFSET SLOOP::REPEAT-SLOOP-MACRO +++ SYSTEM::S-DATA-PRINT-FUNCTION ANSI-LOOP::LOOP-PATH-USER-DATA +++ COMMON-LISP::FIND-ALL-SYMBOLS COMMON-LISP::FIRST +++ SYSTEM::GET-BYTE-STREAM-NCHARS SYSTEM::BKPT-FORM +++ SYSTEM::NODES-FROM-INDEX SYSTEM::INSPECT-SYMBOL +++ SYSTEM::KNOWN-TYPE-P ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE +++ SYSTEM::MAKE-DEFPACKAGE-FORM COMMON-LISP::ARRAY-DIMENSIONS +++ SYSTEM::INSERT-BREAK-POINT SLOOP::PARSE-LOOP +++ ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED +++ ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS SYSTEM::SHORT-NAME +++ SYSTEM::CHECK-TRACE-SPEC ANSI-LOOP::DESTRUCTURING-SIZE +++ SYSTEM::BEST-ARRAY-ELEMENT-TYPE SYSTEM::CONTEXT-HASH +++ COMMON-LISP::SIXTH SYSTEM::IHS-VISIBLE SYSTEM::INSPECT-ARRAY +++ COMMON-LISP::BYTE-SIZE ANSI-LOOP::LOOP-COLLECTOR-CLASS +++ ANSI-LOOP::LOOP-HACK-ITERATION +++ ANSI-LOOP::LOOP-CONSTRUCT-RETURN SYSTEM::S-DATA-SLOT-POSITION +++ ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE SYSTEM::INSPECT-STRING +++ COMMON-LISP::PROVIDE COMMON-LISP::CIS +++ ANSI-LOOP::LOOP-MINIMAX-OPERATIONS +++ SYSTEM::BREAK-BACKWARD-SEARCH-STACK +++ ANSI-LOOP::LOOP-COLLECTOR-DTYPE +++ SYSTEM::IHS-NOT-INTERPRETED-ENV SYSTEM::SEARCH-STACK +++ COMMON-LISP::TENTH ANSI-LOOP::LOOP-DO-THEREIS +++ ANSI-LOOP::LOOP-MAXMIN-COLLECTION +++ ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA +++ ANSI-LOOP::LOOP-MAKE-PSETQ SYSTEM::ADD-TO-HOTLIST +++ SYSTEM::INSPECT-CONS ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS +++ SYSTEM::INSPECT-VECTOR COMMON-LISP::CONSTANTLY +++ SYSTEM::REWRITE-RESTART-CASE-CLAUSE SYSTEM::DM-BAD-KEY +++ SYSTEM::PRINT-SYMBOL-APROPOS SYSTEM::FRS-KIND FPE::ST-LOOKUP +++ COMMON-LISP::FOURTH SYSTEM::TERMINAL-INTERRUPT +++ SYSTEM::DM-KEY-NOT-ALLOWED SYSTEM::UNIQUE-ID +++ SYSTEM::S-DATA-FROZEN SLOOP::POINTER-FOR-COLLECT +++ SYSTEM::INSPECT-PACKAGE SYSTEM::DBL-EVAL +++ ANSI-LOOP::LOOP-MINIMAX-TYPE ANSI-LOOP::LOOP-UNIVERSE-ANSI +++ ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS SYSTEM::DWIM +++ SYSTEM::INSTREAM-STREAM-NAME SLOOP::RETURN-SLOOP-MACRO +++ SYSTEM::PATCH-SHARP SYSTEM::CONTEXT-P SYSTEM::INFO-GET-FILE +++ SYSTEM::RESTART-P COMMON-LISP::COSH COMMON-LISP::SINH +++ SYSTEM::GET-NEXT-VISIBLE-FUN SYSTEM::CHECK-DECLARATIONS +++ SYSTEM::GET-INSTREAM +++ ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD SYSTEM::S-DATA-NAME +++ ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS +++ SYSTEM::S-DATA-DOCUMENTATION SYSTEM::SHOW-BREAK-POINT +++ COMMON-LISP::ACOS COMMON-LISP::INVOKE-DEBUGGER +++ SYSTEM::BKPT-FILE-LINE ANSI-LOOP::LOOP-COLLECTOR-DATA +++ COMMON-LISP::THIRD SYSTEM::S-DATA-CONC-NAME +++ COMMON-LISP::SIGNUM +++ ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED +++ SYSTEM::NORMALIZE-TYPE ANSI-LOOP::LOOP-TYPED-INIT +++ ANSI-LOOP::LOOP-PATH-FUNCTION SYSTEM::INFO-NODE-FROM-POSITION +++ COMMON-LISP::ASINH SYSTEM::RE-QUOTE-STRING +++ SLOOP::LOOP-COLLECT-KEYWORD-P SYSTEM::PRINT-FRS +++ SYSTEM::EVAL-FEATURE ANSI-LOOP::LOOP-COLLECTOR-P +++ ANSI-LOOP::LOOP-COLLECTOR-HISTORY +++ ANSI-LOOP::LOOP-LIST-COLLECTION +++ SYSTEM::BREAK-FORWARD-SEARCH-STACK COMMON-LISP::RESTART-NAME +++ SLOOP::PARSE-NO-BODY ANSI-LOOP::LOOP-UNIVERSE-P +++ SYSTEM::NUMBER-OF-DAYS-FROM-1900 SYSTEM::NODE-OFFSET +++ ANSI-LOOP::LOOP-MINIMAX-P SYSTEM::IHS-FNAME FPE::LOOKUP +++ SLOOP::LOOP-LET-BINDINGS FPE::GREF COMMON-LISP::PHASE +++ COMMON-LISP::BYTE-POSITION SYSTEM::INSTREAM-STREAM +++ ANSI-LOOP::LOOP-PATH-P SYSTEM::SEQTYPE COMMON-LISP::ACOSH +++ COMMON-LISP::ABS COMMON-LISP::COMPLEMENT +++ ANSI-LOOP::LOOP-CONSTANTP SYSTEM::WALK-THROUGH +++ SYSTEM::SETUP-INFO SYSTEM::COMPUTING-ARGS-P +++ SYSTEM::CONTEXT-SPICE SYSTEM::MAKE-KCL-TOP-RESTART +++ COMMON-LISP::COMPILER-MACRO-FUNCTION +++ ANSI-LOOP::LOOP-MAKE-DESETQ SYSTEM::SHOW-ENVIRONMENT +++ SLOOP::TRANSLATE-NAME SYSTEM::INFO-GET-TAGS +++ COMMON-LISP::SECOND SYSTEM::RESET-TRACE-DECLARATIONS +++ SYSTEM::S-DATA-TYPE SYSTEM::FIND-KCL-TOP-RESTART +++ ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE SYSTEM::DO-F +++ ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS COMMON-LISP::VECTOR-POP)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) +++ SYSTEM::IHS-BACKTRACE SYSTEM::BREAK-NEXT SYSTEM::BREAK-QUIT +++ SYSTEM::SHOW-BREAK-VARIABLES SYSTEM::BREAK-BDS +++ COMMON-LISP::MUFFLE-WARNING SYSTEM::BREAK-PREVIOUS +++ SYSTEM::INFO-ERROR ANSI-LOOP::LOOP-OPTIONAL-TYPE +++ SYSTEM::DBL-BACKTRACE SYSTEM::BREAK-LOCAL SYSTEM::BREAK-VS +++ COMMON-LISP::CONTINUE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) +++ COMMON-LISP::FIXNUM) +++ SYSTEM::DBL-WHAT-FRAME FPE::FE-ENABLE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ COMMON-LISP::SUBTYPEP COMMON-LISP::REDUCE SYSTEM::PARSE-BODY +++ COMMON-LISP::STABLE-SORT COMMON-LISP::SORT +++ SLOOP::FIND-IN-ORDERED-LIST)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ SYSTEM::VERIFY-KEYWORDS SYSTEM::RESTART-PRINT +++ ANSI-LOOP::LOOP-GET-COLLECTION-INFO SYSTEM::LIST-MERGE-SORT +++ SYSTEM::READ-INSPECT-COMMAND SYSTEM::SHARP---READER +++ SYSTEM::SHARP-+-READER SYSTEM::SHARP-S-READER)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ SYSTEM::PUSH-OPTIONAL-BINDING)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ SYSTEM::PARSE-DEFMACRO-LAMBDA-LIST SYSTEM::PARSE-DEFMACRO)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) +++ COMMON-LISP::*) +++ SYSTEM::TRACE-CALL)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::*) +++ SYSTEM::MASET)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) +++ FPE::REG-LOOKUP SYSTEM::INSTREAM-LINE SYSTEM::THE-START +++ SYSTEM::S-DATA-LENGTH SYSTEM::S-DATA-SIZE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) +++ SYSTEM::PUSH-CONTEXT SYSTEM::GET-CONTEXT)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) +++ SYSTEM::BREAK-CURRENT SYSTEM::GCL-TOP-LEVEL +++ SYSTEM::BREAK-MESSAGE SYSTEM::BREAK-RESUME +++ ANSI-LOOP::LOOP-DO-FOR SYSTEM::SIMPLE-BACKTRACE +++ SYSTEM::BREAK-HELP)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::STRING) COMMON-LISP::T) +++ SYSTEM::COERCE-SLASH-TERMINATED SYSTEM::RESET-SYS-PATHS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ COMMON-LISP::BIT COMMON-LISP::READ-BYTE +++ COMMON-LISP::CONCATENATE SYSTEM::INFO-SEARCH +++ COMMON-LISP::ARRAY-IN-BOUNDS-P ANSI-LOOP::LOOP-ERROR +++ ANSI-LOOP::LOOP-WARN COMMON-LISP::REMOVE-DUPLICATES +++ SYSTEM::BAD-SEQ-LIMIT SYSTEM::PROCESS-SOME-ARGS +++ ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES +++ SLOOP::LOOP-ADD-TEMPS COMMON-LISP::BIT-NOT COMMON-LISP::SIGNAL +++ SYSTEM::NTH-STACK-FRAME COMMON-LISP::ARRAY-ROW-MAJOR-INDEX +++ COMMON-LISP::MAKE-ARRAY SYSTEM::FILE-SEARCH +++ SYSTEM::LIST-MATCHES COMMON-LISP::FIND-RESTART +++ SYSTEM::BREAK-LEVEL COMMON-LISP::DELETE-DUPLICATES +++ SLOOP::ADD-FROM-DATA COMMON-LISP::ERROR COMMON-LISP::WARN +++ SYSTEM::FILE-TO-STRING +++ COMMON-LISP::UPGRADED-ARRAY-ELEMENT-TYPE COMMON-LISP::SBIT)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ SYSTEM::FIND-DOC SYSTEM::RESTART-REPORT +++ ANSI-LOOP::ESTIMATE-CODE-SIZE-1 SYSTEM::NEWLINE +++ ANSI-LOOP::ESTIMATE-CODE-SIZE SYSTEM::NEW-SEMI-COLON-READER)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) +++ SYSTEM::MAKE-KEYWORD)) +++(COMMON-LISP::MAPC +++ (COMMON-LISP::LAMBDA (COMPILER::X) +++ (COMMON-LISP::SETF +++ (COMMON-LISP::GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE) +++ COMMON-LISP::T)) +++ '(SYSTEM::SI-CLASS-PRECEDENCE-LIST SYSTEM::SI-CLASSP +++ SYSTEM::SIMPLE-CONDITION-CLASS-P SYSTEM::UNTRACE-ONE +++ SYSTEM::CONDITIONP SYSTEM::CONDITION-CLASS-P +++ SYSTEM::MAKE-ACCESS-FUNCTION SYSTEM::SI-CLASS-NAME +++ SYSTEM::AUTOLOAD-MACRO SYSTEM::AUTOLOAD SYSTEM::SI-CLASS-OF +++ SYSTEM::WARNINGP SYSTEM::DEFINE-STRUCTURE +++ FPE::BREAK-ON-FLOATING-POINT-EXCEPTIONS SYSTEM::SI-FIND-CLASS +++ SYSTEM::TRACE-ONE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM +++ COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ SYSTEM::QUICK-SORT)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::T +++ COMMON-LISP::T) +++ COMMON-LISP::T) +++ SYSTEM::BIGNTHCDR)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE ANSI-LOOP::LOOP-FOR-IN +++ SYSTEM::DEFMACRO* SYSTEM::APPLY-DISPLAY-FUN +++ SYSTEM::WARN-VERSION ANSI-LOOP::HIDE-VARIABLE-REFERENCE +++ SYSTEM::SHARP-U-READER ANSI-LOOP::LOOP-FOR-ACROSS +++ SYSTEM::DM-VL SYSTEM::GET-SLOT-POS +++ SYSTEM::RESTART-CASE-EXPRESSION-CONDITION +++ SYSTEM::CHECK-TRACE-ARGS ANSI-LOOP::LOOP-FOR-ON FPE::REF +++ ANSI-LOOP::PRINT-LOOP-UNIVERSE ANSI-LOOP::LOOP-ANSI-FOR-EQUALS +++ SYSTEM::SETF-EXPAND-1 ANSI-LOOP::LOOP-SUM-COLLECTION +++ ANSI-LOOP::LOOP-STANDARD-EXPANSION SYSTEM::MAKE-T-TYPE +++ COMMON-LISP::DEPOSIT-FIELD SYSTEM::MAKE-BREAK-POINT +++ ANSI-LOOP::LOOP-FOR-BEING ANSI-LOOP::LOOP-TRANSLATE +++ SYSTEM::SHARP-A-READER COMMON-LISP::DPB +++ SYSTEM::FLOATING-POINT-ERROR SYSTEM::CHECK-S-DATA +++ SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) +++ COMMON-LISP::T) +++ SLOOP::FIRST-USE-SLOOP-FOR SYSTEM::COERCE-TO-CONDITION +++ SLOOP::FIRST-SLOOP-FOR ANSI-LOOP::LOOP-FOR-ARITHMETIC +++ SYSTEM::MAYBE-BREAK SYSTEM::SETF-STRUCTURE-ACCESS +++ SYSTEM::CALL-TEST SYSTEM::FIND-LINE-IN-FUN)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ COMMON-LISP::COUNT-IF COMMON-LISP::BIT-ANDC2 +++ COMMON-LISP::REMOVE SYSTEM::INTERNAL-COUNT-IF +++ SLOOP::LOOP-ADD-BINDING COMMON-LISP::MAP-INTO +++ COMMON-LISP::FIND-IF COMMON-LISP::NSET-DIFFERENCE +++ COMMON-LISP::UNION COMMON-LISP::NUNION +++ COMMON-LISP::MAKE-SEQUENCE COMMON-LISP::NOTANY +++ COMMON-LISP::POSITION COMMON-LISP::DELETE-IF +++ COMMON-LISP::BIT-ORC2 COMMON-LISP::REPLACE COMMON-LISP::DELETE +++ SYSTEM::BREAK-CALL COMMON-LISP::NINTERSECTION +++ COMMON-LISP::POSITION-IF SYSTEM::FIND-IHS COMMON-LISP::BIT-AND +++ COMMON-LISP::DELETE-IF-NOT ANSI-LOOP::LOOP-CHECK-DATA-TYPE +++ COMMON-LISP::REMOVE-IF COMMON-LISP::READ-SEQUENCE +++ SLOOP::PARSE-LOOP-MACRO COMMON-LISP::BIT-NAND +++ SYSTEM::INTERNAL-COUNT-IF-NOT COMMON-LISP::SUBSETP +++ COMMON-LISP::VECTOR-PUSH-EXTEND COMMON-LISP::EVERY +++ COMMON-LISP::SOME COMMON-LISP::WRITE-SEQUENCE +++ COMMON-LISP::MISMATCH COMMON-LISP::SET-EXCLUSIVE-OR +++ COMMON-LISP::REMOVE-IF-NOT COMMON-LISP::BIT-NOR +++ COMMON-LISP::BIT-XOR COMMON-LISP::BIT-EQV COMMON-LISP::SEARCH +++ COMMON-LISP::SET-DIFFERENCE COMMON-LISP::FILL +++ COMMON-LISP::CERROR COMMON-LISP::ADJUST-ARRAY +++ COMMON-LISP::BIT-ORC1 SYSTEM::INTERNAL-COUNT +++ COMMON-LISP::TYPEP SYSTEM::PROCESS-ERROR +++ COMMON-LISP::COUNT-IF-NOT COMMON-LISP::INTERSECTION +++ SLOOP::IN-ARRAY-SLOOP-FOR COMMON-LISP::FIND-IF-NOT +++ COMMON-LISP::BIT-ANDC1 COMMON-LISP::POSITION-IF-NOT +++ COMMON-LISP::NOTEVERY COMMON-LISP::NSET-EXCLUSIVE-OR +++ COMMON-LISP::FIND COMMON-LISP::COUNT COMMON-LISP::BIT-IOR)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ SYSTEM::PUSH-SUB-LIST-BINDING SYSTEM::DO-ARG-COUNT-ERROR)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::T) +++ ANSI-LOOP::ADD-LOOP-PATH COMMON-LISP::MAP +++ ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH +++ ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH +++ COMMON-LISP::SUBSTITUTE COMMON-LISP::NSUBSTITUTE +++ COMMON-LISP::NSUBSTITUTE-IF-NOT ANSI-LOOP::LOOP-MAKE-VARIABLE +++ COMMON-LISP::SUBSTITUTE-IF-NOT +++ ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH +++ SYSTEM::PUSH-LET-BINDING COMMON-LISP::SUBSTITUTE-IF +++ SYSTEM::CHECK-TYPE-SYMBOL SLOOP::LOOP-DECLARE-BINDING +++ SYSTEM::COMPLETE-PROP COMMON-LISP::NSUBSTITUTE-IF)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ SYSTEM::MAKE-PREDICATE SYSTEM::DO-BREAK-LEVEL +++ SYSTEM::MAKE-CONSTRUCTOR)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ SYSTEM::UNIVERSAL-ERROR-HANDLER)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::FIXNUM) +++ COMMON-LISP::T) +++ SYSTEM::SHARP-SHARP-READER SYSTEM::SHARP-EQ-READER)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ SLOOP::DEF-LOOP-INTERNAL SYSTEM::PRINT-STACK-FRAME +++ COMMON-LISP::MERGE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::T) +++ COMMON-LISP::ENCODE-UNIVERSAL-TIME)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) +++ COMMON-LISP::T) +++ ANSI-LOOP::LOOP-SEQUENCER)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::STRING COMMON-LISP::FIXNUM) +++ COMMON-LISP::FIXNUM) +++ SYSTEM::ATOI)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +++ SYSTEM::DESCRIBE-ENVIRONMENT SYSTEM::STEP-NEXT +++ COMMON-LISP::BREAK COMMON-LISP::ABORT SYSTEM::MAKE-S-DATA +++ ANSI-LOOP::MAKE-LOOP-COLLECTOR SLOOP::PARSE-LOOP-DECLARE +++ ANSI-LOOP::LOOP-GENTEMP SYSTEM::MAKE-INSTREAM +++ SYSTEM::MAYBE-CLEAR-INPUT +++ ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL COMMON-LISP::Y-OR-N-P +++ SYSTEM::CURRENT-STEP-FUN ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL +++ COMMON-LISP::DRIBBLE SYSTEM::MAKE-RESTART +++ SLOOP::PARSE-LOOP-WITH SYSTEM::LOC COMMON-LISP::YES-OR-NO-P +++ SYSTEM::TRANSFORM-KEYWORDS SYSTEM::MAKE-CONTEXT +++ COMMON-LISP::COMPUTE-RESTARTS SYSTEM::DBL-READ +++ SYSTEM::STEP-INTO ANSI-LOOP::MAKE-LOOP-UNIVERSE +++ SYSTEM::BREAK-LOCALS ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE +++ COMMON-LISP::VECTOR ANSI-LOOP::MAKE-LOOP-PATH)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) +++ ANSI-LOOP::LOOP-LIST-STEP SYSTEM::INSPECT-OBJECT +++ COMMON-LISP::DESCRIBE ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES +++ SYSTEM::BREAK-GO SYSTEM::GET-&ENVIRONMENT +++ COMMON-LISP::PRINC-TO-STRING SYSTEM::WAITING +++ SYSTEM::INSTREAM-NAME ANSI-LOOP::NAMED-VARIABLE +++ COMMON-LISP::PRIN1-TO-STRING SYSTEM::INFO-SUBFILE +++ COMMON-LISP::INSPECT SYSTEM::END-WAITING +++ SYSTEM::FIND-DECLARATIONS +++ COMMON-LISP::INVOKE-RESTART-INTERACTIVELY +++ SYSTEM::BREAK-LEVEL-INVOKE-RESTART SYSTEM::ALOAD)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ ANSI-LOOP::MAKE-LOOP-MINIMAX COMMON-LISP::LDB +++ SYSTEM::LIST-DELQ FPE::RF SLOOP::L-EQUAL +++ ANSI-LOOP::LOOP-DECLARE-VARIABLE SYSTEM::DISPLAY-COMPILED-ENV +++ SYSTEM::SET-BACK ANSI-LOOP::HIDE-VARIABLE-REFERENCES +++ SYSTEM::GET-LINE-OF-FORM SYSTEM::BREAK-STEP-INTO +++ SLOOP::THE-TYPE SLOOP::COUNT-SLOOP-COLLECT +++ SYSTEM::KEYWORD-SUPPLIED-P COMMON-LISP::LOGANDC2 +++ ANSI-LOOP::LOOP-MAYBE-BIND-FORM SYSTEM::SET-DIR +++ SYSTEM::COERCE-TO-STRING COMMON-LISP::VECTOR-PUSH +++ SYSTEM::DM-NTH-CDR SLOOP::IN-FRINGE-SLOOP-MAP +++ SLOOP::MAXIMIZE-SLOOP-COLLECT SYSTEM::ADD-FILE +++ SYSTEM::ALL-MATCHES SYSTEM::DM-NTH +++ SLOOP::IN-CAREFULLY-SLOOP-FOR SYSTEM::PARSE-SLOT-DESCRIPTION +++ ANSI-LOOP::LOOP-LOOKUP-KEYWORD FPE::0-READER +++ ANSI-LOOP::LOOP-TMEMBER COMPILER::COMPILER-DEF-HOOK +++ SYSTEM::INFO-AUX COMMON-LISP::NTH SYSTEM::QUOTATION-READER +++ SYSTEM::CHECK-SEQ-START-END COMMON-LISP::LOGNAND +++ SYSTEM::SUBSTRINGP COMMON-LISP::LOGORC2 +++ ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION SYSTEM::SAFE-EVAL +++ ANSI-LOOP::LOOP-DO-IF SLOOP::THEREIS-SLOOP-COLLECT +++ SYSTEM::MATCH-DIMENSIONS SYSTEM::GET-MATCH +++ SYSTEM::SUB-INTERVAL-P FPE::PAREN-READER +++ SLOOP::IN-TABLE-SLOOP-MAP COMMON-LISP::LOGTEST +++ SLOOP::LOGXOR-SLOOP-COLLECT SYSTEM::DM-V +++ SYSTEM::GET-INFO-CHOICES SLOOP::COLLATE-SLOOP-COLLECT +++ SYSTEM::BREAK-STEP-NEXT ANSI-LOOP::LOOP-TEQUAL +++ COMMON-LISP::WRITE-BYTE COMMON-LISP::NTHCDR +++ SYSTEM::SETF-HELPER SLOOP::NEVER-SLOOP-COLLECT SLOOP::DESETQ1 +++ ANSI-LOOP::LOOP-DO-WHILE COMMON-LISP::DOCUMENTATION +++ FPE::%-READER SYSTEM::IN-INTERVAL-P SLOOP::SUM-SLOOP-COLLECT +++ SYSTEM::OBJLT COMMON-LISP::LDB-TEST SLOOP::PARSE-LOOP-MAP +++ SYSTEM::GET-NODES SLOOP::MAKE-VALUE SYSTEM::CONDITION-PASS +++ SLOOP::IN-PACKAGE-SLOOP-MAP SYSTEM::INCREMENT-CURSOR +++ ANSI-LOOP::LOOP-DO-ALWAYS SYSTEM::DISPLAY-ENV SYSTEM::SUPER-GO +++ SLOOP::MINIMIZE-SLOOP-COLLECT COMMON-LISP::LOGNOR +++ COMMON-LISP::LOGANDC1 COMMON-LISP::BYTE SYSTEM::DBL-UP +++ SYSTEM::ITERATE-OVER-BKPTS COMMON-LISP::LOGORC1 +++ FPE::READ-OPERANDS SLOOP::ALWAYS-SLOOP-COLLECT +++ SYSTEM::SETF-EXPAND SYSTEM::OVERWRITE-SLOT-DESCRIPTIONS +++ SYSTEM::*BREAK-POINTS* SYSTEM::LOOKUP-KEYWORD +++ ANSI-LOOP::LOOP-TASSOC SYSTEM::LEFT-PARENTHESIS-READER +++ SLOOP::=-SLOOP-FOR FPE::READ-INSTRUCTION COMMON-LISP::COERCE +++ SYSTEM::SEQUENCE-CURSOR)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ COMMON-LISP::FFLOOR SYSTEM::BREAK-FUNCTION +++ COMMON-LISP::APROPOS-LIST COMMON-LISP::DECODE-UNIVERSAL-TIME +++ SYSTEM::STEPPER COMMON-LISP::REQUIRE SYSTEM::APROPOS-DOC +++ SYSTEM::PRINT-DOC SYSTEM::INFO COMMON-LISP::USE-VALUE +++ COMMON-LISP::WRITE-TO-STRING COMMON-LISP::FCEILING +++ SYSTEM::GET-SETF-METHOD +++ ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE SYSTEM::NLOAD +++ COMMON-LISP::ENSURE-DIRECTORIES-EXIST +++ COMMON-LISP::WILD-PATHNAME-P COMMON-LISP::FTRUNCATE +++ COMMON-LISP::FROUND SYSTEM::PARSE-BODY-HEADER +++ COMMON-LISP::INVOKE-RESTART SYSTEM::SHOW-INFO +++ COMMON-LISP::READ-FROM-STRING +++ SYSTEM::GET-SETF-METHOD-MULTIPLE-VALUE COMMON-LISP::APROPOS +++ COMMON-LISP::STORE-VALUE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +++ ANSI-LOOP::LOOP-DO-WITH SYSTEM::WINE-TMP-REDIRECT +++ SLOOP::PARSE-ONE-WHEN-CLAUSE COMMON-LISP::TYPE-ERROR +++ SYSTEM::INSPECT-INDENT SYSTEM::SET-CURRENT SYSTEM::TEST-ERROR +++ SLOOP::LOOP-POP ANSI-LOOP::LOOP-DO-REPEAT +++ ANSI-LOOP::LOOP-GET-PROGN SYSTEM::DM-TOO-FEW-ARGUMENTS +++ ANSI-LOOP::LOOP-CONTEXT SYSTEM::READ-EVALUATED-FORM +++ SYSTEM::ALL-TRACE-DECLARATIONS +++ COMMON-LISP::LISP-IMPLEMENTATION-VERSION +++ SYSTEM::DEFAULT-SYSTEM-BANNER ANSI-LOOP::LOOP-DO-RETURN +++ SYSTEM::INSPECT-INDENT-1 SYSTEM::STEP-READ-LINE +++ SYSTEM::SET-ENV SYSTEM::DM-TOO-MANY-ARGUMENTS +++ ANSI-LOOP::LOOP-BIND-BLOCK SLOOP::PARSE-LOOP1 +++ ANSI-LOOP::LOOP-DO-NAMED SLOOP::PARSE-LOOP-COLLECT +++ SYSTEM::KCL-TOP-RESTARTS SYSTEM::INSPECT-READ-LINE +++ SYSTEM::SET-UP-TOP-LEVEL SYSTEM::SHOW-RESTARTS SYSTEM::DBL +++ SLOOP::PARSE-LOOP-FOR ANSI-LOOP::LOOP-ITERATION-DRIVER +++ ANSI-LOOP::LOOP-WHEN-IT-VARIABLE ANSI-LOOP::LOOP-DO-DO +++ SYSTEM::DEFAULT-INFO-HOTLIST SYSTEM::GET-TEMP-DIR +++ ANSI-LOOP::LOOP-POP-SOURCE SLOOP::LOOP-UN-POP +++ SYSTEM::TOP-LEVEL ANSI-LOOP::LOOP-DO-FINALLY +++ ANSI-LOOP::LOOP-DO-INITIALLY SYSTEM::GET-INDEX-NODE +++ SYSTEM::SETUP-LINEINFO SLOOP::PARSE-LOOP-WHEN SYSTEM::CLEANUP +++ ANSI-LOOP::LOOP-GET-FORM SLOOP::PARSE-LOOP-DO +++ SYSTEM::INIT-BREAK-POINTS SLOOP::LOOP-PEEK +++ SYSTEM::GET-SIG-FN-NAME SYSTEM::ILLEGAL-BOA)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM COMMON-LISP::T) +++ COMMON-LISP::T) +++ SYSTEM::SMALLNTHCDR)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::FIXNUM) +++ SYSTEM::THE-END ANSI-LOOP::DUPLICATABLE-CODE-P +++ SYSTEM::RELATIVE-LINE SYSTEM::GET-NODE-INDEX)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM) +++ COMMON-LISP::FIXNUM) +++ SYSTEM::ROUND-UP)) ++\ No newline at end of file ++--- gcl-2.6.12.orig/o/alloc.c +++++ gcl-2.6.12/o/alloc.c ++@@ -68,7 +68,7 @@ sbrk1(n) ++ long starting_hole_div=10; ++ long starting_relb_heap_mult=2; ++ long new_holepage; ++-long resv_pages=40; +++long resv_pages=0; ++ ++ #ifdef BSD ++ #include ++@@ -186,14 +186,45 @@ int reserve_pages_for_signal_handler=30; ++ If not in_signal_handler then try to keep a minimum of ++ reserve_pages_for_signal_handler pages on hand in the hole ++ */ +++ +++inline void +++empty_relblock(void) { +++ +++ object o=sSAleaf_collection_thresholdA->s.s_dbind; +++ +++ sSAleaf_collection_thresholdA->s.s_dbind=make_fixnum(0); +++ for (;rb_pointer!=rb_start&&rb_pointer!=rb_end;) +++ GBC(t_relocatable); +++ sSAleaf_collection_thresholdA->s.s_dbind=o; +++ +++} +++ +++inline void +++resize_hole(ufixnum hp,enum type tp) { +++ +++ char *new_start=heap_end+hp*PAGESIZE; +++ char *start=rb_pointer=start) || (new_start=start+size)) { +++ fprintf(stderr,"Toggling relblock when resizing hole to %lu\n",hp); +++ fflush(stderr); +++ tm_table[t_relocatable].tm_adjgbccnt--; +++ GBC(t_relocatable); +++ return resize_hole(hp,tp); +++ } +++ +++ holepage=hp; +++ tm_of(tp)->tm_adjgbccnt--; +++ GBC(tp); +++ +++} +++ ++ inline void * ++ alloc_page(long n) { ++ ++- void *e=heap_end; ++ fixnum d,m; ++-#ifdef SGC ++- int in_sgc=sgc_enabled; ++-#endif +++ ++ if (n>=0) { ++ ++ if (n>(holepage - (in_signal_handler? 0 : ++@@ -215,25 +246,8 @@ eg to add 20 more do (si::set-hole-size ++ d=d<0 ? 0 : d; ++ d=new_holepagetm_type==t_relocatable,j=tm->tm_maxpage,z=(n-j)*(r ? 2 : 1); ++ if (z>available_pages) return 0; ++- if (r && 2*n+page(REAL_RB_START)>real_maxpage) return 0; +++ if (r && 2*n+page(rb_start)>real_maxpage) return 0; ++ available_pages-=z; ++- tm->tm_adjgbccnt*=((double)j)/n; +++ tm->tm_adjgbccnt*=((double)j+1)/(n+1); ++ tm->tm_maxpage=n; ++- return n; +++ /* massert(!check_avail_pages()); */ +++ return 1; ++ } ++ ++ ++@@ -317,8 +355,11 @@ add_page_to_freelist(char *p, struct typ ++ ++ if (sgc_enabled && tm->tm_sgc) ++ pp->sgc_flags=SGC_PAGE_FLAG; +++ +++#ifndef SGC_WHOLE_PAGE ++ if (TYPEWORD_TYPE_P(pp->type)) ++ x->d.s=(sgc_enabled && tm->tm_sgc) ? SGC_RECENT : SGC_NORMAL; +++#endif ++ ++ /* array headers must be always writable, since a write to the ++ body does not touch the header. It may be desirable if there ++@@ -410,17 +451,61 @@ grow_linear(fixnum old, fixnum fract, fi ++ DEFVAR("*OPTIMIZE-MAXIMUM-PAGES*",sSAoptimize_maximum_pagesA,SI,sLnil,""); ++ #define OPTIMIZE_MAX_PAGES (sSAoptimize_maximum_pagesA ==0 || sSAoptimize_maximum_pagesA->s.s_dbind !=sLnil) ++ DEFVAR("*NOTIFY-OPTIMIZE-MAXIMUM-PAGES*",sSAnotify_optimize_maximum_pagesA,SI,sLnil,""); ++-#define MMAX_PG(a_) (a_)->tm_maxpage +++#define MMAX_PG(a_) (a_)->tm_maxpage-(a_)->tm_alt_npage +++ +++static int +++rebalance_maxpages(struct typemanager *my_tm,fixnum z) { +++ +++ fixnum d; +++ ufixnum i,j; +++ +++ +++ d=(z-my_tm->tm_maxpage)*(my_tm->tm_type==t_relocatable ? 2 : 1); +++ j=sum_maxpages(); +++ +++ if (j+d>phys_pages) { +++ +++ ufixnum k=0; +++ +++ for (i=t_start;ik+phys_pages-j ? k+phys_pages-j : d; +++ if (d<=0) +++ return 0; +++ +++ for (i=t_start;i((double)phys_pages/(j+d))*(tm_table+i==my_tm ? z : tm_table[i].tm_maxpage)) */ +++ /* return 0; */ +++ /* for (i=t_start;i0 && page(heap_end)-first_data_page+nrbpage>=phys_pages) ++- return 0; +++ long mro=0,tro=0,j; ++ ++ if (page(core_end)>0.8*real_maxpage) ++ return 0; ++@@ -437,22 +522,27 @@ opt_maxpage(struct typemanager *my_tm) { ++ } ++ #endif ++ ++- z=my_tm->tm_adjgbccnt-1; +++ z=my_tm->tm_adjgbccnt/* -1 */; ++ z/=(1+x-0.9*my_tm->tm_adjgbccnt); ++ z*=(y-mmax_page)*mmax_page; ++ z=sqrt(z); ++ z=z-mmax_page>available_pages ? mmax_page+available_pages : z; ++- my_tm->tm_opt_maxpage=(long)z>my_tm->tm_opt_maxpage ? (long)z : my_tm->tm_opt_maxpage; +++ my_tm->tm_opt_maxpage=(long)(z+my_tm->tm_alt_npage)>my_tm->tm_opt_maxpage ? (long)(z+my_tm->tm_alt_npage) : my_tm->tm_opt_maxpage; ++ ++ if (z<=mmax_page) ++ return 0; ++ ++ r=((x-my_tm->tm_adjgbccnt)+ my_tm->tm_adjgbccnt*mmax_page/z)*(y-mmax_page+z); ++ r/=x*y; +++ +++ j=r<=0.95 && rebalance_maxpages(my_tm,z+mro+my_tm->tm_alt_npage); +++ ++ if (sSAnotify_optimize_maximum_pagesA->s.s_dbind!=sLnil) ++- printf("[type %u max %lu(%lu) opt %lu y %lu(%lu) gbcrat %f sav %f]\n", ++- my_tm->tm_type,mmax_page,mro,(long)z,(long)y,tro,(my_tm->tm_adjgbccnt-1)/(1+x-0.9*my_tm->tm_adjgbccnt),r); ++- return r<=0.95 && set_tm_maxpage(my_tm,z+mro) ? 1 : 0; +++ printf("[type %u max %lu(%lu) opt %lu y %lu(%lu) gbcrat %f sav %f new %lu sum %lu phys %lu]\n", +++ my_tm->tm_type,mmax_page,mro,(long)z,(long)y,tro,(my_tm->tm_adjgbccnt/* -1 */)/(1+x-0.9*my_tm->tm_adjgbccnt),r, +++ my_tm->tm_maxpage,sum_maxpages(),phys_pages); +++ +++ return j ? 1 : 0; ++ ++ } ++ ++@@ -483,41 +573,200 @@ Use ALLOCATE to expand the space.", ++ #else ++ #define TOTAL_THIS_TYPE(tm) (tm->tm_nppage * tm->tm_npage) ++ #endif ++-bool prefer_low_mem_contblock=FALSE; +++ +++static object cbv=Cnil; +++#define cbsrch1 ((struct contblock ***)cbv->v.v_self) +++#define cbsrche (cbsrch1+cbv->v.v_fillp) +++ +++static inline void +++expand_contblock_index_space(void) { +++ +++ if (cbv==Cnil) { +++ cbv=(VFUN_NARGS=4,fSmake_vector1(make_fixnum(16),make_fixnum(aet_fix),Cnil,make_fixnum(0))); +++ cbv->v.v_self[0]=(object)&cb_pointer; +++ enter_mark_origin(&cbv); +++ } +++ +++ if (cbv->v.v_fillp+1==cbv->v.v_dim) { +++ +++ void *v=alloc_relblock(2*cbv->v.v_dim*sizeof(fixnum)); +++ +++ memcpy(v,cbv->v.v_self,cbv->v.v_dim*sizeof(fixnum)); +++ cbv->v.v_self=v; +++ cbv->v.v_dim*=2; +++ +++ } +++ +++} +++ +++static inline void * +++expand_contblock_index(struct contblock ***cbppp) { +++ +++ ufixnum i=cbppp-cbsrch1; +++ +++ expand_contblock_index_space(); +++ +++ cbppp=cbsrch1+i; +++ memmove(cbppp+1,cbppp,(cbsrche-cbppp+1)*sizeof(*cbppp)); +++ cbv->v.v_fillp++; +++ +++ return cbppp; +++ +++} +++ +++static inline void +++contract_contblock_index(struct contblock ***cbppp) { +++ +++ memmove(cbppp+1,cbppp+2,(cbsrche-cbppp-1)*sizeof(*cbppp)); +++ cbv->v.v_fillp--; +++ +++} +++ +++static inline int +++cbcomp(const void *v1,const void *v2) { +++ +++ ufixnum u1=(**(struct contblock ** const *)v1)->cb_size; +++ ufixnum u2=(**(struct contblock ** const *)v2)->cb_size; +++ +++ return u1>1; +++ void *v=v1+nn*s; +++ int j=c(i,v); +++ +++ if (nn) +++ return !j ? v : (j>0 ? bsearchleq(i,v,n-nn,s,c) : bsearchleq(i,v1,nn,s,c)); +++ else +++ return j<=0 ? v : v+s; +++ +++} +++ +++ +++static inline struct contblock *** +++find_cbppp(struct contblock *cbp) { +++ +++ struct contblock **cbpp=&cbp; +++ +++ return cbsrche==cbsrch1 ? cbsrch1 : bsearchleq(&cbpp,cbsrch1,cbsrche-cbsrch1,sizeof(*cbsrch1),cbcomp); +++ +++} +++ +++static inline struct contblock *** +++find_cbppp_by_n(ufixnum n) { +++ +++ struct contblock cb={n,NULL}; +++ +++ return find_cbppp(&cb); +++ +++} +++ +++static inline struct contblock ** +++find_cbpp(struct contblock ***cbppp,ufixnum n) { +++ +++ return *cbppp; +++ +++} +++ +++ +++static inline struct contblock ** +++find_contblock(ufixnum n,void **p) { +++ +++ *p=find_cbppp_by_n(n); +++ return find_cbpp(*p,n); +++} +++ +++inline void +++print_cb(int print) { +++ +++ struct contblock *cbp,***cbppp,**cbpp=&cb_pointer; +++ ufixnum k; +++ +++ for (cbp=cb_pointer,cbppp=cbsrch1;cbp;cbppp++) { +++ massert(cbpppcb_size==(**cbppp)->cb_size;cbpp=&cbp->cb_link,cbp=cbp->cb_link,k++); +++ if (print) +++ fprintf(stderr,"%lu %p %p %lu %lu\n",cbppp-cbsrch1,*cbppp,**cbppp,(**cbppp)->cb_size,k); +++ } +++ massert(cbppp==cbsrche); +++ massert(*cbppp==cbpp); +++ massert(!**cbppp); +++ +++ fflush(stderr); +++ +++} +++ +++inline void +++insert_contblock(void *p,ufixnum s) { +++ +++ struct contblock *cbp=p,**cbpp,***cbppp; +++ +++ cbpp=find_contblock(s,(void **)&cbppp); +++ +++ cbp->cb_size=s; +++ cbp->cb_link=*cbpp; +++ *cbpp=cbp; +++ +++ if ((!cbp->cb_link || cbp->cb_link->cb_size!=s)) { +++ cbppp=expand_contblock_index(cbppp); +++ cbppp[1]=&cbp->cb_link; +++ } +++ +++} +++ +++static inline void +++delete_contblock(void *p,struct contblock **cbpp) { +++ +++ struct contblock ***cbppp=p; +++ ufixnum s=(*cbpp)->cb_size; +++ +++ (*cbpp)=(*cbpp)->cb_link; +++ +++ if ((!(*cbpp) || (*cbpp)->cb_size!=s)) +++ contract_contblock_index(cbppp); +++ +++} +++ +++inline void +++reset_contblock_freelist(void) { +++ +++ cb_pointer=NULL; +++ cbv->v.v_fillp=0; +++ +++} ++ ++ inline void * ++ alloc_from_freelist(struct typemanager *tm,fixnum n) { ++ ++- void *p,*v,*vp; ++- struct contblock **cbpp; ++- fixnum i; +++ void *p; ++ ++ switch (tm->tm_type) { ++ ++ case t_contiguous: ++- for (cbpp= &cb_pointer,v=(void *)-1,vp=NULL; (*cbpp)!=NULL; cbpp= &(*cbpp)->cb_link) ++- if ((*cbpp)->cb_size >= n) { ++- if (!prefer_low_mem_contblock) { ++- vp=cbpp; ++- break; ++- } else if ((void *)(*cbpp)cb_size; +++ delete_contblock(pp,cbpp); +++ if (ncb_size-n; ++- *cbpp=(*cbpp)->cb_link; ++- --ncb; ++- insert_contblock(p+n,i); ++- return(p); +++ return p; ++ } ++ break; ++ ++ case t_relocatable: ++- if (rb_limit-rb_pointer>=n) +++ if (rb_pointer>rb_end && rb_pointer+n>rb_limit && rb_pointer+nn) ++ return ((rb_pointer+=n)-n); ++ break; ++ ++@@ -554,7 +803,7 @@ too_full_p(struct typemanager *tm) { ++ ++ switch (tm->tm_type) { ++ case t_relocatable: ++- return 100*(rb_limit-rb_pointer)cb_link) k+=cbp->cb_size; ++@@ -575,7 +824,7 @@ too_full_p(struct typemanager *tm) { ++ inline void * ++ alloc_after_gc(struct typemanager *tm,fixnum n) { ++ ++- if (tm->tm_npage+tpage(tm,n)>=tm->tm_maxpage && GBC_enable) { +++ if (tm->tm_npage+tpage(tm,n)>tm->tm_maxpage && GBC_enable) { ++ ++ switch (jmp_gmp) { ++ case 0: /* not in gmp call*/ ++@@ -618,11 +867,16 @@ add_pages(struct typemanager *tm,fixnum ++ ++ case t_relocatable: ++ +++ if (rb_pointer>rb_end) { +++ fprintf(stderr,"Moving relblock low before expanding relblock pages\n"); +++ fflush(stderr); +++ GBC(t_relocatable); +++ } ++ nrbpage+=m; ++- rb_end=heap_end+(holepage+nrbpage)*PAGESIZE; ++- rb_limit=rb_end-2*RB_GETA; +++ rb_end+=m*PAGESIZE; +++ rb_limit+=m*PAGESIZE; ++ ++- alloc_page(-(nrbpage+holepage)); +++ alloc_page(-(2*nrbpage+holepage)); ++ ++ break; ++ ++@@ -656,7 +910,7 @@ alloc_after_adding_pages(struct typemana ++ ++ } ++ ++- m=tm->tm_maxpage-tm->tm_npage; +++ /* m=tm->tm_maxpage-tm->tm_npage; */ ++ add_pages(tm,m); ++ ++ return alloc_from_freelist(tm,n); ++@@ -670,15 +924,15 @@ alloc_after_reclaiming_pages(struct type ++ ++ if (tm->tm_type>=t_end) return NULL; ++ ++- reloc_min=npage(rb_pointer-REAL_RB_START); +++ reloc_min=npage(rb_pointer-rb_start); ++ ++ if (m<2*(nrbpage-reloc_min)) { ++ ++ set_tm_maxpage(tm_table+t_relocatable,reloc_min); ++ nrbpage=reloc_min; ++ ++- GBC(t_relocatable); ++ tm_table[t_relocatable].tm_adjgbccnt--; +++ GBC(t_relocatable); ++ ++ return alloc_after_adding_pages(tm,n); ++ ++@@ -742,13 +996,31 @@ alloc_object(enum type t) { ++ ++ inline void * ++ alloc_contblock(size_t n) { ++- return alloc_mem(tm_of(t_contiguous),ROUND_UP_PTR_CONT(n)); +++ return alloc_mem(tm_of(t_contiguous),CEI(n,CPTR_SIZE)); +++} +++ +++inline void * +++alloc_contblock_no_gc(size_t n) { +++ +++ struct typemanager *tm=tm_of(t_contiguous); +++ void *p; +++ +++ n=CEI(n,CPTR_SIZE); +++ +++ if ((p=alloc_from_freelist(tm,n))) +++ return p; +++ +++ if (tpage(tm,n)<(rb_start-heap_end)>>PAGEWIDTH && (p=alloc_after_adding_pages(tm,n))) +++ return p; +++ +++ return NULL; +++ ++ } ++ ++ inline void * ++ alloc_relblock(size_t n) { ++ ++- return alloc_mem(tm_of(t_relocatable),ROUND_UP_PTR(n)); +++ return alloc_mem(tm_of(t_relocatable),CEI(n,PTR_ALIGN)); ++ ++ } ++ ++@@ -789,7 +1061,7 @@ DEFUNM_NEW("ALLOCATED",object,fSallocate ++ tm = & tm_table[tm->tm_type]; ++ if (tm->tm_type == t_relocatable) ++ { tm->tm_npage = (rb_end-rb_start)/PAGESIZE; ++- tm->tm_nfree = rb_end -rb_pointer; +++ tm->tm_nfree = rb_limit -rb_pointer; ++ } ++ else if (tm->tm_type == t_contiguous) ++ { int cbfree =0; ++@@ -808,45 +1080,6 @@ DEFUNM_NEW("ALLOCATED",object,fSallocate ++ )); ++ } ++ ++-/* DEFUN_NEW("RESET-NUMBER-USED",object,fSreset_number_used,SI,0,1,NONE,OO,OO,OO,OO,(object typ),"") */ ++-/* {int i; */ ++-/* if (VFUN_NARGS == 1) */ ++-/* { tm_table[t_from_type(typ)].tm_nused = 0;} */ ++-/* else */ ++-/* for (i=0; i <= t_relocatable ; i++) */ ++-/* { tm_table[i].tm_nused = 0;} */ ++-/* RETURN1(sLnil); */ ++-/* } */ ++- ++-#define IN_CONTBLOCK_P(p,pi) ((void *)p>=(void *)pi && (void *)p<(void *)pi+pi->in_use*PAGESIZE) ++- ++-/* SGC cont pages: explicit free calls can come at any time, and we ++- must make sure to add the newly deallocated block to the right ++- list. CM 20030827*/ ++-#ifdef SGC ++-void ++-insert_maybe_sgc_contblock(char *p,int s) { ++- ++- struct contblock *tmp_cb_pointer; ++- struct pageinfo *pi; ++- ++- for (pi=contblock_list_head;pi && !IN_CONTBLOCK_P(p,pi);pi=pi->next); ++- massert(pi); ++- ++- if (sgc_enabled && ! (pi->sgc_flags&SGC_PAGE_FLAG)) { ++- tmp_cb_pointer=cb_pointer; ++- cb_pointer=old_cb_pointer; ++- sgc_enabled=0; ++- insert_contblock(p,s); ++- sgc_enabled=1; ++- old_cb_pointer=cb_pointer; ++- cb_pointer=tmp_cb_pointer; ++- } else ++- insert_contblock(p,s); ++- ++-} ++-#endif ++- ++ #ifdef SGC_CONT_DEBUG ++ extern void overlap_check(struct contblock *,struct contblock *); ++ #endif ++@@ -856,78 +1089,17 @@ DEFUN_NEW("PRINT-FREE-CONTBLOCK-LIST",ob ++ struct contblock *cbp,*cbp1; ++ ++ for (cbp=cb_pointer;cbp;cbp=cbp->cb_link) { ++- printf("%p %d\n",cbp,cbp->cb_size); +++ printf("%p %lu\n",cbp,cbp->cb_size); ++ for (cbp1=cbp;cbp1;cbp1=cbp1->cb_link) ++ if ((void *)cbp+cbp->cb_size==(void *)cbp1 || ++ (void *)cbp1+cbp1->cb_size==(void *)cbp) ++- printf(" adjacent to %p %d\n",cbp1,cbp1->cb_size); +++ printf(" adjacent to %p %lu\n",cbp1,cbp1->cb_size); ++ } ++ ++ return Cnil; ++ ++ } ++ ++-void ++-insert_contblock(char *p, int s) { ++- ++- struct contblock **cbpp, *cbp; ++- ++- /* SGC cont pages: This used to return when scb_size = ROUND_UP_PTR_CONT(s); ++- ++- for (cbpp=&cb_pointer;*cbpp;) { ++- if ((void *)(*cbpp)+(*cbpp)->cb_size==(void *)cbp) { ++- /* printf("Merge contblock %p %d %p %d\n",cbp,cbp->cb_size,*cbpp,(*cbpp)->cb_size); */ ++- /* fflush(stdout); */ ++- (*cbpp)->cb_size+=cbp->cb_size; ++- cbp=*cbpp; ++- *cbpp=(*cbpp)->cb_link; ++- } else if ((void *)(*cbpp)==(void *)cbp+cbp->cb_size) { ++- /* printf("Merge contblock %p %d %p %d\n",cbp,cbp->cb_size,*cbpp,(*cbpp)->cb_size); */ ++- /* fflush(stdout); */ ++- cbp->cb_size+=(*cbpp)->cb_size; ++- *cbpp=(*cbpp)->cb_link; ++- } else ++- cbpp=&(*cbpp)->cb_link; ++- } ++- s=cbp->cb_size; ++- ++- for (cbpp = &cb_pointer; *cbpp; cbpp = &((*cbpp)->cb_link)) ++- if ((*cbpp)->cb_size >= s) { ++-#ifdef SGC_CONT_DEBUG ++- if (*cbpp==cbp) { ++- fprintf(stderr,"Trying to install a circle at %p\n",cbp); ++- exit(1); ++- } ++- if (sgc_enabled) ++- overlap_check(old_cb_pointer,cb_pointer); ++-#endif ++- cbp->cb_link = *cbpp; ++- *cbpp = cbp; ++-#ifdef SGC_CONT_DEBUG ++- if (sgc_enabled) ++- overlap_check(old_cb_pointer,cb_pointer); ++-#endif ++- return; ++- } ++- cbp->cb_link = NULL; ++- *cbpp = cbp; ++-#ifdef SGC_CONT_DEBUG ++- if (sgc_enabled) ++- overlap_check(old_cb_pointer,cb_pointer); ++-#endif ++- ++-} ++- ++ /* Add a tm_distinct field to prevent page type sharing if desired. ++ Not used now, as its never desirable from an efficiency point of ++ view, and as the only known place one must separate is cons and ++@@ -961,7 +1133,7 @@ init_tm(enum type t, char *name, int els ++ return; ++ } ++ tm_table[(int)t].tm_type = t; ++- tm_table[(int)t].tm_size = elsize ? ROUND_UP_PTR(elsize) : 1; +++ tm_table[(int)t].tm_size = elsize ? CEI(elsize,PTR_ALIGN) : 1; ++ tm_table[(int)t].tm_nppage = (PAGESIZE-sizeof(struct pageinfo))/tm_table[(int)t].tm_size; ++ tm_table[(int)t].tm_free = OBJNULL; ++ tm_table[(int)t].tm_nfree = 0; ++@@ -1096,13 +1268,19 @@ gcl_init_alloc(void *cs_start) { ++ ++ update_real_maxpage(); ++ ++- if (gcl_alloc_initialized) return; +++ if (gcl_alloc_initialized) { +++ massert(rb_start==heap_end &&rb_end==heap_end && rb_limit==heap_end && rb_pointer==heap_end); +++ holepage=new_holepage; +++ alloc_page(-holepage); +++ rb_start=rb_end=rb_limit=rb_pointer=heap_end+(holepage< sizeof(baby_malloc_data)) ++ { ++@@ -1642,11 +1821,11 @@ free(void *ptr) { ++ for (p = &malloc_list,pp=*p; pp && !endp(pp); p = &((pp)->c.c_cdr),pp=pp->c.c_cdr) ++ if ((pp)->c.c_car->st.st_self == ptr) { ++ /* SGC contblock pages: Its possible this is on an old page CM 20030827 */ ++-#ifdef SGC ++- insert_maybe_sgc_contblock((pp)->c.c_car->st.st_self,(pp)->c.c_car->st.st_dim); ++-#else ++- insert_contblock((pp)->c.c_car->st.st_self,(pp)->c.c_car->st.st_dim); ++-#endif +++/* #ifdef SGC */ +++/* insert_maybe_sgc_contblock((pp)->c.c_car->st.st_self,(pp)->c.c_car->st.st_dim); */ +++/* #else */ +++/* insert_contblock((pp)->c.c_car->st.st_self,(pp)->c.c_car->st.st_dim); */ +++/* #endif */ ++ (pp)->c.c_car->st.st_self = NULL; ++ *p = pp->c.c_cdr; ++ #ifdef GCL_GPROF ++@@ -1707,11 +1886,11 @@ realloc(void *ptr, size_t size) { ++ for (i = 0; i < size; i++) ++ x->st.st_self[i] = ((char *)ptr)[i]; ++ /* SGC contblock pages: Its possible this is on an old page CM 20030827 */ ++-#ifdef SGC ++- insert_maybe_sgc_contblock(ptr, j); ++-#else ++- insert_contblock(ptr, j); ++-#endif +++/* #ifdef SGC */ +++/* insert_maybe_sgc_contblock(ptr, j); */ +++/* #else */ +++/* insert_contblock(ptr, j); */ +++/* #endif */ ++ return(x->st.st_self); ++ } ++ } ++--- gcl-2.6.12.orig/o/array.c +++++ gcl-2.6.12/o/array.c ++@@ -457,15 +457,15 @@ static longfloat DFLT_aet_lf = 0.0; ++ static object Iname_t = sLt; ++ static struct { char * dflt; object *namep;} aet_types[] = ++ { {(char *) &DFLT_aet_object, &Iname_t,}, /* t */ ++- {(char *) &DFLT_aet_ch, &sLstring_char,},/* string-char */ +++ {(char *) &DFLT_aet_ch, &sLcharacter,},/* character */ ++ {(char *) &DFLT_aet_fix, &sLbit,}, /* bit */ ++ {(char *) &DFLT_aet_fix, &sLfixnum,}, /* fixnum */ ++ {(char *) &DFLT_aet_sf, &sLshort_float,}, /* short-float */ ++ {(char *) &DFLT_aet_lf, &sLlong_float,}, /* long-float */ ++- {(char *) &DFLT_aet_char,&sLsigned_char,}, /* signed char */ ++- {(char *) &DFLT_aet_char,&sLunsigned_char,}, /* unsigned char */ ++- {(char *) &DFLT_aet_short,&sLsigned_short,}, /* signed short */ ++- {(char *) &DFLT_aet_short, &sLunsigned_short}, /* unsigned short */ +++ {(char *) &DFLT_aet_char,&sSsigned_char,}, /* signed char */ +++ {(char *) &DFLT_aet_char,&sSunsigned_char,}, /* unsigned char */ +++ {(char *) &DFLT_aet_short,&sSsigned_short,}, /* signed short */ +++ {(char *) &DFLT_aet_short, &sSunsigned_short}, /* unsigned short */ ++ }; ++ ++ DEFUN_NEW("GET-AELTTYPE",object,fSget_aelttype,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") ++--- gcl-2.6.12.orig/o/assignment.c +++++ gcl-2.6.12/o/assignment.c ++@@ -172,7 +172,7 @@ DEFUNO_NEW("FSET",object,fSfset,SI ++ sym->s.s_mflag = FALSE; ++ } else if (car(function) == sLspecial) ++ FEerror("Cannot define a special form.", 0); ++- else if (function->c.c_car == sLmacro) { +++ else if (function->c.c_car == sSmacro) { ++ sym->s.s_gfdef = function->c.c_cdr; ++ sym->s.s_mflag = TRUE; ++ } else { ++--- gcl-2.6.12.orig/o/bind.c +++++ gcl-2.6.12/o/bind.c ++@@ -918,8 +918,8 @@ parse_key_new_new(int n, object *base, s ++ /* from here down identical to parse_key_rest */ ++ new = new + n ; ++ {int j=keys->n; ++- object *p= (object *)(keys->defaults); ++- while (--j >=0) base[j]=p[j]; +++ object **p= (object **)(keys->defaults); +++ while (--j >=0) base[j]=*(p[j]); ++ } ++ {if (n==0){ return 0;} ++ {int allow = keys->allow_other_keys; ++@@ -939,7 +939,7 @@ parse_key_new_new(int n, object *base, s ++ new = new -2; ++ k = *new; ++ while(--i >= 0) ++- {if ((*(ke++)).o == k) +++ {if (*(*(ke++)).o == k) ++ {base[i]= new[1]; ++ n=n-2; ++ goto top; ++@@ -1026,8 +1026,7 @@ parse_key_rest_new(object rest, int n, o ++ ++ new = new + n ; ++ {int j=keys->n; ++- object *p= (object *)(keys->defaults); ++- while (--j >=0) base[j]=p[j]; +++ while (--j >=0) base[j]=*keys->defaults[j].o; ++ } ++ {if (n==0){ return 0;} ++ {int allow = keys->allow_other_keys; ++@@ -1047,7 +1046,7 @@ parse_key_rest_new(object rest, int n, o ++ new = new -2; ++ k = *new; ++ while(--i >= 0) ++- {if ((*(ke++)).o == k) +++ {if (*(*(ke++)).o == k) ++ {base[i]= new[1]; ++ n=n-2; ++ goto top; ++@@ -1066,18 +1065,19 @@ parse_key_rest_new(object rest, int n, o ++ return -1; ++ }}} ++ +++static object foo[2]={Cnil,OBJNULL}; ++ ++ void ++ set_key_struct(struct key *ks, object data) ++ {int i=ks->n; ++ while (--i >=0) ++- {ks->keys[i].o = data->cfd.cfd_self[ ks->keys[i].i ]; +++ {ks->keys[i].o = data->cfd.cfd_self+ks->keys[i].i; ++ if (ks->defaults != (void *)Cstd_key_defaults) ++ {fixnum m=ks->defaults[i].i; ++ ks->defaults[i].o= ++- (m==-2 ? Cnil : ++- m==-1 ? OBJNULL : ++- data->cfd.cfd_self[m]);} +++ (m==-2 ? foo : +++ m==-1 ? foo+1 : +++ data->cfd.cfd_self+m);} ++ }} ++ ++ #undef AUX ++--- gcl-2.6.12.orig/o/cfun.c +++++ gcl-2.6.12/o/cfun.c ++@@ -306,6 +306,15 @@ make_special_form_internal(char *s, void ++ return(x); ++ } ++ +++object +++make_si_special_form_internal(char *s, void (*f)()) +++{ +++ object x; +++ x = make_si_ordinary(s); +++ x->s.s_sfdef = f; +++ return(x); +++} +++ ++ DEFUN_NEW("COMPILED-FUNCTION-NAME",object,fScompiled_function_name,SI ++ ,1,1,NONE,OO,OO,OO,OO,(object fun),"") ++ ++--- gcl-2.6.12.orig/o/character.d +++++ gcl-2.6.12/o/character.d ++@@ -50,14 +50,6 @@ Foundation, 675 Mass Ave, Cambridge, MA ++ @(return Cnil) ++ @) ++ ++-@(defun string_char_p (c) ++-@ ++- check_type_character(&c); ++- if (char_font(c) != 0 || char_bits(c) != 0) ++- @(return Cnil) ++- @(return Ct) ++-@) ++- ++ @(defun alpha_char_p (c) ++ int i; ++ @ ++@@ -358,18 +350,6 @@ BEGIN: ++ @(return `make_fixnum(char_code(c))`) ++ @) ++ ++-@(defun char_bits (c) ++-@ ++- check_type_character(&c); ++- @(return `small_fixnum(char_bits(c))`) ++-@) ++- ++-@(defun char_font (c) ++-@ ++- check_type_character(&c); ++- @(return `small_fixnum(char_font(c))`) ++-@) ++- ++ @(defun code_char (c &o (b `make_fixnum(0)`) (f `make_fixnum(0)`)) ++ object x; ++ @ ++@@ -393,29 +373,6 @@ BEGIN: ++ @(return x) ++ @) ++ ++-@(defun make_char (c &o (b `make_fixnum(0)`) (f `make_fixnum(0)`)) ++- object x; ++- int code; ++-@ ++- check_type_character(&c); ++- code = char_code(c); ++- check_type_non_negative_integer(&b); ++- check_type_non_negative_integer(&f); ++- if (type_of(b) == t_bignum) ++- @(return Cnil) ++- if (type_of(f) == t_bignum) ++- @(return Cnil) ++- if (fix(b)>=CHBITSLIM || fix(f)>=CHFONTLIM) ++- @(return Cnil) ++- if (fix(b) == 0 && fix(f) == 0) ++- @(return `code_char(code)`) ++- x = alloc_object(t_character); ++- char_code(x) = code; ++- char_bits(x) = fix(b); ++- char_font(x) = fix(f); ++- @(return x) ++-@) ++- ++ @(defun char_upcase (c) ++ @ ++ check_type_character(&c); ++@@ -489,30 +446,6 @@ int w, r; ++ @(return `make_fixnum(i)`) ++ @) ++ ++-@(defun int_char (x) ++- int i, c, b, f; ++-@ ++- check_type_non_negative_integer(&x); ++- if (type_of(x) == t_bignum) ++- @(return Cnil) ++- i = fix(x); ++- c = i % CHCODELIM; ++- i /= CHCODELIM; ++- b = i % CHBITSLIM; ++- i /= CHBITSLIM; ++- f = i % CHFONTLIM; ++- i /= CHFONTLIM; ++- if (i > 0) ++- @(return Cnil) ++- if (b == 0 && f == 0) ++- @(return `code_char(c)`) ++- x = alloc_object(t_character); ++- char_code(x) = c; ++- char_bits(x) = b; ++- char_font(x) = f; ++- @(return x) ++-@) ++- ++ @(defun char_name (c) ++ @ ++ check_type_character(&c); ++@@ -563,18 +496,6 @@ int w, r; ++ @(return Cnil) ++ @) ++ ++-@(defun char_bit (c n) ++-@ ++- check_type_character(&c); ++- FEerror("Cannot get char-bit of ~S.", 1, c); ++-@) ++- ++-@(defun set_char_bit (c n v) ++-@ ++- check_type_character(&c); ++- FEerror("Cannot set char-bit of ~S.", 1, c); ++-@) ++- ++ void ++ gcl_init_character() ++ { ++@@ -599,8 +520,8 @@ gcl_init_character() ++ #endif ++ ++ make_constant("CHAR-CODE-LIMIT", make_fixnum(CHCODELIM)); ++- make_constant("CHAR-FONT-LIMIT", make_fixnum(CHFONTLIM)); ++- make_constant("CHAR-BITS-LIMIT", make_fixnum(CHBITSLIM)); +++ make_si_constant("CHAR-FONT-LIMIT", make_fixnum(CHFONTLIM)); +++ make_si_constant("CHAR-BITS-LIMIT", make_fixnum(CHBITSLIM)); ++ ++ STreturn = make_simple_string("Return"); ++ enter_mark_origin(&STreturn); ++@@ -620,18 +541,97 @@ gcl_init_character() ++ STnewline = make_simple_string("Newline"); ++ enter_mark_origin(&STnewline); ++ ++- make_constant("CHAR-CONTROL-BIT", make_fixnum(0)); ++- make_constant("CHAR-META-BIT", make_fixnum(0)); ++- make_constant("CHAR-SUPER-BIT", make_fixnum(0)); ++- make_constant("CHAR-HYPER-BIT", make_fixnum(0)); +++ make_si_constant("CHAR-CONTROL-BIT", make_fixnum(0)); +++ make_si_constant("CHAR-META-BIT", make_fixnum(0)); +++ make_si_constant("CHAR-SUPER-BIT", make_fixnum(0)); +++ make_si_constant("CHAR-HYPER-BIT", make_fixnum(0)); +++ ++ } ++ +++@(defun make_char (c &o (b `make_fixnum(0)`) (f `make_fixnum(0)`)) +++ object x; +++ int code; +++@ +++ check_type_character(&c); +++ code = char_code(c); +++ check_type_non_negative_integer(&b); +++ check_type_non_negative_integer(&f); +++ if (type_of(b) == t_bignum) +++ @(return Cnil) +++ if (type_of(f) == t_bignum) +++ @(return Cnil) +++ if (fix(b)>=CHBITSLIM || fix(f)>=CHFONTLIM) +++ @(return Cnil) +++ if (fix(b) == 0 && fix(f) == 0) +++ @(return `code_char(code)`) +++ x = alloc_object(t_character); +++ char_code(x) = code; +++ char_bits(x) = fix(b); +++ char_font(x) = fix(f); +++ @(return x) +++@) +++ +++@(defun char_bits (c) +++@ +++ check_type_character(&c); +++ @(return `small_fixnum(char_bits(c))`) +++@) +++ +++@(defun char_font (c) +++@ +++ check_type_character(&c); +++ @(return `small_fixnum(char_font(c))`) +++@) +++ +++@(defun char_bit (c n) +++@ +++ check_type_character(&c); +++ FEerror("Cannot get char-bit of ~S.", 1, c); +++@) +++ +++@(defun set_char_bit (c n v) +++@ +++ check_type_character(&c); +++ FEerror("Cannot set char-bit of ~S.", 1, c); +++@) +++ +++@(defun string_char_p (c) +++@ +++ check_type_character(&c); +++ if (char_font(c) != 0 || char_bits(c) != 0) +++ @(return Cnil) +++ @(return Ct) +++@) +++ +++@(defun int_char (x) +++ int i, c, b, f; +++@ +++ check_type_non_negative_integer(&x); +++ if (type_of(x) == t_bignum) +++ @(return Cnil) +++ i = fix(x); +++ c = i % CHCODELIM; +++ i /= CHCODELIM; +++ b = i % CHBITSLIM; +++ i /= CHBITSLIM; +++ f = i % CHFONTLIM; +++ i /= CHFONTLIM; +++ if (i > 0) +++ @(return Cnil) +++ if (b == 0 && f == 0) +++ @(return `code_char(c)`) +++ x = alloc_object(t_character); +++ char_code(x) = c; +++ char_bits(x) = b; +++ char_font(x) = f; +++ @(return x) +++@) +++ ++ void ++ gcl_init_character_function() ++ { ++ make_function("STANDARD-CHAR-P", Lstandard_char_p); ++ make_function("GRAPHIC-CHAR-P", Lgraphic_char_p); ++- make_function("STRING-CHAR-P", Lstring_char_p); ++ make_function("ALPHA-CHAR-P", Lalpha_char_p); ++ make_function("UPPER-CASE-P", Lupper_case_p); ++ make_function("LOWER-CASE-P", Llower_case_p); ++@@ -652,17 +652,18 @@ gcl_init_character_function() ++ make_function("CHAR-NOT-LESSP", Lchar_not_lessp); ++ make_function("CHARACTER", Lcharacter); ++ make_function("CHAR-CODE", Lchar_code); ++- make_function("CHAR-BITS", Lchar_bits); ++- make_function("CHAR-FONT", Lchar_font); ++ make_function("CODE-CHAR", Lcode_char); ++- make_function("MAKE-CHAR", Lmake_char); ++ make_function("CHAR-UPCASE", Lchar_upcase); ++ make_function("CHAR-DOWNCASE", Lchar_downcase); ++ make_function("DIGIT-CHAR", Ldigit_char); ++ make_function("CHAR-INT", Lchar_int); ++- make_function("INT-CHAR", Lint_char); ++ make_function("CHAR-NAME", Lchar_name); ++ make_function("NAME-CHAR", Lname_char); ++- make_function("CHAR-BIT", Lchar_bit); ++- make_function("SET-CHAR-BIT", Lset_char_bit); +++ make_si_function("INT-CHAR", Lint_char); +++ make_si_function("MAKE-CHAR", Lmake_char); +++ make_si_function("CHAR-BITS", Lchar_bits); +++ make_si_function("CHAR-FONT", Lchar_font); +++ make_si_function("CHAR-BIT", Lchar_bit); +++ make_si_function("SET-CHAR-BIT", Lset_char_bit); +++ make_si_function("STRING-CHAR-P", Lstring_char_p); ++ } ++--- gcl-2.6.12.orig/o/cmpaux.c +++++ gcl-2.6.12/o/cmpaux.c ++@@ -48,7 +48,7 @@ DEFUNO_NEW("SPECIALP",object,fSspecialp, ++ RETURN1(sym); ++ } ++ ++-DEF_ORDINARY("DEBUG",sSdebug,SI,""); +++DEF_ORDINARY("DEBUGGER",sSdebugger,SI,""); ++ ++ DEFUN_NEW("DEFVAR1",object,fSdefvar1,SI ++ ,2,3,NONE,OO,OO,OO,OO,(object sym,object val,...),"") ++@@ -71,10 +71,10 @@ DEFUN_NEW("DEFVAR1",object,fSdefvar1,SI ++ } ++ ++ ++-DEFUN_NEW("DEBUG",object,fSdebug,SI +++DEFUN_NEW("DEBUG",object,fLdebug,LISP ++ ,2,2,NONE,OO,OO,OO,OO,(object sym,object val),"") ++ { /* 2 args */ ++- putprop(sym,val,sSdebug); +++ putprop(sym,val,sSdebugger); ++ RETURN1(sym); ++ } ++ ++--- gcl-2.6.12.orig/o/error.c +++++ gcl-2.6.12/o/error.c ++@@ -67,27 +67,27 @@ ihs_function_name(object x) ++ y = x->c.c_car; ++ if (y == sLlambda) ++ return(sLlambda); ++- if (y == sLlambda_closure) ++- return(sLlambda_closure); ++- if (y == sLlambda_block || y == sSlambda_block_expanded) { +++ if (y == sSlambda_closure) +++ return(sSlambda_closure); +++ if (y == sSlambda_block || y == sSlambda_block_expanded) { ++ x = x->c.c_cdr; ++ if (type_of(x) != t_cons) ++- return(sLlambda_block); +++ return(sSlambda_block); ++ return(x->c.c_car); ++ } ++- if (y == sLlambda_block_closure) { +++ if (y == sSlambda_block_closure) { ++ x = x->c.c_cdr; ++ if (type_of(x) != t_cons) ++- return(sLlambda_block_closure); +++ return(sSlambda_block_closure); ++ x = x->c.c_cdr; ++ if (type_of(x) != t_cons) ++- return(sLlambda_block_closure); +++ return(sSlambda_block_closure); ++ x = x->c.c_cdr; ++ if (type_of(x) != t_cons) ++- return(sLlambda_block_closure); +++ return(sSlambda_block_closure); ++ x = x->c.c_cdr; ++ if (type_of(x) != t_cons) ++- return(sLlambda_block_closure); +++ return(sSlambda_block_closure); ++ return(x->c.c_car); ++ } ++ /* a general special form */ ++--- gcl-2.6.12.orig/o/eval.c +++++ gcl-2.6.12/o/eval.c ++@@ -227,7 +227,7 @@ funcall(object fun) ++ c = FALSE; ++ fun = fun->c.c_cdr; ++ ++- }else if (x == sLlambda_block) { +++ }else if (x == sSlambda_block) { ++ b = TRUE; ++ c = FALSE; ++ if(sSlambda_block_expanded->s.s_dbind!=OBJNULL) ++@@ -237,14 +237,14 @@ funcall(object fun) ++ ++ ++ ++- } else if (x == sLlambda_closure) { +++ } else if (x == sSlambda_closure) { ++ b = FALSE; ++ c = TRUE; ++ fun = fun->c.c_cdr; ++ } else if (x == sLlambda) { ++ b = c = FALSE; ++ fun = fun->c.c_cdr; ++- } else if (x == sLlambda_block_closure) { +++ } else if (x == sSlambda_block_closure) { ++ b = c = TRUE; ++ fun = fun->c.c_cdr; ++ } else ++@@ -644,13 +644,13 @@ EVAL: ++ ++ vs_check; ++ ++- if (Vevalhook->s.s_dbind != Cnil && eval1 == 0) +++ if (siVevalhook->s.s_dbind != Cnil && eval1 == 0) ++ { ++ bds_ptr old_bds_top = bds_top; ++- object hookfun = symbol_value(Vevalhook); +++ object hookfun = symbol_value(siVevalhook); ++ /* check if Vevalhook is unbound */ ++ ++- bds_bind(Vevalhook, Cnil); +++ bds_bind(siVevalhook, Cnil); ++ form = Ifuncall_n(hookfun,2,form,list(3,lex_env[0],lex_env[1],lex_env[2])); ++ bds_unwind(old_bds_top); ++ return form; ++@@ -721,7 +721,7 @@ APPLICATION: ++ for (x = lex_env[1]; type_of(x) == t_cons; x = x->c.c_cdr) ++ if (x->c.c_car->c.c_car == fun) { ++ x = x->c.c_car; ++- if (MMcadr(x) == sLmacro) { +++ if (MMcadr(x) == sSmacro) { ++ x = MMcaddr(x); ++ goto EVAL_MACRO; ++ } ++@@ -755,10 +755,10 @@ EVAL_ARGS: ++ vs_top = ++top; ++ form = MMcdr(form);} ++ n =top - base; /* number of args */ ++- if (Vapplyhook->s.s_dbind != Cnil) { +++ if (siVapplyhook->s.s_dbind != Cnil) { ++ base[0]= (object)n; ++ base[0] = c_apply_n(list,n+1,base); ++- x = Ifuncall_n(Vapplyhook->s.s_dbind,3, +++ x = Ifuncall_n(siVapplyhook->s.s_dbind,3, ++ x, /* the function */ ++ base[0], /* the arg list */ ++ list(3,lex_env[0],lex_env[1],lex_env[2])); ++@@ -775,7 +775,7 @@ EVAL_ARGS: ++ ++ LAMBDA: ++ if (type_of(fun) == t_cons && MMcar(fun) == sLlambda) { ++- x = listA(4,sLlambda_closure,lex_env[0],lex_env[1],lex_env[2],Mcdr(fun)); +++ x = listA(4,sSlambda_closure,lex_env[0],lex_env[1],lex_env[2],Mcdr(fun)); ++ goto EVAL_ARGS; ++ } ++ FEinvalid_function(fun); ++@@ -805,13 +805,13 @@ EVAL: ++ ++ vs_check; ++ ++- if (Vevalhook->s.s_dbind != Cnil && eval1 == 0) +++ if (siVevalhook->s.s_dbind != Cnil && eval1 == 0) ++ { ++ bds_ptr old_bds_top = bds_top; ++- object hookfun = symbol_value(Vevalhook); ++- /* check if Vevalhook is unbound */ +++ object hookfun = symbol_value(siVevalhook); +++ /* check if siVevalhook is unbound */ ++ ++- bds_bind(Vevalhook, Cnil); +++ bds_bind(siVevalhook, Cnil); ++ vs_base = vs_top; ++ vs_push(form); ++ vs_push(lex_env[0]); ++@@ -903,7 +903,7 @@ APPLICATION: ++ for (x = lex_env[1]; type_of(x) == t_cons; x = x->c.c_cdr) ++ if (x->c.c_car->c.c_car == fun) { ++ x = x->c.c_car; ++- if (MMcadr(x) == sLmacro) { +++ if (MMcadr(x) == sSmacro) { ++ x = MMcaddr(x); ++ goto EVAL_MACRO; ++ } ++@@ -940,7 +940,7 @@ EVAL_ARGS: ++ form = MMcdr(form); ++ } ++ vs_base = base; ++- if (Vapplyhook->s.s_dbind != Cnil) { +++ if (siVapplyhook->s.s_dbind != Cnil) { ++ call_applyhook(fun); ++ return; ++ } ++@@ -959,7 +959,7 @@ LAMBDA: ++ temporary = make_cons(lex_env[2], fun->c.c_cdr); ++ temporary = make_cons(lex_env[1], temporary); ++ temporary = make_cons(lex_env[0], temporary); ++- x = make_cons(sLlambda_closure, temporary); +++ x = make_cons(sSlambda_closure, temporary); ++ vs_push(x); ++ goto EVAL_ARGS; ++ } ++@@ -972,7 +972,7 @@ call_applyhook(object fun) ++ object ah; ++ object *v; ++ ++- ah = symbol_value(Vapplyhook); +++ ah = symbol_value(siVapplyhook); ++ v = vs_base + 1; ++ vs_push(Cnil); ++ while (vs_top > v) ++@@ -1040,7 +1040,7 @@ DEFUNOM_NEW("EVAL",object,fLeval,LISP ++ return Ivs_values(); ++ } ++ ++-LFD(Levalhook)(void) +++LFD(siLevalhook)(void) ++ { ++ object env; ++ bds_ptr old_bds_top = bds_top; ++@@ -1062,15 +1062,15 @@ LFD(Levalhook)(void) ++ vs_push(car(env)); ++ } else ++ too_many_arguments(); ++- bds_bind(Vevalhook, vs_base[1]); ++- bds_bind(Vapplyhook, vs_base[2]); +++ bds_bind(siVevalhook, vs_base[1]); +++ bds_bind(siVapplyhook, vs_base[2]); ++ eval1 = 1; ++ eval(vs_base[0]); ++ lex_env = lex; ++ bds_unwind(old_bds_top); ++ } ++ ++-LFD(Lapplyhook)(void) +++LFD(siLapplyhook)(void) ++ { ++ ++ object env; ++@@ -1094,8 +1094,8 @@ LFD(Lapplyhook)(void) ++ vs_push(car(env)); ++ } else ++ too_many_arguments(); ++- bds_bind(Vevalhook, vs_base[2]); ++- bds_bind(Vapplyhook, vs_base[3]); +++ bds_bind(siVevalhook, vs_base[2]); +++ bds_bind(siVapplyhook, vs_base[3]); ++ z = vs_top; ++ for (l = vs_base[1]; !endp(l); l = l->c.c_cdr) ++ vs_push(l->c.c_car); ++@@ -1392,15 +1392,15 @@ gcl_init_eval(void) ++ make_constant("CALL-ARGUMENTS-LIMIT", make_fixnum(64)); ++ ++ ++- Vevalhook = make_special("*EVALHOOK*", Cnil); ++- Vapplyhook = make_special("*APPLYHOOK*", Cnil); +++ siVevalhook = make_si_special("*EVALHOOK*", Cnil); +++ siVapplyhook = make_si_special("*APPLYHOOK*", Cnil); ++ ++ ++ three_nils.nil3_self[0] = Cnil; ++ three_nils.nil3_self[1] = Cnil; ++ three_nils.nil3_self[2] = Cnil; ++ ++- make_function("EVALHOOK", Levalhook); ++- make_function("APPLYHOOK", Lapplyhook); +++ make_si_function("EVALHOOK", siLevalhook); +++ make_si_function("APPLYHOOK", siLapplyhook); ++ ++ } ++--- gcl-2.6.12.orig/o/fasdump.c +++++ gcl-2.6.12/o/fasdump.c ++@@ -345,14 +345,14 @@ getd(str) ++ #define READ_BYTE1() getc(fas_stream) ++ ++ #define GET8(varx ) \ ++- do{unsigned long var=(unsigned long)READ_BYTE1(); \ ++- var |= ((unsigned long)READ_BYTE1() << SIZE_BYTE); \ ++- var |= ((unsigned long)READ_BYTE1() << (2*SIZE_BYTE)); \ ++- var |= ((unsigned long)READ_BYTE1() << (3*SIZE_BYTE)); \ ++- var |= ((unsigned long)READ_BYTE1() << (4*SIZE_BYTE)); \ ++- var |= ((unsigned long)READ_BYTE1() << (5*SIZE_BYTE)); \ ++- var |= ((unsigned long)READ_BYTE1() << (6*SIZE_BYTE)); \ ++- var |= ((unsigned long)READ_BYTE1() << (7*SIZE_BYTE)); \ +++ do{unsigned long long var=READ_BYTE1(); \ +++ var |= ((unsigned long long)READ_BYTE1() << SIZE_BYTE); \ +++ var |= ((unsigned long long)READ_BYTE1() << (2*SIZE_BYTE)); \ +++ var |= ((unsigned long long)READ_BYTE1() << (3*SIZE_BYTE)); \ +++ var |= ((unsigned long long)READ_BYTE1() << (4*SIZE_BYTE)); \ +++ var |= ((unsigned long long)READ_BYTE1() << (5*SIZE_BYTE)); \ +++ var |= ((unsigned long long)READ_BYTE1() << (6*SIZE_BYTE)); \ +++ var |= ((unsigned long long)READ_BYTE1() << (7*SIZE_BYTE)); \ ++ DPRINTF("{8byte:varx= %ld}", var); \ ++ varx=var;} while (0) ++ ++@@ -386,7 +386,7 @@ getd(str) ++ #define GETFIX(v_) Join(GET,SIZEOF_LONG)(v_) ++ ++ #define PUT8(varx ) \ ++- do{unsigned long var= varx ; \ +++ do{unsigned long long var= varx ; \ ++ DPRINTF("{8byte:varx= %ld}", var); \ ++ WRITE_BYTEI(var,0); \ ++ WRITE_BYTEI(var,1); \ ++@@ -808,7 +808,7 @@ write_fasd(object obj) ++ {int l = MP(obj)->_mp_size; ++ int m = (l >= 0 ? l : -l); ++ ++- unsigned long *u = (unsigned long *) MP(obj)->_mp_d; +++ mp_limb_t *u = MP(obj)->_mp_d; ++ /* fix this */ ++ /* if (sizeof(mp_limb_t) != 4) { FEerror("fix for gmp",0);} */ ++ PUT4(l); ++@@ -1279,7 +1279,7 @@ read_fasd1(int i, object *loc) ++ case DP( d_bignum:) ++ {int j,m; ++ object tem; ++- unsigned long *u; +++ mp_limb_t *u; ++ GET4(j); ++ #ifdef GMP ++ tem = new_bignum(); ++@@ -1287,7 +1287,7 @@ read_fasd1(int i, object *loc) ++ _mpz_realloc(MP(tem),m); ++ MP(tem)->_mp_size = j; ++ j = m; ++- u = (unsigned long *) MP(tem)->_mp_d; +++ u = MP(tem)->_mp_d; ++ #else ++ { BEGIN_NO_INTERRUPT; ++ tem = alloc_object(t_bignum); ++--- gcl-2.6.12.orig/o/file.d +++++ gcl-2.6.12/o/file.d ++@@ -268,7 +268,7 @@ BEGIN: ++ return(strm->sm.sm_object0); ++ ++ case smm_socket: ++- return (sLstring_char); +++ return (sLcharacter); ++ ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++@@ -295,10 +295,10 @@ BEGIN: ++ return(stream_element_type(STREAM_INPUT_STREAM(strm))); ++ ++ case smm_string_input: ++- return(sLstring_char); +++ return(sLcharacter); ++ ++ case smm_string_output: ++- return(sLstring_char); +++ return(sLcharacter); ++ ++ default: ++ error("illegal stream mode"); ++@@ -512,7 +512,7 @@ object if_exists, if_does_not_exist; ++ x->sm.sm_fp = fp; ++ ++ x->sm.sm_buffer = 0; ++- x->sm.sm_object0 = (unzipped ? make_cons(sSAallow_gzipped_fileA,unzipped) : sLstring_char); +++ x->sm.sm_object0 = (unzipped ? make_cons(sSAallow_gzipped_fileA,unzipped) : sLcharacter); ++ x->sm.sm_object1 = fn; ++ x->sm.sm_int0 = x->sm.sm_int1 = 0; ++ vs_push(x); ++@@ -1715,7 +1715,7 @@ LFD(Lstream_element_type)() ++ ++ @(static defun open (filename ++ &key (direction sKinput) ++- (element_type sLstring_char) +++ (element_type sLcharacter) ++ (if_exists Cnil iesp) ++ (if_does_not_exist Cnil idnesp) ++ &aux strm) ++@@ -1800,7 +1800,7 @@ LFD(Lfile_length)() ++ vs_base[0] = make_fixnum(i); ++ } ++ ++-object sSAload_pathnameA; +++object sLAload_pathnameA; ++ DEFVAR("*COLLECT-BINARY-MODULES*",sSAcollect_binary_modulesA,SI,sLnil,""); ++ DEFVAR("*BINARY-MODULES*",sSAbinary_modulesA,SI,Cnil,""); ++ ++@@ -1861,7 +1861,7 @@ DEFVAR("*BINARY-MODULES*",sSAbinary_modu ++ } ++ package = symbol_value(sLApackageA); ++ bds_bind(sLApackageA, package); ++- bds_bind(sSAload_pathnameA,fasl_filename); +++ bds_bind(sLAload_pathnameA,fasl_filename); ++ if (sSAcollect_binary_modulesA->s.s_dbind==Ct) { ++ object _x=sSAbinary_modulesA->s.s_dbind; ++ object _y=Cnil; ++@@ -1920,7 +1920,7 @@ DEFVAR("*BINARY-MODULES*",sSAbinary_modu ++ flush_stream(PRINTstream); ++ } ++ package = symbol_value(sLApackageA); ++- bds_bind(sSAload_pathnameA,pathname); +++ bds_bind(sLAload_pathnameA,pathname); ++ bds_bind(sLApackageA, package); ++ bds_bind(sLAstandard_inputA, strm); ++ frs_push(FRS_PROTECT, Cnil); ++@@ -2534,7 +2534,7 @@ gcl_init_file(void) ++ standard_input->sm.sm_mode = (short)smm_input; ++ standard_input->sm.sm_fp = stdin; ++ standard_input->sm.sm_buffer = 0; ++- standard_input->sm.sm_object0 = sLstring_char; +++ standard_input->sm.sm_object0 = sLcharacter; ++ standard_input->sm.sm_object1 ++ #ifdef UNIX ++ = make_simple_string("stdin"); ++@@ -2546,7 +2546,7 @@ gcl_init_file(void) ++ standard_output->sm.sm_mode = (short)smm_output; ++ standard_output->sm.sm_fp = stdout; ++ standard_output->sm.sm_buffer = 0; ++- standard_output->sm.sm_object0 = sLstring_char; +++ standard_output->sm.sm_object0 = sLcharacter; ++ standard_output->sm.sm_object1 ++ #ifdef UNIX ++ = make_simple_string("stdout"); ++@@ -2571,7 +2571,7 @@ gcl_init_file(void) ++ } ++ ++ DEFVAR("*IGNORE-EOF-ON-TERMINAL-IO*",sSAignore_eof_on_terminal_ioA,SI,Cnil,""); ++-DEFVAR("*LOAD-PATHNAME*",sSAload_pathnameA,SI,Cnil,""); +++DEFVAR("*LOAD-PATHNAME*",sLAload_pathnameA,LISP,Cnil,""); ++ DEFVAR("*LOAD-VERBOSE*",sLAload_verboseA,LISP,Ct,""); ++ ++ DEF_ORDINARY("ABORT",sKabort,KEYWORD,""); ++--- gcl-2.6.12.orig/o/funlink.c +++++ gcl-2.6.12/o/funlink.c ++@@ -19,7 +19,7 @@ typedef object (*object_func)(); ++ static int ++ vpush_extend(void *,object); ++ ++-object sLAlink_arrayA; +++object sSAlink_arrayA; ++ int Rset = 0; ++ ++ DEFVAR("*LINK-LIST*",sSAlink_listA,SI,0,""); ++@@ -67,8 +67,8 @@ call_or_link(object sym, void **link) { ++ if (Rset==0) ++ funcall(fun); ++ else if (type_of(fun) == t_cfun) { ++- (void) vpush_extend( link,sLAlink_arrayA->s.s_dbind); ++- (void) vpush_extend( *link,sLAlink_arrayA->s.s_dbind); +++ (void) vpush_extend( link,sSAlink_arrayA->s.s_dbind); +++ (void) vpush_extend( *link,sSAlink_arrayA->s.s_dbind); ++ *link = (void *) (fun->cf.cf_self); ++ (*(void (*)())(fun->cf.cf_self))(); ++ } else { ++@@ -89,8 +89,8 @@ call_or_link_closure(object sym, void ** ++ } ++ if (type_of(fun) == t_cclosure && (fun->cc.cc_turbo)) { ++ if (Rset) { ++- (void) vpush_extend( link,sLAlink_arrayA->s.s_dbind); ++- (void) vpush_extend( *link,sLAlink_arrayA->s.s_dbind); +++ (void) vpush_extend( link,sSAlink_arrayA->s.s_dbind); +++ (void) vpush_extend( *link,sSAlink_arrayA->s.s_dbind); ++ *ptr = (void *)fun; ++ *link = (void *) (fun->cf.cf_self); ++ MMccall(fun); ++@@ -105,8 +105,8 @@ call_or_link_closure(object sym, void ** ++ /* can't do this if invoking foo(a) is illegal when foo is not defined ++ to take any arguments. In the majority of C's this is legal */ ++ else if (type_of(fun) == t_cfun) { ++- (void) vpush_extend(link,sLAlink_arrayA->s.s_dbind); ++- (void) vpush_extend(*link,sLAlink_arrayA->s.s_dbind); +++ (void) vpush_extend(link,sSAlink_arrayA->s.s_dbind); +++ (void) vpush_extend(*link,sSAlink_arrayA->s.s_dbind); ++ *link = (void *)fun->cf.cf_self; ++ (*(void (*)())fun->cf.cf_self)(); ++ } else { ++@@ -129,7 +129,7 @@ vpush_extend(void *item, object ar) ++ return(ar->v.v_fillp = ind);} ++ else ++ { ++- int newdim= ROUND_UP_PTR((2 + (int) (1.3 * ind))); +++ int newdim= CEI((2 + (int) (1.3 * ind)),PTR_ALIGN); ++ unsigned char *newself; ++ newself = (void *)alloc_relblock(newdim); ++ bcopy(ar->ust.ust_self,newself,ind); ++@@ -180,8 +180,8 @@ is supplied and FLAG is nil, then this f ++ LDEFAULT2: sym = Cnil ; ++ LEND_VARARG: va_end(ap);} ++ ++- if (sLAlink_arrayA ==0) RETURN1(Cnil); ++- link_ar = sLAlink_arrayA->s.s_dbind; +++ if (sSAlink_arrayA ==0) RETURN1(Cnil); +++ link_ar = sSAlink_arrayA->s.s_dbind; ++ if (link_ar==Cnil && flag==Cnil) RETURN1(Cnil); ++ check_type_array(&link_ar); ++ if (type_of(link_ar) != t_string) ++@@ -339,8 +339,8 @@ call_proc(object sym, void **link, int a ++ ++ } ++ ++- (void) vpush_extend(link,sLAlink_arrayA->s.s_dbind); ++- (void) vpush_extend(*link,sLAlink_arrayA->s.s_dbind); +++ (void) vpush_extend(link,sSAlink_arrayA->s.s_dbind); +++ (void) vpush_extend(*link,sSAlink_arrayA->s.s_dbind); ++ *link = (void *)fn; ++ ++ AFTER_LINK: ++@@ -443,8 +443,8 @@ call_proc_new(object sym, void **link, i ++ ++ } ++ ++- (void) vpush_extend(link,sLAlink_arrayA->s.s_dbind); ++- (void) vpush_extend(*link,sLAlink_arrayA->s.s_dbind); +++ (void) vpush_extend(link,sSAlink_arrayA->s.s_dbind); +++ (void) vpush_extend(*link,sSAlink_arrayA->s.s_dbind); ++ *link = (void *)fn; ++ ++ AFTER_LINK: ++@@ -607,7 +607,7 @@ FFN(mv_ref)(unsigned int i) ++ #include "xdrfuns.c" ++ ++ DEF_ORDINARY("CDEFN",sScdefn,SI,""); ++-DEFVAR("*LINK-ARRAY*",sLAlink_arrayA,LISP,Cnil,""); +++DEFVAR("*LINK-ARRAY*",sSAlink_arrayA,SI,Cnil,""); ++ ++ void ++ gcl_init_links(void) ++--- gcl-2.6.12.orig/o/gbc.c +++++ gcl-2.6.12/o/gbc.c ++@@ -24,7 +24,7 @@ ++ IMPLEMENTATION-DEPENDENT ++ */ ++ ++-#define DEBUG +++/* #define DEBUG */ ++ ++ #define IN_GBC ++ #define NEED_MP_H ++@@ -45,7 +45,7 @@ static void ++ sgc_mark_phase(void); ++ ++ static fixnum ++-sgc_count_writable(void); +++sgc_count_read_only(void); ++ ++ #endif ++ ++@@ -55,10 +55,6 @@ mark_c_stack(jmp_buf, int, void (*)(void ++ static void ++ mark_contblock(void *, int); ++ ++-static void ++-mark_object(object); ++- ++- ++ /* the following in line definitions seem to be twice as fast (at ++ least on mc68020) as going to the assembly function calls in bitop.c so ++ since this is more portable and faster lets use them --W. Schelter ++@@ -75,6 +71,31 @@ mark_object(object); ++ #error Do not recognize CPTR_SIZE ++ #endif ++ +++void * +++cb_in(void *p) { +++ struct contblock **cbpp; +++ int i; +++ +++ for (cbpp=&cb_pointer,i=0;*cbpp;cbpp=&((*cbpp)->cb_link),i++) { +++ if ((void *)*cbpp<=p && ((void *)(*cbpp)+(*cbpp)->cb_size) >p) +++ return *cbpp; +++ } +++ return NULL; +++} +++ +++int +++cb_print(void) { +++ struct contblock **cbpp; +++ int i; +++ +++ for (cbpp=&cb_pointer,i=0;*cbpp;cbpp=&((*cbpp)->cb_link),i++) { +++ fprintf(stderr,"%lu at %p\n",(*cbpp)->cb_size,*cbpp); +++ fflush(stderr); +++ } +++ fprintf(stderr,"%u blocks\n",i); +++ return 0; +++} +++ ++ #ifdef CONTBLOCK_MARK_DEBUG ++ int ++ cb_check(void) { ++@@ -121,13 +142,48 @@ off_check(void *v,void *ve,fixnum i,stru ++ } ++ #endif ++ +++void **contblock_stack_list=NULL; +++ +++static inline bool +++pageinfo_p(void *v) { +++ +++ struct pageinfo *pi=v; +++ +++ return pi->magic==PAGE_MAGIC && pi->type<=t_contiguous && +++ (!pi->next || (void *)pi->next>=v+(pi->type==t_contiguous ? pi->in_use : 1)*PAGESIZE); +++ +++} +++ +++static inline bool +++in_contblock_stack_list(void *p,void ***ap) { +++ void **a; +++ for (a=*ap;a && a[0]>p;a=a[1]); +++ *ap=a; +++ /* if (a && a[0]==p) fprintf(stderr,"Skipping %p\n",p); */ +++ return a && a[0]==p; +++} ++ ++ inline struct pageinfo * ++ get_pageinfo(void *x) { ++- struct pageinfo *v=contblock_list_head;void *vv; ++- for (;(vv=v) && (vv>=x || vv+v->in_use*PAGESIZE<=x);v=v->next); ++- return v; +++ +++ void *p=pageinfo(x),**a=contblock_stack_list; +++ struct pageinfo *v; +++ +++ for (;!pageinfo_p(p) || in_contblock_stack_list(p,&a);p-=PAGESIZE); +++ +++ v=p; +++ massert(v->type==t_contiguous && p+v->in_use*PAGESIZE>x); +++ +++ return p; +++ ++ } +++ +++/* inline struct pageinfo * */ +++/* get_pageinfo(void *x) { */ +++/* struct pageinfo *v=contblock_list_head;void *vv; */ +++/* for (;(vv=v) && (vv>=x || vv+v->in_use*PAGESIZE<=x);v=v->next); */ +++/* return v; */ +++/* } */ ++ ++ inline char ++ get_bit(char *v,struct pageinfo *pi,void *x) { ++@@ -300,21 +356,6 @@ enter_mark_origin(object *p) { ++ ++ } ++ ++-inline void ++-mark_cons(object x) { ++- ++- do { ++- object d=x->c.c_cdr; ++- mark(x); ++- mark_object(x->c.c_car); ++- x=d; ++- if (NULL_OR_ON_C_STACK(x) || is_marked_or_free(x))/*catches Cnil*/ ++- return; ++- } while (cdr_listp(x)); ++- mark_object(x); ++- ++-} ++- ++ /* Whenever two arrays are linked together by displacement, ++ if one is live, the other will be made live */ ++ #define mark_displaced_field(ar) mark_object(ar->a.a_displaced) ++@@ -336,27 +377,17 @@ mark_link_array(void *v,void *ve) { ++ if (NULL_OR_ON_C_STACK(v)) ++ return; ++ ++- if (sLAlink_arrayA->s.s_dbind==Cnil) +++ if (sSAlink_arrayA->s.s_dbind==Cnil) ++ return; ++ ++- p=(void *)sLAlink_arrayA->s.s_dbind->v.v_self; ++- pe=(void *)p+sLAlink_arrayA->s.s_dbind->v.v_fillp; ++- ++- if (is_marked(sLAlink_arrayA->s.s_dbind) && COLLECT_RELBLOCK_P ++-#ifdef SGC ++- && (!sgc_enabled || SGC_RELBLOCK_P(sLAlink_arrayA->s.s_dbind->v.v_self)) ++-#endif ++- ) { ++- fixnum j=rb_pointer1-rb_pointer; ++- p=(void *)p+j; ++- pe=(void *)pe+j; ++- } +++ p=(void *)sSAlink_arrayA->s.s_dbind->v.v_self; +++ pe=(void *)p+sSAlink_arrayA->s.s_dbind->v.v_fillp; ++ ++ for (;p=v && *ps.s_dbind==Cnil) +++ if (sSAlink_arrayA->s.s_dbind==Cnil) ++ return; ++ ++- ne=n=p=(void *)sLAlink_arrayA->s.s_dbind->v.v_self; ++- pe=(void *)p+sLAlink_arrayA->s.s_dbind->v.v_fillp; +++ ne=n=p=(void *)sSAlink_arrayA->s.s_dbind->v.v_self; +++ pe=(void *)p+sSAlink_arrayA->s.s_dbind->v.v_fillp; ++ ++ while (ps.s_dbind->v.v_fillp=(ne-n)*sizeof(*n); +++ sSAlink_arrayA->s.s_dbind->v.v_fillp=(ne-n)*sizeof(*n); ++ ++ } ++ ++@@ -392,11 +423,11 @@ sweep_link_array(void) { ++ ++ void ***p,***pe; ++ ++- if (sLAlink_arrayA->s.s_dbind==Cnil) +++ if (sSAlink_arrayA->s.s_dbind==Cnil) ++ return; ++ ++- p=(void *)sLAlink_arrayA->s.s_dbind->v.v_self; ++- pe=(void *)p+sLAlink_arrayA->s.s_dbind->v.v_fillp; +++ p=(void *)sSAlink_arrayA->s.s_dbind->v.v_self; +++ pe=(void *)p+sSAlink_arrayA->s.s_dbind->v.v_fillp; ++ for (;pst.st_self) && */ +++ /* (dp=PCEI(lcv->st.st_self,r)) && dp+s<=(dpe=lcv->st.st_self+lcv->st.st_dim) */ +++ /* && x && x->d.st>=ngc_thresh) { */ +++ +++ if (what_to_collect!=t_contiguous && +++ x && x->d.st>=ngc_thresh && +++ (dp=alloc_contblock_no_gc(s))) { +++ +++ /* fprintf(stderr,"Promoting %p,%lu to %p\n",p,s,dp); */ +++ /* fflush(stderr); */ +++ +++ *pp=memcpy(dp,p,s); +++ /* lcv->st.st_fillp=lcv->st.st_dim=(dpe-(void *)(lcv->st.st_self=dp+s)); */ +++ x->d.st=0; ++ ++- if (tp==t_cons) { ++- mark_cons(x); ++ return; +++ +++ } +++ +++ if (x && x->d.std.st++; +++ +++ if (p>=(void *)heap_end) +++ *pp=(void *)copy_relblock(p,s); +++ else +++ mark_contblock(p,s); +++ +++} +++ +++static void mark_object1(object); +++#define mark_object(x) if (marking(x)) mark_object1(x) +++ +++static inline void +++mark_object_address(object *o,int f) { +++ +++ static ufixnum lp; +++ static ufixnum lr; +++ +++ ufixnum p=page(o); +++ +++ if (lp!=p || !f) { +++ lp=p; +++ lr=sgc_enabled ? WRITABLE_PAGE_P(lp) : 1; ++ } ++ +++ if (lr) +++ mark_object(*o); +++ +++} +++ +++static inline void +++mark_object_array(object *o,object *oe) { +++ int f=0; +++ +++ if (o) +++ for (;oc.c_car); +++ mark_object(Scdr(x));/*FIXME*/ +++ break; ++ ++ case t_fixnum: ++ break; ++ +++ case t_bignum: +++ MARK_LEAF_DATA(x,MP_SELF(x),MP_ALLOCATED(x)*MP_LIMB_SIZE); +++ break; +++ ++ case t_ratio: ++ mark_object(x->rat.rat_num); ++- x = x->rat.rat_den; ++- goto BEGIN; +++ mark_object(x->rat.rat_den); ++ ++ case t_shortfloat: ++ break; ++@@ -456,8 +565,7 @@ mark_object(object x) { ++ ++ case t_complex: ++ mark_object(x->cmp.cmp_imag); ++- x = x->cmp.cmp_real; ++- goto BEGIN; +++ mark_object(x->cmp.cmp_real); ++ ++ case t_character: ++ break; ++@@ -466,13 +574,7 @@ mark_object(object x) { ++ mark_object(x->s.s_plist); ++ mark_object(x->s.s_gfdef); ++ mark_object(x->s.s_dbind); ++- if (x->s.s_self == NULL) ++- break; ++- if (inheap(x->s.s_self)) { ++- if (what_to_collect == t_contiguous) ++- mark_contblock(x->s.s_self,x->s.s_fillp); ++- } else if (COLLECT_RELBLOCK_P) ++- x->s.s_self = copy_relblock(x->s.s_self, x->s.s_fillp); +++ MARK_LEAF_DATA(x,x->s.s_self,x->s.s_fillp); ++ break; ++ ++ case t_package: ++@@ -481,197 +583,88 @@ mark_object(object x) { ++ mark_object(x->p.p_shadowings); ++ mark_object(x->p.p_uselist); ++ mark_object(x->p.p_usedbylist); ++- if (what_to_collect != t_contiguous) ++- break; ++- if (x->p.p_internal != NULL) ++- mark_contblock((char *)(x->p.p_internal), ++- x->p.p_internal_size*sizeof(object)); ++- if (x->p.p_external != NULL) ++- mark_contblock((char *)(x->p.p_external), ++- x->p.p_external_size*sizeof(object)); +++ mark_object_array(x->p.p_internal,x->p.p_internal+x->p.p_internal_size); +++ MARK_LEAF_DATA(x,x->p.p_internal,x->p.p_internal_size*sizeof(object)); +++ mark_object_array(x->p.p_external,x->p.p_external+x->p.p_external_size); +++ MARK_LEAF_DATA(x,x->p.p_external,x->p.p_external_size*sizeof(object)); ++ break; ++ ++ case t_hashtable: ++ mark_object(x->ht.ht_rhsize); ++ mark_object(x->ht.ht_rhthresh); ++- if (x->ht.ht_self == NULL) ++- break; ++- for (i = 0, j = x->ht.ht_size; i < j; i++) { ++- mark_object(x->ht.ht_self[i].hte_key); ++- mark_object(x->ht.ht_self[i].hte_value); ++- } ++- if (inheap(x->ht.ht_self)) { ++- if (what_to_collect == t_contiguous) ++- mark_contblock((char *)x->ht.ht_self,j*sizeof(struct htent)); ++- } else if (COLLECT_RELBLOCK_P) ++- x->ht.ht_self=(void *)copy_relblock((char *)x->ht.ht_self,j*sizeof(struct htent));; +++ if (x->ht.ht_self) +++ for (i=0;iht.ht_size;i++) +++ if (x->ht.ht_self[i].hte_key!=OBJNULL) { +++ mark_object_address(&x->ht.ht_self[i].hte_key,i); +++ mark_object_address(&x->ht.ht_self[i].hte_value,i+1); +++ } +++ MARK_LEAF_DATA(x,x->ht.ht_self,x->ht.ht_size*sizeof(*x->ht.ht_self)); ++ break; ++ ++ case t_array: ++- if ((x->a.a_displaced) != Cnil) ++- mark_displaced_field(x); ++- if (x->a.a_dims != NULL) { ++- if (inheap(x->a.a_dims)) { ++- if (what_to_collect == t_contiguous) ++- mark_contblock((char *)(x->a.a_dims),sizeof(int)*x->a.a_rank); ++- } else if (COLLECT_RELBLOCK_P) ++- x->a.a_dims = (int *) copy_relblock((char *)(x->a.a_dims),sizeof(int)*x->a.a_rank); ++- } ++- if ((enum aelttype)x->a.a_elttype == aet_ch) ++- goto CASE_STRING; ++- if ((enum aelttype)x->a.a_elttype == aet_bit) ++- goto CASE_BITVECTOR; ++- if ((enum aelttype)x->a.a_elttype == aet_object) ++- goto CASE_GENERAL; ++- ++- CASE_SPECIAL: ++- cp = (char *)(x->fixa.fixa_self); ++- if (cp == NULL) ++- break; ++- /* set j to the size in char of the body of the array */ ++- ++- switch((enum aelttype)x->a.a_elttype){ ++-#define ROUND_RB_POINTERS_DOUBLE \ ++-{int tem = ((long)rb_pointer1) & (sizeof(double)-1); \ ++- if (tem) \ ++- { rb_pointer += (sizeof(double) - tem); \ ++- rb_pointer1 += (sizeof(double) - tem); \ ++- }} +++ MARK_LEAF_DATA(x,x->a.a_dims,sizeof(int)*x->a.a_rank); +++ +++ case t_vector: +++ case t_bitvector: +++ +++ switch(j ? j : (enum aelttype)x->v.v_elttype) { +++ ++ case aet_lf: ++- j= sizeof(longfloat)*x->lfa.lfa_dim; ++- if ((COLLECT_RELBLOCK_P) && !(inheap(cp))) ++- ROUND_RB_POINTERS_DOUBLE;/*FIXME gc space violation*/ +++ j= sizeof(longfloat)*x->v.v_dim; +++ if ((COLLECT_RELBLOCK_P) && (void *)x->v.v_self>=(void *)heap_end) +++ rb_pointer=PCEI(rb_pointer,sizeof(double)); /*FIXME GC space violation*/ ++ break; +++ +++ case aet_bit: +++#define W_SIZE (8*sizeof(fixnum)) +++ j= sizeof(fixnum)*((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE); +++ break; +++ ++ case aet_char: ++ case aet_uchar: ++- j=sizeof(char)*x->a.a_dim; +++ j=sizeof(char)*x->v.v_dim; ++ break; +++ ++ case aet_short: ++ case aet_ushort: ++- j=sizeof(short)*x->a.a_dim; +++ j=sizeof(short)*x->v.v_dim; ++ break; +++ +++ case aet_object: +++ if (x->v.v_displaced->c.c_car==Cnil) +++ mark_object_array(x->v.v_self,x->v.v_self+x->v.v_dim); +++ ++ default: ++- j=sizeof(fixnum)*x->fixa.fixa_dim;} ++- ++- goto COPY; ++- ++- CASE_GENERAL: ++- p = x->a.a_self; ++- if (p == NULL ++-#ifdef HAVE_ALLOCA ++- || (char *)p >= core_end ++-#endif ++- ) ++- break; ++- j=0; ++- if (x->a.a_displaced->c.c_car == Cnil) ++- for (i = 0, j = x->a.a_dim; i < j; i++) ++- mark_object(p[i]); ++- cp = (char *)p; ++- j *= sizeof(object); ++- COPY: ++- if (inheap(cp)) { ++- if (what_to_collect == t_contiguous) ++- mark_contblock(cp, j); ++- } else if (COLLECT_RELBLOCK_P) { ++- if (x->a.a_displaced == Cnil) { ++-#ifdef HAVE_ALLOCA ++- if (!NULL_OR_ON_C_STACK(cp)) /* only if body of array not on C stack */ ++-#endif ++- x->a.a_self = (object *)copy_relblock(cp, j); ++- } else if (x->a.a_displaced->c.c_car == Cnil) { ++- i = (long)(object *)copy_relblock(cp, j) - (long)(x->a.a_self); ++- adjust_displaced(x, i); ++- } +++ j=sizeof(fixnum)*x->v.v_dim; +++ ++ } ++- break; ++- ++- case t_vector: ++- if ((x->v.v_displaced) != Cnil) ++- mark_displaced_field(x); ++- if ((enum aelttype)x->v.v_elttype == aet_object) ++- goto CASE_GENERAL; ++- else ++- goto CASE_SPECIAL; ++- ++- case t_bignum: ++-#ifndef GMP_USE_MALLOC ++- if ((int)what_to_collect >= (int)t_contiguous) { ++- j = MP_ALLOCATED(x); ++- cp = (char *)MP_SELF(x); ++- if (cp == 0) ++- break; ++-#ifdef PARI ++- if (j != lg(MP(x)) && ++- /* we don't bother to zero this register, ++- and its contents may get over written */ ++- ! (x == big_register_1 && ++- (int)(cp) <= top && ++- (int) cp >= bot)) ++- printf("bad length 0x%x ",x); ++-#endif ++- j = j * MP_LIMB_SIZE; ++- if (inheap(cp)) { ++- if (what_to_collect == t_contiguous) ++- mark_contblock(cp, j); ++- } else if (COLLECT_RELBLOCK_P) { ++- MP_SELF(x) = (void *) copy_relblock(cp, j);}} ++-#endif /* not GMP_USE_MALLOC */ ++- break; ++- ++- CASE_STRING: ++- case t_string: ++- if ((x->st.st_displaced) != Cnil) ++- mark_displaced_field(x); ++- j = x->st.st_dim; ++- cp = x->st.st_self; ++- if (cp == NULL) ++- break; ++- COPY_STRING: ++- if (inheap(cp)) { ++- if (what_to_collect == t_contiguous) ++- mark_contblock(cp, j); ++- } else if (COLLECT_RELBLOCK_P) { ++- if (x->st.st_displaced == Cnil) ++- x->st.st_self = copy_relblock(cp, j); ++- else if (x->st.st_displaced->c.c_car == Cnil) { ++- i = copy_relblock(cp, j) - cp; ++- adjust_displaced(x, i); +++ +++ case t_string:/*FIXME*/ +++ j=j ? j : x->st.st_dim; +++ +++ if (x->v.v_displaced->c.c_car==Cnil) { +++ void *p=x->v.v_self; +++ MARK_LEAF_DATA(x,x->v.v_self,j); +++ if (x->v.v_displaced!=Cnil) { +++ j=(void *)x->v.v_self-p; +++ x->v.v_self=p; +++ adjust_displaced(x,j); ++ } ++- } +++ } +++ mark_object(x->v.v_displaced); ++ break; ++ ++- CASE_BITVECTOR: ++- case t_bitvector: ++- if ((x->bv.bv_displaced) != Cnil) ++- mark_displaced_field(x); ++- /* We make bitvectors multiple of sizeof(int) in size allocated ++- Assume 8 = number of bits in char */ ++- ++-#define W_SIZE (8*sizeof(fixnum)) ++- j= sizeof(fixnum) * ++- ((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE); ++- cp = x->bv.bv_self; ++- if (cp == NULL) ++- break; ++- goto COPY_STRING; ++- ++ case t_structure: ++- mark_object(x->str.str_def); ++- p = x->str.str_self; ++- if (p == NULL) ++- break; ++ { ++ object def=x->str.str_def; ++- unsigned char * s_type = &SLOT_TYPE(def,0); ++- unsigned short *s_pos= & SLOT_POS(def,0); ++- for (i = 0, j = S_DATA(def)->length; i < j; i++) ++- if (s_type[i]==0) mark_object(STREF(object,x,s_pos[i])); ++- if (inheap(x->str.str_self)) { ++- if (what_to_collect == t_contiguous) ++- mark_contblock((char *)p,S_DATA(def)->size); ++- } else if (COLLECT_RELBLOCK_P) ++- x->str.str_self = (object *)copy_relblock((char *)p, S_DATA(def)->size); +++ unsigned char *s_type= &SLOT_TYPE(def,0); +++ unsigned short *s_pos= &SLOT_POS(def,0); +++ mark_object(x->str.str_def); +++ if (x->str.str_self) +++ for (i=0,j=S_DATA(def)->length;istr.str_self,S_DATA(def)->size); ++ } ++ break; ++ ++@@ -684,12 +677,11 @@ mark_object(object x) { ++ case smm_probe: ++ mark_object(x->sm.sm_object0); ++ mark_object(x->sm.sm_object1); ++- if (what_to_collect == t_contiguous && ++- x->sm.sm_fp && ++- x->sm.sm_buffer) ++- mark_contblock(x->sm.sm_buffer, BUFSIZ); +++ if (x->sm.sm_fp) { +++ MARK_LEAF_DATA(x,x->sm.sm_buffer,BUFSIZ); +++ } ++ break; ++- +++ ++ case smm_synonym: ++ mark_object(x->sm.sm_object0); ++ break; ++@@ -720,44 +712,20 @@ mark_object(object x) { ++ } ++ break; ++ ++-#define MARK_CP(a_,b_) {fixnum _t=(b_);if (inheap(a_)) {\ ++- if (what_to_collect == t_contiguous) mark_contblock((void *)(a_),_t); \ ++- } else if (COLLECT_RELBLOCK_P) (a_)=(void *)copy_relblock((void *)(a_),_t);} ++- ++-#define MARK_MP(a_) {if ((a_)->_mp_d) \ ++- MARK_CP((a_)->_mp_d,(a_)->_mp_alloc*MP_LIMB_SIZE);} ++- ++ case t_random: ++- if ((int)what_to_collect >= (int)t_contiguous) { ++- MARK_MP(x->rnd.rnd_state._mp_seed); ++-#if __GNU_MP_VERSION < 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR < 2) ++- if (x->rnd.rnd_state._mp_algdata._mp_lc) { ++- MARK_MP(x->rnd.rnd_state._mp_algdata._mp_lc->_mp_a); ++- if (!x->rnd.rnd_state._mp_algdata._mp_lc->_mp_m2exp) MARK_MP(x->rnd.rnd_state._mp_algdata._mp_lc->_mp_m); ++- MARK_CP(x->rnd.rnd_state._mp_algdata._mp_lc,sizeof(*x->rnd.rnd_state._mp_algdata._mp_lc)); ++- } ++-#endif ++- } +++ MARK_LEAF_DATA_ALIGNED(x,x->rnd.rnd_state._mp_seed->_mp_d,x->rnd.rnd_state._mp_seed->_mp_alloc*MP_LIMB_SIZE,MP_LIMB_SIZE); ++ break; ++ ++ case t_readtable: ++- if (x->rt.rt_self == NULL) ++- break; ++- if (what_to_collect == t_contiguous) ++- mark_contblock((char *)(x->rt.rt_self), ++- RTABSIZE*sizeof(struct rtent)); ++- for (i = 0; i < RTABSIZE; i++) { ++- mark_object(x->rt.rt_self[i].rte_macro); ++- if (x->rt.rt_self[i].rte_dtab != NULL) { ++- /**/ ++- if (what_to_collect == t_contiguous) ++- mark_contblock((char *)(x->rt.rt_self[i].rte_dtab), ++- RTABSIZE*sizeof(object)); ++- for (j = 0; j < RTABSIZE; j++) ++- mark_object(x->rt.rt_self[i].rte_dtab[j]); ++- /**/ +++ if (x->rt.rt_self) { +++ for (i=0;irt.rt_self[i].rte_macro,i); +++ for (i=0;irt.rt_self[i].rte_dtab,x->rt.rt_self[i].rte_dtab+RTABSIZE); +++ MARK_LEAF_DATA(x,x->rt.rt_self[i].rte_dtab,RTABSIZE*sizeof(object)); ++ } ++ } +++ MARK_LEAF_DATA(x,x->rt.rt_self,RTABSIZE*sizeof(struct rtent)); ++ break; ++ ++ case t_pathname: ++@@ -770,13 +738,8 @@ mark_object(object x) { ++ break; ++ ++ case t_closure: ++- { ++- int i ; ++- for (i= 0 ; i < x->cl.cl_envdim ; i++) ++- mark_object(x->cl.cl_env[i]); ++- if (COLLECT_RELBLOCK_P) ++- x->cl.cl_env=(void *)copy_relblock((void *)x->cl.cl_env,x->cl.cl_envdim*sizeof(object)); ++- } +++ mark_object_array(x->cl.cl_env,x->cl.cl_env+x->cl.cl_envdim); +++ MARK_LEAF_DATA(x,x->cl.cl_env,x->cl.cl_envdim*sizeof(object)); ++ ++ case t_cfun: ++ case t_sfun: ++@@ -789,48 +752,40 @@ mark_object(object x) { ++ ++ case t_cfdata: ++ ++- if (x->cfd.cfd_self != NULL) ++- {int i=x->cfd.cfd_fillp; ++- while(i-- > 0) ++- mark_object(x->cfd.cfd_self[i]);} ++- if (what_to_collect == t_contiguous) { ++- mark_contblock(x->cfd.cfd_start, x->cfd.cfd_size); +++ mark_object_array(x->cfd.cfd_self,x->cfd.cfd_self+x->cfd.cfd_fillp); +++ if (what_to_collect == t_contiguous) ++ mark_link_array(x->cfd.cfd_start,x->cfd.cfd_start+x->cfd.cfd_size); ++- } +++ MARK_LEAF_DATA(NULL,x->cfd.cfd_start,x->cfd.cfd_size);/*Code cannot move*/ ++ break; ++- case t_cclosure: +++ +++ case t_cclosure: ++ mark_object(x->cc.cc_name); ++ mark_object(x->cc.cc_env); ++ mark_object(x->cc.cc_data); ++- if (x->cc.cc_turbo!=NULL) { ++- mark_object(*(x->cc.cc_turbo-1)); ++- if (COLLECT_RELBLOCK_P) ++- x->cc.cc_turbo=(void *)copy_relblock((char *)(x->cc.cc_turbo-1),(1+fix(*(x->cc.cc_turbo-1)))*sizeof(object))+sizeof(object); +++ if (x->cc.cc_turbo) { +++ x->cc.cc_turbo--; +++ mark_object_array(x->cc.cc_turbo,x->cc.cc_turbo+fix(x->cc.cc_turbo[0])); +++ MARK_LEAF_DATA(x,x->cc.cc_turbo,(1+fix(x->cc.cc_turbo[0]))*sizeof(*x->cc.cc_turbo)); +++ x->cc.cc_turbo++; ++ } ++ break; ++ ++ case t_spice: ++ break; ++- default: +++ +++ default: ++ #ifdef DEBUG ++ if (debug) ++ printf("\ttype = %d\n", type_of(x)); ++ #endif ++ error("mark botch"); +++ ++ } +++ ++ } ++ ++ static long *c_stack_where; ++ ++-void **contblock_stack_list=NULL; ++- ++-#define PAGEINFO_P(pi) (pi->magic==PAGE_MAGIC && pi->type<=t_contiguous) ++- ++-#ifdef SGC ++-static void ++-sgc_mark_object1(object); ++-#endif ++- ++ static void ++ mark_stack_carefully(void *topv, void *bottomv, int offset) { ++ ++@@ -865,10 +820,9 @@ mark_stack_carefully(void *topv, void *b ++ ++ pageoffset=v-(void *)pagetochar(p); ++ pi=pagetoinfo(p); ++- if (!PAGEINFO_P(pi)) continue; +++ if (!pageinfo_p(pi)) continue; ++ ++- for (a=contblock_stack_list;a && a[0]!=pi;a=a[1]); ++- if (a) continue; +++ if ((a=contblock_stack_list) && in_contblock_stack_list(pi,&a)) continue; ++ ++ tm=tm_of(pi->type); ++ if (tm->tm_type>=t_end) continue; ++@@ -879,13 +833,10 @@ mark_stack_carefully(void *topv, void *b ++ ++ if (is_marked_or_free(x)) continue; ++ ++-#ifdef SGC ++- if (sgc_enabled) ++- sgc_mark_object(x); ++- else ++-#endif ++- mark_object(x); +++ mark_object(x); +++ ++ } +++ ++ } ++ ++ ++@@ -930,10 +881,6 @@ mark_phase(void) { ++ ++ for (pp = pack_pointer; pp != NULL; pp = pp->p_link) ++ mark_object((object)pp); ++-#ifdef KCLOVM ++- if (ovm_process_created) ++- mark_all_stacks(); ++-#endif ++ ++ #ifdef DEBUG ++ if (debug) { ++@@ -947,18 +894,18 @@ mark_phase(void) { ++ (int)what_to_collect < (int)t_contiguous) { ++ */ ++ ++- {int size; +++ /* {int size; */ ++ ++- for (pp = pack_pointer; pp != NULL; pp = pp->p_link) { ++- size = pp->p_internal_size; ++- if (pp->p_internal != NULL) ++- for (i = 0; i < size; i++) ++- mark_object(pp->p_internal[i]); ++- size = pp->p_external_size; ++- if (pp->p_external != NULL) ++- for (i = 0; i < size; i++) ++- mark_object(pp->p_external[i]); ++- }} +++ /* for (pp = pack_pointer; pp != NULL; pp = pp->p_link) { */ +++ /* size = pp->p_internal_size; */ +++ /* if (pp->p_internal != NULL) */ +++ /* for (i = 0; i < size; i++) */ +++ /* mark_object(pp->p_internal[i]); */ +++ /* size = pp->p_external_size; */ +++ /* if (pp->p_external != NULL) */ +++ /* for (i = 0; i < size; i++) */ +++ /* mark_object(pp->p_external[i]); */ +++ /* }} */ ++ ++ /* mark the c stack */ ++ #ifndef N_RECURSION_REQD ++@@ -1055,42 +1002,27 @@ mark_c_stack(jmp_buf env1, int n, void ( ++ #ifndef C_GC_OFFSET ++ #define C_GC_OFFSET 0 ++ #endif ++- { ++- struct pageinfo *v,*tv;void **a; ++- fixnum i; ++- for (v=contblock_list_head,contblock_stack_list=NULL;v;v=v->next) ++- for (i=1;iin_use;i++) { ++- tv=pagetoinfo(page(v)+i); ++- if (PAGEINFO_P(tv)) { ++- a=contblock_stack_list; ++- /* printf("%p\n",tv); */ ++- contblock_stack_list=alloca(2*sizeof(a)); ++- contblock_stack_list[0]=tv; ++- contblock_stack_list[1]=a; ++- }} ++- ++- if (&where > cs_org) ++- (*fn)(0,cs_org,C_GC_OFFSET); ++- else ++- (*fn)(cs_org,0,C_GC_OFFSET); +++ if (&where > cs_org) +++ (*fn)(0,cs_org,C_GC_OFFSET); +++ else +++ (*fn)(cs_org,0,C_GC_OFFSET); ++ ++- contblock_stack_list=NULL; ++- }} +++ } ++ ++ #if defined(__ia64__) ++- { ++- extern void * __libc_ia64_register_backing_store_base; ++- void * bst=GC_save_regs_in_stack(); ++- void * bsb=__libc_ia64_register_backing_store_base; ++- ++- if (bsb>bst) ++- (*fn)(bsb,bst,C_GC_OFFSET); ++- else ++- (*fn)(bst,bsb,C_GC_OFFSET); ++- ++- } +++ { +++ extern void * __libc_ia64_register_backing_store_base; +++ void * bst=GC_save_regs_in_stack(); +++ void * bsb=__libc_ia64_register_backing_store_base; +++ +++ if (bsb>bst) +++ (*fn)(bsb,bst,C_GC_OFFSET); +++ else +++ (*fn)(bst,bsb,C_GC_OFFSET); +++ +++ } ++ #endif ++- +++ ++ } ++ ++ static void ++@@ -1136,12 +1068,10 @@ static void ++ contblock_sweep_phase(void) { ++ ++ STATIC char *s, *e, *p, *q; ++- STATIC struct contblock *cbp; ++ STATIC struct pageinfo *v; +++ +++ reset_contblock_freelist(); ++ ++- cb_pointer = NULL; ++- ncb = 0; ++- ++ for (v=contblock_list_head;v;v=v->next) { ++ bool z; ++ ++@@ -1163,7 +1093,7 @@ contblock_sweep_phase(void) { ++ #ifdef DEBUG ++ if (debug) { ++ for (cbp = cb_pointer; cbp != NULL; cbp = cbp->cb_link) ++- printf("%d-byte contblock\n", cbp->cb_size); +++ printf("%lud-byte contblock\n", cbp->cb_size); ++ fflush(stdout); ++ } ++ #endif ++@@ -1175,7 +1105,6 @@ contblock_sweep_phase(void) { ++ ++ int (*GBC_enter_hook)() = NULL; ++ int (*GBC_exit_hook)() = NULL; ++-char *old_rb_start; ++ ++ /* void */ ++ /* ttss(void) { */ ++@@ -1201,10 +1130,6 @@ fixnum fault_pages=0; ++ void ++ GBC(enum type t) { ++ ++- long i,j; ++-#ifdef SGC ++- int in_sgc = sgc_enabled; ++-#endif ++ #ifdef DEBUG ++ int tm=0; ++ #endif ++@@ -1216,6 +1141,26 @@ GBC(enum type t) { ++ t=t_contiguous; ++ } ++ +++ ngc_thresh=fix(sSAleaf_collection_thresholdA->s.s_dbind); +++ +++ { /*FIXME try to get this below the setjmp in mark_c_stack*/ +++ struct pageinfo *v,*tv; +++ ufixnum i; +++ void *a; +++ +++ for (v=contblock_list_head,contblock_stack_list=NULL;v;v=v->next) +++ for (i=1;iin_use;i++) { +++ tv=pagetoinfo(page(v)+i); +++ if (pageinfo_p(tv)) { +++ a=contblock_stack_list; +++ /* fprintf(stderr,"pushing %p\n",tv); */ +++ contblock_stack_list=alloca(2*sizeof(a)); +++ contblock_stack_list[0]=tv; +++ contblock_stack_list[1]=a; +++ } +++ } +++ } +++ ++ if (in_signal_handler && t == t_relocatable) ++ error("cant gc relocatable in signal handler"); ++ ++@@ -1241,10 +1186,8 @@ GBC(enum type t) { ++ close_stream(o); ++ } ++ ++- t = t_relocatable; gc_time = -1; ++-#ifdef SGC ++- if(sgc_enabled) sgc_quit(); ++-#endif +++ /* t = t_relocatable; */ +++ gc_time = -1; ++ } ++ ++ ++@@ -1257,10 +1200,15 @@ GBC(enum type t) { ++ tm_table[(int)t].tm_gbccount++; ++ tm_table[(int)t].tm_adjgbccnt++; ++ +++ if (sSAnotify_gbcA->s.s_dbind != Cnil ++ #ifdef DEBUG ++- if (debug || (sSAnotify_gbcA->s.s_dbind != Cnil)) { ++- ++- if (gc_time < 0) gc_time=0; +++ || debug +++#endif +++ ) { +++ +++ if (gc_time < 0) +++ gc_time=0; +++ ++ #ifdef SGC ++ printf("[%s for %ld %s pages..", ++ (sgc_enabled ? "SGC" : "GC"), ++@@ -1272,48 +1220,33 @@ GBC(enum type t) { ++ (tm_of(t)->tm_npage), ++ (tm_table[(int)t].tm_name)+1); ++ #endif +++ ++ #ifdef SGC ++ if(sgc_enabled) ++- printf("(%ld faulted pages, %ld writable, %ld read only)..",fault_pages,sgc_count_writable(), ++- (page(core_end)-first_data_page)-(page(old_rb_start)-page(heap_end))-sgc_count_writable()); +++ printf("(%ld faulted pages, %ld writable, %ld read only)..", +++ fault_pages,(page(core_end)-first_data_page)-(page(rb_start)-page(heap_end))-sgc_count_read_only(), +++ sgc_count_read_only()); ++ #endif +++ ++ fflush(stdout); +++ ++ } ++-#endif +++ ++ if (gc_time >=0 && !gc_recursive++) {gc_start=runtime();} ++ ++- /* maxpage = page(heap_end); */ ++- ++ if (COLLECT_RELBLOCK_P) { ++ ++- i=rb_pointer-REAL_RB_START+PAGESIZE;/*FIXME*/ ++- ++-#ifdef SGC ++- if (sgc_enabled==0) ++-#endif ++- rb_start = heap_end + PAGESIZE*holepage; +++ char *new_start=heap_end+holepage*PAGESIZE,*new_end=new_start+nrbpage*PAGESIZE; ++ ++- rb_end = heap_end + (holepage + nrbpage) *PAGESIZE; ++- ++- if (rb_start < rb_pointer) ++- rb_start1 = (char *) ++- ((long)(rb_pointer + PAGESIZE-1) & -(unsigned long)PAGESIZE); ++- else ++- rb_start1 = rb_start; ++- ++- /* as we walk through marking data, we replace the ++- relocatable pointers ++- in objects by the rb_pointer, advance that ++- by the size, and copy the actual ++- data there to rb_pointer1, and advance it by the size ++- at the end [rb_start1,rb_pointer1] is copied ++- to [rb_start,rb_pointer] ++- */ ++- rb_pointer = rb_start; /* where the new relblock will start */ ++- rb_pointer1 = rb_start1;/* where we will copy it to during gc*/ ++- ++- i = (rb_end < (rb_start1 + i) ? (rb_start1 + i) : rb_end) - heap_end; ++- alloc_page(-(i + PAGESIZE - 1)/PAGESIZE); +++ if (new_start!=rb_start) { +++ rb_pointer=new_start; +++ rb_limit=new_end; +++ } else { +++ rb_pointer=(rb_pointertm_sgc == 0) ++- {sgc_quit(); ++- if (sSAnotify_gbcA->s.s_dbind != Cnil) ++- {fprintf(stdout, " (doing full gc)"); ++- fflush(stdout);} ++- mark_phase();} ++- else ++- sgc_mark_phase();} +++ sgc_mark_phase(); ++ else ++ #endif ++ mark_phase(); ++@@ -1365,27 +1291,16 @@ GBC(enum type t) { ++ #endif ++ ++ if (COLLECT_RELBLOCK_P) { +++ +++ rb_start = heap_end + PAGESIZE*holepage; +++ rb_end = heap_end + (holepage + nrbpage) *PAGESIZE; ++ ++- if (rb_start < rb_start1) { ++- j = (rb_pointer-rb_start + PAGESIZE - 1)/PAGESIZE; ++- memmove(rb_start,rb_start1,j*PAGESIZE); ++- } ++- +++ ++ #ifdef SGC ++ if (sgc_enabled) ++ wrimap=(void *)sSAwritableA->s.s_dbind->v.v_self; ++ #endif ++ ++-#ifdef SGC ++- /* we don't know which pages have relblock on them */ ++- if(sgc_enabled) { ++- fixnum i; ++- for (i=page(rb_start);ipromotion_pointer1) { */ +++/* object *p,st; */ +++/* promoting=1; */ +++/* st=alloc_simple_string(""); */ +++/* for (p=promotion_pointer1;pst.st_dim; */ +++ +++/* else switch (x->v.v_elttype) { */ +++ +++/* case aet_lf: */ +++/* j=sizeof(longfloat)*x->v.v_dim; */ +++/* break; */ +++/* case aet_bit: */ +++/* #define W_SIZE (8*sizeof(fixnum)) */ +++/* j=sizeof(fixnum)*((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE); */ +++/* break; */ +++/* case aet_char: */ +++/* case aet_uchar: */ +++/* j=sizeof(char)*x->v.v_dim; */ +++/* break; */ +++/* case aet_short: */ +++/* case aet_ushort: */ +++/* j=sizeof(short)*x->v.v_dim; */ +++/* break; */ +++/* default: */ +++/* j=sizeof(fixnum)*x->v.v_dim; */ +++/* } */ +++ +++/* st->st.st_dim=j; */ +++/* st->st.st_self=alloc_contblock(st->st.st_dim); */ +++/* fprintf(stderr,"Promoting vector leaf bytes %lu at %p, %p -> %p\n",j,x,x->v.v_self,st->st.st_self); */ +++/* fflush(stderr); */ +++/* memcpy(st->st.st_self,x->v.v_self,st->st.st_dim); */ +++/* x->v.v_self=(void *)st->st.st_self; */ +++/* } */ +++/* promoting=0; */ +++/* } */ +++/* } */ +++ +++ ++ #ifdef DEBUG ++ if (debug) { ++ for (i = 0, j = 0; i < (int)t_end; i++) { ++@@ -1437,11 +1400,6 @@ GBC(enum type t) { ++ ++ interrupt_enable = TRUE; ++ ++-#ifdef SGC ++- if (in_sgc && sgc_enabled==0) ++- sgc_start(); ++-#endif ++- ++ if (GBC_exit_hook != NULL) ++ (*GBC_exit_hook)(); ++ ++@@ -1468,6 +1426,23 @@ GBC(enum type t) { ++ ++ } ++ +++ /* {static int mv; */ +++ /* if (!mv && COLLECT_RELBLOCK_P) { */ +++ /* mv=1; */ +++ /* if (relb_copied) { */ +++ /* sSAstatic_promotion_areaA->s.s_dbind=(VFUN_NARGS=4,fSmake_vector1(make_fixnum(relb_copied),make_fixnum(aet_char),Ct,make_fixnum(0))); */ +++ /* fprintf(stderr,"Making static promotion area %lu bytes\n",relb_copied); */ +++ /* fflush(stderr); */ +++ /* relb_copied=0; */ +++ /* } else { */ +++ /* fprintf(stderr,"Releasing static promotion area\n"); */ +++ /* fflush(stderr); */ +++ /* sSAstatic_promotion_areaA->s.s_dbind=Cnil; */ +++ /* } */ +++ /* mv=0; */ +++ /* } */ +++ /* } */ +++ ++ collect_both=0; ++ ++ END_NO_INTERRUPT; ++@@ -1524,11 +1499,16 @@ FFN(siLroom_report)(void) { ++ vs_push(make_fixnum(available_pages)); ++ vs_push(make_fixnum(ncbpage)); ++ vs_push(make_fixnum(maxcbpage)); ++- vs_push(make_fixnum(ncb)); +++ { +++ ufixnum ncb; +++ struct contblock *cbp; +++ for (ncb=0,cbp=cb_pointer;cbp;cbp=cbp->cb_link,ncb++); +++ vs_push(make_fixnum(ncb)); +++ } ++ vs_push(make_fixnum(cbgbccount)); ++ vs_push(make_fixnum(holepage)); ++- vs_push(make_fixnum(rb_pointer - rb_start)); ++- vs_push(make_fixnum(rb_end - rb_pointer)); +++ vs_push(make_fixnum(rb_pointer - (rb_pointer= 0) */ ++- /* { *q++ = *p++;} */ ++- ++- return res; +++ memmove(q,p,s);/*FIXME memcpy*/ +++ +++ return q; +++ ++ } ++ ++ ++@@ -1595,18 +1572,124 @@ mark_contblock(void *p, int s) { ++ q = p + s; ++ /* SGC cont pages: contblock pages must be no smaller than ++ sizeof(struct contblock). CM 20030827 */ ++- x = (char *)ROUND_DOWN_PTR_CONT(p); ++- y = (char *)ROUND_UP_PTR_CONT(q); +++ x = (char *)PFLR(p,CPTR_SIZE); +++ y = (char *)PCEI(q,CPTR_SIZE); ++ v=get_pageinfo(x); ++ #ifdef SGC ++ if (!sgc_enabled || (v->sgc_flags&SGC_PAGE_FLAG)) ++ #endif ++- set_mark_bits(v,x,y); +++ set_mark_bits(v,x,y); +++ } +++ +++DEFUN_NEW("CONTIGUOUS-REPORT",object,fScontiguous_report,SI,1,1,NONE,OO,OO,OO,OO,(void),"") { +++ +++ struct contblock **cbpp; +++ struct pageinfo *v; +++ ufixnum i,j,k,s; +++ struct typemanager *tm=tm_of(t_cfdata); +++ void *p; +++ +++ for (i=j=0,cbpp=&cb_pointer;(*cbpp);) { +++ for (k=0,s=(*cbpp)->cb_size,p=*cbpp;*cbpp && (*cbpp)->cb_size==s;i+=(*cbpp)->cb_size,j++,k++,cbpp=&(*cbpp)->cb_link); +++ fprintf(stderr,"%lu %lu starting at %p\n",k,s,p); +++ } +++ fprintf(stderr,"\nTotal free %lu in %lu pieces\n\n",i,j); +++ +++ for (i=j=0,v=contblock_list_head;v;i+=v->in_use,j++,v=v->next) +++ fprintf(stderr,"%lu pages at %p\n",(unsigned long)v->in_use,v); +++ fprintf(stderr,"\nTotal pages %lu in %lu pieces\n\n",i,j); +++ +++ for (i=j=0,v=cell_list_head;v;v=v->next) +++ if (tm->tm_type==v->type) { +++ void *p; +++ ufixnum k; +++ for (p=pagetochar(page(v)),k=0;ktm_nppage;k++,p+=tm->tm_size) { +++ object o=p; +++ if (!is_free(o) && type_of(o)==t_cfdata && (void *)o->cfd.cfd_start>=data_start) { +++ fprintf(stderr,"%lu code bytes at %p\n",(unsigned long)o->cfd.cfd_size,o->cfd.cfd_start); +++ i+=o->cfd.cfd_size; +++ j++; +++ } +++ } +++ } +++ fprintf(stderr,"\nTotal code bytes %lu in %lu pieces\n",i,j); +++ +++ for (i=j=0,v=cell_list_head;v;v=v->next) { +++ struct typemanager *tm=tm_of(v->type); +++ void *p; +++ ufixnum k; +++ for (p=pagetochar(page(v)),k=0;ktm_nppage;k++,p+=tm->tm_size) { +++ object o=p; +++ void *d=NULL; +++ ufixnum s=0; +++ if (!is_free(o)) { +++ switch (type_of(o)) { +++ case t_array: +++ case t_vector: +++ d=o->a.a_self; +++ s=o->a.a_dim*sizeof(object); +++ break; +++ case t_hashtable: +++ d=o->ht.ht_self; +++ s=o->ht.ht_size*sizeof(object)*2; +++ break; +++ case t_symbol: +++ d=o->s.s_self; +++ s=o->s.s_fillp; +++ break; +++ case t_string: +++ case t_bitvector: +++ d=o->a.a_self; +++ s=o->a.a_dim; +++ break; +++ case t_package: +++ d=o->p.p_external; +++ s=(o->p.p_external_size+o->p.p_internal_size)*sizeof(object); +++ break; +++ case t_bignum: +++ d=o->big.big_mpz_t._mp_d; +++ s=o->big.big_mpz_t._mp_alloc*MP_LIMB_SIZE; +++ break; +++ case t_structure: +++ d=o->str.str_self; +++ s=S_DATA(o->str.str_def)->length*sizeof(object); +++ break; +++ case t_random: +++ d=o->rnd.rnd_state._mp_seed->_mp_d; +++ s=o->rnd.rnd_state._mp_seed->_mp_alloc*MP_LIMB_SIZE; +++ break; +++ case t_cclosure: +++ d=o->cc.cc_turbo; +++ s=fix(o->cc.cc_turbo[-1]); +++ break; +++ case t_cfdata: +++ d=o->cfd.cfd_start; +++ s=o->cfd.cfd_size; +++ break; +++ case t_readtable: +++ d=o->rt.rt_self; +++ s=RTABSIZE*(sizeof(struct rtent));/*FIXME*/ +++ break; +++ default: +++ break; +++ } +++ if (d>=data_start && d<(void *)heap_end && s) { +++ fprintf(stderr,"%lu %s bytes at %p\n",s,tm_table[type_of(o)].tm_name,d); +++ i+=s; +++ j++; +++ } +++ } +++ } +++ } +++ fprintf(stderr,"\nTotal leaf bytes %lu in %lu pieces\n",i,j); +++ +++ return Cnil; +++ ++ } ++ ++-DEFUN_NEW("GBC",object,fLgbc,LISP,1,1,NONE,OO,OO,OO,OO,(object x0),"") { +++DEFUN_NEW("GBC",object,fSgbc,SI,1,1,NONE,OO,OO,OO,OO,(object x0),"") { ++ ++- /* 1 args */ +++ /* 1 args */ ++ ++ if (x0 == Ct) ++ GBC(t_other); ++@@ -1650,5 +1733,5 @@ gcl_init_GBC(void) { ++ #ifdef SGC ++ make_si_function("SGC-ON",siLsgc_on); ++ #endif ++- +++ ++ } ++--- gcl-2.6.12.orig/o/gmp.c +++++ gcl-2.6.12/o/gmp.c ++@@ -18,12 +18,12 @@ static void *gcl_gmp_realloc(void *oldme ++ MP_SELF(big_gcprotect)=0; ++ bcopy(old,new,oldsize); ++ /* SGC contblock pages: Its possible this is on an old page CM 20030827 */ ++- if (inheap(oldmem)) ++-#ifdef SGC ++- insert_maybe_sgc_contblock(oldmem,oldsize); ++-#else ++- insert_contblock(oldmem,oldsize); ++-#endif +++/* if (inheap(oldmem)) */ +++/* #ifdef SGC */ +++/* insert_maybe_sgc_contblock(oldmem,oldsize); */ +++/* #else */ +++/* insert_contblock(oldmem,oldsize); */ +++/* #endif */ ++ ++ return new; ++ } ++--- gcl-2.6.12.orig/o/hash.d +++++ gcl-2.6.12/o/hash.d ++@@ -30,6 +30,7 @@ object sLequal; ++ object sKsize; ++ object sKrehash_size; ++ object sKrehash_threshold; +++object sKstatic; ++ ++ #define MHSH(a_) ((a_) & ~(1UL<<(sizeof(a_)*CHAR_SIZE-1))) ++ ++@@ -295,8 +296,9 @@ object hashtable; ++ hashtable->ht.ht_rhthresh = ++ make_fixnum(fix(hashtable->ht.ht_rhthresh) + ++ (new_size - old->ht.ht_size)); ++- hashtable->ht.ht_self = ++- (struct htent *)alloc_relblock(new_size * sizeof(struct htent)); +++ hashtable->ht.ht_self = hashtable->ht.ht_static ? +++ (struct htent *)alloc_contblock(new_size * sizeof(struct htent)) : +++ (struct htent *)alloc_relblock(new_size * sizeof(struct htent)); ++ for (i = 0; i < new_size; i++) { ++ hashtable->ht.ht_self[i].hte_key = OBJNULL; ++ hashtable->ht.ht_self[i].hte_value = OBJNULL; ++@@ -322,6 +324,7 @@ DEFVAR("*DEFAULT-HASH-TABLE-REHASH-THRES ++ `sSAdefault_hash_table_rehash_sizeA->s.s_dbind`) ++ (rehash_threshold ++ `sSAdefault_hash_table_rehash_thresholdA->s.s_dbind`) +++ (static `Cnil`) ++ &aux h) ++ enum httest htt=0; ++ int i; ++@@ -363,9 +366,11 @@ DEFVAR("*DEFAULT-HASH-TABLE-REHASH-THRES ++ h->ht.ht_rhsize = rehash_size; ++ h->ht.ht_rhthresh = rehash_threshold; ++ h->ht.ht_nent = 0; +++ h->ht.ht_static = static!=Cnil ? 1 : 0; ++ h->ht.ht_self = NULL; ++- h->ht.ht_self = (struct htent *) ++- alloc_relblock(fix(size) * sizeof(struct htent)); +++ h->ht.ht_self = h->ht.ht_static ? +++ (struct htent *)alloc_contblock(fix(size) * sizeof(struct htent)) : +++ (struct htent *)alloc_relblock(fix(size) * sizeof(struct htent)); ++ for(i = 0; i < fix(size); i++) { ++ h->ht.ht_self[i].hte_key = OBJNULL; ++ h->ht.ht_self[i].hte_value = OBJNULL; ++@@ -547,6 +552,7 @@ gcl_init_hash() ++ sKtest = make_keyword("TEST"); ++ sKrehash_size = make_keyword("REHASH-SIZE"); ++ sKrehash_threshold = make_keyword("REHASH-THRESHOLD"); +++ sKstatic = make_keyword("STATIC"); ++ ++ make_function("MAKE-HASH-TABLE", Lmake_hash_table); ++ make_function("HASH-TABLE-P", Lhash_table_p); ++--- gcl-2.6.12.orig/o/let.c +++++ gcl-2.6.12/o/let.c ++@@ -226,7 +226,7 @@ is an illegal function definition in FLE ++ top[0] = MMcons(lex[2], def); ++ top[0] = MMcons(lex[1], top[0]); ++ top[0] = MMcons(lex[0], top[0]); ++- top[0] = MMcons(sLlambda_block_closure, top[0]); +++ top[0] = MMcons(sSlambda_block_closure, top[0]); ++ lex_fun_bind(MMcar(def), top[0]); ++ def_list = MMcdr(def_list); ++ } ++@@ -262,7 +262,7 @@ is an illegal function definition in LAB ++ top[0] = MMcons(Cnil, top[0]); ++ top[1] = MMcons(top[0], top[1]); ++ top[0] = MMcons(lex[0], top[0]); ++- top[0] = MMcons(sLlambda_block_closure, top[0]); +++ top[0] = MMcons(sSlambda_block_closure, top[0]); ++ lex_fun_bind(MMcar(def), top[0]); ++ def_list = MMcdr(def_list); ++ } ++@@ -315,8 +315,8 @@ gcl_init_let(void) ++ make_special_form("LET", Flet); ++ make_special_form("LET*", FletA); ++ make_special_form("MULTIPLE-VALUE-BIND", Fmultiple_value_bind); ++- make_special_form("COMPILER-LET", Fcompiler_let); ++ make_special_form("FLET",Fflet); ++ make_special_form("LABELS",Flabels); ++ make_special_form("MACROLET",Fmacrolet); +++ make_si_special_form("COMPILER-LET", Fcompiler_let); ++ } ++--- gcl-2.6.12.orig/o/lex.c +++++ gcl-2.6.12/o/lex.c ++@@ -58,7 +58,7 @@ lex_macro_bind(object name, object exp_f ++ { ++ object *top = vs_top; ++ vs_push(make_cons(exp_fun, Cnil)); ++- top[0] = make_cons(sLmacro, top[0]); +++ top[0] = make_cons(sSmacro, top[0]); ++ top[0] = make_cons(name, top[0]); ++ lex_env[1]=make_cons(top[0], lex_env[1]); ++ vs_top = top; ++@@ -70,7 +70,7 @@ lex_tag_bind(object tag, object id) ++ object *top = vs_top; ++ ++ vs_push(make_cons(id, Cnil)); ++- top[0] = make_cons(sLtag, top[0]); +++ top[0] = make_cons(sStag, top[0]); ++ top[0] = make_cons(tag, top[0]); ++ lex_env[2] =make_cons(top[0], lex_env[2]); ++ vs_top = top; ++@@ -95,7 +95,7 @@ lex_tag_sch(object tag) ++ object alist = lex_env[2]; ++ ++ while (!endp(alist)) { ++- if (eql(MMcaar(alist), tag) && MMcadar(alist) == sLtag) +++ if (eql(MMcaar(alist), tag) && MMcadar(alist) == sStag) ++ return(MMcar(alist)); ++ alist = MMcdr(alist); ++ } ++@@ -120,10 +120,10 @@ gcl_init_lex(void) ++ { ++ /* sLfunction = make_ordinary("FUNCTION"); */ ++ /* enter_mark_origin(&sLfunction); */ ++- sLmacro = make_ordinary("MACRO"); ++- enter_mark_origin(&sLmacro); ++- sLtag = make_ordinary("TAG"); ++- enter_mark_origin(&sLtag); +++ sSmacro = make_si_ordinary("MACRO"); +++ enter_mark_origin(&sSmacro); +++ sStag = make_si_ordinary("TAG"); +++ enter_mark_origin(&sStag); ++ sLblock = make_ordinary("BLOCK"); ++ enter_mark_origin(&sLblock); ++ } ++--- gcl-2.6.12.orig/o/macros.c +++++ gcl-2.6.12/o/macros.c ++@@ -161,7 +161,7 @@ macro_def(object form) ++ return(head->s.s_gfdef); ++ else ++ return(Cnil); ++- else if (MMcadr(fd) == sLmacro) +++ else if (MMcadr(fd) == sSmacro) ++ return(MMcaddr(fd)); ++ else ++ return(Cnil); ++@@ -279,7 +279,7 @@ macro_expand(object form) ++ exp_fun = head->s.s_gfdef; ++ else ++ return(form); ++- else if (MMcadr(fd) == sLmacro) +++ else if (MMcadr(fd) == sSmacro) ++ exp_fun = MMcaddr(fd); ++ else ++ return(form); ++@@ -316,7 +316,7 @@ LOOP: ++ exp_fun = head->s.s_gfdef; ++ else ++ goto END; ++- else if (MMcadr(fd) == sLmacro) +++ else if (MMcadr(fd) == sSmacro) ++ exp_fun = MMcaddr(fd); ++ else ++ goto END; ++--- gcl-2.6.12.orig/o/main.c +++++ gcl-2.6.12/o/main.c ++@@ -182,30 +182,41 @@ get_phys_pages_no_malloc(void) { ++ #else ++ ++ ufixnum ++-get_phys_pages_no_malloc(void) { ++- int l; +++get_proc_meminfo_value_in_pages(const char *k) { +++ int l,m; ++ char b[PAGESIZE],*c; ++- const char *k="MemTotal:",*f="/proc/meminfo"; ++- ufixnum res=0,n; +++ ufixnum n; ++ ++- if ((l=open(f,O_RDONLY))!=-1) { ++- if ((n=read(l,b,sizeof(b)))>(PAGEWIDTH-10); +++ massert((l=open("/proc/meminfo",O_RDONLY))!=-1); +++ massert((n=read(l,b,sizeof(b)))>(PAGEWIDTH-10); +++} +++ +++ufixnum +++get_phys_pages_no_malloc(char freep) { +++ return freep ? +++ get_proc_meminfo_value_in_pages("MemFree:")+ +++ get_proc_meminfo_value_in_pages("Buffers:")+ +++ get_proc_meminfo_value_in_pages("Cached:") : +++ get_proc_meminfo_value_in_pages("MemTotal:"); ++ } ++ ++ #endif ++ +++void *initial_sbrk=NULL; +++ ++ int ++ update_real_maxpage(void) { ++ ++ ufixnum i,j,k; ++ void *end,*cur,*beg; +++ ufixnum free_phys_pages=get_phys_pages_no_malloc(1),maxpages; ++ #ifdef __MINGW32__ ++ static fixnum n; ++ ++@@ -215,6 +226,8 @@ update_real_maxpage(void) { ++ } ++ #endif ++ +++ phys_pages=get_phys_pages_no_malloc(1); +++ ++ massert(cur=sbrk(0)); ++ beg=data_start ? data_start : cur; ++ for (i=0,j=(1L<PAGESIZE;j>>=1) ++@@ -225,30 +238,46 @@ update_real_maxpage(void) { ++ } ++ massert(!mbrk(cur)); ++ ++- phys_pages=get_phys_pages_no_malloc(); +++/* phys_pages=get_phys_pages_no_malloc(0); */ ++ ++-#ifdef BRK_DOES_NOT_GUARANTEE_ALLOCATION ++- if (phys_pages>0 && real_maxpage>phys_pages+page(beg)) real_maxpage=phys_pages+page(beg); ++-#endif +++/* #ifdef BRK_DOES_NOT_GUARANTEE_ALLOCATION */ +++/* if (phys_pages>0 && real_maxpage>phys_pages+page(beg)) real_maxpage=phys_pages+page(beg); */ +++/* #endif */ +++ +++ maxpages=real_maxpage-page(beg); ++ ++- available_pages=real_maxpage-page(beg); +++ free_phys_pages=free_phys_pages>maxpages ? maxpages : free_phys_pages; +++ +++ resv_pages=available_pages=0; +++ available_pages=check_avail_pages(); +++ ++ for (i=t_start,j=0;is.s_dbind!=Cnil) { ++ ++- new_holepage=available_pages/starting_hole_div; ++- k=available_pages/20; ++- j*=starting_relb_heap_mult; ++- j=j>1); +++ } +++ +++ new_holepage=0; +++ for (i=t_start;i= dend) { ++ minimize_image(); ++ log_maxpage_bound=l; ++@@ -352,6 +369,8 @@ gcl_mprotect(void *v,unsigned long l,int ++ } ++ #endif ++ +++DEFVAR("*CODE-BLOCK-RESERVE*",sSAcode_block_reserveA,SI,Cnil,""); +++ ++ int ++ main(int argc, char **argv, char **envp) { ++ ++@@ -430,9 +449,10 @@ main(int argc, char **argv, char **envp) ++ gcl_init_readline_function(); ++ #endif ++ #ifdef NEED_STACK_CHK_GUARD ++- __stack_chk_guard=random_ulong();/*Cannot be safely set inside a function which returns*/ +++ __stack_chk_guard=random_ulong();/*Cannot be safely set inside a function which returns*/ ++ #endif ++- +++ allocate_code_block_reserve(); +++ ++ } ++ ++ #ifdef _WIN32 ++@@ -549,22 +569,10 @@ initlisp(void) { ++ import(Ct, lisp_package); ++ export(Ct, lisp_package); ++ ++-#ifdef ANSI_COMMON_LISP ++-/* Cnil->s.s_hpack = common_lisp_package; */ ++- import(Cnil, common_lisp_package); ++- export(Cnil, common_lisp_package); ++- ++-/* Ct->s.s_hpack = common_lisp_package; */ ++- import(Ct, common_lisp_package); ++- export(Ct, common_lisp_package); ++-#endif ++- ++-/* sLquote = make_ordinary("QUOTE"); */ ++-/* sLfunction = make_ordinary("FUNCTION"); */ ++ sLlambda = make_ordinary("LAMBDA"); ++- sLlambda_block = make_ordinary("LAMBDA-BLOCK"); ++- sLlambda_closure = make_ordinary("LAMBDA-CLOSURE"); ++- sLlambda_block_closure = make_ordinary("LAMBDA-BLOCK-CLOSURE"); +++ sSlambda_block = make_si_ordinary("LAMBDA-BLOCK"); +++ sSlambda_closure = make_si_ordinary("LAMBDA-CLOSURE"); +++ sSlambda_block_closure = make_si_ordinary("LAMBDA-BLOCK-CLOSURE"); ++ sLspecial = make_ordinary("SPECIAL"); ++ ++ ++@@ -702,7 +710,7 @@ segmentation_catcher(int i) { ++ /* error("end of file"); */ ++ /* } */ ++ ++-DEFUNO_NEW("BYE",object,fLbye,LISP +++DEFUNO_NEW("BYE",object,fSbye,SI ++ ,0,1,NONE,OO,OO,OO,OO,void,Lby,(object exitc),"") ++ { int n=VFUN_NARGS; ++ int exit_code; ++@@ -714,9 +722,9 @@ DEFUNO_NEW("BYE",object,fLbye,LISP ++ } ++ ++ ++-DEFUN_NEW("QUIT",object,fLquit,LISP +++DEFUN_NEW("QUIT",object,fSquit,SI ++ ,0,1,NONE,OO,OO,OO,OO,(object exitc),"") ++-{ return FFN(fLbye)(exitc); } +++{ return FFN(fSbye)(exitc); } ++ ++ /* DEFUN_NEW("EXIT",object,fLexit,LISP */ ++ /* ,0,1,NONE,OI,OO,OO,OO,(fixnum exitc),"") */ ++@@ -976,8 +984,8 @@ FFN(siLsave_system)(void) { ++ ++ saving_system = FALSE; ++ ++- Lsave(); ++- alloc_page(-(holepage+nrbpage)); +++ siLsave(); +++ alloc_page(-(holepage+2*nrbpage)); ++ ++ } ++ ++@@ -990,7 +998,7 @@ DEFVAR("*COMMAND-ARGS*",sSAcommand_argsA ++ static void ++ init_main(void) { ++ ++- make_function("BY", Lby); +++ make_si_function("BY", Lby); ++ make_si_function("ARGC", siLargc); ++ make_si_function("ARGV", siLargv); ++ ++--- gcl-2.6.12.orig/o/package.d +++++ gcl-2.6.12/o/package.d ++@@ -1159,17 +1159,12 @@ gcl_init_package() ++ { ++ ++ lisp_package ++- = make_package(make_simple_string("LISP"), ++- Cnil, Cnil,47,509); +++ = make_package(make_simple_string("COMMON-LISP"), +++ list(2,make_simple_string("CL"),make_simple_string("LISP")),Cnil,47,509); ++ user_package ++- = make_package(make_simple_string("USER"), ++- Cnil, +++ = make_package(make_simple_string("COMMON-LISP-USER"), +++ list(2,make_simple_string("CL-USER"),make_simple_string("USER")), ++ make_cons(lisp_package, Cnil),509,97); ++-#ifdef ANSI_COMMON_LISP ++- common_lisp_package ++- = make_package(make_simple_string("COMMON-LISP"), ++- Cnil, Cnil,47,509); ++-#endif ++ keyword_package ++ = make_package(make_simple_string("KEYWORD"), ++ Cnil, Cnil,11,509); ++--- gcl-2.6.12.orig/o/predicate.c +++++ gcl-2.6.12/o/predicate.c ++@@ -341,9 +341,9 @@ DEFUNO_NEW("FUNCTIONP",object,fLfunction ++ x0 = Cnil; } ++ else if (t == t_cons) { ++ x = x0->c.c_car; ++- if (x == sLlambda || x == sLlambda_block || +++ if (x == sLlambda || x == sSlambda_block || ++ x == sSlambda_block_expanded || ++- x == sLlambda_closure || x == sLlambda_block_closure) +++ x == sSlambda_closure || x == sSlambda_block_closure) ++ x0 = Ct; ++ else ++ x0 = Cnil; ++@@ -358,6 +358,14 @@ fLfunctionp(object x) { ++ #endif ++ ++ +++DEFUNO_NEW("COMMONP",object,fScommonp,SI,1,1,NONE,OO,OO,OO,OO,void,siLcommonp,(object x0),"") { +++ if (type_of(x0) != t_spice) +++ x0 = Ct; +++ else +++ x0 = Cnil; +++ RETURN1(x0); +++} +++ ++ DEFUNO_NEW("COMPILED-FUNCTION-P",object,fLcompiled_function_p,LISP ++ ,1,1,NONE,OO,OO,OO,OO,void,Lcompiled_function_p,(object x0),"") ++ ++@@ -377,18 +385,6 @@ DEFUNO_NEW("COMPILED-FUNCTION-P",object, ++ x0 = Ct; ++ else ++ x0 = Cnil; ++-RETURN1(x0);} ++- ++-DEFUNO_NEW("COMMONP",object,fLcommonp,LISP ++- ,1,1,NONE,OO,OO,OO,OO,void,Lcommonp,(object x0),"") ++- ++-{ ++- /* 1 args */; ++- ++- if (type_of(x0) != t_spice) ++- x0 = Ct; ++- else ++- x0 = Cnil; ++ RETURN1(x0);} ++ ++ DEFUN_NEW("EQ",object,fLeq,LISP,2,2,NONE,OO,OO,OO,OO,(object x0,object x1),"") { ++--- gcl-2.6.12.orig/o/read.d +++++ gcl-2.6.12/o/read.d ++@@ -2152,7 +2152,8 @@ LFD(Lreadtablep)() ++ rdtbl->rt.rt_self[c].rte_chattrib ++ = cat_terminating; ++ rdtbl->rt.rt_self[c].rte_macro = fnc; ++- @(return Ct) +++ SGC_TOUCH(rdtbl); +++ @(return Ct) ++ @) ++ ++ @(defun get_macro_character (chr &optional (rdtbl `current_readtable()`)) ++--- gcl-2.6.12.orig/o/reference.c +++++ gcl-2.6.12/o/reference.c ++@@ -82,7 +82,7 @@ LFD(Lsymbol_function)(void) ++ FEundefined_function(sym); ++ if (sym->s.s_mflag) { ++ vs_push(sym->s.s_gfdef); ++- vs_base[0] = sLmacro; +++ vs_base[0] = sSmacro; ++ stack_cons(); ++ return; ++ } ++@@ -131,7 +131,7 @@ FFN(Ffunction)(object form) ++ vs_base[0] = MMcons(lex_env[2], vs_base[0]); ++ vs_base[0] = MMcons(lex_env[1], vs_base[0]); ++ vs_base[0] = MMcons(lex_env[0], vs_base[0]); ++- vs_base[0] = MMcons(sLlambda_closure, vs_base[0]); +++ vs_base[0] = MMcons(sSlambda_closure, vs_base[0]); ++ } else ++ FEinvalid_function(fun); ++ } ++@@ -173,7 +173,7 @@ LFD(Lmacro_function)(void) ++ vs_base[0] = Cnil; ++ } ++ ++-LFD(Lspecial_form_p)(void) +++LFD(Lspecial_operator_p)(void) ++ { ++ check_arg(1); ++ if (type_of(vs_base[0]) != t_symbol) ++@@ -194,7 +194,6 @@ gcl_init_reference(void) ++ make_function("SYMBOL-VALUE", Lsymbol_value); ++ make_function("BOUNDP", Lboundp); ++ make_function("MACRO-FUNCTION", Lmacro_function); ++- make_function("SPECIAL-FORM-P", Lspecial_form_p); ++- make_function("SPECIAL-OPERATOR-P", Lspecial_form_p); +++ make_function("SPECIAL-OPERATOR-P", Lspecial_operator_p); ++ } ++ ++--- gcl-2.6.12.orig/o/run_process.c +++++ gcl-2.6.12/o/run_process.c ++@@ -432,7 +432,7 @@ enum smmode smm; ++ stream->sm.sm_fp = fp; ++ stream->sm.sm_buffer = 0; ++ ++- stream->sm.sm_object0 = sLstring_char; +++ stream->sm.sm_object0 = sLcharacter; ++ stream->sm.sm_object1 = host_l; ++ stream->sm.sm_int0 = stream->sm.sm_int1 = 0; ++ vs_push(stream); ++--- gcl-2.6.12.orig/o/save.c +++++ gcl-2.6.12/o/save.c ++@@ -16,11 +16,12 @@ memory_save(char *original_file, char *s ++ extern void _cleanup(); ++ #endif ++ ++-LFD(Lsave)(void) { +++LFD(siLsave)(void) { ++ ++ char filename[256]; ++ extern char *kcl_self; ++- +++ extern void *initial_sbrk; +++ ++ check_arg(1); ++ check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++ coerce_to_filename(vs_base[0], filename); ++@@ -33,7 +34,8 @@ LFD(Lsave)(void) { ++ ++ raw_image=FALSE; ++ cs_org=0; ++- +++ initial_sbrk=core_end; +++ ++ #ifdef MEMORY_SAVE ++ MEMORY_SAVE(kcl_self,filename); ++ #else ++--- gcl-2.6.12.orig/o/sfaslbfd.c +++++ gcl-2.6.12/o/sfaslbfd.c ++@@ -212,7 +212,7 @@ fasload(object faslfile) { ++ ++ set_type_of(&dum,t_stream); ++ dum.sm.sm_mode=smm_input; ++- dum.sm.sm_object0=sLstring_char; +++ dum.sm.sm_object0=sLcharacter; ++ ++ link_callbacks.add_archive_element=madd_archive_element; ++ link_callbacks.multiple_definition=mmultiple_definition; ++--- gcl-2.6.12.orig/o/sfaslelf.c +++++ gcl-2.6.12/o/sfaslelf.c ++@@ -58,7 +58,7 @@ License for more details. ++ #define LOAD_SYM(sym) ({ul _b=ELF_ST_BIND(sym->st_info),_t=ELF_ST_TYPE(sym->st_info); \ ++ sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK || (_t>=STT_LOPROC && _t<=STT_HIPROC));}) ++ ++-#define MASK(n) (~(~0L << (n))) +++#define MASK(n) (~(~0ULL << (n))) ++ ++ ++ ++@@ -242,6 +242,46 @@ relocate_symbols(Sym *sym,Sym *syme,Shdr ++ ++ } ++ +++#ifndef MAX_CODE_ADDRESS +++#define MAX_CODE_ADDRESS -1UL +++#endif +++ +++static void * +++alloc_memory(ul sz) { +++ +++ void *v; +++ +++ if (sSAcode_block_reserveA && +++ sSAcode_block_reserveA->s.s_dbind!=Cnil && sSAcode_block_reserveA->s.s_dbind->st.st_dim>=sz) { +++ +++ v=sSAcode_block_reserveA->s.s_dbind->st.st_self; +++ sSAcode_block_reserveA->s.s_dbind->st.st_self+=sz; +++ sSAcode_block_reserveA->s.s_dbind->st.st_dim-=sz; +++ sSAcode_block_reserveA->s.s_dbind->st.st_fillp=sSAcode_block_reserveA->s.s_dbind->st.st_dim; +++ +++ } else +++ v=alloc_contblock(sz); +++ +++ massert(v && (ul)(v+sz)s.s_dbind=alloc_simple_string(n); +++ sSAcode_block_reserveA->s.s_dbind->st.st_self=alloc_memory(n); +++ +++} +++ ++ static object ++ load_memory(Shdr *sec1,Shdr *sece,void *v1,ul **got,ul **gote) { ++ ++@@ -275,9 +315,7 @@ load_memory(Shdr *sec1,Shdr *sece,void * ++ memory->cfd.cfd_size=sz; ++ memory->cfd.cfd_self=0; ++ memory->cfd.cfd_start=0; ++- prefer_low_mem_contblock=TRUE; ++- memory->cfd.cfd_start=alloc_contblock(sz); ++- prefer_low_mem_contblock=FALSE; +++ memory->cfd.cfd_start=alloc_memory(sz); ++ ++ a=(ul)memory->cfd.cfd_start; ++ a=(a+ma)&~ma; ++--- gcl-2.6.12.orig/o/sgbc.c +++++ gcl-2.6.12/o/sgbc.c ++@@ -7,9 +7,6 @@ ++ ++ */ ++ ++-static void ++-sgc_mark_object1(object); ++- ++ #ifdef BSD ++ /* ulong may have been defined in mp.h but the define is no longer needed */ ++ #undef ulong ++@@ -51,81 +48,12 @@ int gclmprotect ( void *addr, size_t len ++ ++ #include ++ ++-/* void segmentation_catcher(void); */ ++- ++- ++-#define sgc_mark_pack_list(u) \ ++-do {register object xtmp = u; \ ++- while (xtmp != Cnil) \ ++- {if (ON_WRITABLE_PAGE(xtmp)) {mark(xtmp);} \ ++- sgc_mark_object(xtmp->c.c_car); \ ++- xtmp=Scdr(xtmp);}}while(0) ++- ++- ++ #ifdef SDEBUG ++ object sdebug; ++ joe1(){;} ++ joe() {;} ++ #endif ++ ++-/* static void */ ++-/* sgc_mark_cons(object x) { */ ++- ++-/* cs_check(x); */ ++- ++-/* /\* x is already marked. *\/ */ ++- ++-/* BEGIN: */ ++-/* #ifdef SDEBUG */ ++-/* if(x==sdebug) joe1(); */ ++-/* #endif */ ++-/* sgc_mark_object(x->c.c_car); */ ++-/* #ifdef OLD */ ++-/* IF_WRITABLE(x->c.c_car, goto MARK_CAR;); */ ++-/* goto MARK_CDR; */ ++- ++-/* MARK_CAR: */ ++-/* if (!is_marked_or_free(x->c.c_car)) { */ ++-/* if (consp(x->c.c_car)) { */ ++-/* mark(x->c.c_car); */ ++-/* sgc_mark_cons(x->c.c_car); */ ++-/* } else */ ++-/* sgc_mark_object1(x->c.c_car);} */ ++-/* MARK_CDR: */ ++-/* #endif */ ++-/* /\* if (is_imm_fixnum(x->c.c_cdr)) return; *\/ */ ++-/* x = Scdr(x); */ ++-/* IF_WRITABLE(x, goto WRITABLE_CDR;); */ ++-/* return; */ ++-/* WRITABLE_CDR: */ ++-/* if (is_marked_or_free(x)) return; */ ++-/* if (consp(x)) { */ ++-/* mark(x); */ ++-/* goto BEGIN; */ ++-/* } */ ++-/* sgc_mark_object1(x); */ ++-/* } */ ++- ++-inline void ++-sgc_mark_cons(object x) { ++- ++- do { ++- object d=x->c.c_cdr; ++- mark(x); ++- sgc_mark_object(x->c.c_car); ++- x=d; ++- if (!IS_WRITABLE(page(x)) || is_marked_or_free(x))/*catches Cnil*/ ++- return; ++- } while (cdr_listp(x)); ++- sgc_mark_object(x); ++- ++-} ++- ++-/* Whenever two arrays are linked together by displacement, ++- if one is live, the other will be made live */ ++-#define sgc_mark_displaced_field(ar) sgc_mark_object(ar->a.a_displaced) ++- ++- ++ /* structures and arrays of type t, need to be marked if their ++ bodies are not write protected even if the headers are. ++ So we should keep these on pages particular to them. ++@@ -134,415 +62,6 @@ sgc_mark_cons(object x) { ++ This takes only 1.47 as opposed to 1.33 microseconds per set. ++ */ ++ static void ++-sgc_mark_object1(object x) { ++- ++- fixnum i,j; ++- object *p; ++- char *cp; ++- enum type tp; ++- ++- cs_check(x); ++- BEGIN: ++-#ifdef SDEBUG ++- if (x == OBJNULL || !ON_WRITABLE_PAGE(x)) ++- return; ++- IF_WRITABLE(x,goto OK); ++- joe(); ++- OK: ++-#endif ++- if (is_marked_or_free(x)) ++- return; ++-#ifdef SDEBUG ++- if(x==sdebug) joe1(); ++-#endif ++- ++- tp=type_of(x); ++- ++- if (tp==t_cons) { ++- sgc_mark_cons(x); ++- return; ++- } ++- ++- mark(x); ++- ++- switch (tp) { ++- ++- case t_fixnum: ++- break; ++- ++- case t_ratio: ++- sgc_mark_object(x->rat.rat_num); ++- x = x->rat.rat_den; ++- IF_WRITABLE(x,if(!is_marked_or_free(x)) goto BEGIN); ++- ++- case t_shortfloat: ++- break; ++- ++- case t_longfloat: ++- break; ++- ++- case t_complex: ++- sgc_mark_object(x->cmp.cmp_imag); ++- x = x->cmp.cmp_real; ++- IF_WRITABLE(x,if(!is_marked_or_free(x)) goto BEGIN); ++- ++- case t_character: ++- break; ++- ++- case t_symbol: ++- IF_WRITABLE(x->s.s_plist,if(!is_marked_or_free(x->s.s_plist)) ++- {/* mark(x->s.s_plist); */ ++- sgc_mark_cons(x->s.s_plist);}); ++- sgc_mark_object(x->s.s_gfdef); ++- sgc_mark_object(x->s.s_dbind); ++- if (x->s.s_self == NULL) ++- break; ++- /* to do */ ++- if (inheap(x->s.s_self)) { ++- if (what_to_collect == t_contiguous) ++- mark_contblock(x->s.s_self,x->s.s_fillp); ++- } else if (SGC_RELBLOCK_P(x->s.s_self) && COLLECT_RELBLOCK_P) ++- x->s.s_self = copy_relblock(x->s.s_self, x->s.s_fillp); ++- break; ++- ++- case t_package: ++- sgc_mark_object(x->p.p_name); ++- sgc_mark_object(x->p.p_nicknames); ++- sgc_mark_object(x->p.p_shadowings); ++- sgc_mark_object(x->p.p_uselist); ++- sgc_mark_object(x->p.p_usedbylist); ++- if (what_to_collect == t_contiguous) { ++- if (x->p.p_internal != NULL) ++- mark_contblock((char *)(x->p.p_internal), ++- x->p.p_internal_size*sizeof(object)); ++- if (x->p.p_external != NULL) ++- mark_contblock((char *)(x->p.p_external), ++- x->p.p_external_size*sizeof(object)); ++- } ++- break; ++- ++- case t_hashtable: ++- sgc_mark_object(x->ht.ht_rhsize); ++- sgc_mark_object(x->ht.ht_rhthresh); ++- if (x->ht.ht_self == NULL) ++- break; ++- for (i = 0, j = x->ht.ht_size; i < j; i++) { ++- if (ON_WRITABLE_PAGE(&x->ht.ht_self[i])) { ++- sgc_mark_object(x->ht.ht_self[i].hte_key); ++- sgc_mark_object(x->ht.ht_self[i].hte_value); ++- } ++- } ++- if (inheap(x->ht.ht_self)) { ++- if (what_to_collect == t_contiguous) ++- mark_contblock((char *)(x->ht.ht_self),j * sizeof(struct htent)); ++- } else if (SGC_RELBLOCK_P(x->ht.ht_self) && COLLECT_RELBLOCK_P) ++- x->ht.ht_self=(void *)copy_relblock((char *)x->ht.ht_self,j*sizeof(struct htent));; ++- break; ++- ++- case t_array: ++- if ((x->a.a_displaced) != Cnil) ++- sgc_mark_displaced_field(x); ++- if (x->a.a_dims != NULL) { ++- if (inheap(x->a.a_dims)) { ++- if (what_to_collect == t_contiguous) ++- mark_contblock((char *)(x->a.a_dims),sizeof(int)*x->a.a_rank); ++- } else if (SGC_RELBLOCK_P(x->a.a_dims) && COLLECT_RELBLOCK_P) ++- x->a.a_dims = (int *) copy_relblock((char *)(x->a.a_dims),sizeof(int)*x->a.a_rank); ++- } ++- if ((enum aelttype)x->a.a_elttype == aet_ch) ++- goto CASE_STRING; ++- if ((enum aelttype)x->a.a_elttype == aet_bit) ++- goto CASE_BITVECTOR; ++- if ((enum aelttype)x->a.a_elttype == aet_object) ++- goto CASE_GENERAL; ++- ++- CASE_SPECIAL: ++- cp = (char *)(x->fixa.fixa_self); ++- if (cp == NULL) ++- break; ++- /* set j to the size in char of the body of the array */ ++- ++- switch((enum aelttype)x->a.a_elttype){ ++- case aet_lf: ++- j= sizeof(longfloat)*x->lfa.lfa_dim; ++- if ((COLLECT_RELBLOCK_P) && !(inheap(cp)) && SGC_RELBLOCK_P(x->a.a_self)) ++- ROUND_RB_POINTERS_DOUBLE;/*FIXME gc space violation*/ ++- break; ++- case aet_char: ++- case aet_uchar: ++- j=sizeof(char)*x->a.a_dim; ++- break; ++- case aet_short: ++- case aet_ushort: ++- j=sizeof(short)*x->a.a_dim; ++- break; ++- default: ++- j=sizeof(fixnum)*x->fixa.fixa_dim;} ++- ++- goto COPY; ++- ++- CASE_GENERAL: ++- p = x->a.a_self; ++- if (p == NULL ++-#ifdef HAVE_ALLOCA ++- || (char *)p >= core_end ++-#endif ++- ++- ) ++- break; ++- j=0; ++- if (x->a.a_displaced->c.c_car == Cnil) ++- for (i = 0, j = x->a.a_dim; i < j; i++) ++- if (ON_WRITABLE_PAGE(&p[i])) ++- sgc_mark_object(p[i]); ++- cp = (char *)p; ++- j *= sizeof(object); ++- COPY: ++- if (inheap(cp)) { ++- if (what_to_collect == t_contiguous) ++- mark_contblock(cp, j); ++- } else if (SGC_RELBLOCK_P(cp) && COLLECT_RELBLOCK_P) { ++- if (x->a.a_displaced == Cnil) { ++-#ifdef HAVE_ALLOCA ++- if (!NULL_OR_ON_C_STACK(cp)) /* only if body of array not on C stack */ ++-#endif ++- x->a.a_self = (object *)copy_relblock(cp, j); ++- } else if (x->a.a_displaced->c.c_car == Cnil) { ++- i = (long)(object *)copy_relblock(cp, j) - (long)(x->a.a_self); ++- adjust_displaced(x, i); ++- } ++- } ++- break; ++- ++- case t_vector: ++- if ((x->v.v_displaced) != Cnil) ++- sgc_mark_displaced_field(x); ++- if ((enum aelttype)x->v.v_elttype == aet_object) ++- goto CASE_GENERAL; ++- else ++- goto CASE_SPECIAL; ++- ++- case t_bignum: ++-#ifdef SDEBUG ++- if (TYPE_MAP(page(x->big.big_self)) < t_contiguous) ++- printf("bad body for %x (%x)\n",x,cp); ++-#endif ++-#ifndef GMP_USE_MALLOC ++- j = MP_ALLOCATED(x); ++- cp = (char *)MP_SELF(x); ++- if (cp == 0) ++- break; ++- j = j * MP_LIMB_SIZE; ++- if (inheap(cp)) { ++- if (what_to_collect == t_contiguous) ++- mark_contblock(cp, j); ++- } else if (SGC_RELBLOCK_P(cp) && COLLECT_RELBLOCK_P) ++- MP_SELF(x) = (void *) copy_relblock(cp, j); ++-#endif /* not GMP_USE_MALLOC */ ++- break; ++- ++- ++- CASE_STRING: ++- case t_string: ++- if ((x->st.st_displaced) != Cnil) ++- sgc_mark_displaced_field(x); ++- j = x->st.st_dim; ++- cp = x->st.st_self; ++- if (cp == NULL) ++- break; ++- ++- COPY_STRING: ++- if (inheap(cp)) { ++- if (what_to_collect == t_contiguous) ++- mark_contblock(cp, j); ++- } else if (SGC_RELBLOCK_P(cp) && COLLECT_RELBLOCK_P) { ++- if (x->st.st_displaced == Cnil) ++- x->st.st_self = copy_relblock(cp, j); ++- else if (x->st.st_displaced->c.c_car == Cnil) { ++- i = copy_relblock(cp, j) - cp; ++- adjust_displaced(x, i); ++- } ++- } ++- break; ++- ++- CASE_BITVECTOR: ++- case t_bitvector: ++- if ((x->bv.bv_displaced) != Cnil) ++- sgc_mark_displaced_field(x); ++- /* We make bitvectors multiple of sizeof(int) in size allocated ++- Assume 8 = number of bits in char */ ++- ++-#define W_SIZE (8*sizeof(fixnum)) ++- j= sizeof(fixnum) * ++- ((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE); ++- cp = x->bv.bv_self; ++- if (cp == NULL) ++- break; ++- goto COPY_STRING; ++- ++- case t_structure: ++- sgc_mark_object(x->str.str_def); ++- p = x->str.str_self; ++- if (p == NULL) ++- break; ++- { ++- object def=x->str.str_def; ++- unsigned char *s_type = &SLOT_TYPE(def,0); ++- unsigned short *s_pos = &SLOT_POS (def,0); ++- for (i = 0, j = S_DATA(def)->length; i < j; i++) ++- if (s_type[i]==0 && ON_WRITABLE_PAGE(&STREF(object,x,s_pos[i]))) ++- sgc_mark_object(STREF(object,x,s_pos[i])); ++- if (inheap(x->str.str_self)) { ++- if (what_to_collect == t_contiguous) ++- mark_contblock((char *)p,S_DATA(def)->size); ++- } else if (SGC_RELBLOCK_P(p) && (COLLECT_RELBLOCK_P)) ++- x->str.str_self = (object *) copy_relblock((char *)p, S_DATA(def)->size); ++- } ++- break; ++- ++- case t_stream: ++- switch (x->sm.sm_mode) { ++- case smm_input: ++- case smm_output: ++- case smm_io: ++- case smm_socket: ++- case smm_probe: ++- sgc_mark_object(x->sm.sm_object0); ++- sgc_mark_object(x->sm.sm_object1); ++- if (what_to_collect == t_contiguous && ++- x->sm.sm_fp && ++- x->sm.sm_buffer) ++- mark_contblock(x->sm.sm_buffer, BUFSIZ); ++- break; ++- ++- case smm_synonym: ++- sgc_mark_object(x->sm.sm_object0); ++- break; ++- ++- case smm_broadcast: ++- case smm_concatenated: ++- sgc_mark_object(x->sm.sm_object0); ++- break; ++- ++- case smm_two_way: ++- case smm_echo: ++- sgc_mark_object(x->sm.sm_object0); ++- sgc_mark_object(x->sm.sm_object1); ++- break; ++- ++- case smm_string_input: ++- case smm_string_output: ++- sgc_mark_object(x->sm.sm_object0); ++- break; ++-#ifdef USER_DEFINED_STREAMS ++- case smm_user_defined: ++- sgc_mark_object(x->sm.sm_object0); ++- sgc_mark_object(x->sm.sm_object1); ++- break; ++-#endif ++- default: ++- error("mark stream botch"); ++- } ++- break; ++- ++-#define SGC_MARK_CP(a_,b_) {fixnum _t=(b_);if (inheap((a_))) {\ ++- if (what_to_collect == t_contiguous) mark_contblock((void *)(a_),_t); \ ++- } else if (SGC_RELBLOCK_P((a_)) && COLLECT_RELBLOCK_P) (a_)=(void *)copy_relblock((void *)(a_),_t);} ++- ++-#define SGC_MARK_MP(a_) {if ((a_)->_mp_d) SGC_MARK_CP((a_)->_mp_d,(a_)->_mp_alloc*MP_LIMB_SIZE);} ++- ++- case t_random: ++- SGC_MARK_MP(x->rnd.rnd_state._mp_seed); ++-#if __GNU_MP_VERSION < 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR < 2) ++- if (x->rnd.rnd_state._mp_algdata._mp_lc) { ++- SGC_MARK_MP(x->rnd.rnd_state._mp_algdata._mp_lc->_mp_a); ++- if (!x->rnd.rnd_state._mp_algdata._mp_lc->_mp_m2exp) SGC_MARK_MP(x->rnd.rnd_state._mp_algdata._mp_lc->_mp_m); ++- SGC_MARK_CP(x->rnd.rnd_state._mp_algdata._mp_lc,sizeof(*x->rnd.rnd_state._mp_algdata._mp_lc)); ++- } ++-#endif ++- break; ++- ++- case t_readtable: ++- if (x->rt.rt_self == NULL) ++- break; ++- if (what_to_collect == t_contiguous) ++- mark_contblock((char *)(x->rt.rt_self),RTABSIZE*sizeof(struct rtent)); ++- for (i = 0; i < RTABSIZE; i++) { ++- sgc_mark_object(x->rt.rt_self[i].rte_macro); ++- if (x->rt.rt_self[i].rte_dtab != NULL) { ++- if (what_to_collect == t_contiguous) ++- mark_contblock((char *)(x->rt.rt_self[i].rte_dtab),RTABSIZE*sizeof(object)); ++- for (j = 0; j < RTABSIZE; j++) ++- sgc_mark_object(x->rt.rt_self[i].rte_dtab[j]); ++- } ++- } ++- break; ++- ++- case t_pathname: ++- sgc_mark_object(x->pn.pn_host); ++- sgc_mark_object(x->pn.pn_device); ++- sgc_mark_object(x->pn.pn_directory); ++- sgc_mark_object(x->pn.pn_name); ++- sgc_mark_object(x->pn.pn_type); ++- sgc_mark_object(x->pn.pn_version); ++- break; ++- ++- case t_closure: ++- { ++- int i ; ++- for (i= 0 ; i < x->cl.cl_envdim ; i++) ++- sgc_mark_object(x->cl.cl_env[i]); ++- if (SGC_RELBLOCK_P(x->cl.cl_env) && COLLECT_RELBLOCK_P) ++- x->cl.cl_env=(void *)copy_relblock((void *)x->cl.cl_env,x->cl.cl_envdim*sizeof(object)); ++- ++- } ++- ++- case t_cfun: ++- case t_sfun: ++- case t_vfun: ++- case t_afun: ++- case t_gfun: ++- sgc_mark_object(x->cf.cf_name); ++- sgc_mark_object(x->cf.cf_data); ++- break; ++- ++- case t_cfdata: ++- ++- if (x->cfd.cfd_self != NULL) { ++- int i=x->cfd.cfd_fillp; ++- while(i-- > 0) ++- sgc_mark_object(x->cfd.cfd_self[i]); ++- } ++- if (what_to_collect == t_contiguous) { ++- mark_contblock(x->cfd.cfd_start, x->cfd.cfd_size); ++- mark_link_array(x->cfd.cfd_start,x->cfd.cfd_start+x->cfd.cfd_size); ++- } ++- break; ++- case t_cclosure: ++- sgc_mark_object(x->cc.cc_name); ++- sgc_mark_object(x->cc.cc_env); ++- sgc_mark_object(x->cc.cc_data); ++- if (x->cc.cc_turbo!=NULL) { ++- sgc_mark_object(*(x->cc.cc_turbo-1)); ++- if (SGC_RELBLOCK_P(x->cc.cc_turbo) && COLLECT_RELBLOCK_P) ++- x->cc.cc_turbo=(void *)copy_relblock((char *)(x->cc.cc_turbo-1),(1+fix(*(x->cc.cc_turbo-1)))*sizeof(object))+sizeof(object); ++- } ++- break; ++- ++- case t_spice: ++- break; ++- ++- default: ++-#ifdef DEBUG ++- if (debug) ++- printf("\ttype = %d\n", type_of(x)); ++-#endif ++- error("mark botch"); ++- } ++- ++-} ++- ++-static void ++ sgc_mark_phase(void) { ++ ++ STATIC fixnum i, j; ++@@ -552,8 +71,8 @@ sgc_mark_phase(void) { ++ STATIC ihs_ptr ihsp; ++ STATIC struct pageinfo *v; ++ ++- sgc_mark_object(Cnil->s.s_plist); ++- sgc_mark_object(Ct->s.s_plist); +++ mark_object(Cnil->s.s_plist); +++ mark_object(Ct->s.s_plist); ++ ++ /* mark all non recent data on writable pages */ ++ { ++@@ -563,15 +82,17 @@ sgc_mark_phase(void) { ++ ++ for (v=cell_list_head;v;v=v->next) { ++ i=page(v); ++- if (!WRITABLE_PAGE_P(i)) continue; +++ if (v->sgc_flags&SGC_PAGE_FLAG || !WRITABLE_PAGE_P(i)) continue; ++ ++ t=v->type; ++ tm=tm_of(t); ++ p=pagetochar(i); ++ for (j = tm->tm_nppage; --j >= 0; p += tm->tm_size) { ++ object x = (object) p; ++- if (SGC_OR_M(x)) continue; ++- sgc_mark_object1(x); +++#ifndef SGC_WHOLE_PAGE +++ if (TYPEWORD_TYPE_P(v->type) && x->d.s) continue; +++#endif +++ mark_object1(x); ++ } ++ } ++ } ++@@ -595,24 +116,24 @@ sgc_mark_phase(void) { ++ mark_stack_carefully(MVloc+(sizeof(MVloc)/sizeof(object)),MVloc,0); ++ ++ for (bdp = bds_org; bdp<=bds_top; bdp++) { ++- sgc_mark_object(bdp->bds_sym); ++- sgc_mark_object(bdp->bds_val); +++ mark_object(bdp->bds_sym); +++ mark_object(bdp->bds_val); ++ } ++ ++ for (frp = frs_org; frp <= frs_top; frp++) ++- sgc_mark_object(frp->frs_val); +++ mark_object(frp->frs_val); ++ ++ for (ihsp = ihs_org; ihsp <= ihs_top; ihsp++) ++- sgc_mark_object(ihsp->ihs_function); +++ mark_object(ihsp->ihs_function); ++ ++ for (i = 0; i < mark_origin_max; i++) ++- sgc_mark_object(*mark_origin[i]); +++ mark_object(*mark_origin[i]); ++ for (i = 0; i < mark_origin_block_max; i++) ++ for (j = 0; j < mark_origin_block[i].mob_size; j++) ++- sgc_mark_object(mark_origin_block[i].mob_addr[j]); +++ mark_object(mark_origin_block[i].mob_addr[j]); ++ ++ for (pp = pack_pointer; pp != NULL; pp = pp->p_link) ++- sgc_mark_object((object)pp); +++ mark_object((object)pp); ++ #ifdef KCLOVM ++ if (ovm_process_created) ++ sgc_mark_all_stacks(); ++@@ -624,20 +145,6 @@ sgc_mark_phase(void) { ++ fflush(stdout); ++ } ++ #endif ++- { ++- int size; ++- ++- for (pp = pack_pointer; pp != NULL; pp = pp->p_link) { ++- size = pp->p_internal_size; ++- if (pp->p_internal != NULL) ++- for (i = 0; i < size; i++) ++- sgc_mark_pack_list(pp->p_internal[i]); ++- size = pp->p_external_size; ++- if (pp->p_external != NULL) ++- for (i = 0; i < size; i++) ++- sgc_mark_pack_list(pp->p_external[i]); ++- } ++- } ++ ++ mark_c_stack(0,N_RECURSION_REQD,mark_stack_carefully); ++ ++@@ -657,9 +164,6 @@ sgc_sweep_phase(void) { ++ ++ tm = tm_of((enum type)v->type); ++ ++- if (!WRITABLE_PAGE_P(page(v))) ++- continue; ++- ++ p = pagetochar(page(v)); ++ f = tm->tm_free; ++ k = 0; ++@@ -678,14 +182,18 @@ sgc_sweep_phase(void) { ++ continue; ++ } ++ ++- if (TYPEWORD_TYPE_P(pageinfo(x)->type) && x->d.s == SGC_NORMAL) +++#ifndef SGC_WHOLE_PAGE +++ if (TYPEWORD_TYPE_P(v->type) && x->d.s == SGC_NORMAL) ++ continue; +++#endif ++ ++ /* it is ok to free x */ ++ ++ SET_LINK(x,f); ++ make_free(x); +++#ifndef SGC_WHOLE_PAGE ++ if (TYPEWORD_TYPE_P(v->type)) x->d.s = SGC_RECENT; +++#endif ++ f = x; ++ k++; ++ ++@@ -694,7 +202,7 @@ sgc_sweep_phase(void) { ++ tm->tm_nfree += k; ++ v->in_use-=k; ++ ++- } else /*non sgc_page */ +++ } else if (WRITABLE_PAGE_P(page(v))) /*non sgc_page */ ++ for (j = tm->tm_nppage; --j >= 0; p += size) { ++ x = (object)p; ++ if (is_marked(x) && !is_free(x)) { ++@@ -711,9 +219,9 @@ sgc_contblock_sweep_phase(void) { ++ ++ STATIC char *s, *e, *p, *q; ++ STATIC struct pageinfo *v; +++ +++ reset_contblock_freelist(); ++ ++- cb_pointer = NULL; ++- ncb = 0; ++ for (v=contblock_list_head;v;v=v->next) { ++ bool z; ++ ++@@ -739,13 +247,6 @@ sgc_contblock_sweep_phase(void) { ++ ++ } ++ ++- ++- ++-#define PAGE_ROUND_UP(adr) \ ++- ((char *)(PAGESIZE*(((long)(adr)+PAGESIZE -1) >> PAGEWIDTH))) ++- ++-/* char *old_rb_start; */ ++- ++ #undef tm ++ ++ #ifdef SDEBUG ++@@ -763,11 +264,11 @@ sgc_count(object yy) { ++ ++ fixnum writable_pages=0; ++ ++-/* count writable pages excluding the hole */ +++/* count read-only pages */ ++ static fixnum ++-sgc_count_writable(void) { +++sgc_count_read_only(void) { ++ ++- return page(core_end)-page(rb_start)+writable_pages-(page(old_rb_start)-page(heap_end)); +++ return sgc_enabled ? sSAwritableA->s.s_dbind->v.v_dim-writable_pages : 0; ++ ++ } ++ ++@@ -1031,7 +532,11 @@ memprotect_test_reset(void) { ++ /* If opt_maxpage is set, add full pages to the sgc set if needed ++ too. 20040804 CM*/ ++ /* #define FSGC(tm) (tm->tm_type==t_cons ? tm->tm_nppage : (tm->tm_opt_maxpage ? 0 : tm->tm_sgc_minfree)) */ +++#ifdef SGC_WHOLE_PAGE +++#define FSGC(tm) tm->tm_nppage +++#else ++ #define FSGC(tm) (!TYPEWORD_TYPE_P(tm->tm_type) ? tm->tm_nppage : tm->tm_sgc_minfree) +++#endif ++ ++ DEFVAR("*WRITABLE*",sSAwritableA,SI,Cnil,""); ++ ++@@ -1047,13 +552,16 @@ sgc_start(void) { ++ object omp=sSAoptimize_maximum_pagesA->s.s_dbind; ++ double tmp,scale; ++ +++ allocate_more_pages=0; +++ if (sgc_enabled) +++ return 1; +++ ++ sSAoptimize_maximum_pagesA->s.s_dbind=Cnil; ++ ++ if (memprotect_result!=memprotect_success && do_memprotect_test()) ++ return 0; ++ ++- if (sgc_enabled) ++- return 1; +++ empty_relblock(); ++ ++ /* Reset maxpage statistics if not invoked automatically on a hole ++ overrun. 20040804 CM*/ ++@@ -1193,26 +701,7 @@ sgc_start(void) { ++ ++ } ++ ++- /* Now allocate the sgc relblock. We do this as the tail ++- end of the ordinary rb. */ ++- { ++- char *new; ++- tm=tm_of(t_relocatable); ++- ++- { ++- old_rb_start=rb_start; ++- if(((unsigned long)WSGC(tm)) && allocate_more_pages) { ++- new=alloc_relblock(((unsigned long)WSGC(tm))*PAGESIZE); ++- /* the above may cause a gc, shifting the relblock */ ++- old_rb_start=rb_start; ++- new= PAGE_ROUND_UP(new); ++- } else new=PAGE_ROUND_UP(rb_pointer); ++- rb_start=rb_pointer=new; ++- } ++- } ++- /* the relblock has been allocated */ ++- ++- sSAwritableA->s.s_dbind=fSmake_vector1_1((page(rb_start)-first_data_page),aet_bit,Cnil); +++ sSAwritableA->s.s_dbind=fSmake_vector1_1((page(heap_end)-first_data_page),aet_bit,Ct); ++ wrimap=(void *)sSAwritableA->s.s_dbind->v.v_self; ++ ++ /* now move the sgc free lists into place. alt_free should ++@@ -1231,12 +720,16 @@ sgc_start(void) { ++ #endif ++ if (pageinfo(f)->sgc_flags&SGC_PAGE_FLAG) { ++ SET_LINK(f,x); +++#ifndef SGC_WHOLE_PAGE ++ if (TYPEWORD_TYPE_P(pageinfo(f)->type)) f->d.s = SGC_RECENT; +++#endif ++ x=f; ++ count++; ++ } else { ++ SET_LINK(f,y); +++#ifndef SGC_WHOLE_PAGE ++ if (TYPEWORD_TYPE_P(pageinfo(f)->type)) f->d.s = SGC_NORMAL; +++#endif ++ y=f; ++ } ++ f=next; ++@@ -1253,9 +746,12 @@ sgc_start(void) { ++ ++ { ++ ++- struct contblock *new_cb_pointer=NULL,*tmp_cb_pointer=NULL,**cbpp; +++ struct contblock **cbpp; ++ void *p=NULL,*pe; ++ struct pageinfo *pi; +++ +++ old_cb_pointer=cb_pointer; +++ reset_contblock_freelist(); ++ ++ for (pi=contblock_list_head;pi;pi=pi->next) { ++ ++@@ -1264,26 +760,17 @@ sgc_start(void) { ++ p=CB_DATA_START(pi); ++ pe=p+CB_DATA_SIZE(pi->in_use); ++ ++- for (cbpp=&cb_pointer;*cbpp;) +++ for (cbpp=&old_cb_pointer;*cbpp;) ++ if ((void *)*cbpp>=p && (void *)*cbppcb_size,*l=(*cbpp)->cb_link; ++ set_sgc_bits(pi,s,e); ++- tmp_cb_pointer=cb_pointer; ++- cb_pointer=new_cb_pointer; ++ insert_contblock(s,e-s); ++- new_cb_pointer=cb_pointer; ++- cb_pointer=tmp_cb_pointer; ++ *cbpp=l; ++ } else ++ cbpp=&(*cbpp)->cb_link; ++ ++ } ++ ++- /* SGC contblock pages: switch to new free SGC contblock list. CM ++- 20030827 */ ++- old_cb_pointer=cb_pointer; ++- cb_pointer=new_cb_pointer; ++- ++ #ifdef SGC_CONT_DEBUG ++ overlap_check(old_cb_pointer,cb_pointer); ++ #endif ++@@ -1315,11 +802,13 @@ sgc_start(void) { ++ SET_WRITABLE(i); ++ } ++ ++- for (i=page(heap_end);itm_alt_npage=page(rb_start)-page(old_rb_start); ++- for (i=page(rb_start);is.s_dbind; +++ for (i=page(v->v.v_self);i<=page(v->v.v_self+CEI(v->bv.bv_offset+v->v.v_dim-1,8*sizeof(fixnum))/(8*sizeof(fixnum)));i++) ++ SET_WRITABLE(i); +++ } +++ +++ tm_of(t_relocatable)->tm_alt_npage=0; ++ ++ fault_pages=0; ++ ++@@ -1363,8 +852,7 @@ sgc_quit(void) { ++ ++ struct typemanager *tm; ++ struct contblock *tmp_cb_pointer,*next; ++- unsigned long i,j,np; ++- char *p; +++ unsigned long i,np; ++ struct pageinfo *v; ++ ++ memory_protect(0); ++@@ -1379,7 +867,6 @@ sgc_quit(void) { ++ wrimap=NULL; ++ ++ sgc_enabled=0; ++- rb_start = old_rb_start; ++ ++ /* SGC cont pages: restore contblocks, each tmp_cb_pointer coming ++ from the new list is guaranteed not to be on the old. Need to ++@@ -1389,9 +876,7 @@ sgc_quit(void) { ++ #ifdef SGC_CONT_DEBUG ++ overlap_check(old_cb_pointer,cb_pointer); ++ #endif ++- tmp_cb_pointer=cb_pointer; ++- cb_pointer=old_cb_pointer; ++- for (;tmp_cb_pointer; tmp_cb_pointer=next) { +++ for (tmp_cb_pointer=old_cb_pointer;tmp_cb_pointer; tmp_cb_pointer=next) { ++ next=tmp_cb_pointer->cb_link; ++ insert_contblock((void *)tmp_cb_pointer,tmp_cb_pointer->cb_size); ++ } ++@@ -1440,11 +925,13 @@ sgc_quit(void) { ++ ++ /*FIXME*/ ++ /* remove the recent flag from any objects on sgc pages */ ++- for (v=cell_list_head;v;v=v->next) +++#ifndef SGC_WHOLE_PAGE +++ for (v=cell_list_head;v;v=v->next) ++ if (v->type==(tm=tm_of(v->type))->tm_type && TYPEWORD_TYPE_P(v->type) && v->sgc_flags & SGC_PAGE_FLAG) ++ for (p=pagetochar(page(v)),j=tm->tm_nppage;j>0;--j,p+=tm->tm_size) ++- ((object) p)->d.s=SGC_NORMAL; ++- +++ ((object) p)->d.s=SGC_NORMAL; +++#endif +++ ++ for (v=contblock_list_head;v;v=v->next) ++ if (v->sgc_flags&SGC_PAGE_FLAG) ++ bzero(CB_SGCF_START(v),CB_DATA_START(v)-CB_SGCF_START(v)); ++@@ -1488,7 +975,6 @@ memprotect_handler(int sig, long code, v ++ faddr = addr; ++ #endif ++ p = page(faddr); ++- /* p = ROUND_DOWN_PAGE_NO(p); */ ++ if (p >= first_protectable_page ++ && faddr < (void *)core_end ++ && !(WRITABLE_PAGE_P(p))) { ++@@ -1560,10 +1046,10 @@ memory_protect(int on) { ++ INSTALL_MPROTECT_HANDLER; ++ ++ beg=first_protectable_page; ++- writable = IS_WRITABLE(beg); +++ writable = WRITABLE_PAGE_P(beg); ++ for (i=beg ; ++i<= end; ) { ++ ++- if (writable==IS_WRITABLE(i) && i<=end) continue; +++ if (writable==WRITABLE_PAGE_P(i) && ist.st_self = alloc_relblock(fix(size)); ++--- gcl-2.6.12.orig/o/structure.c +++++ gcl-2.6.12/o/structure.c ++@@ -257,7 +257,7 @@ LFD(siLmake_structure)(void) ++ } ++ ++ static void ++-FFN(siLcopy_structure)(void) +++FFN(Lcopy_structure)(void) ++ { ++ object x, y; ++ struct s_data *def; ++@@ -452,7 +452,7 @@ gcl_init_structure_function(void) ++ ++ make_si_function("MAKE-STRUCTURE", siLmake_structure); ++ make_si_function("MAKE-S-DATA-STRUCTURE",siLmake_s_data_structure); ++- make_si_function("COPY-STRUCTURE", siLcopy_structure); +++ make_function("COPY-STRUCTURE", Lcopy_structure); ++ make_si_function("STRUCTURE-NAME", siLstructure_name); ++ /* make_si_function("STRUCTURE-REF", siLstructure_ref); */ ++ /* make_si_function("STRUCTURE-DEF", siLstructure_def); */ ++--- gcl-2.6.12.orig/o/toplevel.c +++++ gcl-2.6.12/o/toplevel.c ++@@ -68,12 +68,12 @@ FFN(Fdefun)(object args) ++ } ++ vs_base = vs_top; ++ if (lex_env[0] == Cnil && lex_env[1] == Cnil && lex_env[2] == Cnil) { ++- vs_push(MMcons(sLlambda_block, args)); +++ vs_push(MMcons(sSlambda_block, args)); ++ } else { ++ vs_push(MMcons(lex_env[2], args)); ++ vs_base[0] = MMcons(lex_env[1], vs_base[0]); ++ vs_base[0] = MMcons(lex_env[0], vs_base[0]); ++- vs_base[0] = MMcons(sLlambda_block_closure, vs_base[0]); +++ vs_base[0] = MMcons(sSlambda_block_closure, vs_base[0]); ++ } ++ {object fname = clear_compiler_properties(name,vs_base[0]); ++ fname->s.s_gfdef = vs_base[0]; ++--- gcl-2.6.12.orig/o/typespec.c +++++ gcl-2.6.12/o/typespec.c ++@@ -73,7 +73,7 @@ LFD(Ltype_of)(void) ++ if ((' ' <= i && i < '\177') || i == '\n') ++ vs_base[0] = sLstandard_char; ++ else ++- vs_base[0] = sLstring_char; +++ vs_base[0] = sLcharacter; ++ } ++ break; ++ ++@@ -176,7 +176,6 @@ LFD(Ltype_of)(void) ++ DEF_ORDINARY("PROCLAIMED-ARG-TYPES",sSproclaimed_arg_types,SI,""); ++ DEF_ORDINARY("PROCLAIMED-RETURN-TYPE",sSproclaimed_return_type,SI,""); ++ DEF_ORDINARY("PROCLAIMED-FUNCTION",sSproclaimed_function,SI,""); ++-DEF_ORDINARY("COMMON",sLcommon,LISP,""); ++ DEF_ORDINARY("NULL",sLnull,LISP,""); ++ DEF_ORDINARY("CONS",sLcons,LISP,""); ++ DEF_ORDINARY("LIST",sLlist,LISP,""); ++@@ -197,7 +196,6 @@ DEF_ORDINARY("CHARACTER",sLcharacter,LIS ++ DEF_ORDINARY("NUMBER",sLnumber,LISP,""); ++ DEF_ORDINARY("RATIONAL",sLrational,LISP,""); ++ DEF_ORDINARY("FLOAT",sLfloat,LISP,""); ++-DEF_ORDINARY("STRING-CHAR",sLstring_char,LISP,""); ++ DEF_ORDINARY("REAL",sLreal,LISP,""); ++ DEF_ORDINARY("INTEGER",sLinteger,LISP,""); ++ DEF_ORDINARY("RATIO",sLratio,LISP,""); ++@@ -205,7 +203,6 @@ DEF_ORDINARY("SHORT-FLOAT",sLshort_float ++ DEF_ORDINARY("STANDARD-CHAR",sLstandard_char,LISP,""); ++ DEF_ORDINARY("BOOLEAN",sLboolean,LISP,""); ++ DEF_ORDINARY("FIXNUM",sLfixnum,LISP,""); ++-DEF_ORDINARY("POSITIVE-FIXNUM",sLpositive_fixnum,LISP,""); ++ DEF_ORDINARY("COMPLEX",sLcomplex,LISP,""); ++ DEF_ORDINARY("SINGLE-FLOAT",sLsingle_float,LISP,""); ++ DEF_ORDINARY("PACKAGE",sLpackage,LISP,""); ++@@ -228,10 +225,10 @@ DEF_ORDINARY("VALUES",sLvalues,LISP,""); ++ DEF_ORDINARY("MOD",sLmod,LISP,""); ++ DEF_ORDINARY("SIGNED-BYTE",sLsigned_byte,LISP,""); ++ DEF_ORDINARY("UNSIGNED-BYTE",sLunsigned_byte,LISP,""); ++-DEF_ORDINARY("SIGNED-CHAR",sLsigned_char,LISP,""); ++-DEF_ORDINARY("UNSIGNED-CHAR",sLunsigned_char,LISP,""); ++-DEF_ORDINARY("SIGNED-SHORT",sLsigned_short,LISP,""); ++-DEF_ORDINARY("UNSIGNED-SHORT",sLunsigned_short,LISP,""); +++DEF_ORDINARY("SIGNED-CHAR",sSsigned_char,SI,""); +++DEF_ORDINARY("UNSIGNED-CHAR",sSunsigned_char,SI,""); +++DEF_ORDINARY("SIGNED-SHORT",sSsigned_short,SI,""); +++DEF_ORDINARY("UNSIGNED-SHORT",sSunsigned_short,SI,""); ++ DEF_ORDINARY("*",sLA,LISP,""); ++ DEF_ORDINARY("PLUSP",sLplusp,LISP,""); ++ DEF_ORDINARY("DIVISION-BY-ZERO",sLdivision_by_zero,LISP,""); ++@@ -244,8 +241,6 @@ DEF_ORDINARY("UNDEFINED-FUNCTION",sLunde ++ DEF_ORDINARY("UNBOUND-VARIABLE",sLunbound_variable,LISP,""); ++ DEF_ORDINARY("PACKAGE-ERROR",sLpackage_error,LISP,""); ++ ++-/* #ifdef ANSI_COMMON_LISP */ ++-/* New ansi types */ ++ DEF_ORDINARY("METHOD-COMBINATION",sLmethod_combination,LISP,""); ++ DEF_ORDINARY("ARITHMETIC-ERROR",sLarithmetic_error,LISP,""); ++ DEF_ORDINARY("BASE-CHAR",sLbase_char,LISP,""); ++@@ -290,7 +285,6 @@ DEF_ORDINARY("TWO-WAY-STREAM",sLtwo_way_ ++ DEF_ORDINARY("TYPE-ERROR",sLtype_error,LISP,""); ++ DEF_ORDINARY("UNBOUND-SLOT",sLunbound_slot,LISP,""); ++ DEF_ORDINARY("WARNING",sLwarning,LISP,""); ++-/* #endif */ ++ ++ DEFCONST("CHAR-SIZE",sSchar_size,SI,small_fixnum(CHAR_SIZE),"Size in bits of a character"); ++ DEFCONST("SHORT-SIZE",sSshort_size,SI,small_fixnum(CHAR_SIZE*sizeof(short)),"Size in bits of a short integer"); ++--- gcl-2.6.12.orig/o/unexelf.c +++++ gcl-2.6.12/o/unexelf.c ++@@ -634,7 +634,7 @@ find_section (char *name, char *section_ ++ static void ++ unexec (char *new_name, char *old_name, unsigned int data_start, unsigned int bss_start, unsigned int entry_address) ++ { ++- int new_file, old_file, new_file_size; +++ int new_file, old_file; ++ ++ /* Pointers to the base of the image of the two files. */ ++ caddr_t old_base, new_base; ++@@ -654,17 +654,14 @@ unexec (char *new_name, char *old_name, ++ /* Point to the section name table in the old file */ ++ char *old_section_names; ++ ++- ElfW(Addr) old_bss_addr, new_bss_addr; ++- ElfW(Word) old_bss_size, new_data2_size,old_bss_offset; ++- ElfW(Off) new_data2_offset; ++- ElfW(Addr) new_data2_addr; +++ ElfW(Addr) old_bss_addr, new_bss_addr,new_data2_addr; +++ ElfW(Off) old_bss_size, new_data2_size,old_bss_offset,new_data2_offset,old_file_size,new_file_size; ++ ++ int n, nn; ++ int old_bss_index, old_sbss_index; ++ int old_data_index, new_data2_index; ++ int old_mdebug_index; ++ struct stat stat_buf; ++- int old_file_size; ++ ++ /* Open the old file, allocate a buffer of the right size, and read ++ in the file contents. */ ++--- gcl-2.6.12.orig/o/unixsave.c +++++ gcl-2.6.12/o/unixsave.c ++@@ -140,7 +140,7 @@ char *original_file, *save_file; ++ ++ extern void _cleanup(); ++ ++-LFD(Lsave)() { +++LFD(siLsave)() { ++ char filename[256]; ++ ++ check_arg(1); ++@@ -159,6 +159,6 @@ LFD(Lsave)() { ++ void ++ gcl_init_unixsave(void) ++ { ++- make_function("SAVE", Lsave); +++ make_si_function("SAVE", siLsave); ++ } ++ ++--- gcl-2.6.12.orig/o/unixsys.c +++++ gcl-2.6.12/o/unixsys.c ++@@ -169,7 +169,7 @@ msystem(const char *s) { ++ } ++ ++ static void ++-FFN(Lsystem)(void) +++FFN(siLsystem)(void) ++ { ++ char command[32768]; ++ int i; ++@@ -284,6 +284,6 @@ un_mmap(void *v1,void *ve) { ++ void ++ gcl_init_unixsys(void) { ++ ++- make_function("SYSTEM", Lsystem); +++ make_si_function("SYSTEM", siLsystem); ++ ++ } ++--- gcl-2.6.12.orig/o/unixtime.c +++++ gcl-2.6.12/o/unixtime.c ++@@ -282,7 +282,7 @@ DEFUN_NEW("CURRENT-TIMEZONE",object,fScu ++ localtime_r(&_t, <); ++ return (object)(gt.tm_hour-lt.tm_hour+24*(gt.tm_yday!=lt.tm_yday ? (gt.tm_year>lt.tm_year||gt.tm_yday>lt.tm_yday ? 1 : -1) : 0)); ++ #else ++- fixnum _t=time(0); +++ time_t _t=time(0); ++ return (object)(-localtime(&_t)->tm_gmtoff/3600); ++ #endif ++ } ++@@ -296,7 +296,7 @@ DEFUN_NEW("CURRENT-DSTP",object,fScurren ++ #elif defined NO_SYSTEM_TIME_ZONE /*solaris*/ ++ return Cnil; ++ #else ++- fixnum _t=time(0); +++ time_t _t=time(0); ++ return localtime(&_t)->tm_isdst > 0 ? Ct : Cnil; ++ #endif ++ } ++--- gcl-2.6.12.orig/pcl/defsys.lisp +++++ gcl-2.6.12/pcl/defsys.lisp ++@@ -52,24 +52,10 @@ ++ ++ (in-package :user) ++ ++-#+kcl (in-package :walker :use '(:lisp)) ++-#+kcl (in-package :iterate :use '(:lisp :walker)) ++-#+kcl (in-package :pcl :use '(:walker :iterate :lisp)) +++(load "package.lisp") ++ ++ (eval-when (compile load eval) ++ ++-(if (find-package ':walker) ++- (use-package '(:lisp) ':walker) ++- (make-package ':walker :use '(:lisp))) ++- ++-(if (find-package ':iterate) ++- (use-package '(:lisp :walker) ':iterate) ++- (make-package ':iterate :use '(:lisp :walker))) ++- ++-(if (find-package ':pcl) ++- (use-package '(:walker :iterate :lisp) ':pcl) ++- (make-package ':pcl :use '(:walker :iterate :lisp))) ++- ++ (export (intern (symbol-name :iterate) ;Have to do this here, ++ (find-package :iterate)) ;because in the defsystem ++ (find-package :iterate)) ;(later in this file) ++@@ -90,7 +76,7 @@ ++ ++ (eval-when (compile load eval) ++ (defvar *pcl-proclaim* ++- '(optimize (speed 3) (safety #+kcl 0 #-kcl 1) (space 0) +++ '(optimize (speed 3) (safety 1) (space 0) ++ #+lucid (compilation-speed 0))) ++ ) ++ ++@@ -261,7 +247,6 @@ and load your system with: ++ #+Xerox-Medley (Xerox-Medley xerox) ++ #+TI TI ++ #+(and dec vax common) Vaxlisp ++- #+KCL KCL ++ #+IBCL IBCL ++ #+gcl gcl ++ #+excl (excl franz) ++@@ -305,7 +290,6 @@ and load your system with: ++ #+Cloe-Runtime ("l" . "fasl") ++ #+(and dec common vax (not ultrix)) ("LSP" . "FAS") ++ #+(and dec common vax ultrix) ("lsp" . "fas") ++- #+KCL ("lsp" . "o") ++ #+IBCL ("lsp" . "o") ++ #+Xerox ("lisp" . "dfasl") ++ #+(and Lucid MC68000) ("lisp" . "lbin") ++@@ -675,7 +659,7 @@ and load your system with: ++ ;; 3.0 it's in the LUCID-COMMON-LISP package. ++ ;; ++ #+LUCID (or lucid::*source-pathname* (bad-time)) ++- #+akcl si:*load-pathname* +++ #+akcl *load-pathname* ++ #+cmu17 *load-truename* ++ #-(or Lispm excl Xerox (and dec vax common) LUCID akcl cmu17) nil)) ++ ++--- gcl-2.6.12.orig/pcl/gcl_pcl_pkg.lisp +++++ gcl-2.6.12/pcl/gcl_pcl_pkg.lisp ++@@ -176,11 +176,8 @@ ++ ++ nil)) ++ ++-#+kcl ++-(progn ++-(import '(si:structurep si:structure-def si:structure-ref)) ++-(shadow 'lisp:dotimes) ++-) +++#+kcl(import '(si:structurep si:structure-def si:structure-ref)) +++ ++ #+kcl ++ (in-package "SI") ++ #+kcl ++--- gcl-2.6.12.orig/pcl/gcl_pcl_walk.lisp +++++ gcl-2.6.12/pcl/gcl_pcl_walk.lisp ++@@ -608,7 +608,7 @@ ++ (push `(,(car f) . (function . (,#'unbound-lexical-function . nil))) ++ lexicals)) ++ (dolist (m macros) ++- (push `(,(car m) . (macro . ( ,(cadr m) . nil))) +++ (push `(,(car m) . (si::macro . ( ,(cadr m) . nil))) ++ lexicals)) ++ (list first lexicals third))) ++ ++@@ -623,7 +623,7 @@ ++ (when env ++ (let ((entry (assoc macro (second env)))) ++ (and entry ++- (eq (cadr entry) 'macro) +++ (eq (cadr entry) 'si::macro) ++ (caddr entry))))) ++ );#+(or KCL IBCL) ++ ++@@ -1202,7 +1202,7 @@ ++ ++ #+(or KCL IBCL) ++ (progn ++- (define-walker-template lambda-block walk-named-lambda);Not really right, +++ (define-walker-template si::lambda-block walk-named-lambda);Not really right, ++ ;we don't hack block ++ ;names anyways. ++ ) ++@@ -1367,7 +1367,7 @@ ++ #+cmu17 ++ (special-operator-p fn) ++ #-cmu17 ++- (special-form-p fn)) +++ (special-operator-p fn)) ++ (error ++ "~S is a special form, not defined in the CommonLisp.~%~ ++ manual This code walker doesn't know how to walk it.~%~ ++--- gcl-2.6.12.orig/pcl/impl/gcl/gcl_pcl_impl_low.lisp +++++ gcl-2.6.12/pcl/impl/gcl/gcl_pcl_impl_low.lisp ++@@ -277,17 +277,17 @@ static object set_cclosure (object resul ++ (fourth slotd)) ++ ++ (defun renew-sys-files() ++- ;; packages: ++- (compiler::get-packages "sys-package.lisp") ++- (with-open-file (st "sys-package.lisp" ++- :direction :output ++- :if-exists :append) ++- (format st "(lisp::in-package \"SI\") ++-(export '(%structure-name ++- %compiled-function-name ++- %set-compiled-function-name)) ++-(in-package \"PCL\") ++-")) +++;; ;; packages: +++;; (compiler::get-packages "sys-package.lisp") +++;; (with-open-file (st "sys-package.lisp" +++;; :direction :output +++;; :if-exists :append) +++;; (format st "(lisp::in-package \"SI\") +++;; (export '(%structure-name +++;; %compiled-function-name +++;; %set-compiled-function-name)) +++;; (in-package \"PCL\") +++;; ")) ++ ++ ;; proclaims ++ (compiler::make-all-proclaims "*.fn") ++--- gcl-2.6.12.orig/pcl/makefile +++++ gcl-2.6.12/pcl/makefile ++@@ -9,9 +9,7 @@ GFILES:=$(addprefix gcl_pcl_gazonk,$(GFI ++ ++ AFILES:=$(FILES) $(GFILES) ++ ++-SETUP='(load "sys-package.lisp")' \ ++- '(setq *features* (delete (quote :kcl) *features*))'\ ++- '(load "defsys.lisp")(push (quote :kcl) *features*)' \ +++SETUP='(load "defsys.lisp")' \ ++ '(setq pcl::*default-pathname-extensions* (cons "lisp" "o"))' \ ++ '(setq pcl::*pathname-extensions* (cons "lisp" "o"))' \ ++ '(load "sys-proclaim.lisp")' \ ++--- /dev/null +++++ gcl-2.6.12/pcl/package.lisp ++@@ -0,0 +1,21 @@ +++(in-package :user) +++ +++(eval-when (compile load eval) +++ +++(if (find-package :walker) +++ (use-package '(:lisp) :walker) +++ (make-package :walker :use '(:lisp))) +++ +++(if (find-package :iterate) +++ (use-package '(:lisp :walker) :iterate) +++ (make-package :iterate :use '(:lisp :walker))) +++ +++(if (find-package :pcl) +++ (use-package '(:walker :iterate :lisp) :pcl) +++ (make-package :pcl :use '(:walker :iterate :lisp)))) +++ +++(in-package :pcl) +++(defvar *the-pcl-package* (find-package :pcl)) +++(defun load-truename (&optional errorp) *load-pathname*) +++(import 'si::(clines defentry defcfun object void int double)) +++(import 'si::compiler-let :walker) ++--- gcl-2.6.12.orig/pcl/sys-proclaim.lisp +++++ gcl-2.6.12/pcl/sys-proclaim.lisp ++@@ -1,775 +1,1044 @@ ++ ++-(IN-PACKAGE "PCL") ++-(PROCLAIM ++- '(FTYPE (FUNCTION NIL T) ++- INITIALIZE-CHECKING-OR-CACHING-FUNCTION-LIST MAKE-ARG-INFO ++- RENEW-SYS-FILES ALLOCATE-FUNCALLABLE-INSTANCE-1 ++- SHOW-DFUN-CONSTRUCTORS MAKE-CACHE SHOW-EMF-CALL-TRACE ++- INITIAL-DISPATCH-DFUN-INFO DISPATCH-DFUN-INFO ++- IN-THE-COMPILER-P UPDATE-DISPATCH-DFUNS ++- SHOW-FREE-CACHE-VECTORS NO-METHODS-DFUN-INFO ++- %%ALLOCATE-INSTANCE--CLASS DEFAULT-METHOD-ONLY-DFUN-INFO ++- BOOTSTRAP-META-BRAID GET-EFFECTIVE-METHOD-GENSYM ++- STRUCTURE-FUNCTIONS-EXIST-P LIST-ALL-DFUNS MAKE-CPD ++- CACHES-TO-ALLOCATE INITIAL-DFUN-INFO ++- ALLOCATE-FUNCALLABLE-INSTANCE-2 BOOTSTRAP-BUILT-IN-CLASSES)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T) *) DEFAULT-CODE-CONVERTER ++- MAKE-FINAL-DISPATCH-DFUN PROTOTYPES-FOR-MAKE-METHOD-LAMBDA ++- FIND-STRUCTURE-CLASS EARLY-COLLECT-INHERITANCE ++- EMIT-ONE-INDEX-WRITERS NET-CODE-CONVERTER ++- MAKE-DISPATCH-DFUN *NORMALIZE-TYPE COMPILE-IIS-FUNCTIONS ++- GENERIC-FUNCTION-NAME-P EMIT-IN-CHECKING-CACHE-P ++- EMIT-ONE-CLASS-READER GET-GENERIC-FUNCTION-INFO ++- COMPUTE-APPLICABLE-METHODS-EMF ANALYZE-LAMBDA-LIST ++- EMIT-ONE-INDEX-READERS EARLY-METHOD-FUNCTION PCL-DESCRIBE ++- TYPE-FROM-SPECIALIZER FIND-WRAPPER METHOD-PROTOTYPE-FOR-GF ++- SPECIALIZER-FROM-TYPE STRUCTURE-WRAPPER ++- GET-DISPATCH-FUNCTION EMIT-TWO-CLASS-READER ++- PARSE-METHOD-GROUP-SPECIFIER CLASS-EQ-TYPE ++- EMIT-CONSTANT-VALUE EMIT-TWO-CLASS-WRITER ++- CONVERT-TO-SYSTEM-TYPE PARSE-DEFMETHOD ++- EMIT-ONE-CLASS-WRITER)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (*) T) |__si::MAKE-CACHING| |__si::MAKE-N-N| ++- MAKE-INITIALIZE-INFO |__si::MAKE-NO-METHODS| ++- |__si::MAKE-TWO-CLASS| INTERN-PV-TABLE ++- |__si::MAKE-ARG-INFO| |__si::MAKE-ONE-INDEX-DFUN-INFO| ++- FIX-EARLY-GENERIC-FUNCTIONS CALLED-FIN-WITHOUT-FUNCTION ++- MAKE-FAST-METHOD-CALL STRING-APPEND |__si::MAKE-ONE-INDEX| ++- |__si::MAKE-INITIAL| |__si::MAKE-CHECKING| ZERO ++- |__si::MAKE-PV-TABLE| MAKE-PROGN FALSE MAKE-PV-TABLE ++- WALKER::UNBOUND-LEXICAL-FUNCTION |__si::MAKE-DISPATCH| ++- USE-PACKAGE-PCL TRUE |__si::MAKE-DEFAULT-METHOD-ONLY| ++- |__si::MAKE-INITIAL-DISPATCH| |__si::MAKE-CONSTANT-VALUE| ++- |__si::MAKE-DFUN-INFO| |__si::MAKE-STD-INSTANCE| ++- MAKE-METHOD-CALL |__si::MAKE-CLASS-PRECEDENCE-DESCRIPTION| ++- MAKE-FAST-INSTANCE-BOUNDP |__si::MAKE-ACCESSOR-DFUN-INFO| ++- |STRUCTURE-OBJECT class constructor| |__si::MAKE-CACHE| ++- |__si::MAKE-ONE-CLASS| PV-WRAPPERS-FROM-PV-ARGS)) ++-(PROCLAIM '(FTYPE (FUNCTION (T) (OR CACHE NULL)) PV-TABLE-CACHE)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T *) *) MAKE-METHOD-FUNCTION-INTERNAL ++- PARSE-METHOD-OR-SPEC MAKE-METHOD-LAMBDA-INTERNAL ++- COERCE-TO-CLASS MAKE-FINAL-DFUN-INTERNAL GET-FUNCTION ++- EXTRACT-DECLARATIONS COMPILE-LAMBDA GET-FUNCTION1 ++- MAKE-CACHING-DFUN GET-METHOD-FUNCTION DISPATCH-DFUN-COST ++- MACROEXPAND-ALL PARSE-SPECIALIZED-LAMBDA-LIST ENSURE-CLASS ++- WALK-FORM MAKE-INSTANCE-1 GET-DFUN-CONSTRUCTOR ++- MAP-ALL-CLASSES ENSURE-GENERIC-FUNCTION ++- MAKE-CONSTANT-VALUE-DFUN)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T) T) ACCESSOR-MISS-FUNCTION ADD-TO-CVECTOR ++- QUALIFIER-CHECK-RUNTIME SET-FUNCTION-PRETTY-ARGLIST ++- ADD-DIRECT-SUBCLASSES REMOVE-METHOD SET-WRAPPER ++- DOCTOR-DFUN-FOR-THE-DEBUGGER MAKE-PLIST ++- SYMBOL-OR-CONS-LESSP MAKE-STD-BOUNDP-METHOD-FUNCTION ++- UPDATE-CPL METHODS-CONVERTER MAKE-DFUN-ARG-LIST ++- MAKE-DISCRIMINATING-FUNCTION-ARGLIST ++- STANDARD-INSTANCE-ACCESS REMTAIL DO-SATISFIES-DEFTYPE ++- CPL-FORWARD-REFERENCED-CLASS-ERROR FIND-STANDARD-II-METHOD ++- MAKE-UNORDERED-METHODS-EMF UPDATE-INITIALIZE-INFO-INTERNAL ++- ADD-METHOD COMPUTE-PV |SETF PCL FIND-CLASS-PREDICATE| ++- PROCLAIM-DEFMETHOD UPDATE-ALL-PV-TABLE-CACHES ++- ITERATE::SIMPLE-EXPAND-ITERATE-FORM CLASS-MIGHT-PRECEDE-P ++- MEC-ALL-CLASSES SET-FUNCALLABLE-INSTANCE-FUNCTION ++- MAKE-DFUN-LAMBDA-LIST CHECKING-DFUN-INFO ++- METHOD-FUNCTION-RETURNING-T PV-WRAPPERS-FROM-ALL-WRAPPERS ++- SET-METHODS ITERATE::MV-SETQ SUPERCLASSES-COMPATIBLE-P ++- SLOT-EXISTS-P SWAP-WRAPPERS-AND-SLOTS DESCRIBE-PACKAGE ++- VALUE-FOR-CACHING SAUT-NOT-PROTOTYPE ++- SET-STANDARD-SVUC-METHOD PLIST-VALUE AUGMENT-TYPE ++- UPDATE-CLASS N-N-DFUN-INFO VARIABLE-SPECIAL-P ++- UPDATE-STD-OR-STR-METHODS ADD-FORMS MAKE-CAXR ++- MAKE-DLAP-LAMBDA-LIST REDIRECT-EARLY-FUNCTION-INTERNAL ++- GET-KEY-ARG1 EMIT-N-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION ++- MAKE-INTERNAL-READER-METHOD-FUNCTION |SETF PCL FIND-CLASS| ++- COMPUTE-CALLS PROCLAIM-DEFGENERIC WALKER::NOTE-DECLARATION ++- SYSTEM:%SET-COMPILED-FUNCTION-NAME VARIABLE-LEXICAL-P ++- CANONICALIZE-DEFCLASS-OPTION RAISE-METATYPE ++- PARSE-QUALIFIER-PATTERN SAUT-NOT-CLASS-EQ ++- MAKE-PV-TABLE-INTERNAL WALKER::ENVIRONMENT-FUNCTION ++- COMPUTE-APPLICABLE-METHODS-FUNCTION ++- EMIT-1-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION ++- PV-TABLE-LOOKUP VARIABLE-CLASS ++- MAKE-FAST-METHOD-CALL-LAMBDA-LIST |SETF PCL GDEFINITION| ++- NET-CONSTANT-CONVERTER WALKER::VARIABLE-SYMBOL-MACRO-P ++- SYMBOL-LESSP GF-MAKE-FUNCTION-FROM-EMF ++- REMOVE-DIRECT-SUBCLASSES UPDATE-INITS ++- |SETF PCL METHOD-FUNCTION-PLIST| COMPUTE-STD-CPL ++- CPL-INCONSISTENT-ERROR CHANGE-CLASS-INTERNAL ++- FIND-SLOT-DEFINITION COMPUTE-LAYOUT NO-SLOT ++- %SET-CCLOSURE-ENV COMPUTE-CONSTANTS ++- SET-STRUCTURE-SVUC-METHOD GET-KEY-ARG REMOVE-SLOT-ACCESSORS ++- MAKE-CDXR MEMF-CONSTANT-CONVERTER BOOTSTRAP-SLOT-INDEX ++- CLASS-CAN-PRECEDE-P MEC-ALL-CLASSES-INTERNAL ++- CLASSES-HAVE-COMMON-SUBCLASS-P MAKE-CLASS-PREDICATE ++- SAUT-NOT-CLASS DESTRUCTURE-INTERNAL ++- ITERATE::EXTRACT-SPECIAL-BINDINGS MAKE-EARLY-ACCESSOR ++- MAP-PV-TABLE-REFERENCES-OF MAKE-STD-WRITER-METHOD-FUNCTION ++- FUNCALLABLE-STANDARD-INSTANCE-ACCESS ++- METHOD-FUNCTION-RETURNING-NIL MEC-ALL-CLASS-LISTS ++- ADD-SLOT-ACCESSORS EMIT-1-NIL-DLAP ++- MAKE-STD-READER-METHOD-FUNCTION ++- CANONICALIZE-SLOT-SPECIFICATION LIST-EQ REAL-REMOVE-METHOD ++- WALKER::ENVIRONMENT-MACRO SAUT-NOT-EQL UPDATE-SLOTS ++- DEAL-WITH-ARGUMENTS-OPTION PRINTING-RANDOM-THING-INTERNAL ++- WALKER::WALK-REPEAT-EVAL ++- PV-WRAPPERS-FROM-ALL-ARGS WALKER::NOTE-LEXICAL-BINDING)) ++-(PROCLAIM '(FTYPE (FUNCTION (T) (INTEGER 1 255)) CACHE-NKEYS)) ++-(PROCLAIM '(FTYPE (FUNCTION (T) (INTEGER 1 256)) CACHE-LINE-SIZE)) ++-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM T T) *) COMPUTE-CACHE-PARAMETERS)) ++-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM T *) *) FIND-FREE-CACHE-LINE)) ++-(PROCLAIM '(FTYPE (FUNCTION (T) FIELD-TYPE) CACHE-FIELD)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T) FUNCTION) CACHE-LIMIT-FN ++- FAST-METHOD-CALL-FUNCTION METHOD-CALL-FUNCTION)) ++-(MAPC (LAMBDA (COMPILER::X) ++- (SETF (GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE) T)) ++- '(TRACE-METHOD-INTERNAL FDEFINE-CAREFULLY DO-STANDARD-DEFSETF-1 ++- REDEFINE-FUNCTION)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (FIXNUM FIXNUM T) FIXNUM) ++- COMPUTE-PRIMARY-CACHE-LOCATION)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T FIXNUM *) T) GET-CACHE-FROM-CACHE ++- COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T) (VALUES T T)) MAKE-KEYWORD ++- MAKE-CLASS-PREDICATE-NAME)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T *) T) FIND-CLASS-PREDICATE FIND-CLASS-CELL ++- USE-CONSTANT-VALUE-DFUN-P MAKE-EARLY-GF ITERATE::MAYBE-WARN ++- TRACE-METHOD ALLOCATE-FUNCALLABLE-INSTANCE WALKER::RELIST ++- UPDATE-DFUN USE-DISPATCH-DFUN-P PV-TABLE-LOOKUP-PV-ARGS ++- MAKE-WRAPPER EARLY-METHOD-SPECIALIZERS ++- INITIALIZE-METHOD-FUNCTION MAKE-FINAL-DFUN ++- WALKER::WALKER-ENVIRONMENT-BIND-1 MAKE-TYPE-PREDICATE-NAME ++- ALLOCATE-STRUCTURE-INSTANCE MAKE-SPECIALIZABLE ++- CAPITALIZE-WORDS SET-DFUN ITERATE::FUNCTION-LAMBDA-P ++- FIND-CLASS INITIALIZE-INTERNAL-SLOT-GFS SET-ARG-INFO ++- WALKER::RELIST* ALLOCATE-STANDARD-INSTANCE)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T) *) SAUT-NOT ENSURE-CLASS-VALUES ++- EMIT-CHECKING EMIT-DEFAULT-ONLY-FUNCTION EMIT-DEFAULT-ONLY ++- SAUT-CLASS CLASS-APPLICABLE-USING-CLASS-P EMIT-CACHING ++- DESTRUCTURE GET-NEW-FUNCTION-GENERATOR-INTERNAL ++- COMPUTE-TEST MAKE-DIRECT-SLOTD SLOT-NAME-LISTS-FROM-SLOTS ++- SAUT-EQL INSURE-DFUN CHECK-INITARGS-VALUES ++- SET-FUNCTION-NAME INITIAL-DFUN COMPUTE-STD-CPL-PHASE-1 ++- *SUBTYPEP COMPUTE-APPLICABLE-METHODS-USING-TYPES ++- SDFUN-FOR-CACHING INVOKE-EMF SPLIT-DECLARATIONS ++- GENERATE-FAST-CLASS-SLOT-ACCESS-P COMPUTE-CODE SLOT-VALUE ++- SPECIALIZER-APPLICABLE-USING-TYPE-P SLOT-BOUNDP ++- FORM-LIST-TO-LISP ITERATE::PARSE-DECLARATIONS ++- MAKE-INSTANCE-FUNCTION-TRAP SAUT-PROTOTYPE ++- MUTATE-SLOTS-AND-CALLS SAUT-AND SAUT-CLASS-EQ ++- FIND-SUPERCLASS-CHAIN SLOT-UNBOUND-INTERNAL ++- UPDATE-SLOT-VALUE-GF-INFO SLOT-MAKUNBOUND)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION NIL *) EMIT-N-N-WRITERS EMIT-N-N-READERS ++- COUNT-ALL-DFUNS)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T) T) CHECKING-FUNCTION ++- METHOD-CALL-CALL-METHOD-ARGS EARLY-COLLECT-CPL ++- METHOD-FUNCTION-PV-TABLE ECD-OTHER-INITARGS ++- BOOTSTRAP-CLASS-PREDICATES CONSTANT-SYMBOL-P GDEFINITION ++- %FBOUNDP INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION ++- MAKE-INSTANCE-FUNCTION-SYMBOL FGEN-TEST ++- GF-PRECOMPUTE-DFUN-AND-EMF-P VARIABLE-GLOBALLY-SPECIAL-P ++- SLOT-INITARGS-FROM-STRUCTURE-SLOTD ARG-INFO-P ++- STRUCTURE-TYPE-INTERNAL-SLOTDS CCLOSUREP CHECKING-CACHE ++- GF-LAMBDA-LIST ++- MAKE-OPTIMIZED-STRUCTURE-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++- STRUCTURE-SVUC-METHOD DISPATCH-CACHE ++- BOOTSTRAP-ACCESSOR-DEFINITIONS FINAL-ACCESSOR-DFUN-TYPE ++- SETFBOUNDP ONE-CLASS-P EARLY-GF-P UPDATE-C-A-M-GF-INFO ++- FGEN-GENSYMS SORT-SLOTS MAKE-CLASS-EQ-PREDICATE N-N-CACHE ++- SFUN-P DFUN-ARG-SYMBOL ++- INITIALIZE-INFO-CACHED-DEFAULT-INITARGS-FUNCTION ++- EARLY-METHOD-STANDARD-ACCESSOR-SLOT-NAME ++- MAKE-TYPE-PREDICATE SORT-CALLS ++- MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION TWO-CLASS-WRAPPER1 ++- USE-DEFAULT-METHOD-ONLY-DFUN-P FGEN-SYSTEM ++- CACHING-DFUN-COST CPD-CLASS CACHING-CACHE ++- INITIAL-DISPATCH-P LOOKUP-FGEN ++- COMPUTE-APPLICABLE-METHODS-EMF-STD-P COMPUTE-LINE-SIZE ++- GF-INFO-STATIC-C-A-M-EMF FAST-INSTANCE-BOUNDP-P ++- N-N-ACCESSOR-TYPE KEYWORD-SPEC-NAME DEFAULT-TEST-CONVERTER ++- RESET-INITIALIZE-INFO INITIAL-P ++- INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION-SYMBOL ++- EXPAND-MAKE-INSTANCE-FORM STRUCTURE-SLOT-BOUNDP ++- STANDARD-SVUC-METHOD TWO-CLASS-INDEX ++- EARLY-CLASS-PRECEDENCE-LIST MAKE-INITIAL-DFUN GMAKUNBOUND ++- METHODS-CONTAIN-EQL-SPECIALIZER-P EXPAND-SHORT-DEFCOMBIN ++- ACCESSOR-DFUN-INFO-CACHE MAKE-CALL-METHODS ++- STRUCTURE-SLOTD-NAME ALLOCATE-CACHE-VECTOR ++- RESET-CLASS-INITIALIZE-INFO GET-SETF-FUNCTION-NAME ++- METHOD-CALL-P LEGAL-CLASS-NAME-P EXTRACT-PARAMETERS ++- EARLY-SLOT-DEFINITION-NAME ECD-METACLASS DISPATCH-P ++- METHOD-FUNCTION-PLIST %STD-INSTANCE-SLOTS ++- CANONICAL-SLOT-NAME CONSTANT-VALUE-DFUN-INFO ++- FUNCTION-RETURNING-T FUNCTION-PRETTY-ARGLIST ++- STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST CHECK-WRAPPER-VALIDITY ++- INITIALIZE-INFO-P CPD-AFTER ++- MAKE-OPTIMIZED-STRUCTURE-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++- ONE-INDEX-INDEX WALKER::ENV-DECLARATIONS ++- STRUCTURE-SLOTD-TYPE MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION ++- EVAL-FORM LIST-DFUN ++- INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-T-FUNCTION ++- CACHE-OWNER FAST-METHOD-CALL-PV-CELL DFUN-INFO-P ++- UPDATE-PV-TABLE-CACHE-INFO EARLY-CLASS-SLOTDS ++- FUNCTION-RETURNING-NIL ECD-CLASS-NAME ++- TWO-CLASS-ACCESSOR-TYPE EARLY-CLASS-DEFINITION ++- FAST-METHOD-CALL-P INITIALIZE-INFO-CACHED-RI-VALID-P ++- COMPUTE-MCASE-PARAMETERS GF-DFUN-INFO ++- INITIALIZE-INFO-CACHED-COMBINED-INITARGS-FORM-LIST ++- EARLY-METHOD-LAMBDA-LIST ONE-CLASS-WRAPPER0 ++- CLASS-PRECEDENCE-DESCRIPTION-P GET-MAKE-INSTANCE-FUNCTIONS ++- EXPAND-LONG-DEFCOMBIN MAP-SPECIALIZERS ++- EARLY-CLASS-DIRECT-SUBCLASSES WALKER::ENV-WALK-FORM ++- STRUCTURE-TYPE-INCLUDED-TYPE-NAME ++- ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE GBOUNDP ECD-SOURCE ++- CLASS-FROM-TYPE INITIALIZE-INFO-CACHED-NEW-KEYS ++- ARG-INFO-NKEYS DEFAULT-CONSTANT-CONVERTER ++- INITIALIZE-INFO-CACHED-COMBINED-INITIALIZE-FUNCTION ++- STORE-FGEN EARLY-METHOD-STANDARD-ACCESSOR-P ++- INTERN-FUNCTION-NAME NET-TEST-CONVERTER ARG-INFO-KEY/REST-P ++- COMPLICATED-INSTANCE-CREATION-METHOD ++- FTYPE-DECLARATION-FROM-LAMBDA-LIST ++- GENERIC-CLOBBERS-FUNCTION DEFAULT-STRUCTUREP ++- GF-INFO-C-A-M-EMF-STD-P ARG-INFO-VALID-P ++- FORMAT-CYCLE-REASONS FAST-METHOD-CALL-ARG-INFO ++- GET-MAKE-INSTANCE-FUNCTION-SYMBOL %STD-INSTANCE-WRAPPER ++- SLOT-BOUNDP-SYMBOL INITIAL-CACHE ++- METHOD-FUNCTION-NEEDS-NEXT-METHODS-P ++- SYSTEM:%COMPILED-FUNCTION-NAME MAKE-CALLS-TYPE-DECLARATION ++- UPDATE-CLASS-CAN-PRECEDE-P SLOT-READER-SYMBOL FREE-CACHE ++- DNET-METHODS-P CONSTANT-VALUE-CACHE ++- GET-BUILT-IN-CLASS-SYMBOL UPDATE-GFS-OF-CLASS ++- ONE-CLASS-CACHE STD-INSTANCE-P ONE-INDEX-CACHE ++- STRUCTURE-SLOTD-WRITER-FUNCTION FGEN-GENERATOR-LAMBDA ++- EXTRACT-SPECIALIZER-NAMES EARLY-SLOT-DEFINITION-LOCATION ++- DO-STANDARD-DEFSETFS-FOR-DEFCLASS %CCLOSURE-ENV ++- EARLY-ACCESSOR-METHOD-SLOT-NAME ACCESSOR-DFUN-INFO-P ++- INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS SLOT-WRITER-SYMBOL ++- ARG-INFO-KEYWORDS INITIALIZE-INFO-WRAPPER ++- FAST-METHOD-CALL-NEXT-METHOD-CALL INITIAL-DISPATCH-CACHE ++- NEXT-WRAPPER-FIELD ++- INITIALIZE-INFO-CACHED-INITARGS-FORM-LIST CHECKING-P ++- EXTRACT-REQUIRED-PARAMETERS GET-BUILT-IN-WRAPPER-SYMBOL ++- INITIALIZE-INFO-CACHED-CONSTANTS ++- STRUCTURE-SLOTD-READER-FUNCTION EARLY-METHOD-CLASS ++- STRUCTURE-OBJECT-P DEFAULT-METHOD-ONLY-CACHE ++- PARSE-SPECIALIZERS INTERN-EQL-SPECIALIZER ++- COMPILE-LAMBDA-DEFERRED MAKE-CONSTANT-FUNCTION ++- MAKE-PV-TYPE-DECLARATION ARG-INFO-APPLYP ++- GET-PV-CELL-FOR-CLASS ONE-INDEX-DFUN-INFO-INDEX ++- UNENCAPSULATED-FDEFINITION CHECK-CACHE ++- WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE ++- INITIALIZE-INFO-KEY ONE-CLASS-INDEX SYSTEM:%STRUCTURE-NAME ++- SLOT-VECTOR-SYMBOL MAKE-PV-TABLE-TYPE-DECLARATION ++- TWO-CLASS-CACHE PROCLAIM-INCOMPATIBLE-SUPERCLASSES ++- BUILT-IN-OR-STRUCTURE-WRAPPER1 ECD-SUPERCLASS-NAMES ++- STRUCTURE-TYPE CLASS-HAS-A-FORWARD-REFERENCED-SUPERCLASS-P ++- N-N-P INTERNED-SYMBOL-P DEFAULT-METHOD-ONLY-P ++- EARLY-CLASS-SLOTS NO-METHODS-P ARG-INFO-NUMBER-OPTIONAL ++- ONE-INDEX-P GET-MAKE-INSTANCE-FUNCTION EARLY-CLASS-NAME ++- METHOD-FUNCTION-FROM-FAST-FUNCTION MAKE-PERMUTATION-VECTOR ++- ONE-CLASS-ACCESSOR-TYPE TWO-CLASS-P BUILT-IN-WRAPPER-OF ++- FREE-CACHE-VECTOR GET-CACHE-VECTOR ARG-INFO-LAMBDA-LIST ++- UPDATE-GF-INFO ONE-INDEX-DFUN-INFO-CACHE %SYMBOL-FUNCTION ++- ACCESSOR-DFUN-INFO-ACCESSOR-TYPE FUNCALLABLE-INSTANCE-P ++- ECD-CANONICAL-SLOTS EARLY-COLLECT-SLOTS ++- INITIALIZE-INFO-CACHED-VALID-P UNPARSE-SPECIALIZERS ++- GF-INFO-FAST-MF-P ++- MAKE-OPTIMIZED-STRUCTURE-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION ++- EARLY-CLASS-NAME-OF GF-DFUN-CACHE CLASS-PREDICATE ++- EXTRACT-LAMBDA-LIST CLASS-OF COPY-CACHE SYMBOL-PKG-NAME ++- ONE-INDEX-DFUN-INFO-P WRAPPER-OF METHOD-FUNCTION-METHOD ++- CPD-SUPERS DEFAULT-STRUCTURE-INSTANCE-P ++- STRUCTURE-SLOTD-INIT-FORM EARLY-METHOD-QUALIFIERS ++- LIST-LARGE-CACHE UPDATE-GF-SIMPLE-ACCESSOR-TYPE TYPE-CLASS ++- MAKE-EQL-PREDICATE EARLY-GF-NAME UPDATE-ALL-C-A-M-GF-INFO ++- FLUSH-CACHE-VECTOR-INTERNAL ITERATE::SEQUENCE-ACCESSOR ++- MAP-ALL-GENERIC-FUNCTIONS STRUCTURE-TYPE-P ++- FIND-CYCLE-REASONS DEFAULT-STRUCTURE-TYPE ++- COMPUTE-CLASS-SLOTS WRAPPER-FOR-STRUCTURE ++- INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-NIL-FUNCTION ++- USE-CACHING-DFUN-P EARLY-COLLECT-DEFAULT-INITARGS ++- DEFAULT-SECONDARY-DISPATCH-FUNCTION ONE-INDEX-ACCESSOR-TYPE ++- WALKER::ENV-WALK-FUNCTION WALKER::ENV-LOCK ++- STRUCTURE-SLOTD-ACCESSOR-SYMBOL ++- METHOD-LL->GENERIC-FUNCTION-LL CACHE-P WRAPPER-FIELD ++- INITIALIZE-INFO-BOUND-SLOTS DEFAULT-CONSTANTP ++- MAKE-FUNCTION-INLINE COMPUTE-STD-CPL-PHASE-2 ++- CACHING-DFUN-INFO CONSTANT-VALUE-P ++- WALKER::GET-WALKER-TEMPLATE ARG-INFO-METATYPES COUNT-DFUN ++- MAKE-INITFUNCTION WALKER::ENV-LEXICAL-VARIABLES PV-TABLEP ++- COMPILE-LAMBDA-UNCOMPILED UNDEFMETHOD-1 ++- GF-INFO-SIMPLE-ACCESSOR-TYPE FORCE-CACHE-FLUSHES ++- DFUN-INFO-CACHE GFS-OF-TYPE TWO-CLASS-WRAPPER0 ++- ITERATE::VARIABLES-FROM-LET SHOW-DFUN-COSTS ++- ARG-INFO-PRECEDENCE FGEN-GENERATOR ++- RESET-CLASS-INITIALIZE-INFO-1 CACHING-P NO-METHODS-CACHE)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (*) *) INVALID-METHOD-ERROR ++- METHOD-COMBINATION-ERROR UNTRACE-METHOD ++- UPDATE-MAKE-INSTANCE-FUNCTION-TABLE LIST-LARGE-CACHES)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T) LIST) CACHE-OVERFLOW PV-TABLE-SLOT-NAME-LISTS ++- PV-TABLE-CALL-LIST)) ++-(PROCLAIM '(FTYPE (FUNCTION (T) BOOLEAN) CACHE-VALUEP)) ++-(PROCLAIM '(FTYPE (FUNCTION NIL FIXNUM) GET-WRAPPER-CACHE-NUMBER)) ++-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM T) T) %CCLOSURE-ENV-NTHCDR)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T T) *) ++- COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL ++- WALK-METHOD-LAMBDA ++- |(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| ++- |(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| ++- |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| ++- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| ++- |(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| ++- |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| ++- |(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| ++- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| ++- ADD-METHOD-DECLARATIONS ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| ++- MAKE-TWO-CLASS-ACCESSOR-DFUN ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| ++- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| ++- |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| ++- |(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| ++- |(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| ++- |(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))|)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T T T T) *) ++- |(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| ++- ITERATE::ITERATE-TRANSFORM-BODY)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T *) *) ITERATE::RENAME-LET-BINDINGS ++- MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T) *) CONSTANT-VALUE-MISS ++- EMIT-ONE-OR-N-INDEX-READER/WRITER CACHING-MISS ++- CACHE-MISS-VALUES ++- |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| ++- WALKER::WALK-FORM-INTERNAL ++- GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION ++- SLOT-VALUE-USING-CLASS-DFUN SLOT-BOUNDP-USING-CLASS-DFUN ++- |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| ++- |(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| ++- |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| ++- MAKE-FINAL-CONSTANT-VALUE-DFUN CHECK-METHOD-ARG-INFO ++- MAKE-OPTIMIZED-STD-BOUNDP-METHOD-FUNCTION ++- MAKE-FINAL-CACHING-DFUN EMIT-READER/WRITER-FUNCTION ++- SET-SLOT-VALUE ++- |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| ++- WALKER::WALK-LET-IF ACCESSOR-VALUES1 ++- |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| ++- ITERATE::EXPAND-INTO-LET OPTIMIZE-SLOT-VALUE-BY-CLASS-P ++- ITERATE::RENAME-VARIABLES ++- EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION CHECKING-MISS ++- |(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| ++- ACCESSOR-VALUES-INTERNAL GET-CLASS-SLOT-VALUE-1 ++- LOAD-LONG-DEFCOMBIN ++- |(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| ++- |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| ++- MAKE-OPTIMIZED-STD-WRITER-METHOD-FUNCTION ++- |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| ++- MAKE-OPTIMIZED-STD-READER-METHOD-FUNCTION ++- EMIT-READER/WRITER GENERATING-LISP ++- MAKE-FINAL-N-N-ACCESSOR-DFUN ++- |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| ++- ITERATE::WALK-GATHERING-BODY ++- |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| ++- GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++- CONVERT-METHODS)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T) *) BOOTSTRAP-ACCESSOR-DEFINITION ++- INITIALIZE-INSTANCE-SIMPLE-FUNCTION ++- |(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))| ++- ORDER-SPECIALIZERS MAKE-ONE-CLASS-ACCESSOR-DFUN ++- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| ++- |(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| ++- GET-ACCESSOR-FROM-SVUC-METHOD-FUNCTION ++- |(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| ++- SETF-SLOT-VALUE-USING-CLASS-DFUN ++- GENERATE-DISCRIMINATION-NET ++- MAKE-FINAL-ONE-INDEX-ACCESSOR-DFUN ++- |(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| ++- |(FAST-METHOD DESCRIBE-OBJECT (T T))| ACCESSOR-VALUES ++- LOAD-SHORT-DEFCOMBIN SET-CLASS-SLOT-VALUE-1 ++- |(FAST-METHOD MAKE-INSTANCE (SYMBOL))| ++- REAL-MAKE-METHOD-LAMBDA EMIT-CHECKING-OR-CACHING-FUNCTION ++- |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| ++- |(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| ++- MAKE-SHARED-INITIALIZE-FORM-LIST ++- |(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| ++- ACCESSOR-MISS |(FAST-METHOD NO-APPLICABLE-METHOD (T))| ++- MAKE-FINAL-CHECKING-DFUN ++- |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| ++- GET-ACCESSOR-METHOD-FUNCTION ++- |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| ++- |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| ++- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| ++- |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| ++- |(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| ++- |(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| ++- |(FAST-METHOD CHANGE-CLASS (T SYMBOL))| ++- EMIT-CHECKING-OR-CACHING)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T T T) *) MEMF-CODE-CONVERTER ++- |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++- GENERATE-DISCRIMINATION-NET-INTERNAL ++- DO-SHORT-METHOD-COMBINATION ++- MAKE-LONG-METHOD-COMBINATION-FUNCTION ++- CACHE-MISS-VALUES-INTERNAL)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T *) *) MAKE-ONE-INDEX-ACCESSOR-DFUN ++- WALKER::WALK-DECLARATIONS GET-SECONDARY-DISPATCH-FUNCTION)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T *) *) SLOT-VALUE-OR-DEFAULT NESTED-WALK-FORM ++- LOAD-DEFGENERIC MAKE-ACCESSOR-TABLE ++- MAKE-DEFAULT-INITARGS-FORM-LIST ++- GET-EFFECTIVE-METHOD-FUNCTION MAKE-CHECKING-DFUN ++- GET-COMPLEX-INITIALIZATION-FUNCTIONS MAKE-N-N-ACCESSOR-DFUN ++- GET-SIMPLE-INITIALIZATION-FUNCTION MAKE-FINAL-ACCESSOR-DFUN ++- TYPES-FROM-ARGUMENTS MAKE-EFFECTIVE-METHOD-FUNCTION ++- COMPUTE-SECONDARY-DISPATCH-FUNCTION)) ++-(PROCLAIM '(FTYPE (FUNCTION (T T T T T T *) *) REAL-MAKE-A-METHOD)) ++-(PROCLAIM '(FTYPE (FUNCTION (T) SIMPLE-VECTOR) CACHE-VECTOR)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T T T) T) BOOTSTRAP-MAKE-SLOT-DEFINITION ++- |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++- LOAD-DEFCLASS MAKE-EARLY-CLASS-DEFINITION ++- WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1 OPTIMIZE-GF-CALL ++- EMIT-SLOT-ACCESS REAL-LOAD-DEFCLASS SET-ARG-INFO1)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T T) T) ++- |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| ++- |(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| ++- |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| ++- |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| ++- EXPAND-EMF-CALL-METHOD ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| ++- COMPUTE-PV-SLOT ++- |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| ++- UPDATE-SLOTS-IN-PV BOOTSTRAP-MAKE-SLOT-DEFINITIONS ++- WALKER::WALK-TEMPLATE-HANDLE-REPEAT WALKER::WALK-BINDINGS-1 ++- OPTIMIZE-ACCESSOR-CALL REAL-MAKE-METHOD-INITARGS-FORM ++- |(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| ++- |(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| ++- MAKE-EMF-CACHE MAKE-METHOD-INITARGS-FORM-INTERNAL1 ++- BOOTSTRAP-ACCESSOR-DEFINITIONS1 ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| ++- MAKE-INSTANCE-FUNCTION-COMPLEX MAKE-FGEN ++- |(FAST-METHOD REMOVE-NAMED-METHOD (T T))| ++- |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| ++- MAKE-FINAL-ORDINARY-DFUN-INTERNAL ++- |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++- MAKE-INSTANCE-FUNCTION-SIMPLE OPTIMIZE-INSTANCE-ACCESS ++- MAKE-PARAMETER-REFERENCES ++- GET-MAKE-INSTANCE-FUNCTION-INTERNAL ++- |(FAST-METHOD SLOT-UNBOUND (T T T))| ++- |(FAST-METHOD (SETF DOCUMENTATION) (T T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| ++- |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++- LOAD-FUNCTION-GENERATOR ++- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| ++- |(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| ++- |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| ++- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| ++- OPTIMIZE-GENERIC-FUNCTION-CALL)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T *) T) EMIT-FETCH-WRAPPER FILL-CACHE ++- GET-METHOD CHECK-INITARGS-2-PLIST MAKE-EMF-CALL ++- CHECK-INITARGS-1 WALKER::WALK-ARGLIST REAL-GET-METHOD ++- CAN-OPTIMIZE-ACCESS1 CHECK-INITARGS-2-LIST)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T) T) ONE-CLASS-DFUN-INFO ++- |(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| SORT-METHODS ++- OPTIMIZE-GF-CALL-INTERNAL WALKER::WALK-LABELS ++- |(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| ++- |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| ++- WALKER::WALK-DO ++- |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| ++- ITERATE::RENAME-AND-CAPTURE-VARIABLES EXPAND-DEFGENERIC ++- |(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| ++- |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| ++- FLUSH-CACHE-TRAP WALKER::WALK-MACROLET ++- |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| ++- |(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| ++- COMPUTE-EFFECTIVE-METHOD OPTIMIZE-SET-SLOT-VALUE ++- WALKER::WALK-SYMBOL-MACROLET OPTIMIZE-SLOT-BOUNDP ++- |(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| ++- GET-FUNCTION-GENERATOR FIX-SLOT-ACCESSORS ++- SET-FUNCTION-NAME-1 WALKER::WALK-LET EMIT-BOUNDP-CHECK ++- INITIALIZE-INTERNAL-SLOT-GFS* PRINT-CACHE WALKER::WALK-IF ++- WALKER::WALK-SETQ WALKER::RELIST-INTERNAL ++- |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| ++- EMIT-1-T-DLAP CAN-OPTIMIZE-ACCESS WALKER::WALK-COMPILER-LET ++- |(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| ++- |SETF PCL METHOD-FUNCTION-GET| ++- |(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| ++- GET-NEW-FUNCTION-GENERATOR WALKER::WALK-UNEXPECTED-DECLARE ++- |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| ++- VARIABLE-DECLARATION ++- |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| ++- MAP-ALL-ORDERS ONE-INDEX-DFUN-INFO WALKER::WALK-LAMBDA ++- |(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| ++- NOTE-PV-TABLE-REFERENCE WALKER::RECONS ++- STANDARD-COMPUTE-EFFECTIVE-METHOD ++- |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| ++- |SETF PCL PLIST-VALUE| EMIT-GREATER-THAN-1-DLAP ++- MAKE-METHOD-SPEC ITERATE::OPTIMIZE-GATHERING-FORM ++- OPTIMIZE-SLOT-VALUE PRINT-STD-INSTANCE COMPUTE-PRECEDENCE ++- WALKER::WALK-TAGBODY WALKER::WALK-NAMED-LAMBDA ++- |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| ++- SKIP-FAST-SLOT-ACCESS-P TRACE-EMF-CALL-INTERNAL ++- |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| ++- |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| ++- |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| ++- ITERATE::SIMPLE-EXPAND-GATHERING-FORM ++- |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| ++- SORT-APPLICABLE-METHODS SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P ++- OBSOLETE-INSTANCE-TRAP WALKER::WALK-PROG ++- |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| ++- INVALIDATE-WRAPPER ++- |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| ++- |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++- |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++- ENTRY-IN-CACHE-P WALKER::WALK-TAGBODY-1 ++- |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| ++- MAKE-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++- |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| ++- WALKER::WALK-LOCALLY WALKER::WALK-MULTIPLE-VALUE-BIND ++- |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| ++- WRAP-METHOD-GROUP-SPECIFIER-BINDINGS WALKER::WALK-LET* ++- |(FAST-METHOD CLASS-PREDICATE-NAME (T))| ++- |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| ++- |(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| ++- EMIT-SLOT-READ-FORM FIRST-FORM-TO-LISP ++- MAKE-OPTIMIZED-STD-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION ++- |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| ++- WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL ++- WALKER::WALK-PROG* WALKER::WALK-FLET ++- |(FAST-METHOD SPECIALIZER-CLASS (CLASS))| ++- MAKE-OPTIMIZED-STD-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++- |(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| ++- MAKE-METHOD-INITARGS-FORM-INTERNAL WALKER::WALK-DO* ++- MAKE-TOP-LEVEL-FORM ++- |(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| ++- |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| ++- |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| ++- ITERATE::OPTIMIZE-ITERATE-FORM DECLARE-STRUCTURE ++- MAKE-DFUN-CALL ITERATE::VARIABLE-SAME-P ++- |(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++- WALKER::WALK-MULTIPLE-VALUE-SETQ CONVERT-TABLE ++- |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| ++- |(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))|)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T) T) ++- |(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| ++- EMIT-CHECKING-OR-CACHING-FUNCTION-PRELIMINARY ++- |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| ++- WALKER::WALK-LET/LET* ++- |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++- |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| ++- |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| ++- MAKE-EFFECTIVE-METHOD-FUNCTION-TYPE ++- |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| ++- |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++- |(FAST-METHOD DOCUMENTATION (T))| ++- |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| ++- MAYBE-EXPAND-ACCESSOR-FORM BOOTSTRAP-SET-SLOT ++- |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| ++- WALKER::WALK-TEMPLATE ++- |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| ++- |(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| ++- |(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))| ++- GET-WRAPPERS-FROM-CLASSES ++- |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| ++- MAKE-EFFECTIVE-METHOD-FUNCTION1 ++- |(FAST-METHOD PRINT-OBJECT (CLASS T))| ++- |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| ++- |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| ++- EXPAND-CACHE EXPAND-DEFCLASS ++- |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| ++- |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| ++- |(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| ++- |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| ++- |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| ++- |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| ++- |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++- MAKE-EFFECTIVE-METHOD-FUNCTION-INTERNAL ++- |(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| ++- |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++- |(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| ++- TWO-CLASS-DFUN-INFO ++- |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++- |(FAST-METHOD PRINT-OBJECT (T T))| ++- |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| ++- FILL-CACHE-P MEMF-TEST-CONVERTER ++- |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| ++- WALKER::WALK-BINDINGS-2 ++- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| ++- |(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++- |(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| ++- |(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++- |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| ++- WALKER::WALK-DO/DO* ADJUST-CACHE ++- |(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++- |(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++- |(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| ++- OPTIMIZE-READER ++- |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| ++- |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| ++- |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| ++- EXPAND-SYMBOL-MACROLET-INTERNAL ++- |(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| ++- |(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| ++- MAKE-DISPATCH-LAMBDA ++- |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| ++- |(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| ++- INITIALIZE-INSTANCE-SIMPLE ++- |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| ++- OPTIMIZE-WRITER ++- |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| ++- |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| ++- |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| ++- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++- LOAD-PRECOMPILED-IIS-ENTRY ++- LOAD-PRECOMPILED-DFUN-CONSTRUCTOR ++- |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| ++- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++- |(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| ++- WALKER::WALK-PROG/PROG* ++- |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| ++- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| ++- |(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| ++- |(FAST-METHOD MAKE-INSTANCE (CLASS))| ++- |(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| ++- |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| ++- |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))|)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T *) T) COMPUTE-SECONDARY-DISPATCH-FUNCTION1 ++- FIND-CLASS-PREDICATE-FROM-CELL ++- ENSURE-GENERIC-FUNCTION-USING-CLASS GET-DECLARATION ++- METHOD-FUNCTION-GET CPL-ERROR EMIT-MISS ++- PRECOMPUTE-EFFECTIVE-METHODS GET-METHOD-FUNCTION-PV-CELL ++- MAP-CACHE EXPAND-EFFECTIVE-METHOD-FUNCTION ++- MAKE-EMF-FROM-METHOD GET-EFFECTIVE-METHOD-FUNCTION1 ++- REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION ++- NAMED-OBJECT-PRINT-FUNCTION ++- MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE PROBE-CACHE ++- INITIALIZE-INFO REAL-ENSURE-GF-USING-CLASS--NULL ++- FIND-CLASS-FROM-CELL WALKER::CONVERT-MACRO-TO-LAMBDA ++- REAL-ADD-METHOD RECORD-DEFINITION)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T T T *) T) MAKE-DEFMETHOD-FORM ++- MAKE-DEFMETHOD-FORM-INTERNAL LOAD-DEFMETHOD ++- EARLY-MAKE-A-METHOD)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T T *) T) EMIT-DLAP ++- GET-SECONDARY-DISPATCH-FUNCTION1)) ++-(PROCLAIM '(FTYPE (FUNCTION (T T FIXNUM) T) COMPUTE-STD-CPL-PHASE-3)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T T T T T) T) ++- GET-SECONDARY-DISPATCH-FUNCTION2)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T *) T) REAL-ADD-NAMED-METHOD ++- EARLY-ADD-NAMED-METHOD FILL-DFUN-CACHE)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T T T T) T) ++- |(FAST-METHOD SLOT-MISSING (T T T T))| ++- LOAD-DEFMETHOD-INTERNAL EXPAND-DEFMETHOD)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T FIXNUM) T) GET-CACHE ++- FILL-CACHE-FROM-CACHE-P)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T T T T T T T T T *) T) ++- BOOTSTRAP-INITIALIZE-CLASS)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T) FIXNUM) N-N-ACCESSORS-LIMIT-FN ++- FAST-INSTANCE-BOUNDP-INDEX PV-TABLE-PV-SIZE ++- ARG-INFO-NUMBER-REQUIRED EARLY-CLASS-SIZE DEFAULT-LIMIT-FN ++- CHECKING-LIMIT-FN ONE-INDEX-LIMIT-FN CPD-COUNT CACHE-COUNT ++- PV-CACHE-LIMIT-FN CACHING-LIMIT-FN)) ++-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM) T) POWER-OF-TWO-CEILING)) ++-(PROCLAIM '(FTYPE (FUNCTION (T T *) (VALUES T T)) SYMBOL-APPEND)) ++-(PROCLAIM '(FTYPE (FUNCTION (T STREAM T) T) PRINT-DFUN-INFO)) ++-(PROCLAIM ++- '(FTYPE (FUNCTION (T) NON-NEGATIVE-FIXNUM) CACHE-NLINES CACHE-MASK ++- CACHE-MAX-LOCATION CACHE-SIZE)) +++(COMMON-LISP::IN-PACKAGE "PCL") +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FUNCTION) +++ PCL::CACHE-LIMIT-FN PCL::FAST-METHOD-CALL-FUNCTION +++ PCL::METHOD-CALL-FUNCTION)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +++ PCL::DISPATCH-DFUN-INFO PCL::DEFAULT-METHOD-ONLY-DFUN-INFO +++ PCL::MAKE-CACHE PCL::BOOTSTRAP-BUILT-IN-CLASSES +++ PCL::RENEW-SYS-FILES PCL::SHOW-EMF-CALL-TRACE PCL::MAKE-CPD +++ PCL::BOOTSTRAP-META-BRAID PCL::CACHES-TO-ALLOCATE +++ PCL::LIST-ALL-DFUNS PCL::INITIAL-DISPATCH-DFUN-INFO +++ PCL::INITIAL-DFUN-INFO PCL::%%ALLOCATE-INSTANCE--CLASS +++ PCL::MAKE-ARG-INFO PCL::ALLOCATE-FUNCALLABLE-INSTANCE-2 +++ PCL::SHOW-FREE-CACHE-VECTORS PCL::UPDATE-DISPATCH-DFUNS +++ PCL::GET-EFFECTIVE-METHOD-GENSYM PCL::IN-THE-COMPILER-P +++ PCL::SHOW-DFUN-CONSTRUCTORS PCL::NO-METHODS-DFUN-INFO +++ PCL::INITIALIZE-CHECKING-OR-CACHING-FUNCTION-LIST +++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE-1 +++ PCL::STRUCTURE-FUNCTIONS-EXIST-P)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) PCL::FIELD-TYPE) +++ PCL::CACHE-FIELD)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ COMMON-LISP::SIMPLE-VECTOR) +++ PCL::CACHE-VECTOR)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ (COMMON-LISP::INTEGER 1 256)) +++ PCL::CACHE-LINE-SIZE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ (COMMON-LISP::INTEGER 1 255)) +++ PCL::CACHE-NKEYS)) +++(COMMON-LISP::MAPC +++ (COMMON-LISP::LAMBDA (COMPILER::X) +++ (COMMON-LISP::SETF +++ (COMMON-LISP::GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE) +++ COMMON-LISP::T)) +++ '(PCL::REDEFINE-FUNCTION PCL::DO-STANDARD-DEFSETF-1 +++ PCL::FDEFINE-CAREFULLY PCL::TRACE-METHOD-INTERNAL)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) +++ PCL::SYMBOL-APPEND)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +++ PCL::FAST-METHOD-CALL-NEXT-METHOD-CALL +++ PCL::GENERIC-CLOBBERS-FUNCTION PCL::STRUCTURE-SLOTD-TYPE +++ WALKER::GET-WALKER-TEMPLATE PCL::COMPILE-LAMBDA-UNCOMPILED +++ PCL::EXTRACT-LAMBDA-LIST PCL::DEFAULT-METHOD-ONLY-P +++ PCL::DISPATCH-CACHE PCL::STRUCTURE-SLOTD-NAME +++ PCL::FAST-METHOD-CALL-P PCL::SFUN-P +++ PCL::FTYPE-DECLARATION-FROM-LAMBDA-LIST +++ PCL::EARLY-CLASS-DEFINITION PCL::CONSTANT-SYMBOL-P +++ PCL::ARG-INFO-LAMBDA-LIST WALKER::ENV-LEXICAL-VARIABLES +++ PCL::INTERN-EQL-SPECIALIZER PCL::PARSE-SPECIALIZERS +++ PCL::%STD-INSTANCE-WRAPPER PCL::UPDATE-ALL-C-A-M-GF-INFO +++ PCL::INITIALIZE-INFO-CACHED-COMBINED-INITIALIZE-FUNCTION +++ PCL::STORE-FGEN PCL::COMPUTE-MCASE-PARAMETERS +++ PCL::INTERNED-SYMBOL-P PCL::MAKE-CALL-METHODS +++ PCL::USE-CACHING-DFUN-P PCL::LEGAL-CLASS-NAME-P +++ WALKER::VARIABLE-GLOBALLY-SPECIAL-P PCL::FUNCTION-RETURNING-T +++ PCL::METHOD-FUNCTION-METHOD PCL::GET-BUILT-IN-CLASS-SYMBOL +++ PCL::DEFAULT-STRUCTURE-TYPE PCL::GF-DFUN-INFO PCL::CACHING-P +++ PCL::FREE-CACHE-VECTOR PCL::ONE-CLASS-CACHE +++ PCL::DEFAULT-TEST-CONVERTER PCL::UNDEFMETHOD-1 +++ PCL::MAKE-INITFUNCTION PCL::GET-CACHE-VECTOR +++ PCL::CLASS-PRECEDENCE-DESCRIPTION-P PCL::GF-INFO-FAST-MF-P +++ PCL::ECD-SOURCE PCL::INITIAL-P PCL::ARG-INFO-APPLYP +++ PCL::ARG-INFO-KEYWORDS +++ PCL::MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION +++ PCL::CACHING-DFUN-COST PCL::INITIAL-DISPATCH-P PCL::EVAL-FORM +++ PCL::MAKE-CONSTANT-FUNCTION PCL::FUNCTION-RETURNING-NIL +++ PCL::INITIALIZE-INFO-BOUND-SLOTS PCL::FGEN-GENSYMS +++ PCL::EXPAND-SHORT-DEFCOMBIN WALKER::ENV-LOCK +++ PCL::INITIALIZE-INFO-CACHED-CONSTANTS +++ PCL::INITIALIZE-INFO-WRAPPER +++ PCL::STRUCTURE-TYPE-INCLUDED-TYPE-NAME PCL::TWO-CLASS-INDEX +++ PCL::ONE-INDEX-ACCESSOR-TYPE +++ PCL::EARLY-COLLECT-DEFAULT-INITARGS WALKER::ENV-WALK-FORM +++ PCL::STRUCTURE-TYPE-INTERNAL-SLOTDS PCL::MAKE-FUNCTION-INLINE +++ PCL::FLUSH-CACHE-VECTOR-INTERNAL +++ PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-T-FUNCTION +++ PCL::FGEN-GENERATOR PCL::CONSTANT-VALUE-P +++ PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION +++ PCL::EARLY-CLASS-PRECEDENCE-LIST PCL::SLOT-BOUNDP-SYMBOL +++ PCL::ARG-INFO-NUMBER-OPTIONAL +++ PCL::GF-PRECOMPUTE-DFUN-AND-EMF-P PCL::GET-PV-CELL-FOR-CLASS +++ PCL::CHECKING-FUNCTION PCL::USE-DEFAULT-METHOD-ONLY-DFUN-P +++ PCL::INITIAL-DISPATCH-CACHE PCL::STRUCTURE-SVUC-METHOD +++ PCL::NO-METHODS-CACHE PCL::GF-DFUN-CACHE PCL::%CCLOSURE-ENV +++ PCL::CONSTANT-VALUE-CACHE PCL::BUILT-IN-WRAPPER-OF +++ PCL::CLASS-HAS-A-FORWARD-REFERENCED-SUPERCLASS-P +++ PCL::EARLY-COLLECT-CPL COMMON-LISP::CLASS-OF +++ PCL::STRUCTURE-SLOTD-ACCESSOR-SYMBOL PCL::SYMBOL-PKG-NAME +++ PCL::GDEFINITION +++ PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-NIL-FUNCTION +++ PCL::ACCESSOR-DFUN-INFO-CACHE PCL::EXTRACT-SPECIALIZER-NAMES +++ PCL::CHECK-WRAPPER-VALIDITY PCL::MAKE-INITIAL-DFUN +++ PCL::WRAPPER-FIELD PCL::EARLY-SLOT-DEFINITION-LOCATION +++ PCL::EARLY-GF-P PCL::GF-INFO-STATIC-C-A-M-EMF PCL::LOOKUP-FGEN +++ PCL::MAKE-PV-TYPE-DECLARATION +++ PCL::INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS +++ PCL::EARLY-METHOD-CLASS +++ PCL::DEFAULT-SECONDARY-DISPATCH-FUNCTION +++ WALKER::ENV-DECLARATIONS PCL::ALLOCATE-CACHE-VECTOR +++ PCL::FUNCTION-PRETTY-ARGLIST +++ PCL::EARLY-CLASS-DIRECT-SUBCLASSES +++ PCL::COMPUTE-APPLICABLE-METHODS-EMF-STD-P +++ PCL::MAKE-CLASS-EQ-PREDICATE PCL::ECD-OTHER-INITARGS +++ PCL::GBOUNDP PCL::METHOD-FUNCTION-PV-TABLE +++ WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE +++ PCL::MAKE-INSTANCE-FUNCTION-SYMBOL +++ PCL::MAKE-OPTIMIZED-STRUCTURE-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +++ PCL::FIND-CYCLE-REASONS PCL::FGEN-TEST +++ PCL::SLOT-INITARGS-FROM-STRUCTURE-SLOTD PCL::FREE-CACHE +++ PCL::TYPE-CLASS PCL::INITIAL-CACHE +++ PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS +++ PCL::STRUCTURE-SLOTD-WRITER-FUNCTION +++ PCL::INITIALIZE-INFO-CACHED-DEFAULT-INITARGS-FUNCTION +++ PCL::EARLY-COLLECT-SLOTS PCL::LIST-DFUN +++ PCL::EXPAND-MAKE-INSTANCE-FORM PCL::N-N-CACHE +++ PCL::MAKE-TYPE-PREDICATE PCL::INTERN-FUNCTION-NAME +++ PCL::GET-MAKE-INSTANCE-FUNCTIONS WALKER::ENV-WALK-FUNCTION +++ PCL::TWO-CLASS-CACHE PCL::MAKE-CALLS-TYPE-DECLARATION +++ PCL::MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION +++ PCL::INITIALIZE-INFO-KEY PCL::GF-LAMBDA-LIST +++ ITERATE::VARIABLES-FROM-LET PCL::COMPUTE-CLASS-SLOTS +++ PCL::DFUN-ARG-SYMBOL PCL::CHECKING-P PCL::ARG-INFO-P +++ PCL::INITIALIZE-INFO-CACHED-RI-VALID-P PCL::CHECKING-CACHE +++ PCL::METHOD-FUNCTION-PLIST PCL::STRUCTURE-OBJECT-P +++ PCL::ARG-INFO-PRECEDENCE PCL::ONE-CLASS-INDEX +++ PCL::STD-INSTANCE-P PCL::STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST +++ PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +++ PCL::EARLY-SLOT-DEFINITION-NAME PCL::UNPARSE-SPECIALIZERS +++ PCL::STRUCTURE-TYPE-P PCL::ACCESSOR-DFUN-INFO-ACCESSOR-TYPE +++ PCL::PV-TABLEP PCL::CLASS-FROM-TYPE +++ PCL::GF-INFO-SIMPLE-ACCESSOR-TYPE PCL::STRUCTURE-TYPE +++ PCL::MAKE-EQL-PREDICATE PCL::TWO-CLASS-ACCESSOR-TYPE +++ PCL::DEFAULT-STRUCTURE-INSTANCE-P +++ PCL::EARLY-METHOD-STANDARD-ACCESSOR-SLOT-NAME +++ PCL::ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE PCL::GFS-OF-TYPE +++ PCL::DEFAULT-STRUCTUREP PCL::EARLY-CLASS-NAME-OF +++ PCL::%STD-INSTANCE-SLOTS PCL::ONE-INDEX-INDEX PCL::WRAPPER-OF +++ PCL::ARG-INFO-VALID-P PCL::KEYWORD-SPEC-NAME +++ PCL::METHOD-CALL-P PCL::SHOW-DFUN-COSTS PCL::DFUN-INFO-CACHE +++ PCL::DEFAULT-CONSTANT-CONVERTER ITERATE::SEQUENCE-ACCESSOR +++ PCL::COUNT-DFUN PCL::EXPAND-LONG-DEFCOMBIN +++ PCL::CACHING-DFUN-INFO PCL::INITIALIZE-INFO-CACHED-VALID-P +++ PCL::FAST-INSTANCE-BOUNDP-P PCL::ARG-INFO-METATYPES +++ PCL::EXTRACT-PARAMETERS PCL::GF-INFO-C-A-M-EMF-STD-P +++ PCL::FINAL-ACCESSOR-DFUN-TYPE PCL::GMAKUNBOUND +++ PCL::FAST-METHOD-CALL-ARG-INFO PCL::COMPUTE-LINE-SIZE +++ PCL::ONE-INDEX-CACHE PCL::NO-METHODS-P +++ PCL::COMPUTE-STD-CPL-PHASE-2 +++ PCL::COMPLICATED-INSTANCE-CREATION-METHOD +++ PCL::MAKE-PERMUTATION-VECTOR PCL::CONSTANT-VALUE-DFUN-INFO +++ PCL::TWO-CLASS-WRAPPER1 PCL::MAP-ALL-GENERIC-FUNCTIONS +++ PCL::CLASS-PREDICATE SYSTEM::%STRUCTURE-NAME +++ PCL::RESET-CLASS-INITIALIZE-INFO +++ PCL::BUILT-IN-OR-STRUCTURE-WRAPPER1 PCL::EARLY-CLASS-NAME +++ PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION-SYMBOL +++ PCL::UPDATE-PV-TABLE-CACHE-INFO PCL::SLOT-READER-SYMBOL +++ PCL::ARG-INFO-NKEYS PCL::METHOD-CALL-CALL-METHOD-ARGS +++ PCL::CCLOSUREP PCL::DEFAULT-METHOD-ONLY-CACHE +++ PCL::NEXT-WRAPPER-FIELD PCL::SLOT-WRITER-SYMBOL +++ PCL::ACCESSOR-DFUN-INFO-P +++ PCL::GET-MAKE-INSTANCE-FUNCTION-SYMBOL +++ PCL::EXTRACT-REQUIRED-PARAMETERS PCL::FORMAT-CYCLE-REASONS +++ PCL::UNENCAPSULATED-FDEFINITION +++ PCL::GET-BUILT-IN-WRAPPER-SYMBOL PCL::ONE-CLASS-P +++ PCL::ECD-METACLASS PCL::METHOD-LL->GENERIC-FUNCTION-LL +++ PCL::PROCLAIM-INCOMPATIBLE-SUPERCLASSES PCL::ONE-INDEX-P +++ PCL::INITIALIZE-INFO-CACHED-INITARGS-FORM-LIST +++ PCL::ECD-CANONICAL-SLOTS +++ PCL::METHOD-FUNCTION-NEEDS-NEXT-METHODS-P +++ PCL::INITIALIZE-INFO-CACHED-NEW-KEYS +++ PCL::STRUCTURE-SLOTD-READER-FUNCTION +++ PCL::INITIALIZE-INFO-CACHED-COMBINED-INITARGS-FORM-LIST +++ PCL::DISPATCH-P PCL::LIST-LARGE-CACHE +++ PCL::FAST-METHOD-CALL-PV-CELL PCL::GET-MAKE-INSTANCE-FUNCTION +++ PCL::DNET-METHODS-P PCL::STRUCTURE-SLOTD-INIT-FORM +++ PCL::UPDATE-CLASS-CAN-PRECEDE-P PCL::ONE-CLASS-ACCESSOR-TYPE +++ PCL::RESET-INITIALIZE-INFO PCL::STANDARD-SVUC-METHOD +++ PCL::DEFAULT-CONSTANTP PCL::UPDATE-C-A-M-GF-INFO +++ PCL::ONE-INDEX-DFUN-INFO-CACHE PCL::EARLY-CLASS-SLOTS +++ PCL::CPD-SUPERS PCL::FGEN-GENERATOR-LAMBDA +++ PCL::ECD-SUPERCLASS-NAMES PCL::ECD-CLASS-NAME PCL::SETFBOUNDP +++ PCL::GET-SETF-FUNCTION-NAME PCL::DFUN-INFO-P +++ PCL::SLOT-VECTOR-SYMBOL PCL::INITIALIZE-INFO-P +++ PCL::TWO-CLASS-P PCL::UPDATE-GF-SIMPLE-ACCESSOR-TYPE +++ PCL::COPY-CACHE PCL::MAKE-PV-TABLE-TYPE-DECLARATION +++ PCL::SORT-CALLS PCL::STRUCTURE-SLOT-BOUNDP PCL::%FBOUNDP +++ PCL::RESET-CLASS-INITIALIZE-INFO-1 PCL::UPDATE-GF-INFO +++ PCL::WRAPPER-FOR-STRUCTURE PCL::FUNCALLABLE-INSTANCE-P +++ PCL::CPD-CLASS PCL::EARLY-METHOD-STANDARD-ACCESSOR-P +++ PCL::SORT-SLOTS PCL::CANONICAL-SLOT-NAME +++ PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION +++ PCL::EARLY-ACCESSOR-METHOD-SLOT-NAME PCL::%SYMBOL-FUNCTION +++ PCL::EARLY-METHOD-LAMBDA-LIST PCL::ONE-INDEX-DFUN-INFO-INDEX +++ PCL::N-N-ACCESSOR-TYPE PCL::CACHING-CACHE +++ PCL::EARLY-CLASS-SLOTDS PCL::ONE-INDEX-DFUN-INFO-P +++ SYSTEM::%COMPILED-FUNCTION-NAME +++ PCL::BOOTSTRAP-CLASS-PREDICATES PCL::NET-TEST-CONVERTER +++ PCL::DO-STANDARD-DEFSETFS-FOR-DEFCLASS PCL::TWO-CLASS-WRAPPER0 +++ PCL::MAP-SPECIALIZERS PCL::EARLY-GF-NAME PCL::N-N-P +++ PCL::FGEN-SYSTEM PCL::METHODS-CONTAIN-EQL-SPECIALIZER-P +++ PCL::UPDATE-GFS-OF-CLASS PCL::ONE-CLASS-WRAPPER0 +++ PCL::CPD-AFTER +++ PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION +++ PCL::CACHE-P PCL::EARLY-METHOD-QUALIFIERS PCL::CHECK-CACHE +++ PCL::FORCE-CACHE-FLUSHES PCL::CACHE-OWNER +++ PCL::COMPILE-LAMBDA-DEFERRED PCL::ARG-INFO-KEY/REST-P)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) +++ COMMON-LISP::INVALID-METHOD-ERROR PCL::LIST-LARGE-CACHES +++ PCL::UPDATE-MAKE-INSTANCE-FUNCTION-TABLE PCL::UNTRACE-METHOD +++ COMMON-LISP::METHOD-COMBINATION-ERROR)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ PCL::NON-NEGATIVE-FIXNUM) +++ PCL::CACHE-MAX-LOCATION PCL::CACHE-NLINES PCL::CACHE-SIZE +++ PCL::CACHE-MASK)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ PCL::MAKE-INTERNAL-READER-METHOD-FUNCTION +++ ITERATE::SIMPLE-EXPAND-ITERATE-FORM PCL::ADD-DIRECT-SUBCLASSES +++ PCL::PROCLAIM-DEFMETHOD PCL::UPDATE-INITIALIZE-INFO-INTERNAL +++ PCL::RAISE-METATYPE PCL::CLASS-CAN-PRECEDE-P +++ WALKER::VARIABLE-SPECIAL-P PCL::GF-MAKE-FUNCTION-FROM-EMF +++ PCL::|SETF PCL METHOD-FUNCTION-PLIST| +++ PCL::SET-FUNCTION-PRETTY-ARGLIST +++ PCL::FUNCALLABLE-STANDARD-INSTANCE-ACCESS +++ PCL::MAKE-DISCRIMINATING-FUNCTION-ARGLIST +++ PCL::DEAL-WITH-ARGUMENTS-OPTION WALKER::NOTE-DECLARATION +++ PCL::MAKE-CLASS-PREDICATE PCL::VALUE-FOR-CACHING +++ PCL::EMIT-1-NIL-DLAP PCL::MAKE-CAXR PCL::SYMBOL-LESSP +++ PCL::GET-KEY-ARG1 PCL::ADD-FORMS +++ PCL::EMIT-N-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION +++ PCL::DOCTOR-DFUN-FOR-THE-DEBUGGER +++ PCL::CLASSES-HAVE-COMMON-SUBCLASS-P PCL::N-N-DFUN-INFO +++ PCL::CANONICALIZE-SLOT-SPECIFICATION +++ PCL::REDIRECT-EARLY-FUNCTION-INTERNAL +++ PCL::UPDATE-STD-OR-STR-METHODS PCL::%SET-CCLOSURE-ENV +++ PCL::QUALIFIER-CHECK-RUNTIME +++ PCL::MAKE-STD-READER-METHOD-FUNCTION +++ PCL::ADD-SLOT-ACCESSORS PCL::ADD-TO-CVECTOR +++ PCL::COMPUTE-LAYOUT PCL::DESTRUCTURE-INTERNAL +++ PCL::SUPERCLASSES-COMPATIBLE-P +++ PCL::COMPUTE-APPLICABLE-METHODS-FUNCTION ITERATE::MV-SETQ +++ PCL::COMPUTE-STD-CPL PCL::SET-METHODS PCL::CHECKING-DFUN-INFO +++ ITERATE::EXTRACT-SPECIAL-BINDINGS PCL::SWAP-WRAPPERS-AND-SLOTS +++ PCL::CANONICALIZE-DEFCLASS-OPTION PCL::MAKE-CDXR +++ PCL::PRINTING-RANDOM-THING-INTERNAL COMMON-LISP::ADD-METHOD +++ PCL::STANDARD-INSTANCE-ACCESS +++ SYSTEM::%SET-COMPILED-FUNCTION-NAME PCL::FIND-SLOT-DEFINITION +++ PCL::CLASS-MIGHT-PRECEDE-P +++ PCL::MAKE-STD-BOUNDP-METHOD-FUNCTION PCL::SAUT-NOT-EQL +++ PCL::SET-WRAPPER PCL::SET-STANDARD-SVUC-METHOD +++ PCL::SAUT-NOT-PROTOTYPE PCL::ACCESSOR-MISS-FUNCTION +++ PCL::NO-SLOT PCL::REMTAIL PCL::PV-WRAPPERS-FROM-ALL-ARGS +++ PCL::UPDATE-CLASS PCL::AUGMENT-TYPE PCL::MAKE-EARLY-ACCESSOR +++ PCL::MAKE-PLIST PCL::MEC-ALL-CLASSES-INTERNAL +++ PCL::MAKE-STD-WRITER-METHOD-FUNCTION +++ PCL::PARSE-QUALIFIER-PATTERN PCL::MEMF-CONSTANT-CONVERTER +++ PCL::|SETF PCL FIND-CLASS-PREDICATE| +++ PCL::MAKE-UNORDERED-METHODS-EMF WALKER::ENVIRONMENT-FUNCTION +++ PCL::MEC-ALL-CLASS-LISTS PCL::SAUT-NOT-CLASS-EQ +++ PCL::DO-SATISFIES-DEFTYPE PCL::SET-STRUCTURE-SVUC-METHOD +++ PCL::MAKE-DLAP-LAMBDA-LIST PCL::METHOD-FUNCTION-RETURNING-T +++ PCL::COMPUTE-CALLS PCL::REMOVE-SLOT-ACCESSORS +++ PCL::UPDATE-ALL-PV-TABLE-CACHES PCL::MAKE-DFUN-LAMBDA-LIST +++ WALKER::NOTE-LEXICAL-BINDING PCL::REMOVE-DIRECT-SUBCLASSES +++ PCL::MAP-PV-TABLE-REFERENCES-OF PCL::COMPUTE-CONSTANTS +++ PCL::METHOD-FUNCTION-RETURNING-NIL PCL::METHODS-CONVERTER +++ PCL::PV-TABLE-LOOKUP PCL::DESCRIBE-PACKAGE +++ COMMON-LISP::SLOT-EXISTS-P PCL::MAKE-PV-TABLE-INTERNAL +++ PCL::SAUT-NOT-CLASS PCL::|SETF PCL FIND-CLASS| +++ PCL::UPDATE-INITS PCL::UPDATE-CPL +++ PCL::EMIT-1-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION +++ PCL::COMPUTE-PV WALKER::VARIABLE-LEXICAL-P +++ PCL::PROCLAIM-DEFGENERIC PCL::MAKE-DFUN-ARG-LIST +++ PCL::GET-KEY-ARG COMMON-LISP::REMOVE-METHOD +++ PCL::PV-WRAPPERS-FROM-ALL-WRAPPERS PCL::VARIABLE-CLASS +++ PCL::UPDATE-SLOTS PCL::SYMBOL-OR-CONS-LESSP +++ PCL::MEC-ALL-CLASSES PCL::LIST-EQ +++ PCL::SET-FUNCALLABLE-INSTANCE-FUNCTION +++ WALKER::WALK-REPEAT-EVAL WALKER::ENVIRONMENT-MACRO +++ WALKER::VARIABLE-SYMBOL-MACRO-P +++ PCL::MAKE-FAST-METHOD-CALL-LAMBDA-LIST +++ PCL::BOOTSTRAP-SLOT-INDEX PCL::PLIST-VALUE +++ PCL::CHANGE-CLASS-INTERNAL PCL::NET-CONSTANT-CONVERTER +++ PCL::|SETF PCL GDEFINITION| PCL::FIND-STANDARD-II-METHOD)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ WALKER::WALK-FORM PCL::MAKE-INSTANCE-1 +++ PCL::EXTRACT-DECLARATIONS PCL::GET-FUNCTION +++ WALKER::MACROEXPAND-ALL PCL::ALLOCATE-STRUCTURE-INSTANCE +++ PCL::MAKE-FINAL-DFUN-INTERNAL PCL::GET-METHOD-FUNCTION +++ PCL::COERCE-TO-CLASS PCL::MAP-ALL-CLASSES PCL::ENSURE-CLASS +++ PCL::PARSE-METHOD-OR-SPEC COMMON-LISP::ENSURE-GENERIC-FUNCTION +++ PCL::MAKE-CACHING-DFUN PCL::GET-FUNCTION1 +++ PCL::GET-DFUN-CONSTRUCTOR PCL::MAKE-CONSTANT-VALUE-DFUN +++ PCL::MAKE-METHOD-FUNCTION-INTERNAL PCL::COMPILE-LAMBDA +++ PCL::PARSE-SPECIALIZED-LAMBDA-LIST PCL::DISPATCH-DFUN-COST +++ PCL::MAKE-METHOD-LAMBDA-INTERNAL)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) +++ PCL::MAKE-CLASS-PREDICATE-NAME PCL::MAKE-KEYWORD)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ PCL::FIND-CLASS-FROM-CELL PCL::GET-METHOD-FUNCTION-PV-CELL +++ PCL::PROBE-CACHE PCL::NAMED-OBJECT-PRINT-FUNCTION +++ PCL::PRECOMPUTE-EFFECTIVE-METHODS +++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE +++ PCL::GET-EFFECTIVE-METHOD-FUNCTION1 PCL::MAKE-EMF-FROM-METHOD +++ PCL::EMIT-MISS PCL::REAL-ENSURE-GF-USING-CLASS--NULL +++ PCL::RECORD-DEFINITION WALKER::CONVERT-MACRO-TO-LAMBDA +++ PCL::INITIALIZE-INFO PCL::EXPAND-EFFECTIVE-METHOD-FUNCTION +++ PCL::METHOD-FUNCTION-GET PCL::FIND-CLASS-PREDICATE-FROM-CELL +++ PCL::ENSURE-GENERIC-FUNCTION-USING-CLASS +++ PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION1 PCL::GET-DECLARATION +++ PCL::REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION +++ PCL::MAP-CACHE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) +++ COMMON-LISP::T) +++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| +++ PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +++ PCL::|(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| +++ WALKER::WALK-PROG/PROG* +++ PCL::|(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| +++ WALKER::WALK-BINDINGS-2 +++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| +++ WALKER::WALK-DO/DO* +++ PCL::|(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +++ PCL::|(FAST-METHOD DOCUMENTATION (T))| +++ PCL::|(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| +++ PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| +++ PCL::|(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| +++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| +++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| +++ PCL::INITIALIZE-INSTANCE-SIMPLE PCL::BOOTSTRAP-SET-SLOT +++ PCL::|(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| +++ PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| +++ PCL::|(FAST-METHOD PRINT-OBJECT (CLASS T))| +++ PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| +++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| +++ PCL::|(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| +++ PCL::FILL-CACHE-P +++ PCL::|(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| +++ PCL::|(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| +++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| +++ PCL::|(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| +++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| +++ PCL::OPTIMIZE-WRITER PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-TYPE +++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-INTERNAL +++ PCL::|(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| +++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION1 +++ PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| +++ PCL::|(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| +++ PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| +++ PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| +++ PCL::|(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| +++ PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| +++ PCL::|(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| +++ PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| +++ PCL::ADJUST-CACHE +++ PCL::|(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +++ PCL::LOAD-PRECOMPILED-DFUN-CONSTRUCTOR +++ PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| +++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +++ PCL::|(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| +++ PCL::|(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| +++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| +++ PCL::MEMF-TEST-CONVERTER +++ PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +++ PCL::|(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| +++ PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| +++ WALKER::WALK-TEMPLATE PCL::TWO-CLASS-DFUN-INFO +++ PCL::EXPAND-CACHE +++ PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| +++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| +++ PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| +++ PCL::GET-WRAPPERS-FROM-CLASSES +++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| +++ PCL::|(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +++ PCL::LOAD-PRECOMPILED-IIS-ENTRY +++ PCL::|(FAST-METHOD PRINT-OBJECT (T T))| +++ PCL::EXPAND-SYMBOL-MACROLET-INTERNAL +++ PCL::MAYBE-EXPAND-ACCESSOR-FORM +++ PCL::EMIT-CHECKING-OR-CACHING-FUNCTION-PRELIMINARY +++ PCL::|(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| +++ PCL::|(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| +++ PCL::|(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| +++ PCL::|(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| +++ PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +++ PCL::EXPAND-DEFCLASS +++ PCL::|(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| +++ WALKER::WALK-LET/LET* PCL::MAKE-DISPATCH-LAMBDA +++ PCL::|(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| +++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| +++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| +++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))| +++ PCL::OPTIMIZE-READER +++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| +++ PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +++ PCL::|(FAST-METHOD MAKE-INSTANCE (CLASS))|)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ PCL::OPTIMIZE-SET-SLOT-VALUE +++ PCL::|(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| +++ PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| +++ PCL::MAKE-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +++ PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| +++ PCL::|(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| +++ PCL::PRINT-CACHE WALKER::WALK-UNEXPECTED-DECLARE +++ ITERATE::OPTIMIZE-ITERATE-FORM +++ PCL::|(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| +++ WALKER::WALK-MULTIPLE-VALUE-SETQ PCL::FIRST-FORM-TO-LISP +++ PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| +++ WALKER::WALK-LABELS +++ PCL::|(FAST-METHOD SPECIALIZER-CLASS (CLASS))| +++ PCL::ONE-CLASS-DFUN-INFO PCL::GET-FUNCTION-GENERATOR +++ WALKER::RELIST-INTERNAL PCL::NOTE-PV-TABLE-REFERENCE +++ WALKER::WALK-LAMBDA PCL::WRAP-METHOD-GROUP-SPECIFIER-BINDINGS +++ PCL::ONE-INDEX-DFUN-INFO PCL::MAP-ALL-ORDERS +++ PCL::OPTIMIZE-GF-CALL-INTERNAL PCL::COMPUTE-PRECEDENCE +++ WALKER::WALK-DO PCL::PRINT-STD-INSTANCE +++ PCL::OBSOLETE-INSTANCE-TRAP PCL::SORT-APPLICABLE-METHODS +++ PCL::|(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +++ PCL::EMIT-GREATER-THAN-1-DLAP +++ PCL::|(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +++ WALKER::WALK-FLET +++ PCL::|(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| +++ PCL::|SETF PCL PLIST-VALUE| WALKER::WALK-PROG* +++ WALKER::VARIABLE-DECLARATION +++ PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| +++ PCL::SKIP-FAST-SLOT-ACCESS-P PCL::SET-FUNCTION-NAME-1 +++ WALKER::WALK-MACROLET PCL::CAN-OPTIMIZE-ACCESS +++ WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL +++ PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| +++ PCL::|(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| +++ PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| +++ PCL::SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P +++ PCL::|(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| +++ PCL::|(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| +++ PCL::EMIT-BOUNDP-CHECK PCL::|SETF PCL METHOD-FUNCTION-GET| +++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| +++ PCL::MAKE-METHOD-SPEC PCL::FLUSH-CACHE-TRAP WALKER::WALK-IF +++ PCL::OPTIMIZE-SLOT-BOUNDP +++ PCL::STANDARD-COMPUTE-EFFECTIVE-METHOD +++ WALKER::WALK-MULTIPLE-VALUE-BIND +++ ITERATE::RENAME-AND-CAPTURE-VARIABLES WALKER::WALK-LET* +++ WALKER::WALK-DO* +++ PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| +++ PCL::INVALIDATE-WRAPPER +++ PCL::|(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| +++ PCL::|(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| +++ PCL::MAKE-OPTIMIZED-STD-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION +++ ITERATE::SIMPLE-EXPAND-GATHERING-FORM PCL::ENTRY-IN-CACHE-P +++ WALKER::WALK-LOCALLY PCL::OPTIMIZE-SLOT-VALUE +++ PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL +++ PCL::|(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| +++ PCL::|(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| +++ PCL::|(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| +++ PCL::|(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| +++ PCL::TRACE-EMF-CALL-INTERNAL WALKER::WALK-SYMBOL-MACROLET +++ PCL::|(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| +++ PCL::CONVERT-TABLE +++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| +++ PCL::INITIALIZE-INTERNAL-SLOT-GFS* +++ PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| +++ PCL::|(FAST-METHOD CLASS-PREDICATE-NAME (T))| +++ PCL::|(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| +++ PCL::MAKE-OPTIMIZED-STD-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| +++ PCL::|(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| +++ PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| +++ WALKER::WALK-SETQ PCL::EXPAND-DEFGENERIC +++ PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| +++ ITERATE::OPTIMIZE-GATHERING-FORM PCL::FIX-SLOT-ACCESSORS +++ PCL::EMIT-SLOT-READ-FORM WALKER::WALK-PROG +++ PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| +++ WALKER::WALK-NAMED-LAMBDA PCL::GET-NEW-FUNCTION-GENERATOR +++ PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| +++ WALKER::WALK-TAGBODY +++ PCL::|(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| +++ WALKER::WALK-COMPILER-LET PCL::DECLARE-STRUCTURE +++ WALKER::WALK-LET ITERATE::VARIABLE-SAME-P +++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| +++ PCL::EMIT-1-T-DLAP PCL::MAKE-DFUN-CALL +++ PCL::COMPUTE-EFFECTIVE-METHOD PCL::SORT-METHODS +++ WALKER::WALK-TAGBODY-1 +++ PCL::|(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| +++ PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| +++ PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| +++ PCL::MAKE-TOP-LEVEL-FORM +++ PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| +++ WALKER::RECONS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ PCL::UPDATE-SLOTS-IN-PV PCL::MAKE-INSTANCE-FUNCTION-COMPLEX +++ PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::GET-MAKE-INSTANCE-FUNCTION-INTERNAL +++ PCL::|(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| +++ PCL::MAKE-INSTANCE-FUNCTION-SIMPLE +++ PCL::|(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| +++ PCL::COMPUTE-PV-SLOT PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL1 +++ PCL::|(FAST-METHOD SLOT-UNBOUND (T T T))| +++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| +++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| +++ PCL::OPTIMIZE-INSTANCE-ACCESS +++ PCL::|(FAST-METHOD REMOVE-NAMED-METHOD (T T))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| +++ PCL::REAL-MAKE-METHOD-INITARGS-FORM +++ PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| +++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T T))| +++ PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| +++ PCL::MAKE-FINAL-ORDINARY-DFUN-INTERNAL +++ PCL::BOOTSTRAP-MAKE-SLOT-DEFINITIONS +++ PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| +++ PCL::MAKE-PARAMETER-REFERENCES +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| +++ PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::OPTIMIZE-ACCESSOR-CALL +++ WALKER::WALK-TEMPLATE-HANDLE-REPEAT WALKER::WALK-BINDINGS-1 +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| +++ PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS1 +++ PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::MAKE-FGEN +++ PCL::|(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| +++ PCL::|(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| +++ PCL::OPTIMIZE-GENERIC-FUNCTION-CALL +++ PCL::LOAD-FUNCTION-GENERATOR PCL::MAKE-EMF-CACHE +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| +++ PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::EXPAND-EMF-CALL-METHOD)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) +++ COMMON-LISP::T) +++ PCL::EXPAND-DEFMETHOD PCL::LOAD-DEFMETHOD-INTERNAL)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::T) +++ PCL::FILL-CACHE PCL::CAN-OPTIMIZE-ACCESS1 PCL::MAKE-EMF-CALL +++ PCL::EMIT-FETCH-WRAPPER PCL::CHECK-INITARGS-2-LIST +++ PCL::GET-METHOD PCL::CHECK-INITARGS-2-PLIST +++ PCL::CHECK-INITARGS-1 PCL::REAL-GET-METHOD +++ WALKER::WALK-ARGLIST)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ PCL::GET-SECONDARY-DISPATCH-FUNCTION2)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::T) +++ PCL::LOAD-DEFMETHOD PCL::MAKE-DEFMETHOD-FORM +++ PCL::EARLY-MAKE-A-METHOD PCL::MAKE-DEFMETHOD-FORM-INTERNAL)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::SET-ARG-INFO1 PCL::BOOTSTRAP-MAKE-SLOT-DEFINITION +++ PCL::LOAD-DEFCLASS PCL::REAL-LOAD-DEFCLASS +++ PCL::OPTIMIZE-GF-CALL WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1 +++ PCL::EMIT-SLOT-ACCESS PCL::MAKE-EARLY-CLASS-DEFINITION)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ PCL::EMIT-DLAP PCL::GET-SECONDARY-DISPATCH-FUNCTION1)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ PCL::EARLY-ADD-NAMED-METHOD PCL::FILL-DFUN-CACHE +++ PCL::REAL-ADD-NAMED-METHOD)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::T) +++ PCL::BOOTSTRAP-INITIALIZE-CLASS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::FIXNUM) +++ COMMON-LISP::T) +++ PCL::COMPUTE-STD-CPL-PHASE-3)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::FIXNUM) +++ COMMON-LISP::T) +++ PCL::FILL-CACHE-FROM-CACHE-P PCL::GET-CACHE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::LIST) +++ PCL::PV-TABLE-CALL-LIST PCL::CACHE-OVERFLOW +++ PCL::PV-TABLE-SLOT-NAME-LISTS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::FIXNUM COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ PCL::COMPUTE-CACHE-PARAMETERS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::FIXNUM COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ PCL::FIND-FREE-CACHE-LINE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::BOOLEAN) +++ PCL::CACHE-VALUEP)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) +++ PCL::DEFAULT-CODE-CONVERTER PCL::EMIT-IN-CHECKING-CACHE-P +++ PCL::METHOD-PROTOTYPE-FOR-GF PCL::EMIT-TWO-CLASS-WRITER +++ PCL::PARSE-METHOD-GROUP-SPECIFIER PCL::EMIT-ONE-CLASS-WRITER +++ PCL::EMIT-ONE-INDEX-WRITERS PCL::FIND-STRUCTURE-CLASS +++ PCL::PROTOTYPES-FOR-MAKE-METHOD-LAMBDA PCL::MAKE-DISPATCH-DFUN +++ PCL::COMPUTE-APPLICABLE-METHODS-EMF PCL::EARLY-METHOD-FUNCTION +++ PCL::NET-CODE-CONVERTER PCL::GET-DISPATCH-FUNCTION +++ PCL::STRUCTURE-WRAPPER PCL::FIND-WRAPPER PCL::CLASS-EQ-TYPE +++ PCL::TYPE-FROM-SPECIALIZER PCL::SPECIALIZER-FROM-TYPE +++ PCL::PCL-DESCRIBE PCL::PARSE-DEFMETHOD +++ PCL::ANALYZE-LAMBDA-LIST PCL::EMIT-ONE-CLASS-READER +++ PCL::EARLY-COLLECT-INHERITANCE PCL::GET-GENERIC-FUNCTION-INFO +++ PCL::COMPILE-IIS-FUNCTIONS PCL::EMIT-CONSTANT-VALUE +++ PCL::EMIT-ONE-INDEX-READERS PCL::GENERIC-FUNCTION-NAME-P +++ PCL::CONVERT-TO-SYSTEM-TYPE PCL::MAKE-FINAL-DISPATCH-DFUN +++ PCL::EMIT-TWO-CLASS-READER PCL::*NORMALIZE-TYPE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +++ PCL::|__si::MAKE-CLASS-PRECEDENCE-DESCRIPTION| +++ PCL::MAKE-FAST-INSTANCE-BOUNDP PCL::MAKE-INITIALIZE-INFO +++ PCL::|STRUCTURE-OBJECT class constructor| +++ PCL::|__si::MAKE-CACHE| PCL::|__si::MAKE-DEFAULT-METHOD-ONLY| +++ PCL::TRUE PCL::|__si::MAKE-PV-TABLE| +++ PCL::|__si::MAKE-ONE-INDEX| WALKER::UNBOUND-LEXICAL-FUNCTION +++ PCL::|__si::MAKE-CHECKING| PCL::MAKE-PV-TABLE +++ PCL::|__si::MAKE-NO-METHODS| PCL::MAKE-METHOD-CALL +++ PCL::CALLED-FIN-WITHOUT-FUNCTION PCL::USE-PACKAGE-PCL +++ PCL::INTERN-PV-TABLE PCL::|__si::MAKE-ACCESSOR-DFUN-INFO| +++ PCL::|__si::MAKE-DISPATCH| +++ PCL::|__si::MAKE-ONE-INDEX-DFUN-INFO| +++ PCL::|__si::MAKE-ARG-INFO| PCL::FIX-EARLY-GENERIC-FUNCTIONS +++ PCL::ZERO PCL::MAKE-PROGN PCL::|__si::MAKE-INITIAL| +++ PCL::|__si::MAKE-ONE-CLASS| PCL::|__si::MAKE-DFUN-INFO| +++ PCL::|__si::MAKE-CONSTANT-VALUE| +++ PCL::|__si::MAKE-STD-INSTANCE| PCL::PV-WRAPPERS-FROM-PV-ARGS +++ PCL::|__si::MAKE-TWO-CLASS| PCL::|__si::MAKE-N-N| +++ PCL::|__si::MAKE-CACHING| PCL::FALSE PCL::STRING-APPEND +++ PCL::|__si::MAKE-INITIAL-DISPATCH| PCL::MAKE-FAST-METHOD-CALL)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) +++ PCL::ARG-INFO-NUMBER-REQUIRED PCL::PV-TABLE-PV-SIZE +++ PCL::CACHE-COUNT PCL::PV-CACHE-LIMIT-FN PCL::CHECKING-LIMIT-FN +++ PCL::CACHING-LIMIT-FN PCL::N-N-ACCESSORS-LIMIT-FN +++ PCL::DEFAULT-LIMIT-FN PCL::EARLY-CLASS-SIZE PCL::CPD-COUNT +++ PCL::ONE-INDEX-LIMIT-FN PCL::FAST-INSTANCE-BOUNDP-INDEX)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) +++ PCL::POWER-OF-TWO-CEILING)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ PCL::MAKE-TYPE-PREDICATE-NAME PCL::MAKE-FINAL-DFUN +++ PCL::CAPITALIZE-WORDS PCL::SET-DFUN ITERATE::MAYBE-WARN +++ PCL::MAKE-EARLY-GF PCL::USE-DISPATCH-DFUN-P WALKER::RELIST +++ PCL::MAKE-SPECIALIZABLE PCL::PV-TABLE-LOOKUP-PV-ARGS +++ PCL::ALLOCATE-STANDARD-INSTANCE +++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE +++ PCL::USE-CONSTANT-VALUE-DFUN-P ITERATE::FUNCTION-LAMBDA-P +++ PCL::UPDATE-DFUN PCL::SET-ARG-INFO +++ PCL::EARLY-METHOD-SPECIALIZERS PCL::MAKE-WRAPPER +++ PCL::FIND-CLASS-CELL WALKER::WALKER-ENVIRONMENT-BIND-1 +++ PCL::TRACE-METHOD WALKER::RELIST* COMMON-LISP::FIND-CLASS +++ PCL::INITIALIZE-INTERNAL-SLOT-GFS PCL::FIND-CLASS-PREDICATE +++ PCL::INITIALIZE-METHOD-FUNCTION)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ PCL::SAUT-NOT PCL::INVOKE-EMF PCL::SAUT-PROTOTYPE +++ PCL::COMPUTE-CODE ITERATE::PARSE-DECLARATIONS +++ PCL::SDFUN-FOR-CACHING +++ PCL::COMPUTE-APPLICABLE-METHODS-USING-TYPES +++ PCL::GET-NEW-FUNCTION-GENERATOR-INTERNAL +++ PCL::SLOT-NAME-LISTS-FROM-SLOTS PCL::DESTRUCTURE +++ PCL::SPLIT-DECLARATIONS PCL::MAKE-DIRECT-SLOTD +++ PCL::FORM-LIST-TO-LISP PCL::EMIT-CHECKING +++ PCL::CPL-FORWARD-REFERENCED-CLASS-ERROR PCL::COMPUTE-TEST +++ PCL::SET-FUNCTION-NAME COMMON-LISP::SLOT-BOUNDP PCL::SAUT-AND +++ PCL::EMIT-CACHING PCL::INITIAL-DFUN +++ COMMON-LISP::SLOT-MAKUNBOUND COMMON-LISP::SLOT-VALUE +++ PCL::UPDATE-SLOT-VALUE-GF-INFO +++ PCL::CLASS-APPLICABLE-USING-CLASS-P +++ PCL::CPL-INCONSISTENT-ERROR PCL::*SUBTYPEP +++ PCL::SLOT-UNBOUND-INTERNAL +++ PCL::GENERATE-FAST-CLASS-SLOT-ACCESS-P +++ PCL::CHECK-INITARGS-VALUES PCL::ENSURE-CLASS-VALUES +++ PCL::SAUT-EQL PCL::REAL-REMOVE-METHOD PCL::EMIT-DEFAULT-ONLY +++ PCL::INSURE-DFUN PCL::EMIT-DEFAULT-ONLY-FUNCTION +++ PCL::MUTATE-SLOTS-AND-CALLS PCL::FIND-SUPERCLASS-CHAIN +++ PCL::SAUT-CLASS PCL::MAKE-INSTANCE-FUNCTION-TRAP +++ PCL::SAUT-CLASS-EQ PCL::COMPUTE-STD-CPL-PHASE-1 +++ PCL::SPECIALIZER-APPLICABLE-USING-TYPE-P)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ (COMMON-LISP::OR PCL::CACHE COMMON-LISP::NULL)) +++ PCL::PV-TABLE-CACHE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::*) +++ WALKER::WALK-DECLARATIONS PCL::GET-SECONDARY-DISPATCH-FUNCTION +++ PCL::MAKE-ONE-INDEX-ACCESSOR-DFUN)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) +++ COMMON-LISP::*) +++ PCL::MAKE-SHARED-INITIALIZE-FORM-LIST PCL::ACCESSOR-MISS +++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| +++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| +++ PCL::|(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| +++ PCL::|(FAST-METHOD NO-APPLICABLE-METHOD (T))| +++ PCL::SET-CLASS-SLOT-VALUE-1 +++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| +++ PCL::|(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))| +++ PCL::GET-ACCESSOR-FROM-SVUC-METHOD-FUNCTION +++ PCL::SETF-SLOT-VALUE-USING-CLASS-DFUN +++ PCL::|(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| +++ PCL::EMIT-CHECKING-OR-CACHING-FUNCTION +++ PCL::MAKE-FINAL-ONE-INDEX-ACCESSOR-DFUN +++ PCL::LOAD-SHORT-DEFCOMBIN PCL::EMIT-CHECKING-OR-CACHING +++ PCL::|(FAST-METHOD MAKE-INSTANCE (SYMBOL))| +++ PCL::MAKE-FINAL-CHECKING-DFUN +++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| +++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| +++ PCL::ACCESSOR-VALUES +++ PCL::|(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| +++ PCL::|(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| +++ PCL::REAL-MAKE-METHOD-LAMBDA +++ PCL::|(FAST-METHOD CHANGE-CLASS (T SYMBOL))| +++ PCL::GET-ACCESSOR-METHOD-FUNCTION +++ PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| +++ PCL::|(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| +++ PCL::ORDER-SPECIALIZERS +++ PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| +++ PCL::GENERATE-DISCRIMINATION-NET +++ PCL::|(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| +++ PCL::|(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| +++ PCL::MAKE-ONE-CLASS-ACCESSOR-DFUN +++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (T T))| +++ PCL::BOOTSTRAP-ACCESSOR-DEFINITION +++ PCL::INITIALIZE-INSTANCE-SIMPLE-FUNCTION)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ PCL::GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION +++ PCL::MAKE-OPTIMIZED-STD-WRITER-METHOD-FUNCTION +++ PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| +++ PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| +++ PCL::|(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| +++ PCL::MAKE-OPTIMIZED-STD-BOUNDP-METHOD-FUNCTION +++ PCL::CONVERT-METHODS WALKER::WALK-LET-IF +++ PCL::EMIT-READER/WRITER-FUNCTION PCL::ACCESSOR-VALUES-INTERNAL +++ PCL::|(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| +++ PCL::LOAD-LONG-DEFCOMBIN PCL::CHECK-METHOD-ARG-INFO +++ PCL::ACCESSOR-VALUES1 +++ PCL::|(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| +++ PCL::GENERATING-LISP PCL::MAKE-FINAL-N-N-ACCESSOR-DFUN +++ WALKER::WALK-FORM-INTERNAL PCL::CONSTANT-VALUE-MISS +++ PCL::SLOT-VALUE-USING-CLASS-DFUN PCL::CACHING-MISS +++ PCL::|(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| +++ PCL::SLOT-BOUNDP-USING-CLASS-DFUN PCL::CHECKING-MISS +++ PCL::|(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| +++ PCL::EMIT-READER/WRITER ITERATE::EXPAND-INTO-LET +++ PCL::GET-CLASS-SLOT-VALUE-1 +++ PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION +++ PCL::MAKE-FINAL-CACHING-DFUN +++ PCL::|(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| +++ PCL::|(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| +++ PCL::GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +++ PCL::|(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| +++ PCL::OPTIMIZE-SLOT-VALUE-BY-CLASS-P PCL::SET-SLOT-VALUE +++ PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER +++ ITERATE::RENAME-VARIABLES +++ PCL::|(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| +++ PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| +++ ITERATE::WALK-GATHERING-BODY PCL::CACHE-MISS-VALUES +++ PCL::MAKE-OPTIMIZED-STD-READER-METHOD-FUNCTION +++ PCL::MAKE-FINAL-CONSTANT-VALUE-DFUN)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ PCL::DO-SHORT-METHOD-COMBINATION PCL::MEMF-CODE-CONVERTER +++ PCL::GENERATE-DISCRIMINATION-NET-INTERNAL +++ PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::MAKE-LONG-METHOD-COMBINATION-FUNCTION +++ PCL::CACHE-MISS-VALUES-INTERNAL)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| +++ PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| +++ PCL::ADD-METHOD-DECLARATIONS +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| +++ PCL::|(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| +++ PCL::COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL +++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| +++ PCL::|(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| +++ PCL::MAKE-TWO-CLASS-ACCESSOR-DFUN +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| +++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| +++ PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| +++ PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| +++ PCL::|(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| +++ PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::WALK-METHOD-LAMBDA +++ PCL::|(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))|)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::*) +++ PCL::REAL-MAKE-A-METHOD)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ PCL::MAKE-DEFAULT-INITARGS-FORM-LIST +++ PCL::GET-COMPLEX-INITIALIZATION-FUNCTIONS +++ PCL::SLOT-VALUE-OR-DEFAULT +++ PCL::GET-SIMPLE-INITIALIZATION-FUNCTION PCL::REAL-ADD-METHOD +++ PCL::LOAD-DEFGENERIC PCL::CPL-ERROR +++ PCL::MAKE-FINAL-ACCESSOR-DFUN PCL::MAKE-N-N-ACCESSOR-DFUN +++ PCL::TYPES-FROM-ARGUMENTS PCL::MAKE-ACCESSOR-TABLE +++ PCL::MAKE-CHECKING-DFUN WALKER::NESTED-WALK-FORM +++ PCL::GET-EFFECTIVE-METHOD-FUNCTION +++ PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION +++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) +++ COMMON-LISP::*) +++ ITERATE::ITERATE-TRANSFORM-BODY +++ PCL::|(FAST-METHOD SLOT-MISSING (T T T T))| +++ PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))|)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1 +++ ITERATE::RENAME-LET-BINDINGS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM COMMON-LISP::T) +++ COMMON-LISP::FIXNUM) +++ PCL::COMPUTE-PRIMARY-CACHE-LOCATION)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::*) +++ COMMON-LISP::T) +++ PCL::COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION +++ PCL::GET-CACHE-FROM-CACHE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM COMMON-LISP::T) +++ COMMON-LISP::T) +++ PCL::%CCLOSURE-ENV-NTHCDR)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::STREAM COMMON-LISP::T) +++ COMMON-LISP::T) +++ PCL::PRINT-DFUN-INFO)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) +++ PCL::COUNT-ALL-DFUNS PCL::EMIT-N-N-WRITERS +++ PCL::EMIT-N-N-READERS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::FIXNUM) +++ PCL::GET-WRAPPER-CACHE-NUMBER)) ++ (IN-PACKAGE "PCL") ++ ++-(DOLIST (V '(DISASSEMBLE |(FAST-WRITER-METHOD SLOT-OBJECT OPTIONS)| ++- |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHODS)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT METHODS)| ++- |(FAST-WRITER-METHOD SLOT-CLASS DIRECT-SLOTS)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SLOTS)| ++- |(FAST-WRITER-METHOD SLOT-CLASS SLOTS)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT SLOTS)| +++(DOLIST (V '(|(FAST-WRITER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-METHODS)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT SLOTS)| +++ |(FAST-WRITER-METHOD SLOT-CLASS SLOTS)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SLOTS)| +++ |(FAST-WRITER-METHOD SLOT-CLASS DIRECT-SLOTS)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT METHODS)| +++ |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHODS)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT OPTIONS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)| ++ ADD-READER-METHOD ++ SHORT-COMBINATION-IDENTITY-WITH-ONE-ARGUMENT ++- REMOVE-READER-METHOD |LISP::T class predicate| ++- EQL-SPECIALIZER-P |(SETF GENERIC-FUNCTION-NAME)| ++- OBJECT-PLIST SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL ++- |PCL::STANDARD-METHOD-COMBINATION class predicate| ++- |PCL::STANDARD-EFFECTIVE-SLOT-DEFINITION class predicate| ++- |PCL::STANDARD-DIRECT-SLOT-DEFINITION class predicate| +++ REMOVE-READER-METHOD EQL-SPECIALIZER-P +++ |(SETF GENERIC-FUNCTION-NAME)| OBJECT-PLIST +++ SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL ++ |PCL::STANDARD-SLOT-DEFINITION class predicate| ++- |PCL::STANDARD-OBJECT class predicate| +++ |PCL::STANDARD-DIRECT-SLOT-DEFINITION class predicate| +++ |PCL::STANDARD-EFFECTIVE-SLOT-DEFINITION class predicate| +++ |PCL::STANDARD-METHOD-COMBINATION class predicate| ++ |(FAST-READER-METHOD SLOT-OBJECT METHOD)| ++- |PCL::BUILT-IN-CLASS class predicate| SPECIALIZER-TYPE ++- |LISP::RATIONAL class predicate| ++- |LISP::RATIO class predicate| GF-DFUN-STATE +++ SPECIALIZER-TYPE GF-DFUN-STATE ++ |(SETF GENERIC-FUNCTION-METHOD-CLASS)| ++- |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)| ++ |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)| +++ |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)| ++ |(SETF GENERIC-FUNCTION-METHOD-COMBINATION)| ++ CLASS-DEFSTRUCT-CONSTRUCTOR ++- |(FAST-READER-METHOD DEFINITION-SOURCE-MIXIN SOURCE)| ++ |(FAST-READER-METHOD SLOT-OBJECT SOURCE)| +++ |(FAST-READER-METHOD DEFINITION-SOURCE-MIXIN SOURCE)| ++ METHOD-FAST-FUNCTION |(SETF GENERIC-FUNCTION-METHODS)| ++ |(SETF GF-PRETTY-ARGLIST)| ++- |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)| ++- |(FAST-READER-METHOD SLOT-OBJECT ARG-INFO)| ++- |(FAST-READER-METHOD SLOT-CLASS INITIALIZE-INFO)| ++ |(FAST-READER-METHOD SLOT-OBJECT INITIALIZE-INFO)| +++ |(FAST-READER-METHOD SLOT-CLASS INITIALIZE-INFO)| +++ |(FAST-READER-METHOD SLOT-OBJECT ARG-INFO)| +++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)| ++ SPECIALIZERP EXACT-CLASS-SPECIALIZER-P ++- |(FAST-READER-METHOD PCL-CLASS WRAPPER)| ++ |(FAST-READER-METHOD SLOT-OBJECT WRAPPER)| ++- |(FAST-READER-METHOD SLOT-DEFINITION INITARGS)| +++ |(FAST-READER-METHOD PCL-CLASS WRAPPER)| ++ |(FAST-READER-METHOD SLOT-OBJECT INITARGS)| ++- |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-CONSTRUCTOR)| ++- |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)| ++- |(FAST-READER-METHOD SLOT-OBJECT OPERATOR)| +++ |(FAST-READER-METHOD SLOT-DEFINITION INITARGS)| ++ |(FAST-READER-METHOD SHORT-METHOD-COMBINATION OPERATOR)| ++- |LISP::CHARACTER class predicate| +++ |(FAST-READER-METHOD SLOT-OBJECT OPERATOR)| +++ |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)| +++ |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-CONSTRUCTOR)| ++ COMPATIBLE-META-CLASS-CHANGE-P ++- |LISP::SEQUENCE class predicate| ++- |(FAST-READER-METHOD CLASS CLASS-EQ-SPECIALIZER)| ++ |(FAST-READER-METHOD SLOT-OBJECT CLASS-EQ-SPECIALIZER)| +++ |(FAST-READER-METHOD CLASS CLASS-EQ-SPECIALIZER)| ++ |(BOUNDP READER-FUNCTION)| TRACE-METHOD-INTERNAL ++ |(BOUNDP PREDICATE-NAME)| |(BOUNDP READERS)| ++ UPDATE-GF-DFUN |(BOUNDP CLASS-PRECEDENCE-LIST)| ++- |(BOUNDP ACCESSOR-FLAGS)| |(BOUNDP DOCUMENTATION)| ++- |(BOUNDP LOCATION)| SPECIALIZER-OBJECT +++ |(BOUNDP ACCESSOR-FLAGS)| |(BOUNDP LOCATION)| +++ |(BOUNDP DOCUMENTATION)| SPECIALIZER-OBJECT ++ |(BOUNDP INCOMPATIBLE-SUPERCLASS-LIST)| ++ ACCESSOR-METHOD-SLOT-NAME |(BOUNDP SPECIALIZERS)| ++ |(BOUNDP IDENTITY-WITH-ONE-ARGUMENT)| ++@@ -783,158 +1052,146 @@ ++ CLASS-EQ-SPECIALIZER-P ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT SOURCE)| SLOTS-FETCHER ++ |(SETF SLOT-ACCESSOR-STD-P)| REMOVE-WRITER-METHOD ++- |(BOUNDP INITFUNCTION)| |(BOUNDP WRITER-FUNCTION)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT ARG-INFO)| +++ |(BOUNDP WRITER-FUNCTION)| |(BOUNDP INITFUNCTION)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT INITIALIZE-INFO)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT ARG-INFO)| ++ STRUCTURE-CLASS-P |(BOUNDP WRITERS)| ++- |(BOUNDP INITFORM)| +++ |(BOUNDP INITFORM)| |SETF COMMON-LISP CLASS-NAME| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT WRAPPER)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT INITARGS)| ++- |LISP::BIT-VECTOR class predicate| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)| ++ UPDATE-CONSTRUCTORS |(BOUNDP SLOT-NAME)| ++ |(SETF SLOT-DEFINITION-INITARGS)| |(BOUNDP ALLOCATION)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT CLASS-EQ-SPECIALIZER)| ++- DOCUMENTATION |(BOUNDP GENERIC-FUNCTION)| ++- |(BOUNDP FUNCTION)| |(BOUNDP LAMBDA-LIST)| +++ DOCUMENTATION |(BOUNDP FUNCTION)| +++ |(BOUNDP GENERIC-FUNCTION)| |(BOUNDP LAMBDA-LIST)| ++ METHOD-PRETTY-ARGLIST |(BOUNDP SLOT-DEFINITION)| ++- |LISP::ARRAY class predicate| ++ |(BOUNDP CAN-PRECEDE-LIST)| |(BOUNDP PROTOTYPE)| ++ CLASS-EQ-SPECIALIZER INFORM-TYPE-SYSTEM-ABOUT-CLASS ++ |PCL::DEFINITION-SOURCE-MIXIN class predicate| ++- |(BOUNDP DFUN-STATE)| ++- |LISP::STRUCTURE-OBJECT class predicate| ++- |(BOUNDP FROM-DEFCLASS-P)| COMPILE |(READER METHOD)| ++- |LISP::STANDARD-OBJECT class predicate| +++ |(BOUNDP DFUN-STATE)| |(BOUNDP FROM-DEFCLASS-P)| +++ |(READER METHOD)| ++ |(CALL STANDARD-COMPUTE-EFFECTIVE-METHOD)| ++- |(BOUNDP FAST-FUNCTION)| ++- |LISP::COMPLEX class predicate| |(BOUNDP METHOD-CLASS)| ++- |(READER SOURCE)| |(BOUNDP METHOD-COMBINATION)| +++ |(BOUNDP FAST-FUNCTION)| |(BOUNDP METHOD-CLASS)| +++ |(READER SOURCE)| |(BOUNDP INTERNAL-WRITER-FUNCTION)| ++ |(BOUNDP INTERNAL-READER-FUNCTION)| ++- |(BOUNDP INTERNAL-WRITER-FUNCTION)| ++- ACCESSOR-METHOD-CLASS |(BOUNDP DIRECT-METHODS)| ++- |(BOUNDP DIRECT-SLOTS)| |(BOUNDP BOUNDP-FUNCTION)| ++- |(BOUNDP DIRECT-SUPERCLASSES)| ++- |(BOUNDP DIRECT-SUBCLASSES)| |(BOUNDP OPTIONS)| ++- |(BOUNDP METHODS)| |(WRITER METHOD)| ++- |LISP::BUILT-IN-CLASS class predicate| +++ |(BOUNDP METHOD-COMBINATION)| ACCESSOR-METHOD-CLASS +++ |(BOUNDP DIRECT-SLOTS)| |(BOUNDP DIRECT-METHODS)| +++ |(BOUNDP BOUNDP-FUNCTION)| |(BOUNDP DIRECT-SUBCLASSES)| +++ |(BOUNDP DIRECT-SUPERCLASSES)| |(BOUNDP METHODS)| +++ |(BOUNDP OPTIONS)| |(WRITER METHOD)| ++ |PCL::DEPENDENT-UPDATE-MIXIN class predicate| ++ GENERIC-FUNCTION-PRETTY-ARGLIST |(WRITER SOURCE)| +++ |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| +++ |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| +++ |(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))| ++ |(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| ++- |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| ++ |(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))| ++- |(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))| ++- |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| ++- |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| +++ |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| +++ |(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| +++ |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| +++ |(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| ++ |(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| ++ |(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| ++ |(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| ++- |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| ++- |(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| ++- |(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| ++ MAKE-BOUNDP-METHOD-FUNCTION ++- |LISP::STRING class predicate| ++ |(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| ++ |(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| ++ |PCL::METAOBJECT class predicate| ++- |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| ++- |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| ++- |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| ++- |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| ++- |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| ++- |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| +++ |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +++ |(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| +++ |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| +++ |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| +++ |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| +++ |(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| +++ |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| +++ |(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| +++ |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| +++ |(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +++ |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| +++ |(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +++ |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +++ |(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| +++ |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +++ |(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| +++ |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +++ |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| ++ |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| ++ |(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| ++- |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| +++ |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| +++ |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| +++ |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| ++ |(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| ++ |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| +++ |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| +++ |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| +++ |(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +++ |(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| +++ |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +++ |(FAST-METHOD CHANGE-CLASS (T SYMBOL))| ++ |(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| ++ |(FAST-METHOD MAKE-INSTANCE (SYMBOL))| ++- |(FAST-METHOD CHANGE-CLASS (T SYMBOL))| ++ |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++- |(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| ++- |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| ++- |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++- |(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++- |(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| ++- |(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| ++- |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| ++- |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| ++- |(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| ++- |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| ++- |(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| ++- |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| ++ |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| ++- |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| ++- |(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| ++- |(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| ++- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| ++- |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| ++- |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| ++- |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| ++- |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| ++- |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| ++- |(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| ++- |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| ++- |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| ++- |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| ++- |(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| ++- |(FAST-METHOD MAKE-INSTANCE (CLASS))| ++- |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| ++- |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| ++- |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| ++- |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| ++- |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| ++- |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| ++- |(FAST-METHOD SPECIALIZER-CLASS (CLASS))| +++ |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| ++ |(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| ++- |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| ++- |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| ++- |(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| ++- |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| ++- |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++- |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| ++- |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| ++- |(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| ++- |(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| ++- |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| ++- |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| ++- |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| ++- |(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| +++ |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| +++ |(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++ |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| +++ |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| +++ |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| ++ |(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++- |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +++ |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| +++ |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| +++ |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| +++ |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| ++ |(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| ++- |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| ++- |(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| +++ |(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| +++ |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| +++ |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| +++ |(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| ++ |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| ++- |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| +++ |(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| +++ |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| +++ |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| +++ |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +++ |(FAST-METHOD SPECIALIZER-CLASS (CLASS))| +++ |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| +++ |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| +++ |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| +++ |(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| +++ |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| +++ |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| +++ |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| +++ |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| +++ |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| +++ |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| +++ |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| +++ |(FAST-METHOD MAKE-INSTANCE (CLASS))| +++ |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| +++ |(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| +++ |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| +++ |(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| +++ |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| +++ |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| +++ |(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| +++ |(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| +++ |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| ++ CLASS-PREDICATE-NAME ++- |PCL::STRUCTURE-EFFECTIVE-SLOT-DEFINITION class predicate| ++- |PCL::STRUCTURE-DIRECT-SLOT-DEFINITION class predicate| ++ |PCL::STRUCTURE-SLOT-DEFINITION class predicate| ++- |PCL::STRUCTURE-OBJECT class predicate| ++- |LISP::SYMBOL class predicate| +++ |PCL::STRUCTURE-DIRECT-SLOT-DEFINITION class predicate| +++ |PCL::STRUCTURE-EFFECTIVE-SLOT-DEFINITION class predicate| ++ |PCL::EFFECTIVE-SLOT-DEFINITION class predicate| ++ |(COMBINED-METHOD SHARED-INITIALIZE)| ++ LEGAL-QUALIFIERS-P ADD-BOUNDP-METHOD ++- LEGAL-LAMBDA-LIST-P |LISP::VECTOR class predicate| ++- |SETF PCL GENERIC-FUNCTION-NAME| +++ LEGAL-LAMBDA-LIST-P |SETF PCL GENERIC-FUNCTION-NAME| ++ |(READER READER-FUNCTION)| |(READER PREDICATE-NAME)| ++- |(READER READERS)| DESCRIBE-OBJECT ++- |(READER CLASS-PRECEDENCE-LIST)| ++- |(READER ACCESSOR-FLAGS)| |(READER DOCUMENTATION)| ++- |(READER LOCATION)| CLASS-INITIALIZE-INFO +++ |(READER READERS)| |(READER CLASS-PRECEDENCE-LIST)| +++ |(READER ACCESSOR-FLAGS)| |(READER LOCATION)| +++ |(READER DOCUMENTATION)| CLASS-INITIALIZE-INFO ++ |(SETF CLASS-SLOT-VALUE)| MAKE-WRITER-METHOD-FUNCTION ++ |SETF PCL GF-DFUN-STATE| ++ |(READER INCOMPATIBLE-SUPERCLASS-LIST)| ++@@ -942,75 +1199,75 @@ ++ |(READER IDENTITY-WITH-ONE-ARGUMENT)| ++ |(SETF CLASS-INITIALIZE-INFO)| ++ |(READER PRETTY-ARGLIST)| |(READER DEFSTRUCT-FORM)| ++- |SETF PCL CLASS-NAME| |SETF PCL SLOT-DEFINITION-NAME| +++ |SETF PCL SLOT-DEFINITION-NAME| ++ |(WRITER READER-FUNCTION)| ++ |(SETF CLASS-DEFSTRUCT-CONSTRUCTOR)| ++ |(WRITER PREDICATE-NAME)| |(WRITER READERS)| ++- |(READER INITFUNCTION)| |(READER WRITER-FUNCTION)| +++ |(READER WRITER-FUNCTION)| |(READER INITFUNCTION)| ++ INITIALIZE-INTERNAL-SLOT-FUNCTIONS ++- |SETF PCL SLOT-DEFINITION-TYPE| ++- |(WRITER CLASS-PRECEDENCE-LIST)| |(READER WRITERS)| +++ |SETF PCL SLOT-DEFINITION-TYPE| |(READER WRITERS)| +++ |(WRITER CLASS-PRECEDENCE-LIST)| ++ |(WRITER ACCESSOR-FLAGS)| |(READER INITFORM)| ++- METHOD-COMBINATION-P |(WRITER DOCUMENTATION)| ++- |(WRITER LOCATION)| +++ METHOD-COMBINATION-P |(WRITER LOCATION)| +++ |(WRITER DOCUMENTATION)| ++ |(CALL REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION)| ++- |SETF PCL METHOD-GENERIC-FUNCTION| ++- |SETF PCL GENERIC-FUNCTION-METHOD-COMBINATION| ++ |SETF PCL GENERIC-FUNCTION-METHODS| ++- |(READER SLOT-NAME)| +++ |SETF PCL GENERIC-FUNCTION-METHOD-COMBINATION| +++ |SETF PCL METHOD-GENERIC-FUNCTION| |(READER SLOT-NAME)| ++ |(WRITER INCOMPATIBLE-SUPERCLASS-LIST)| ++ |SETF PCL SLOT-ACCESSOR-STD-P| ++ |(CALL REAL-MAKE-METHOD-INITARGS-FORM)| ++ |(READER ALLOCATION)| |(WRITER SPECIALIZERS)| ++ |(CALL REAL-ENSURE-GF-USING-CLASS--NULL)| ++ |(WRITER IDENTITY-WITH-ONE-ARGUMENT)| ++- |(SETF METHOD-GENERIC-FUNCTION)| LEGAL-SPECIALIZERS-P ++- |(WRITER PRETTY-ARGLIST)| |SETF PCL OBJECT-PLIST| ++- |LISP::FLOAT class predicate| |(WRITER DEFSTRUCT-FORM)| ++- |(READER GENERIC-FUNCTION)| |(READER FUNCTION)| +++ |(SETF METHOD-GENERIC-FUNCTION)| +++ |(WRITER PRETTY-ARGLIST)| LEGAL-SPECIALIZERS-P +++ |SETF PCL OBJECT-PLIST| |(WRITER DEFSTRUCT-FORM)| +++ |(READER FUNCTION)| |(READER GENERIC-FUNCTION)| ++ |(READER LAMBDA-LIST)| |(READER SLOT-DEFINITION)| ++ |PCL::CLASS-PROTOTYPE-SPECIALIZER class predicate| ++- |SETF PCL CLASS-DEFSTRUCT-FORM| ++ |SETF PCL SLOT-DEFINITION-INITFORM| +++ |SETF PCL CLASS-DEFSTRUCT-FORM| ++ |(READER CAN-PRECEDE-LIST)| ++ |SETF PCL GENERIC-FUNCTION-METHOD-CLASS| ++- |(READER PROTOTYPE)| |(WRITER INITFUNCTION)| ++- |(WRITER WRITER-FUNCTION)| |(WRITER WRITERS)| +++ |(READER PROTOTYPE)| |(WRITER WRITER-FUNCTION)| +++ |(WRITER INITFUNCTION)| |(WRITER WRITERS)| ++ SLOT-ACCESSOR-STD-P |(WRITER INITFORM)| ++ |(READER DFUN-STATE)| |(READER FROM-DEFCLASS-P)| ++ |SETF PCL GF-PRETTY-ARGLIST| ++- |SETF PCL SLOT-DEFINITION-INITFUNCTION| ++- |SETF PCL SLOT-DEFINITION-ALLOCATION| ++- |SETF PCL SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION| ++- |SETF PCL SLOT-DEFINITION-INTERNAL-READER-FUNCTION| ++- |SETF PCL SLOT-DEFINITION-BOUNDP-FUNCTION| ++- |SETF PCL SLOT-DEFINITION-WRITER-FUNCTION| ++- |SETF PCL SLOT-DEFINITION-READER-FUNCTION| +++ |SETF PCL SLOT-ACCESSOR-FUNCTION| ++ |SETF PCL SLOT-DEFINITION-LOCATION| ++- |SETF PCL SLOT-ACCESSOR-FUNCTION| |(WRITER SLOT-NAME)| ++- |(BOUNDP NAME)| |(WRITER ALLOCATION)| ++- |(READER FAST-FUNCTION)| |(READER METHOD-CLASS)| ++- |(SETF OBJECT-PLIST)| |(READER METHOD-COMBINATION)| ++- |(READER INTERNAL-READER-FUNCTION)| +++ |SETF PCL SLOT-DEFINITION-READER-FUNCTION| +++ |SETF PCL SLOT-DEFINITION-WRITER-FUNCTION| +++ |SETF PCL SLOT-DEFINITION-BOUNDP-FUNCTION| +++ |SETF PCL SLOT-DEFINITION-INTERNAL-READER-FUNCTION| +++ |SETF PCL SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION| +++ |SETF PCL SLOT-DEFINITION-ALLOCATION| +++ |SETF PCL SLOT-DEFINITION-INITFUNCTION| +++ |(WRITER SLOT-NAME)| |(BOUNDP NAME)| +++ |(READER FAST-FUNCTION)| |(WRITER ALLOCATION)| +++ |(READER METHOD-CLASS)| |(SETF OBJECT-PLIST)| ++ |(READER INTERNAL-WRITER-FUNCTION)| ++- METHOD-COMBINATION-OPTIONS |(READER DIRECT-METHODS)| ++- |(READER DIRECT-SLOTS)| ++- |SETF PCL SLOT-DEFINITION-READERS| ++- |(READER BOUNDP-FUNCTION)| |(WRITER GENERIC-FUNCTION)| ++- |(WRITER FUNCTION)| |(READER DIRECT-SUPERCLASSES)| ++- |(READER DIRECT-SUBCLASSES)| |SETF PCL DOCUMENTATION| ++- |(WRITER LAMBDA-LIST)| |LISP::LIST class predicate| ++- FUNCALLABLE-STANDARD-CLASS-P |(BOUNDP CLASS)| +++ |(READER INTERNAL-READER-FUNCTION)| +++ |(READER METHOD-COMBINATION)| +++ METHOD-COMBINATION-OPTIONS |(READER DIRECT-SLOTS)| +++ |(READER DIRECT-METHODS)| +++ |SETF PCL SLOT-DEFINITION-READERS| |(WRITER FUNCTION)| +++ |(WRITER GENERIC-FUNCTION)| |(READER BOUNDP-FUNCTION)| +++ |SETF PCL DOCUMENTATION| |(READER DIRECT-SUBCLASSES)| +++ |(READER DIRECT-SUPERCLASSES)| |(WRITER LAMBDA-LIST)| +++ FUNCALLABLE-STANDARD-CLASS-P ++ |(FAST-WRITER-METHOD SLOT-OBJECT METHOD)| ++- |(WRITER SLOT-DEFINITION)| |(READER OPTIONS)| ++- |(READER METHODS)| |(WRITER CAN-PRECEDE-LIST)| ++- |SETF PCL SLOT-VALUE-USING-CLASS| +++ |(BOUNDP CLASS)| |(WRITER SLOT-DEFINITION)| +++ |(READER METHODS)| |(READER OPTIONS)| +++ |(WRITER CAN-PRECEDE-LIST)| ++ |SETF PCL SLOT-DEFINITION-CLASS| ++- |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)| +++ |SETF PCL SLOT-VALUE-USING-CLASS| ++ |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)| ++- |(WRITER PROTOTYPE)| |(BOUNDP OBJECT)| |(BOUNDP TYPE)| ++- CLASS-CAN-PRECEDE-LIST |SETF PCL CLASS-SLOTS| ++- |SETF PCL CLASS-DIRECT-SLOTS| SLOT-ACCESSOR-FUNCTION +++ |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)| +++ |(WRITER PROTOTYPE)| |(BOUNDP TYPE)| |(BOUNDP OBJECT)| +++ CLASS-CAN-PRECEDE-LIST |SETF PCL CLASS-DIRECT-SLOTS| +++ |SETF PCL CLASS-SLOTS| SLOT-ACCESSOR-FUNCTION ++ |(BOUNDP PLIST)| ++ |SETF PCL CLASS-INCOMPATIBLE-SUPERCLASS-LIST| ++ |SETF PCL SLOT-DEFINITION-WRITERS| ++@@ -1018,290 +1275,287 @@ ++ |(WRITER DFUN-STATE)| |(WRITER FROM-DEFCLASS-P)| ++ |(BOUNDP SLOTS)| SLOT-CLASS-P ++ MAKE-READER-METHOD-FUNCTION LEGAL-METHOD-FUNCTION-P ++- |(FAST-WRITER-METHOD SLOT-OBJECT ARG-INFO)| ++- |(FAST-WRITER-METHOD SLOT-CLASS INITIALIZE-INFO)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT INITIALIZE-INFO)| +++ |(FAST-WRITER-METHOD SLOT-CLASS INITIALIZE-INFO)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT ARG-INFO)| ++ |PCL::PLIST-MIXIN class predicate| ++ |(WRITER FAST-FUNCTION)| |(WRITER METHOD-CLASS)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT WRAPPER)| ++- |(WRITER METHOD-COMBINATION)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT WRAPPER)| GET-METHOD +++ |(WRITER INTERNAL-WRITER-FUNCTION)| ++ |(WRITER INTERNAL-READER-FUNCTION)| ++- |(WRITER INTERNAL-WRITER-FUNCTION)| GET-METHOD ++- |(WRITER DIRECT-METHODS)| |(WRITER DIRECT-SLOTS)| ++- |(FAST-WRITER-METHOD SLOT-DEFINITION INITARGS)| +++ |(WRITER METHOD-COMBINATION)| |(WRITER DIRECT-SLOTS)| +++ |(WRITER DIRECT-METHODS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT INITARGS)| ++- |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-CONSTRUCTOR)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)| +++ |(FAST-WRITER-METHOD SLOT-DEFINITION INITARGS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT OPERATOR)| ++- |(WRITER BOUNDP-FUNCTION)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)| +++ |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-CONSTRUCTOR)| +++ |(WRITER BOUNDP-FUNCTION)| |(WRITER DIRECT-SUBCLASSES)| ++ |(WRITER DIRECT-SUPERCLASSES)| ++- |(WRITER DIRECT-SUBCLASSES)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT CLASS-EQ-SPECIALIZER)| ++- |(WRITER OPTIONS)| |(WRITER METHODS)| +++ |(WRITER METHODS)| |(WRITER OPTIONS)| ++ SHORT-METHOD-COMBINATION-P GF-ARG-INFO ++ SPECIALIZER-METHOD-TABLE MAKE-METHOD-INITARGS-FORM ++ CLASS-DEFSTRUCT-FORM ++- |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION NAME)| ++- |(FAST-READER-METHOD SLOT-OBJECT NAME)| ++- |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION DFUN-STATE)| ++- |(FAST-READER-METHOD SLOT-OBJECT DFUN-STATE)| ++- |(FAST-READER-METHOD STANDARD-ACCESSOR-METHOD SLOT-NAME)| ++- |(FAST-READER-METHOD SLOT-OBJECT SLOT-NAME)| ++- |(FAST-READER-METHOD SLOT-DEFINITION NAME)| ++- |(FAST-READER-METHOD CLASS NAME)| ++- |(FAST-READER-METHOD CLASS PREDICATE-NAME)| ++ |(FAST-READER-METHOD SLOT-OBJECT PREDICATE-NAME)| ++- |LISP::INTEGER class predicate| GF-PRETTY-ARGLIST ++- SAME-SPECIALIZER-P ++- SLOT-DEFINITION-INTERNAL-READER-FUNCTION ++- SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION ++- SLOT-DEFINITION-READER-FUNCTION ++- SLOT-DEFINITION-WRITER-FUNCTION +++ |(FAST-READER-METHOD CLASS PREDICATE-NAME)| +++ |(FAST-READER-METHOD CLASS NAME)| +++ |(FAST-READER-METHOD SLOT-DEFINITION NAME)| +++ |(FAST-READER-METHOD SLOT-OBJECT SLOT-NAME)| +++ |(FAST-READER-METHOD STANDARD-ACCESSOR-METHOD SLOT-NAME)| +++ |(FAST-READER-METHOD SLOT-OBJECT DFUN-STATE)| +++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION DFUN-STATE)| +++ |(FAST-READER-METHOD SLOT-OBJECT NAME)| +++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION NAME)| +++ GF-PRETTY-ARGLIST SAME-SPECIALIZER-P ++ SLOT-DEFINITION-BOUNDP-FUNCTION ++- |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHOD-CLASS)| ++- |(FAST-READER-METHOD SLOT-OBJECT METHOD-CLASS)| ++- |(FAST-READER-METHOD SLOT-OBJECT ACCESSOR-FLAGS)| ++- |(FAST-READER-METHOD SLOT-DEFINITION CLASS)| ++- |(FAST-READER-METHOD SLOT-OBJECT CLASS)| ++- |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION DOCUMENTATION)| ++- |(FAST-READER-METHOD SLOT-OBJECT DOCUMENTATION)| ++- |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHOD-COMBINATION)| ++- |(FAST-READER-METHOD SLOT-OBJECT METHOD-COMBINATION)| ++- |(FAST-READER-METHOD STANDARD-ACCESSOR-METHOD SLOT-DEFINITION)| ++- |(FAST-READER-METHOD SLOT-OBJECT SLOT-DEFINITION)| ++- |(FAST-READER-METHOD STANDARD-METHOD GENERIC-FUNCTION)| ++- |(FAST-READER-METHOD SLOT-OBJECT GENERIC-FUNCTION)| ++- |(FAST-READER-METHOD SLOT-OBJECT FUNCTION)| ++- |(FAST-READER-METHOD STANDARD-METHOD FAST-FUNCTION)| ++- |(FAST-READER-METHOD SLOT-OBJECT FAST-FUNCTION)| ++- |(FAST-READER-METHOD STANDARD-EFFECTIVE-SLOT-DEFINITION LOCATION)| ++- |(FAST-READER-METHOD SLOT-OBJECT LOCATION)| ++- |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION READER-FUNCTION)| ++- |(FAST-READER-METHOD SLOT-OBJECT READER-FUNCTION)| ++- |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION WRITER-FUNCTION)| ++- |(FAST-READER-METHOD SLOT-OBJECT WRITER-FUNCTION)| ++- |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION BOUNDP-FUNCTION)| ++- |(FAST-READER-METHOD SLOT-OBJECT BOUNDP-FUNCTION)| ++- |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-READER-FUNCTION)| ++- |(FAST-READER-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)| ++- |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-WRITER-FUNCTION)| ++- |(FAST-READER-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)| ++- |(FAST-READER-METHOD STANDARD-SLOT-DEFINITION ALLOCATION)| ++- |(FAST-READER-METHOD SLOT-OBJECT ALLOCATION)| ++- |(FAST-READER-METHOD SLOT-DEFINITION INITFUNCTION)| ++- |(FAST-READER-METHOD SLOT-OBJECT INITFUNCTION)| ++- |(FAST-READER-METHOD LONG-METHOD-COMBINATION FUNCTION)| ++- |(FAST-READER-METHOD TRACED-METHOD FUNCTION)| +++ SLOT-DEFINITION-WRITER-FUNCTION +++ SLOT-DEFINITION-READER-FUNCTION +++ SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION +++ SLOT-DEFINITION-INTERNAL-READER-FUNCTION +++ |(FAST-READER-METHOD SLOT-OBJECT CLASS)| +++ |(FAST-READER-METHOD SLOT-DEFINITION CLASS)| +++ |(FAST-READER-METHOD SLOT-OBJECT ACCESSOR-FLAGS)| +++ |(FAST-READER-METHOD SLOT-OBJECT METHOD-CLASS)| +++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHOD-CLASS)| ++ |(FAST-READER-METHOD TRACED-METHOD GENERIC-FUNCTION)| ++- |(FAST-READER-METHOD STANDARD-METHOD SPECIALIZERS)| ++- |(FAST-READER-METHOD SLOT-OBJECT SPECIALIZERS)| ++- |(FAST-READER-METHOD SLOT-DEFINITION READERS)| ++- |(FAST-READER-METHOD SLOT-OBJECT READERS)| ++- |(FAST-READER-METHOD SLOT-DEFINITION WRITERS)| +++ |(FAST-READER-METHOD TRACED-METHOD FUNCTION)| +++ |(FAST-READER-METHOD LONG-METHOD-COMBINATION FUNCTION)| +++ |(FAST-READER-METHOD SLOT-OBJECT INITFUNCTION)| +++ |(FAST-READER-METHOD SLOT-DEFINITION INITFUNCTION)| +++ |(FAST-READER-METHOD SLOT-OBJECT ALLOCATION)| +++ |(FAST-READER-METHOD STANDARD-SLOT-DEFINITION ALLOCATION)| +++ |(FAST-READER-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)| +++ |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-WRITER-FUNCTION)| +++ |(FAST-READER-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)| +++ |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-READER-FUNCTION)| +++ |(FAST-READER-METHOD SLOT-OBJECT BOUNDP-FUNCTION)| +++ |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION BOUNDP-FUNCTION)| +++ |(FAST-READER-METHOD SLOT-OBJECT WRITER-FUNCTION)| +++ |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION WRITER-FUNCTION)| +++ |(FAST-READER-METHOD SLOT-OBJECT READER-FUNCTION)| +++ |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION READER-FUNCTION)| +++ |(FAST-READER-METHOD SLOT-OBJECT LOCATION)| +++ |(FAST-READER-METHOD STANDARD-EFFECTIVE-SLOT-DEFINITION LOCATION)| +++ |(FAST-READER-METHOD SLOT-OBJECT FAST-FUNCTION)| +++ |(FAST-READER-METHOD STANDARD-METHOD FAST-FUNCTION)| +++ |(FAST-READER-METHOD SLOT-OBJECT FUNCTION)| +++ |(FAST-READER-METHOD SLOT-OBJECT GENERIC-FUNCTION)| +++ |(FAST-READER-METHOD STANDARD-METHOD GENERIC-FUNCTION)| +++ |(FAST-READER-METHOD SLOT-OBJECT SLOT-DEFINITION)| +++ |(FAST-READER-METHOD STANDARD-ACCESSOR-METHOD SLOT-DEFINITION)| +++ |(FAST-READER-METHOD SLOT-OBJECT METHOD-COMBINATION)| +++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHOD-COMBINATION)| +++ |(FAST-READER-METHOD SLOT-OBJECT DOCUMENTATION)| +++ |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION DOCUMENTATION)| ++ |(FAST-READER-METHOD SLOT-OBJECT WRITERS)| ++- |(FAST-READER-METHOD EQL-SPECIALIZER OBJECT)| ++- |(FAST-READER-METHOD SLOT-OBJECT OBJECT)| ++- |(FAST-READER-METHOD CLASS-PROTOTYPE-SPECIALIZER OBJECT)| ++- |(FAST-READER-METHOD CLASS-EQ-SPECIALIZER OBJECT)| ++- |(FAST-READER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| ++- |(FAST-READER-METHOD SHORT-METHOD-COMBINATION IDENTITY-WITH-ONE-ARGUMENT)| ++- |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION TYPE)| ++- |(FAST-READER-METHOD SLOT-OBJECT TYPE)| ++- |(FAST-READER-METHOD SLOT-DEFINITION TYPE)| ++- |(FAST-READER-METHOD PCL-CLASS PROTOTYPE)| ++- |(FAST-READER-METHOD SLOT-OBJECT PROTOTYPE)| +++ |(FAST-READER-METHOD SLOT-DEFINITION WRITERS)| +++ |(FAST-READER-METHOD SLOT-OBJECT READERS)| +++ |(FAST-READER-METHOD SLOT-DEFINITION READERS)| +++ |(FAST-READER-METHOD SLOT-OBJECT SPECIALIZERS)| +++ |(FAST-READER-METHOD STANDARD-METHOD SPECIALIZERS)| ++ |(FAST-READER-METHOD SPECIALIZER TYPE)| ++- |(FAST-READER-METHOD SLOT-DEFINITION INITFORM)| ++- |(FAST-READER-METHOD SLOT-OBJECT INITFORM)| ++- |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)| +++ |(FAST-READER-METHOD SLOT-OBJECT PROTOTYPE)| +++ |(FAST-READER-METHOD PCL-CLASS PROTOTYPE)| +++ |(FAST-READER-METHOD SLOT-DEFINITION TYPE)| +++ |(FAST-READER-METHOD SLOT-OBJECT TYPE)| +++ |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION TYPE)| +++ |(FAST-READER-METHOD SHORT-METHOD-COMBINATION IDENTITY-WITH-ONE-ARGUMENT)| +++ |(FAST-READER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| +++ |(FAST-READER-METHOD CLASS-EQ-SPECIALIZER OBJECT)| +++ |(FAST-READER-METHOD CLASS-PROTOTYPE-SPECIALIZER OBJECT)| +++ |(FAST-READER-METHOD SLOT-OBJECT OBJECT)| +++ |(FAST-READER-METHOD EQL-SPECIALIZER OBJECT)| ++ |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| ++- |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION PRETTY-ARGLIST)| ++- |(FAST-READER-METHOD SLOT-OBJECT PRETTY-ARGLIST)| ++- |(FAST-READER-METHOD STANDARD-METHOD LAMBDA-LIST)| ++- |(FAST-READER-METHOD SLOT-OBJECT LAMBDA-LIST)| ++- |(FAST-READER-METHOD PCL-CLASS CLASS-PRECEDENCE-LIST)| ++- |(FAST-READER-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)| ++- |(FAST-READER-METHOD PCL-CLASS CAN-PRECEDE-LIST)| ++- |(FAST-READER-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)| ++- |(FAST-READER-METHOD PCL-CLASS INCOMPATIBLE-SUPERCLASS-LIST)| ++- |(FAST-READER-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)| ++- |(FAST-READER-METHOD PLIST-MIXIN PLIST)| +++ |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)| +++ |(FAST-READER-METHOD SLOT-OBJECT INITFORM)| +++ |(FAST-READER-METHOD SLOT-DEFINITION INITFORM)| ++ |(FAST-READER-METHOD SLOT-OBJECT PLIST)| ++- |(FAST-READER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| ++- |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION OPTIONS)| ++- |(FAST-READER-METHOD SLOT-OBJECT OPTIONS)| ++- |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHODS)| ++- |(FAST-READER-METHOD SLOT-OBJECT METHODS)| ++- |(FAST-READER-METHOD SLOT-CLASS DIRECT-SLOTS)| ++- |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SLOTS)| ++- |(FAST-READER-METHOD SLOT-CLASS SLOTS)| ++- |(FAST-READER-METHOD SLOT-OBJECT SLOTS)| +++ |(FAST-READER-METHOD PLIST-MIXIN PLIST)| +++ |(FAST-READER-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)| +++ |(FAST-READER-METHOD PCL-CLASS INCOMPATIBLE-SUPERCLASS-LIST)| +++ |(FAST-READER-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)| +++ |(FAST-READER-METHOD PCL-CLASS CAN-PRECEDE-LIST)| +++ |(FAST-READER-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)| +++ |(FAST-READER-METHOD PCL-CLASS CLASS-PRECEDENCE-LIST)| +++ |(FAST-READER-METHOD SLOT-OBJECT LAMBDA-LIST)| +++ |(FAST-READER-METHOD STANDARD-METHOD LAMBDA-LIST)| +++ |(FAST-READER-METHOD SLOT-OBJECT PRETTY-ARGLIST)| +++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION PRETTY-ARGLIST)| ++ |(FAST-READER-METHOD SLOT-OBJECT DIRECT-METHODS)| ++- |(FAST-READER-METHOD CLASS DIRECT-SUPERCLASSES)| ++- |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)| ++- |(FAST-READER-METHOD CLASS DIRECT-SUBCLASSES)| +++ |(FAST-READER-METHOD SLOT-OBJECT SLOTS)| +++ |(FAST-READER-METHOD SLOT-CLASS SLOTS)| +++ |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SLOTS)| +++ |(FAST-READER-METHOD SLOT-CLASS DIRECT-SLOTS)| +++ |(FAST-READER-METHOD SLOT-OBJECT METHODS)| +++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHODS)| +++ |(FAST-READER-METHOD SLOT-OBJECT OPTIONS)| +++ |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION OPTIONS)| +++ |(FAST-READER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| ++ |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)| +++ |(FAST-READER-METHOD CLASS DIRECT-SUBCLASSES)| +++ |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)| +++ |(FAST-READER-METHOD CLASS DIRECT-SUPERCLASSES)| ++ SLOT-DEFINITION-CLASS EQL-SPECIALIZER-OBJECT ++ |PCL::DIRECT-SLOT-DEFINITION class predicate| ++ CLASS-CONSTRUCTORS |(BOUNDP WRAPPER)| SLOTS-TO-INSPECT ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT NAME)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT DFUN-STATE)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOT-NAME)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT PREDICATE-NAME)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOT-NAME)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DFUN-STATE)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT NAME)| ++ |(BOUNDP DEFSTRUCT-ACCESSOR-SYMBOL)| ++ SPECIALIZER-DIRECT-GENERIC-FUNCTIONS ++ |(BOUNDP CLASS-EQ-SPECIALIZER)| ++ |(SETF SLOT-DEFINITION-NAME)| ADD-WRITER-METHOD ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT METHOD-CLASS)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT ACCESSOR-FLAGS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT CLASS)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT DOCUMENTATION)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT METHOD-COMBINATION)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOT-DEFINITION)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT GENERIC-FUNCTION)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT FUNCTION)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT FAST-FUNCTION)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT LOCATION)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT READER-FUNCTION)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT WRITER-FUNCTION)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT BOUNDP-FUNCTION)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT ALLOCATION)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT ACCESSOR-FLAGS)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT METHOD-CLASS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT INITFUNCTION)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT ALLOCATION)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT BOUNDP-FUNCTION)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT WRITER-FUNCTION)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT READER-FUNCTION)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT LOCATION)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT FAST-FUNCTION)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT FUNCTION)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT GENERIC-FUNCTION)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOT-DEFINITION)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT METHOD-COMBINATION)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DOCUMENTATION)| ++ |(BOUNDP OPERATOR)| |(BOUNDP ARG-INFO)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT SPECIALIZERS)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT READERS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT WRITERS)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT OBJECT)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT TYPE)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT READERS)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT SPECIALIZERS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT PROTOTYPE)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT INITFORM)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT TYPE)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT OBJECT)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| ++- |(SETF SLOT-DEFINITION-CLASS)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT INITFORM)| ++ |(SETF SLOT-VALUE-USING-CLASS)| ++- |(SETF SLOT-DEFINITION-LOCATION)| ++- |(SETF SLOT-DEFINITION-READER-FUNCTION)| ++- |(SETF SLOT-DEFINITION-WRITER-FUNCTION)| ++- |(SETF SLOT-DEFINITION-BOUNDP-FUNCTION)| ++- |(SETF SLOT-DEFINITION-INTERNAL-READER-FUNCTION)| ++- |(SETF SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION)| ++- |(SETF SLOT-DEFINITION-ALLOCATION)| ++- |(SETF SLOT-DEFINITION-INITFUNCTION)| +++ |(SETF SLOT-DEFINITION-CLASS)| ++ |(SETF SLOT-ACCESSOR-FUNCTION)| +++ |(SETF SLOT-DEFINITION-INITFUNCTION)| +++ |(SETF SLOT-DEFINITION-ALLOCATION)| +++ |(SETF SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION)| +++ |(SETF SLOT-DEFINITION-INTERNAL-READER-FUNCTION)| +++ |(SETF SLOT-DEFINITION-BOUNDP-FUNCTION)| +++ |(SETF SLOT-DEFINITION-WRITER-FUNCTION)| +++ |(SETF SLOT-DEFINITION-READER-FUNCTION)| +++ |(SETF SLOT-DEFINITION-LOCATION)| ++ |(BOUNDP DEFSTRUCT-CONSTRUCTOR)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT PRETTY-ARGLIST)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT LAMBDA-LIST)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT PLIST)| ++- |(SETF SLOT-DEFINITION-READERS)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT LAMBDA-LIST)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT PRETTY-ARGLIST)| ++ |(SETF SLOT-DEFINITION-WRITERS)| +++ |(SETF SLOT-DEFINITION-READERS)| ++ |(SETF SLOT-DEFINITION-TYPE)| ++ |(SETF SLOT-DEFINITION-INITFORM)| ++ |(BOUNDP INITIALIZE-INFO)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT OPTIONS)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT METHODS)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SLOTS)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOTS)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-METHODS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-METHODS)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOTS)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SLOTS)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT METHODS)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT OPTIONS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)| ++ |(FAST-INTERNAL-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)| ++ |(BOUNDP INITARGS)| LONG-METHOD-COMBINATION-FUNCTION ++ GENERIC-FUNCTION-P ++- |PCL::SLOT-DEFINITION class predicate| ++- |LISP::NULL class predicate| |(READER NAME)| ++- |(READER CLASS)| |(FAST-METHOD SLOT-MISSING (T T T T))| +++ |PCL::SLOT-DEFINITION class predicate| |(READER NAME)| +++ |(READER CLASS)| |(FAST-METHOD SLOT-UNBOUND (T T T))| ++ |(FAST-METHOD (SETF DOCUMENTATION) (T T))| ++- |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| ++- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| ++- |(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| ++- |(FAST-METHOD SLOT-UNBOUND (T T T))| ++- |(FAST-METHOD REMOVE-NAMED-METHOD (T T))| ++- |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| +++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| ++ |(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| ++- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| ++ |(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| +++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| +++ |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| +++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| +++ |(FAST-METHOD REMOVE-NAMED-METHOD (T T))| +++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| +++ |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| ++- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| ++- |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| +++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| +++ |(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| +++ |(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| +++ |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| +++ |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +++ |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| +++ |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| +++ |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +++ |(FAST-METHOD PRINT-OBJECT (CLASS T))| +++ |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| +++ |(FAST-METHOD PRINT-OBJECT (T T))| +++ |(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +++ |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| +++ |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| +++ |(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| +++ |(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +++ |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +++ |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| +++ |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| +++ |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| +++ |(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| +++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| +++ |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| +++ |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| +++ |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| +++ |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| +++ |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| +++ |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| +++ |(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| +++ |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| +++ |(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| +++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| +++ |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| +++ |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| +++ |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| +++ |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| +++ |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| +++ |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +++ |(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| +++ |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| ++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| +++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| ++ |(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| +++ |(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| +++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| +++ |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| +++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| +++ |(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| +++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| +++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| ++- |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| ++- |(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| ++ |(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| ++- |(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| ++- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| ++- |(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| ++- |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| ++- |(FAST-METHOD DESCRIBE-OBJECT (T T))| ++- |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| ++- |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| ++- |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| ++ |(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| +++ |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| +++ |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| ++ |(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| +++ |(FAST-METHOD DESCRIBE-OBJECT (T T))| ++ |(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| ++ |(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| +++ |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| +++ |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| ++ |(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| +++ |(FAST-METHOD SLOT-MISSING (T T T T))| ++ |(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| ++- |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++- |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| ++- |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| ++- |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| ++- |(FAST-METHOD PRINT-OBJECT (T T))| ++- |(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| ++- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++- |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++- |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| ++- |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| ++- |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++- |(FAST-METHOD PRINT-OBJECT (CLASS T))| ++- |(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++- |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| ++- |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| ++- |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| ++- |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| ++- |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| ++- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| ++- |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| ++- |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| ++- |(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| ++- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| ++- |(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++- |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| ++- |(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| ++- |(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| ++- |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| ++- |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| ++- |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| ++- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++- |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| ++- |(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| ++- |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| ++- |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| ++- |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++- LEGAL-SLOT-NAME-P |(READER OBJECT)| |(READER TYPE)| +++ LEGAL-SLOT-NAME-P |(READER TYPE)| |(READER OBJECT)| ++ CLASS-WRAPPER |(READER PLIST)| ++- |(FAST-METHOD NO-APPLICABLE-METHOD (T))| ++- |(FAST-METHOD DOCUMENTATION (T))| ++ |(FAST-METHOD CLASS-PREDICATE-NAME (T))| +++ |(FAST-METHOD DOCUMENTATION (T))| +++ |(FAST-METHOD NO-APPLICABLE-METHOD (T))| ++ |(READER SLOTS)| |(WRITER NAME)| DEFINITION-SOURCE ++ |PCL::SLOT-OBJECT class predicate| DEFAULT-INITARGS ++- |(WRITER CLASS)| CLASS-SLOT-VALUE |(WRITER OBJECT)| ++- |(WRITER TYPE)| +++ |(WRITER CLASS)| CLASS-SLOT-VALUE |(WRITER TYPE)| +++ |(WRITER OBJECT)| ++ |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| ++ |(WRITER PLIST)| |(WRITER SLOTS)| ++ |PCL::DOCUMENTATION-MIXIN class predicate| ++@@ -1309,37 +1563,55 @@ ++ LEGAL-QUALIFIER-P METHOD-P ++ |PCL::SPECIALIZER-WITH-OBJECT class predicate| ++ CLASS-SLOT-CELLS ++- |(COMBINED-METHOD REINITIALIZE-INSTANCE)| ++ |(COMBINED-METHOD INITIALIZE-INSTANCE)| +++ |(COMBINED-METHOD REINITIALIZE-INSTANCE)| ++ STANDARD-ACCESSOR-METHOD-P |(SETF CLASS-NAME)| ++- STANDARD-METHOD-P STANDARD-READER-METHOD-P ++- STANDARD-GENERIC-FUNCTION-P |(READER WRAPPER)| +++ STANDARD-GENERIC-FUNCTION-P STANDARD-READER-METHOD-P +++ STANDARD-METHOD-P |(READER WRAPPER)| ++ |(READER DEFSTRUCT-ACCESSOR-SYMBOL)| ++ |(READER CLASS-EQ-SPECIALIZER)| ++- COMPUTE-DEFAULT-INITARGS ++ COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS ++- |(SETF CLASS-DEFSTRUCT-FORM)| +++ COMPUTE-DEFAULT-INITARGS |(SETF CLASS-DEFSTRUCT-FORM)| ++ |(CALL REAL-MAKE-METHOD-LAMBDA)| ++ |(SETF CLASS-INCOMPATIBLE-SUPERCLASS-LIST)| ++- |SETF PCL CLASS-SLOT-VALUE| |(SETF CLASS-DIRECT-SLOTS)| ++- |(SETF CLASS-SLOTS)| DO-STANDARD-DEFSETF-1 ++- |(READER OPERATOR)| |(CALL REAL-ADD-METHOD)| ++- |(CALL REAL-REMOVE-METHOD)| |(CALL REAL-GET-METHOD)| +++ |COMMON-LISP::NULL class predicate| +++ |COMMON-LISP::SYMBOL class predicate| +++ |COMMON-LISP::CHARACTER class predicate| +++ |COMMON-LISP::BIT-VECTOR class predicate| +++ |COMMON-LISP::STRING class predicate| +++ |COMMON-LISP::VECTOR class predicate| +++ |COMMON-LISP::ARRAY class predicate| +++ |COMMON-LISP::CONS class predicate| +++ |COMMON-LISP::LIST class predicate| +++ |COMMON-LISP::SEQUENCE class predicate| +++ |COMMON-LISP::RATIO class predicate| +++ |COMMON-LISP::INTEGER class predicate| +++ |COMMON-LISP::RATIONAL class predicate| +++ |COMMON-LISP::FLOAT class predicate| +++ |COMMON-LISP::COMPLEX class predicate| +++ |COMMON-LISP::NUMBER class predicate| +++ |COMMON-LISP::T class predicate| +++ |COMMON-LISP::STRUCTURE-OBJECT class predicate| +++ |COMMON-LISP::STANDARD-OBJECT class predicate| +++ |COMMON-LISP::BUILT-IN-CLASS class predicate| +++ |SETF PCL CLASS-SLOT-VALUE| |(SETF CLASS-SLOTS)| +++ |(SETF CLASS-DIRECT-SLOTS)| DO-STANDARD-DEFSETF-1 +++ |(READER OPERATOR)| |(CALL REAL-GET-METHOD)| +++ |(CALL REAL-REMOVE-METHOD)| |(CALL REAL-ADD-METHOD)| ++ |(READER ARG-INFO)| METHOD-COMBINATION-TYPE ++ |(READER DEFSTRUCT-CONSTRUCTOR)| ++ |(INTERNAL-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)| ++ |(READER INITIALIZE-INFO)| |(WRITER WRAPPER)| ++- STANDARD-CLASS-P |LISP::NUMBER class predicate| ++- LEGAL-SPECIALIZER-P +++ STANDARD-CLASS-P LEGAL-SPECIALIZER-P ++ |PCL::LONG-METHOD-COMBINATION class predicate| ++ |(WRITER DEFSTRUCT-ACCESSOR-SYMBOL)| ++ COMPUTE-SLOT-ACCESSOR-INFO |(READER INITARGS)| ++ |(WRITER CLASS-EQ-SPECIALIZER)| ++ STANDARD-BOUNDP-METHOD-P FDEFINE-CAREFULLY ++ |(SETF DOCUMENTATION)| RAW-INSTANCE-ALLOCATOR ++- |SETF PCL CLASS-INITIALIZE-INFO| ++ |SETF PCL SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL| ++- |(WRITER OPERATOR)| |(WRITER ARG-INFO)| +++ |SETF PCL CLASS-INITIALIZE-INFO| |(WRITER OPERATOR)| +++ |(WRITER ARG-INFO)| ++ COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO ++ STANDARD-WRITER-METHOD-P ++ CLASS-INCOMPATIBLE-SUPERCLASS-LIST ++@@ -1349,78 +1621,77 @@ ++ METHOD-COMBINATION-DOCUMENTATION ++ |SETF PCL SLOT-DEFINITION-INITARGS| ++ REMOVE-BOUNDP-METHOD ADD-NAMED-METHOD ++- |(WRITER INITARGS)| ++ |SETF PCL CLASS-DEFSTRUCT-CONSTRUCTOR| ++- |LISP::CONS class predicate| |(BOUNDP METHOD)| ++- |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION NAME)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT NAME)| ++- |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION DFUN-STATE)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT DFUN-STATE)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT SLOT-NAME)| ++- |(FAST-WRITER-METHOD SLOT-DEFINITION NAME)| ++- |(FAST-WRITER-METHOD CLASS NAME)| +++ |(WRITER INITARGS)| |(BOUNDP METHOD)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT PREDICATE-NAME)| +++ |(FAST-WRITER-METHOD CLASS NAME)| +++ |(FAST-WRITER-METHOD SLOT-DEFINITION NAME)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT SLOT-NAME)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT DFUN-STATE)| +++ |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION DFUN-STATE)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT NAME)| +++ |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION NAME)| ++ |(BOUNDP SOURCE)| |(SETF GF-DFUN-STATE)| ++ SHORT-COMBINATION-OPERATOR ++- |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHOD-CLASS)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT METHOD-CLASS)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT ACCESSOR-FLAGS)| ++- |(FAST-WRITER-METHOD SLOT-DEFINITION CLASS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT CLASS)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT DOCUMENTATION)| ++- |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHOD-COMBINATION)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT METHOD-COMBINATION)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT SLOT-DEFINITION)| ++- |(FAST-WRITER-METHOD STANDARD-METHOD GENERIC-FUNCTION)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT GENERIC-FUNCTION)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT FUNCTION)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT FAST-FUNCTION)| ++- |(FAST-WRITER-METHOD STANDARD-EFFECTIVE-SLOT-DEFINITION LOCATION)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT LOCATION)| ++- |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION READER-FUNCTION)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT READER-FUNCTION)| ++- |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION WRITER-FUNCTION)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT WRITER-FUNCTION)| ++- |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION BOUNDP-FUNCTION)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT BOUNDP-FUNCTION)| ++- |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-READER-FUNCTION)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)| ++- |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-WRITER-FUNCTION)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)| ++- |(FAST-WRITER-METHOD STANDARD-SLOT-DEFINITION ALLOCATION)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT ALLOCATION)| ++- |(FAST-WRITER-METHOD SLOT-DEFINITION INITFUNCTION)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT INITFUNCTION)| +++ |(FAST-WRITER-METHOD SLOT-DEFINITION CLASS)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT ACCESSOR-FLAGS)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT METHOD-CLASS)| +++ |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHOD-CLASS)| ++ |(FAST-WRITER-METHOD TRACED-METHOD GENERIC-FUNCTION)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT SPECIALIZERS)| ++- |(FAST-WRITER-METHOD SLOT-DEFINITION READERS)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT READERS)| ++- |(FAST-WRITER-METHOD SLOT-DEFINITION WRITERS)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT INITFUNCTION)| +++ |(FAST-WRITER-METHOD SLOT-DEFINITION INITFUNCTION)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT ALLOCATION)| +++ |(FAST-WRITER-METHOD STANDARD-SLOT-DEFINITION ALLOCATION)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)| +++ |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-WRITER-FUNCTION)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)| +++ |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-READER-FUNCTION)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT BOUNDP-FUNCTION)| +++ |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION BOUNDP-FUNCTION)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT WRITER-FUNCTION)| +++ |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION WRITER-FUNCTION)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT READER-FUNCTION)| +++ |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION READER-FUNCTION)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT LOCATION)| +++ |(FAST-WRITER-METHOD STANDARD-EFFECTIVE-SLOT-DEFINITION LOCATION)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT FAST-FUNCTION)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT FUNCTION)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT GENERIC-FUNCTION)| +++ |(FAST-WRITER-METHOD STANDARD-METHOD GENERIC-FUNCTION)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT SLOT-DEFINITION)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT METHOD-COMBINATION)| +++ |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHOD-COMBINATION)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT DOCUMENTATION)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT WRITERS)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT OBJECT)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT TYPE)| ++- |(FAST-WRITER-METHOD SLOT-DEFINITION TYPE)| +++ |(FAST-WRITER-METHOD SLOT-DEFINITION WRITERS)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT READERS)| +++ |(FAST-WRITER-METHOD SLOT-DEFINITION READERS)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT SPECIALIZERS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT PROTOTYPE)| +++ |(FAST-WRITER-METHOD SLOT-DEFINITION TYPE)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT TYPE)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT OBJECT)| ++ REMOVE-NAMED-METHOD ++- |(FAST-WRITER-METHOD SLOT-DEFINITION INITFORM)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT INITFORM)| ++- |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| ++- |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION PRETTY-ARGLIST)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT PRETTY-ARGLIST)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT LAMBDA-LIST)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)| ++- |(FAST-WRITER-METHOD PCL-CLASS INCOMPATIBLE-SUPERCLASS-LIST)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)| ++- |(FAST-WRITER-METHOD PLIST-MIXIN PLIST)| +++ |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT INITFORM)| +++ |(FAST-WRITER-METHOD SLOT-DEFINITION INITFORM)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT PLIST)| +++ |(FAST-WRITER-METHOD PLIST-MIXIN PLIST)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)| +++ |(FAST-WRITER-METHOD PCL-CLASS INCOMPATIBLE-SUPERCLASS-LIST)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT LAMBDA-LIST)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT PRETTY-ARGLIST)| +++ |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION PRETTY-ARGLIST)| ++ LEGAL-DOCUMENTATION-P CLASS-DIRECT-SUPERCLASSES ++ CLASS-DIRECT-SUBCLASSES CLASS-DIRECT-DEFAULT-INITARGS ++ SLOT-DEFINITION-READERS SLOT-VALUE-USING-CLASS ++- COMPUTE-APPLICABLE-METHODS CLASS-NAME CLASSP ++- CLASS-PROTOTYPE READER-METHOD-CLASS REMOVE-METHOD +++ COMPUTE-APPLICABLE-METHODS CLASS-NAME CLASS-PROTOTYPE +++ CLASSP READER-METHOD-CLASS REMOVE-METHOD ++ SLOT-DEFINITION-INITFORM ++ UPDATE-INSTANCE-FOR-REDEFINED-CLASS ++ UPDATE-INSTANCE-FOR-DIFFERENT-CLASS CHANGE-CLASS ++@@ -1454,5 +1725,6 @@ ++ ENSURE-CLASS-USING-CLASS NO-APPLICABLE-METHOD ++ SLOT-DEFINITION-WRITERS ++ COMPUTE-APPLICABLE-METHODS-USING-CLASSES ++- CLASS-PRECEDENCE-LIST)) +++ CLASS-PRECEDENCE-LIST DISASSEMBLE DESCRIBE-OBJECT +++ COMPILE)) ++ (SETF (GET V 'SYSTEM::PROCLAIMED-CLOSURE) T)) ++--- gcl-2.6.12.orig/unixport/makefile +++++ gcl-2.6.12/unixport/makefile ++@@ -69,42 +69,7 @@ $(LSPDIR)/auto_new.lsp: $(LSPDIR)/auto.l ++ [ "$(RL_OBJS)" = "" ] || \ ++ echo "(AUTOLOAD 'init-readline '|readline|)" >>$@ ++ ++-init_gcl.lsp.tmp: init_gcl.lsp.in ++- cp $< $@ ++- ++-init_pre_gcl.lsp.tmp: init_pre_gcl.lsp.in ++- cp $< $@ ++- ++-init_mod_gcl.lsp.tmp: init_mod_gcl.lsp.in ++- cp $< $@ ++- ++-init_xgcl.lsp.tmp: init_gcl.lsp.tmp ++- ln -snf $< $@ ++- ++-init_pcl_gcl.lsp.tmp: init_pcl_gcl.lsp.in ../cmpnew/gcl_cmpmain.lsp \ ++- ../pcl/sys-package.lisp ../clcs/package.lisp \ ++- $(shell find ../clcs/ -name "clcs_*.lisp") ++- ++- awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} {if (i==0) print}' $< >$@ ++-# cat ../cmpnew/gcl_cmpmain.lsp >>$@ ++- cat ../pcl/sys-package.lisp >>$@ ++- awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} {if (i==1) print}' $< >>$@ ++- ++-init_ansi_gcl.lsp.tmp: init_ansi_gcl.lsp.in ../cmpnew/gcl_cmpmain.lsp \ ++- ../pcl/sys-package.lisp ../clcs/package.lisp ++- ++- awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} \ ++- /^ *@LI-CLCS-PACKAGE@/{i=2;next} {if (i==0) print}' $< >$@ ++-# cat ../cmpnew/gcl_cmpmain.lsp >>$@ ++- cat ../pcl/sys-package.lisp >>$@ ++- awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} \ ++- /^ *@LI-CLCS-PACKAGE@/{i=2;next} {if (i==1) print}' $< >>$@ ++- cat ../clcs/package.lisp >>$@ ++- awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} \ ++- /^ *@LI-CLCS-PACKAGE@/{i=2;next} {if (i==2) print}' $< >>$@ ++- ++- ++-init_%.lsp: init_%.lsp.tmp +++sys_init.lsp: sys_init.lsp.in ++ ++ cat $< | sed \ ++ -e "s#@LI-VERS@#(`cat ../majvers`.`cat ../minvers`) `date`#1" \ ++@@ -118,14 +83,14 @@ init_%.lsp: init_%.lsp.tmp ++ -e "s#@LI-OPT-TWO@#\"$(O2FLAGS)\"#1" \ ++ -e "s#@LI-INIT-LSP@#\"$@\"#1" >$@ ++ ++-saved_%:raw_% $(RSYM) init_%.lsp raw_%_map msys \ +++saved_%:raw_% $(RSYM) sys_init.lsp raw_%_map msys \ ++ $(CMPDIR)/gcl_cmpmain.lsp \ ++ $(CMPDIR)/gcl_lfun_list.lsp \ ++ $(CMPDIR)/gcl_cmpopt.lsp $(HDIR)/cmpinclude.h \ ++ $(LSPDIR)/gcl_auto_new.lsp ++ ++- cp init_$*.lsp foo ++- echo " (in-package \"USER\")(system:save-system \"$@\")" >>foo +++ cp sys_init.lsp foo +++ echo "(unless si::*quit-tags* (in-package \"USER\")(system:save-system \"$@\"))" >>foo ++ ar x lib$*.a $$(ar t lib$*.a |grep ^gcl_) ++ $(PORTDIR)/raw_$*$(EXE) $(PORTDIR)/ -libdir $(GCLDIR)/ < foo ++ # check that saved image can be prelinked ++@@ -194,7 +159,7 @@ map_%: ++ clean: ++ rm -rf saved_*$(EXE) raw_*$(EXE) *.o core a.out $(RSYM) \ ++ $(LSPDIR)/auto_new.lsp foo *maxima* init_*.lsp lib*.a gmp* bfd* *.lsp.tmp \ ++- gazonk*.lsp plt*h *_map saved_* lib* raw_* msys out* log* tmp* gcl.script +++ gazonk*.lsp plt*h *_map saved_* lib* raw_* msys out* log* tmp* gcl.script sys_init.lsp ++ ++ .INTERMEDIATE: init_ansi_gcl.lsp.tmp init_gcl.lsp.tmp raw_gcl raw_ansi_gcl ++ .PRECIOUS: init_pre_gcl.lsp init_gcl.lsp init_ansi_gcl.lsp ++--- gcl-2.6.12.orig/unixport/sys_ansi_gcl.c +++++ gcl-2.6.12/unixport/sys_ansi_gcl.c ++@@ -7,6 +7,10 @@ void ++ gcl_init_init() ++ { ++ +++ object features; +++ features=find_symbol(make_simple_string("*FEATURES*"),system_package); +++ features->s.s_dbind=make_cons(make_keyword("ANSI-CL"),make_cons(make_keyword("COMMON-LISP"),features->s.s_dbind)); +++ ++ build_symbol_table(); ++ ++ lsp_init("../lsp/gcl_export.lsp"); ++@@ -86,7 +90,7 @@ gcl_init_system(object no_init) ++ ar_check_init(gcl_cmpmain,no_init); ++ ++ #ifdef HAVE_XGCL ++- lsp_init("../xgcl-2/sysdef.lisp"); +++ lsp_init("../xgcl-2/package.lisp"); ++ ar_check_init(gcl_Xlib,no_init); ++ ar_check_init(gcl_Xutil,no_init); ++ ar_check_init(gcl_X,no_init); ++--- gcl-2.6.12.orig/unixport/sys_gcl.c +++++ gcl-2.6.12/unixport/sys_gcl.c ++@@ -83,7 +83,7 @@ gcl_init_system(object no_init) { ++ ar_check_init(gcl_cmpmain,no_init); ++ ++ #ifdef HAVE_XGCL ++- lsp_init("../xgcl-2/sysdef.lisp"); +++ lsp_init("../xgcl-2/package.lisp"); ++ ar_check_init(gcl_Xlib,no_init); ++ ar_check_init(gcl_Xutil,no_init); ++ ar_check_init(gcl_X,no_init); ++--- /dev/null +++++ gcl-2.6.12/unixport/sys_init.lsp.in ++@@ -0,0 +1,82 @@ +++(make-package :compiler :use '(:lisp :si)) +++(make-package :sloop :use '(:lisp)) +++(make-package :ansi-loop :use'(:lisp)) +++(make-package :defpackage :use '(:lisp)) +++(make-package :tk :use '(:lisp :sloop)) +++(make-package :fpe :use '(:lisp)) +++(make-package :cltl1-compat) +++ +++(in-package :system) +++(use-package :fpe) +++ +++#+(or pcl ansi-cl)(load "../pcl/package.lisp") +++#+ansi-cl(load "../clcs/package.lisp") +++ +++(init-system) +++(in-package :si) +++(gbc t) +++ +++(unless *link-array* +++ (setq *link-array* (make-array (ash 1 11) :element-type 'character :fill-pointer 0))) +++(use-fast-links t) +++ +++(let* ((x (append (pathname-directory *system-directory*) (list :parent))) +++ (lsp (append x (list "lsp"))) +++ (cmpnew (append x (list "cmpnew"))) +++ (h (append x (list "h"))) +++ (xgcl-2 (append x (list "xgcl-2"))) +++ (pcl (append x (list "pcl"))) +++ (clcs (append x (list "clcs"))) +++ (gtk (append x (list "gcl-tk")))) +++ (dolist (d (list lsp cmpnew #-pre-gcl xgcl-2 #+(or pcl ansi-cl) pcl #+ansi-cl clcs)) +++ (load (make-pathname :name "sys-proclaim" :type "lisp" :directory d))) +++ (load (make-pathname :name "tk-package" :type "lsp" :directory gtk)) +++ (load (make-pathname :name "gcl_lfun_list" :type "lsp" :directory cmpnew)) +++ (load (make-pathname :name "gcl_cmpopt" :type "lsp" :directory cmpnew)) +++ (load (make-pathname :name "gcl_auto_new" :type "lsp" :directory lsp)) +++ +++ (gbc t)) +++ +++(setf (symbol-function 'clear-compiler-properties) +++ (symbol-function 'compiler::compiler-clear-compiler-properties)) +++ +++(terpri) +++(setq *inhibit-macro-special* t) +++(gbc t) +++(reset-gbc-count) +++ +++(defun top-level nil (gcl-top-level)) +++ +++(set-up-top-level) +++ +++(setq *gcl-extra-version* @LI-EXTVERS@ +++ *gcl-minor-version* @LI-MINVERS@ +++ *gcl-major-version* @LI-MAJVERS@) +++ +++(defvar *system-banner* (default-system-banner)) +++(setq *optimize-maximum-pages* t) +++ +++(fmakunbound 'init-cmp-anon) +++(when (fboundp 'user-init) (user-init)) +++(in-package :compiler) +++(setq *cc* @LI-CC@ +++ *ld* @LI-LD@ +++ *ld-libs* @LI-LD-LIBS@ +++ *opt-three* @LI-OPT-THREE@ +++ *opt-two* @LI-OPT-TWO@ +++ *init-lsp* @LI-INIT-LSP@) +++ +++(import 'si::(clines defentry defcfun object void int double +++ quit bye gbc system commonp +++ *break-on-warnings* +++ make-char char-bits char-font char-bit set-char-bit string-char-p int-char +++ char-font-limit char-bits-limit char-control-bit +++ char-meta-bit char-super-bit char-hyper-bit compiler-let) :cltl1-compat) +++(deftype cltl1-compat::string-char nil 'character) +++(do-symbols (s :cltl1-compat) (export s :cltl1-compat)) +++ +++#-ansi-cl(use-package :cltl1-compat :lisp) +++#-ansi-cl(do-symbols (s :cltl1-compat) (export s :lisp))) +++(export '*load-pathname* :si);For maxima, at least as of 5.34.1 +++ +++#+ansi-cl (use-package :pcl :user) ++--- gcl-2.6.12.orig/unixport/sys_pcl_gcl.c +++++ gcl-2.6.12/unixport/sys_pcl_gcl.c ++@@ -7,6 +7,10 @@ void ++ gcl_init_init() ++ { ++ +++ object features; +++ features=find_symbol(make_simple_string("*FEATURES*"),system_package); +++ features->s.s_dbind=make_cons(make_keyword("PCL"),features->s.s_dbind); +++ ++ build_symbol_table(); ++ ++ lsp_init("../lsp/gcl_export.lsp"); ++@@ -86,7 +90,7 @@ gcl_init_system(object no_init) ++ ar_check_init(gcl_cmpmain,no_init); ++ ++ #ifdef HAVE_XGCL ++- lsp_init("../xgcl-2/sysdef.lisp"); +++ lsp_init("../xgcl-2/package.lisp"); ++ ar_check_init(gcl_Xlib,no_init); ++ ar_check_init(gcl_Xutil,no_init); ++ ar_check_init(gcl_X,no_init); ++--- gcl-2.6.12.orig/unixport/sys_pre_gcl.c +++++ gcl-2.6.12/unixport/sys_pre_gcl.c ++@@ -4,6 +4,10 @@ void ++ gcl_init_init() ++ { ++ +++ object features; +++ features=find_symbol(make_simple_string("*FEATURES*"),system_package); +++ features->s.s_dbind=make_cons(make_keyword("PRE-GCL"),features->s.s_dbind); +++ ++ build_symbol_table(); ++ ++ lsp_init("../lsp/gcl_export.lsp"); ++@@ -80,6 +84,7 @@ gcl_init_system(object no_init) ++ lsp_init("../cmpnew/gcl_cmpvar.lsp"); ++ lsp_init("../cmpnew/gcl_cmpvs.lsp"); ++ lsp_init("../cmpnew/gcl_cmpwt.lsp"); +++ lsp_init("../cmpnew/gcl_cmpmain.lsp"); ++ ++ ++ } ++--- gcl-2.6.12.orig/xgcl-2/gcl_init_xgcl.lsp +++++ gcl-2.6.12/xgcl-2/gcl_init_xgcl.lsp ++@@ -36,8 +36,8 @@ ++ (progn (allocate 'cons 100) (allocate 'string 40) ++ (system:init-system) (gbc t) ++ (si::multiply-bignum-stack 25) ++- (or lisp::*link-array* ++- (setq lisp::*link-array* +++ (or si::*link-array* +++ (setq si::*link-array* ++ (make-array 500 :element-type 'fixnum :fill-pointer 0))) ++ (use-fast-links t) ++ (setq compiler::*cmpinclude* "") (load #"../cmpnew/cmpmain.lsp") (gbc t) (load #"../cmpnew/lfun_list.lsp") ++--- gcl-2.6.12.orig/xgcl-2/makefile +++++ gcl-2.6.12/xgcl-2/makefile ++@@ -4,10 +4,13 @@ ++ all: objects #docs ++ ++ objects: $(LISP) ++- echo '(load "sysdef.lisp")(xlib::compile-xgcl)' | $(LISP) +++ echo '(load "sysdef.lisp")(load "sys-proclaim.lisp")(xlib::compile-xgcl)' | $(LISP) ++ ++ saved_xgcl: $(LISP) ++- echo '(load "sysdef.lisp")(xlib::compile-xgcl)(xlib::save-xgcl "$@")' | $(LISP) +++ echo '(load "sysdef.lisp")(load "sys-proclaim.lisp")(xlib::compile-xgcl)(xlib::save-xgcl "$@")' | $(LISP) +++ +++sys-proclaim.lisp: +++ echo '(load "sysdef.lisp")(compiler::emit-fn t)(xlib::compile-xgcl)(compiler::make-all-proclaims "*.fn")' | $(LISP) ++ ++ docs: dwdoc/dwdoccontents.html dwdoc.pdf ++ ++@@ -22,7 +25,7 @@ dwdoc.pdf: dwdoc.tex ++ ++ clean: ++ rm -f *.o *.data saved_* cmpinclude.h dwdoc.aux dwdoc.log gmon.out ++- rm -f gcl*c gcl*h gcl*data gcl_xrecompile* user-init* +++ rm -f gcl*c gcl*h gcl*data gcl_xrecompile* user-init* *fn ++ ++ clean-docs: ++ rm -rf dwdoc dwdoc.pdf ++--- /dev/null +++++ gcl-2.6.12/xgcl-2/package.lisp ++@@ -0,0 +1 @@ +++(make-package :XLIB :use '(:lisp :system)) ++--- /dev/null +++++ gcl-2.6.12/xgcl-2/sys-proclaim.lisp ++@@ -0,0 +1,287 @@ +++ +++(COMMON-LISP::IN-PACKAGE "COMMON-LISP-USER") +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) +++ XLIB::WINDOW-UNSET XLIB::WINDOW-GET-GEOMETRY +++ XLIB::WINDOW-SET-INVERT XLIB::WINDOW-FONT-INFO +++ XLIB::GET-ST-POINT XLIB::EDITMENU-YANK +++ XLIB::WINDOW-INIT-MOUSE-POLL XLIB::WINDOW-SET-XOR +++ XLIB::WINDOW-TOP-NEG-Y XLIB::WINDOW-LEFT +++ XLIB::WINDOW-QUERY-POINTER XLIB::TEXTMENU-DRAW +++ XLIB::EDITMENU-CARAT XLIB::EDITMENU-DRAW +++ XLIB::WINDOW-STD-LINE-ATTR XLIB::WINDOW-UNMAP +++ XLIB::WINDOW-QUERY-POINTER-B XLIB::WINDOW-BACKGROUND +++ XLIB::EDITMENU-DELETE XLIB::WINDOW-MOVE XLIB::DOWINDOWCOM +++ XLIB::WINDOW-SYNC XLIB::PICMENU-DRAW XLIB::WINDOW-MAP +++ XLIB::WINDOW-RESET-COLOR XLIB::EDITMENU-KILL +++ XLIB::BARMENU-DRAW XLIB::WINDOW-GET-GEOMETRY-B +++ XLIB::MENU-CLEAR XLIB::WINDOW-RESET XLIB::WINDOW-WFUNCTION +++ XLIB::MENU-DRAW XLIB::WINDOW-FOREGROUND XLIB::WINDOW-CLEAR +++ XLIB::EDITMENU-BACKSPACE XLIB::WINDOW-DRAW-BORDER +++ XLIB::LISP-STRING XLIB::WINDOW-SET-ERASE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +++ XLIB::OPEN-WINDOW)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ XLIB::WINDOW-GET-ELLIPSE XLIB::EDITMENU-SELECT +++ XLIB::WINDOW-SET-XCOLOR XLIB::TEXTMENU-SELECT +++ XLIB::PICMENU-SELECT XLIB::MAKECONT XLIB::WINDOW-GET-CIRCLE +++ XLIB::MENU XLIB::WINDOW-GET-REGION XLIB::TEXTMENU-SET-TEXT +++ XLIB::MENU-SELECT XLIB::BARMENU-SELECT +++ XLIB::PICMENU-CREATE-FROM-SPEC XLIB::PRINTINDEX +++ XLIB::EDITMENU-EDIT XLIB::MENU-CREATE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ XLIB::BARMENU-UPDATE-VALUE XLIB::WINDOW-FONT-STRING-WIDTH +++ XLIB::MENU-FIND-ITEM-WIDTH XLIB::WINDOW-STRING-WIDTH +++ XLIB::PICMENU-BOX-ITEM XLIB::WINDOW-SET-FOREGROUND +++ XLIB::WINDOW-INVERTAREA XLIB::PICMENU-UNBOX-ITEM +++ XLIB::PICMENU-DRAW-NAMED-BUTTON XLIB::WINDOW-SET-CURSOR +++ XLIB::WINDOW-SET-LINE-WIDTH XLIB::PICMENU-DELETE-NAMED-BUTTON +++ XLIB::EDITMENU-ERASE XLIB::PICMENU-DRAW-BUTTON +++ XLIB::WINDOW-SET-BACKGROUND)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) +++ XLIB::XINIT XLIB::WINDOW-SCREEN-HEIGHT)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) +++ XLIB::WINDOW-CIRCLE-RADIUS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ XLIB::WINDOW-XOR-BOX-XY XLIB::WINDOW-DRAW-BOX-CORNERS +++ XLIB::WINDOW-DRAW-LINE-XY XLIB::WINDOW-DRAW-ARROW2-XY +++ XLIB::WINDOW-DRAW-ARROW-XY XLIB::WINDOW-DRAW-ELLIPSE-XY +++ XLIB::WINDOW-ERASE-BOX-XY XLIB::WINDOW-DRAW-BOX-XY +++ XLIB::WINDOW-DRAW-ARROWHEAD-XY)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) +++ COMMON-LISP::*) +++ XLIB::WINDOW-COPY-AREA-XY)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ XLIB::WINDOW-PRETTYPRINTAT XLIB::MENU-UNBOX-ITEM +++ XLIB::WINDOW-PRINTAT XLIB::WINDOW-DRAW-CROSSHAIRS-XY +++ XLIB::WINDOW-MOVETO-XY XLIB::WINDOW-INVERT-AREA +++ XLIB::WINDOW-DRAW-DOT-XY XLIB::WINDOW-DRAW-CARAT +++ XLIB::WINDOW-ERASE-AREA XLIB::MENU-BOX-ITEM +++ XLIB::WINDOW-DRAW-CROSS-XY)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ XLIB::WINDOW-DRAW-CIRCLE-XY XLIB::WINDOW-PRINT-LINE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) +++ COMMON-LISP::*) +++ XLIB::WINDOW-PRETTYPRINTAT-XY XLIB::WINDOW-DRAW-CIRCLE-PT +++ XLIB::EDITMENU-DISPLAY XLIB::WINDOW-PRINTAT-XY +++ XLIB::WINDOW-PROCESS-CHAR-EVENT XLIB::MENU-DISPLAY-ITEM)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ XLIB::WINDOW-ADJ-BOX-XY)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ XLIB::WINDOW-DRAW-ARC-XY)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ XLIB::WINDOW-DRAW-ELLIPSE-PT XLIB::WINDOW-ERASE-AREA-XY +++ XLIB::WINDOW-INVERT-AREA-XY XLIB::WINDOW-DRAW-VECTOR-PT)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::*) +++ XLIB::WINDOW-DRAW-LINE XLIB::WINDOW-DRAW-BOX +++ XLIB::WINDOW-DRAW-CIRCLE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::*) +++ XLIB::WINDOW-DRAW-RCBOX-XY)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ XLIB::WINDOW-DRAW-LATEX-XY)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ XLIB::WINDOW-SET-LINE-ATTR)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ XLIB::WINDOW-DRAW-BOX-LINE-XY)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ XLIB::WINDOW-POSITIVE-Y XLIB::WINDOW-STRING-EXTENTS +++ XLIB::MENU-CHOOSE XLIB::WINDOW-SET-FONT XLIB::PUSHFONT +++ XLIB::WINDOW-STRING-HEIGHT XLIB::WORDLIST< +++ XLIB::EDITMENU-LINE-Y XLIB::MENU-ITEM-Y +++ XLIB::MENU-FIND-ITEM-HEIGHT XLIB::XFERCHARS +++ XLIB::WINDOW-CENTEROFFSET XLIB::MENU-FIND-ITEM-Y +++ XLIB::EDITMENU-CHAR XLIB::MENU-ITEM-VALUE +++ XLIB::MENU-FIND-ITEM)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ XLIB::WINDOW-FREE-COLOR)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +++ XLIB::SEARCHFORALPHA XLIB::SAFE-CHAR XLIB::WINDOW-XINIT +++ XLIB::WINDOW-MENU XLIB::WINDOW-INIT-KEYMAP XLIB::PARSE-INT +++ XLIB::WINDOW-DESTROY-SELECTED-WINDOW +++ XLIB::WINDOW-GET-MOUSE-POSITION)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::FIXNUM) +++ XLIB::FLUSHLINE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ XLIB::PICMENU-BUTTON-CONTAINSXY? XLIB::MENU-MOVETO-XY +++ XLIB::WINDOW-GET-BOX-SIZE XLIB::PRINTINDEXN +++ XLIB::WINDOW-GET-LINE-POSITION +++ XLIB::PICMENU-SET-NAMED-BUTTON-COLOR XLIB::EDITMENU-SETXY +++ XLIB::MENU-SELECT-B XLIB::MENU-REPOSITION-LINE +++ XLIB::WINDOW-GET-VECTOR-END)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ XLIB::WINDOW-CREATE XLIB::WINDOW-TRACK-MOUSE +++ XLIB::PICMENU-ITEM-POSITION XLIB::WINDOW-GET-CHARS +++ XLIB::TEXTMENU-CREATE XLIB::EDITMENU-CREATE XLIB::TOHTML +++ XLIB::WINDOW-SET-COLOR XLIB::MENU-ITEM-POSITION)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ XLIB::WINDOW-INPUT-STRING XLIB::PICMENU-CREATE-SPEC +++ XLIB::WINDOW-SET-COLOR-RGB XLIB::WINDOW-PRINT-LINES +++ XLIB::PICMENU-CREATE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::T) +++ XLIB::WINDOW-GET-ICON-POSITION XLIB::BARMENU-CREATE +++ XLIB::WINDOW-GET-LATEX-POSITION XLIB::WINDOW-GET-BOX-POSITION)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ XLIB::WINDOW-EDIT XLIB::WINDOW-TRACK-MOUSE-IN-REGION)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ XLIB::WINDOW-ADJUST-BOX-SIDE XLIB::EDITMENU-EDIT-FN)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ XLIB::WINDOW-GET-BOX-LINE-POSITION)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +++ XLIB::WINDOW-DESTROY XLIB::EDITMENU-CALCULATE-SIZE +++ XLIB::STRINGIFY XLIB::DOLINE XLIB::PUSHENV +++ XLIB::WINDOW-POLL-MOUSE XLIB::WINDOW-FONT XLIB::WINDOW-SIZE +++ XLIB::EDITMENU-END XLIB::WINDOW-PAINT XLIB::WINDOW-GEOMETRY +++ XLIB::MENU-DESTROY XLIB::WINDOW-LABEL +++ XLIB::PICMENU-CALCULATE-SIZE XLIB::POPENV XLIB::WINDOW-PARENT +++ XLIB::WINDOW-WAIT-UNMAP XLIB::EDITMENU-INIT +++ XLIB::WINDOW-GET-POINT XLIB::MENU-SELECT! +++ XLIB::MENU-CALCULATE-SIZE XLIB::BARMENU-INIT XLIB::DOCOMMAND +++ XLIB::MENU-INIT XLIB::WINDOW-OPEN XLIB::EDITMENU-META-B +++ XLIB::WINDOW-GET-RAW-CHAR XLIB::WINDOW-DRAWABLE-HEIGHT +++ XLIB::MENU-REPOSITION XLIB::WINDOW-YPOSITION +++ XLIB::EDITMENU-ALPHANUMBERICP XLIB::EDITMENU-NEXT +++ XLIB::MENU-SIZE XLIB::EDITMENU-PREVIOUS XLIB::EDITMENU-FORWARD +++ XLIB::EDITMENU-BEGINNING XLIB::PICMENU-DESTROY +++ XLIB::WINDOW-RESET-GEOMETRY XLIB::WINDOW-GCONTEXT +++ XLIB::EDITMENU-BACKWARD XLIB::TERMLINE +++ XLIB::WINDOW-DRAWABLE-WIDTH XLIB::WINDOW-GET-CROSSHAIRS +++ XLIB::BARMENU-CALCULATE-SIZE XLIB::WINDOW-CHAR-DECODE +++ XLIB::DOTABULAR XLIB::PICMENU-INIT XLIB::WINDOW-WAIT-EXPOSURE +++ XLIB::PARSE-WORD XLIB::TEXTMENU-INIT XLIB::SEARCHFOR +++ XLIB::MENU-OFFSET XLIB::MENU-ADJUST-OFFSET +++ XLIB::WINDOW-SET-COPY XLIB::TEXTMENU-CALCULATE-SIZE +++ XLIB::WINDOW-GET-CROSS XLIB::EDITMENU-META-F +++ XLIB::WINDOW-GET-CLICK XLIB::EDITMENU-CURRENT-CHAR +++ XLIB::DOHTML XLIB::WINDOW-CLOSE XLIB::EDITMENU-RETURN +++ XLIB::WINDOW-CODE-CHAR)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) +++ XLIB::WINDOW-FORCE-OUTPUT)) ++\ No newline at end of file ++--- gcl-2.6.12.orig/xgcl-2/sysdef.lisp +++++ gcl-2.6.12/xgcl-2/sysdef.lisp ++@@ -19,9 +19,8 @@ ++ ; Some of the files that interface to the Xlib are adapted from DEC/MIT files. ++ ; See the file dec.copyright for details. ++ ++-(make-package :XLIB) +++(load "package.lisp") ++ (in-package :XLIB) ++-(sys::use-package '(:lisp :system :sys)) ++ ++ (defvar *files* '( "gcl_Xlib" ++ "gcl_Xutil" diff --cc debian/patches/Version_2_6_13pre12 index 00000000,00000000..8d55df80 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre12 @@@ -1,0 -1,0 +1,1168 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-10) unstable; urgency=medium ++ . ++ * rebuild in clean sid environment ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/bin/dpp.c +++++ gcl-2.6.12/bin/dpp.c ++@@ -430,7 +430,8 @@ put_declaration() ++ { ++ int i; ++ ++- fprintf(out, "\tint narg;\n"); +++ if (nopt || rest_flag || key_flag) +++ fprintf(out, "\tint narg;\n"); ++ fprintf(out, "\tregister object *DPPbase=vs_base;\n"); ++ ++ for (i = 0; i < nopt; i++) ++@@ -453,12 +454,12 @@ put_declaration() ++ fprintf(out, "#define\t%s\tDPPbase[%d+%d+2*%d+%d]\n", ++ aux[i].a_var, nreq, nopt, nkey, i); ++ fprintf(out, "\n"); ++- fprintf(out, "\tnarg = vs_top - vs_base;\n"); ++ if (nopt == 0 && !rest_flag && !key_flag) ++ fprintf(out, "\tcheck_arg(%d);\n", nreq); ++ else { ++- fprintf(out, "\tif (narg < %d)\n", nreq); ++- fprintf(out, "\t\ttoo_few_arguments();\n"); +++ fprintf(out, "\tnarg = vs_top - vs_base;\n"); +++ fprintf(out, "\tif (narg < %d)\n", nreq); +++ fprintf(out, "\t\ttoo_few_arguments();\n"); ++ } ++ for (i = 0; i < nopt; i++) ++ if (optional[i].o_svar != NULL) { ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpfun.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpfun.lsp ++@@ -976,9 +976,13 @@ ++ (wt-nl "}}") ++ (wt-nl "vs_top=(vs_base=base+" base ")+" (- *vs* base) ";") ++ (unwind-exit 'fun-val nil (cons 'values 2)))) ++- ((unwind-exit (get-inline-loc `((t t) t #.(flags rfa) ++- ,(concatenate 'string ++- "({struct htent *_z=gethash" ++- (if *safe-compile* "_with_check" "") ++- "(#0,#1);_z->hte_key==OBJNULL ? (#2) : _z->hte_value;})")) ++- args))))) +++ ((let ((*inline-blocks* 0) +++ (*restore-avma* *restore-avma*) +++ (fd `((t t) t #.(flags rfa) +++ ,(concatenate 'string +++ "({struct htent *_z=gethash" +++ (if *safe-compile* "_with_check" "") +++ "(#0,#1);_z->hte_key==OBJNULL ? (#2) : _z->hte_value;})")))) +++ (save-avma fd) +++ (unwind-exit (get-inline-loc fd args)) +++ (close-inline-blocks))))) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmptag.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmptag.lsp ++@@ -62,6 +62,7 @@ ++ ((and (eq (car clause) 'go) ++ (tag-p (setq tem (cadddr (cdr clause)))) ++ (eq (tag-name tem) tag-name))) +++ ((eq (car clause) 'location) nil) ++ (t (or (jumps-to-p (car clause) tag-name) ++ (jumps-to-p (cdr clause) tag-name))))) ++ ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -4171,18 +4171,52 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu ++ #fi ++ # subst GCC not only under 386-linux, but where available -- CM ++ +++TCFLAGS="-fsigned-char" +++ ++ if test "$GCC" = "yes" ; then ++ ++- TCFLAGS="-Wall -fsigned-char" +++ TCFLAGS="$TCFLAGS -Wall" ++ ++- #FIXME -Wno-unused-but-set-variable when time ++- TMPF=-Wno-unused-but-set-variable ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFLAG $TMPF" >&5 ++-$as_echo_n "checking for CFLAG $TMPF... " >&6; } ++- CFLAGS_ORI=$CFLAGS ++- CFLAGS="$CFLAGS $TMPF" +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for clang" >&5 +++$as_echo_n "checking for clang... " >&6; } ++ ++ if test "$cross_compiling" = yes; then : +++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +++as_fn_error $? "cannot run test program while cross compiling +++See \`config.log' for more details" "$LINENO" 5; } +++else +++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext +++/* end confdefs.h. */ +++ +++ +++ int main() { +++ return +++ #ifdef __clang__ +++ 0 +++ #else +++ 1 +++ #endif +++ ;} +++_ACEOF +++if ac_fn_c_try_run "$LINENO"; then : +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +++$as_echo "yes" >&6; } +++ clang="yes" +++ TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body" +++ +++$as_echo "#define CLANG 1" >>confdefs.h +++ +++else +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +++$as_echo "no" >&6; } +++ #FIXME -Wno-unused-but-set-variable when time +++ TMPF=-Wno-unused-but-set-variable +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFLAG $TMPF" >&5 +++$as_echo_n "checking for CFLAG $TMPF... " >&6; } +++ CFLAGS_ORI=$CFLAGS +++ CFLAGS="$CFLAGS $TMPF" +++ if test "$cross_compiling" = yes; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++ $as_echo "no" >&6; } ++ else ++@@ -4201,11 +4235,14 @@ rm -f core *.core core.conftest.* gmon.o ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++ fi ++ ++- CFLAGS=$CFLAGS_ORI +++ CFLAGS=$CFLAGS_ORI +++fi +++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ +++ conftest.$ac_objext conftest.beam conftest.$ac_ext +++fi ++ ++-else ++- TCFLAGS="-fsigned-char" ++ fi +++ ++ if test "$GCC" = "yes" ; then ++ TCFLAGS="$TCFLAGS -pipe" ++ case $use in ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -483,21 +483,37 @@ AC_SUBST(CC) ++ #fi ++ # subst GCC not only under 386-linux, but where available -- CM ++ ++-if test "$GCC" = "yes" ; then +++TCFLAGS="-fsigned-char" ++ ++- TCFLAGS="-Wall -fsigned-char" +++if test "$GCC" = "yes" ; then ++ ++- #FIXME -Wno-unused-but-set-variable when time ++- TMPF=-Wno-unused-but-set-variable ++- AC_MSG_CHECKING([for CFLAG $TMPF]) ++- CFLAGS_ORI=$CFLAGS ++- CFLAGS="$CFLAGS $TMPF" ++- AC_TRY_RUN([int main() {return 0;}],TCFLAGS="$TCFLAGS $TMPF";AC_MSG_RESULT(yes),AC_MSG_RESULT(no),AC_MSG_RESULT(no)) ++- CFLAGS=$CFLAGS_ORI +++ TCFLAGS="$TCFLAGS -Wall" ++ ++-else ++- TCFLAGS="-fsigned-char" +++ AC_MSG_CHECKING([for clang]) +++ AC_RUN_IFELSE([ +++ AC_LANG_SOURCE([[ +++ int main() { +++ return +++ #ifdef __clang__ +++ 0 +++ #else +++ 1 +++ #endif +++ ;}]])], +++ [AC_MSG_RESULT([yes]) +++ clang="yes" +++ TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body" +++ AC_DEFINE([CLANG],[1],[running clang compiler])], +++ [AC_MSG_RESULT([no]) +++ #FIXME -Wno-unused-but-set-variable when time +++ TMPF=-Wno-unused-but-set-variable +++ AC_MSG_CHECKING([for CFLAG $TMPF]) +++ CFLAGS_ORI=$CFLAGS +++ CFLAGS="$CFLAGS $TMPF" +++ AC_TRY_RUN([int main() {return 0;}],TCFLAGS="$TCFLAGS $TMPF";AC_MSG_RESULT(yes),AC_MSG_RESULT(no),AC_MSG_RESULT(no)) +++ CFLAGS=$CFLAGS_ORI]) ++ fi +++ ++ if test "$GCC" = "yes" ; then ++ TCFLAGS="$TCFLAGS -pipe" ++ case $use in ++--- gcl-2.6.12.orig/gcl-tk/comm.c +++++ gcl-2.6.12/gcl-tk/comm.c ++@@ -183,7 +183,7 @@ int m; ++ { bcopy(sfd->valid_data,sfd->read_buffer,sfd->valid_data_size); ++ sfd->valid_data=sfd->read_buffer;} ++ /* there is at least a packet size of space available */ ++- if ((fix(FFN(fScheck_fd_for_input)(sfd->fd,sfd->write_timeout))>0)); +++ if ((fix(FFN(fScheck_fd_for_input)(sfd->fd,sfd->write_timeout))>0)) ++ again: ++ {char *start = sfd->valid_data+sfd->valid_data_size; ++ nread = SAFE_READ(sfd->fd,start, ++--- gcl-2.6.12.orig/gcl-tk/guis.c +++++ gcl-2.6.12/gcl-tk/guis.c ++@@ -455,7 +455,7 @@ struct connection_state *sfd; ++ int tot; ++ struct message_header *msg; ++ msg = (struct message_header *) buf; ++- m= read1(sfd,msg,MESSAGE_HEADER_SIZE,DEFAULT_TIMEOUT_FOR_TK_READ); +++ m= read1(sfd,(void *)msg,MESSAGE_HEADER_SIZE,DEFAULT_TIMEOUT_FOR_TK_READ); ++ if (m == MESSAGE_HEADER_SIZE) ++ { ++ if ( msg->magic1!=MAGIC1 ++@@ -468,7 +468,7 @@ struct connection_state *sfd; ++ if (tot >= bufleng) ++ {msg = (void *)malloc(tot+1); ++ bcopy(buf,msg,MESSAGE_HEADER_SIZE);} ++- m = read1(sfd,&(msg->body), +++ m = read1(sfd,(void *)&(msg->body), ++ body_length,DEFAULT_TIMEOUT_FOR_TK_READ); ++ if (m == body_length) ++ { return msg;}} ++--- gcl-2.6.12.orig/h/compbas.h +++++ gcl-2.6.12/h/compbas.h ++@@ -4,7 +4,7 @@ ++ #define EXTER extern ++ #endif ++ #ifndef INLINE ++-#if defined(__GNUC__) && __GNUC__ <= 4 +++#if (defined(__GNUC__) && __GNUC__ <= 4) && !defined __clang__ ++ #define INLINE extern inline ++ #else ++ #define INLINE inline ++--- gcl-2.6.12.orig/h/fixnum.h +++++ gcl-2.6.12/h/fixnum.h ++@@ -13,7 +13,7 @@ ++ #define is_imm_fix(a_) INT_IN_BITS(a_,LOW_SHFT-1) ++ #elif defined (IM_FIX_BASE) && defined(IM_FIX_LIM) ++ #define make_imm_fixnum(a_) ((object)((a_)+(IM_FIX_BASE+(IM_FIX_LIM>>1)))) ++-#define fix_imm_fixnum(a_) (((fixnum)(a_))-(IM_FIX_BASE+(IM_FIX_LIM>>1))) +++#define fix_imm_fixnum(a_) ((fixnum)(((fixnum)(a_))-(IM_FIX_BASE+(IM_FIX_LIM>>1)))) ++ #define mark_imm_fixnum(a_) ((a_)=((object)(((fixnum)(a_)) | IM_FIX_LIM))) ++ #define unmark_imm_fixnum(a_) ((a_)=((object)(((fixnum)(a_)) &~ IM_FIX_LIM))) ++ #define is_imm_fixnum(a_) (((ufixnum)(a_))>=IM_FIX_BASE) ++--- gcl-2.6.12.orig/h/gclincl.h.in +++++ gcl-2.6.12/h/gclincl.h.in ++@@ -9,9 +9,6 @@ ++ /* punt guess for no randomize value */ ++ #undef ADDR_NO_RANDOMIZE ++ ++-/* compile ansi compliant image */ ++-#undef ANSI_COMMON_LISP ++- ++ /* binding stack size */ ++ #undef BDSSIZE ++ ++@@ -21,6 +18,9 @@ ++ /* can prevent sbrk from returning random values */ ++ #undef CAN_UNRANDOMIZE_SBRK ++ +++/* running clang compiler */ +++#undef CLANG +++ ++ /* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP ++ systems. This function is required for `alloca.c' support on those systems. ++ */ ++--- gcl-2.6.12.orig/h/object.h +++++ gcl-2.6.12/h/object.h ++@@ -342,7 +342,8 @@ EXTER long holepage; /* hole pages * ++ EXTER long new_holepage,starting_hole_div,starting_relb_heap_mult; ++ ++ ++-EXTER char *rb_start; /* relblock start */ +++EXTER char *new_rb_start; /* desired relblock start after next gc */ +++EXTER char *rb_start; /* relblock start */ ++ EXTER char *rb_end; /* relblock end */ ++ EXTER char *rb_limit; /* relblock limit */ ++ EXTER char *rb_pointer; /* relblock pointer */ ++--- gcl-2.6.12.orig/h/protoize.h +++++ gcl-2.6.12/h/protoize.h ++@@ -1946,3 +1946,12 @@ get_pageinfo(void *); ++ ++ void ++ add_page_to_freelist(char *, struct typemanager *); +++ +++ufixnum +++sum_maxpages(void); +++ +++void +++resize_hole(ufixnum,enum type); +++ +++void +++setup_rb(void); ++--- gcl-2.6.12.orig/o/alloc.c +++++ gcl-2.6.12/o/alloc.c ++@@ -325,14 +325,29 @@ empty_relblock(void) { ++ ++ } ++ ++-static inline void +++void +++setup_rb(void) { +++ +++ int init=new_rb_start!=rb_start || rb_pointer>=rb_end; +++ +++ rb_start=new_rb_start; +++ rb_end=rb_start+(nrbpage<>PAGEWIDTH))); +++ +++} +++ +++void ++ resize_hole(ufixnum hp,enum type tp) { ++ ++- char *new_start=heap_end+hp*PAGESIZE; ++ char *start=rb_pointer=start) || (new_start=start+size)) { +++ new_rb_start=heap_end+hp*PAGESIZE; +++ +++ if ((new_rb_start=start) || (new_rb_start=start+size)) { ++ fprintf(stderr,"Toggling relblock when resizing hole to %lu\n",hp); ++ fflush(stderr); ++ tm_table[t_relocatable].tm_adjgbccnt--; ++@@ -340,9 +355,11 @@ resize_hole(ufixnum hp,enum type tp) { ++ return resize_hole(hp,tp); ++ } ++ ++- holepage=hp; ++- tm_of(tp)->tm_adjgbccnt--; ++- GBC(tp); +++ if (size) { +++ tm_of(tp)->tm_adjgbccnt--; +++ GBC(tp); +++ } else +++ setup_rb(); ++ ++ } ++ ++@@ -355,7 +372,7 @@ alloc_page(long n) { ++ ++ if (!s) { ++ ++- if (nn>holepage) { +++ if (nn>((rb_start-heap_end)>>PAGEWIDTH)) { ++ ++ ++ fixnum d=available_pages-nn; ++@@ -373,12 +390,11 @@ alloc_page(long n) { ++ e=heap_end; ++ v=e+nn*PAGESIZE; ++ ++- if (!s) { +++ if (!s) ++ ++- holepage -= nn; ++ heap_end=v; ++ ++- } else if (v>(void *)core_end) { +++ else if (v>(void *)core_end) { ++ ++ massert(!mbrk(v)); ++ core_end=v; ++@@ -395,7 +411,7 @@ alloc_page(long n) { ++ ++ struct pageinfo *cell_list_head=NULL,*cell_list_tail=NULL;; ++ ++-static inline ufixnum +++ufixnum ++ sum_maxpages(void) { ++ ++ ufixnum i,j; ++@@ -516,7 +532,7 @@ rebalance_maxpages(struct typemanager *m ++ k+=(tm_table[i].tm_maxpage-tm_table[i].tm_npage)*(i==t_relocatable ? 2 : 1); ++ ++ e=e>k ? k : e; ++- if (e+phys_pages-j<=0) +++ if (e+phys_pages<=j) ++ return 0; ++ ++ f=k ? 1.0-(double)e/k : 1.0; ++@@ -895,17 +911,20 @@ add_pages(struct typemanager *tm,fixnum ++ ++ case t_relocatable: ++ ++- if (rb_pointer>rb_end) { +++ if (rb_pointer>rb_end && m>((rb_start-heap_end)>>PAGEWIDTH)) { ++ fprintf(stderr,"Moving relblock low before expanding relblock pages\n"); ++ fflush(stderr); ++ tm_table[t_relocatable].tm_adjgbccnt--; ++ GBC(t_relocatable); ++ } ++ nrbpage+=m; ++- rb_end+=m*PAGESIZE; ++ rb_limit+=m*PAGESIZE; +++ if (rb_pointer>rb_end) +++ rb_start-=m*PAGESIZE; +++ else +++ rb_end+=m*PAGESIZE; ++ ++- alloc_page(-(2*nrbpage+holepage)); +++ alloc_page(-(2*nrbpage+((rb_start-heap_end)>>PAGEWIDTH))); ++ ++ break; ++ ++@@ -1116,7 +1135,7 @@ DEFUNM_NEW("ALLOCATED",object,fSallocate ++ { struct typemanager *tm=(&tm_table[t_from_type(typ)]); ++ tm = & tm_table[tm->tm_type]; ++ if (tm->tm_type == t_relocatable) ++- { tm->tm_npage = (rb_end-rb_start)/PAGESIZE; +++ { tm->tm_npage = (rb_end-rb_start)>>PAGEWIDTH; ++ tm->tm_nfree = rb_limit -rb_pointer; ++ } ++ else if (tm->tm_type == t_contiguous) ++@@ -1242,11 +1261,8 @@ object malloc_list=Cnil; ++ ++ void ++ maybe_set_hole_from_maxpages(void) { ++- if (rb_start==heap_end && rb_end==rb_start && rb_limit==rb_start && rb_pointer==rb_start) { ++- holepage=new_holepage; ++- alloc_page(-holepage); ++- rb_start=rb_end=rb_limit=rb_pointer=heap_end+(holepage<= (void*)baby_malloc_data && ptr - (void*)baby_malloc_data st.st_fillp = size; ++ return(ptr); ++ } else { ++- j = x->st.st_dim; ++ x->st.st_self = alloc_contblock(size); ++ x->st.st_fillp = x->st.st_dim = size; ++ for (i = 0; i < size; i++) ++ x->st.st_self[i] = ((char *)ptr)[i]; ++-/* SGC contblock pages: Its possible this is on an old page CM 20030827 */ ++-/* #ifdef SGC */ ++-/* insert_maybe_sgc_contblock(ptr, j); */ ++-/* #else */ ++-/* insert_contblock(ptr, j); */ ++-/* #endif */ ++ return(x->st.st_self); ++ } ++ } ++--- gcl-2.6.12.orig/o/assignment.c +++++ gcl-2.6.12/o/assignment.c ++@@ -259,7 +259,7 @@ DEFUNO_NEW("FMAKUNBOUND",object,fLfmakun ++ static void ++ FFN(Fsetf)(object form) ++ { ++- object result,*t,*t1; +++ object *t,*t1; ++ if (endp(form)) { ++ vs_base = vs_top; ++ vs_push(Cnil); ++@@ -269,7 +269,7 @@ FFN(Fsetf)(object form) ++ vs_top = top; ++ if (endp(MMcdr(form))) ++ FEinvalid_form("No value for ~S.", form->c.c_car); ++- result = setf(MMcar(form), MMcadr(form)); +++ setf(MMcar(form), MMcadr(form)); ++ form = MMcddr(form); ++ } while (!endp(form)); ++ t=vs_base; ++--- gcl-2.6.12.orig/o/cfun.c +++++ gcl-2.6.12/o/cfun.c ++@@ -343,7 +343,8 @@ turbo_closure(object fun) ++ ++ if(1)/*(fun->cc.cc_turbo==NULL)*/ ++ {BEGIN_NO_INTERRUPT; ++- for (n = 0, l = fun->cc.cc_env; !endp(l); n++, l = l->c.c_cdr); +++ for (n = 0, l = fun->cc.cc_env; !endp(l); n++, l = l->c.c_cdr) +++ ; ++ { ++ block= AR_ALLOC(alloc_relblock,(1+n),object); ++ *block=make_fixnum(n); ++--- gcl-2.6.12.orig/o/format.c +++++ gcl-2.6.12/o/format.c ++@@ -170,6 +170,22 @@ object sSAindent_formatted_outputA; ++ fmt_string = old_fmt_string ; \ ++ fmt_paramp = old_fmt_paramp ++ +++#define fmt_old1 VOL object old_fmt_stream; \ +++ VOL int old_ctl_origin; \ +++ VOL int old_ctl_index; \ +++ VOL int old_ctl_end; \ +++ jmp_bufp VOL old_fmt_jmp_bufp; \ +++ VOL int old_fmt_indents; \ +++ VOL object old_fmt_string ; \ +++ VOL format_parameter *old_fmt_paramp +++#define fmt_save1 old_fmt_stream = fmt_stream; \ +++ old_ctl_origin = ctl_origin; \ +++ old_ctl_index = ctl_index; \ +++ old_ctl_end = ctl_end; \ +++ old_fmt_jmp_bufp = fmt_jmp_bufp; \ +++ old_fmt_indents = fmt_indents; \ +++ old_fmt_string = fmt_string ; \ +++ old_fmt_paramp = fmt_paramp ++ #define fmt_restore1 fmt_stream = old_fmt_stream; \ ++ ctl_origin = old_ctl_origin; \ ++ ctl_index = old_ctl_index; \ ++@@ -1776,7 +1792,7 @@ fmt_case(bool colon, bool atsign) ++ { ++ VOL object x; ++ VOL int i, j; ++- fmt_old; +++ fmt_old1; ++ jmp_buf fmt_jmp_buf0; ++ int up_colon; ++ bool b; ++@@ -1787,7 +1803,7 @@ fmt_case(bool colon, bool atsign) ++ j = fmt_skip(); ++ if (ctl_string[--j] != ')' || ctl_string[--j] != '~') ++ fmt_error("~) expected"); ++- fmt_save; +++ fmt_save1; ++ fmt_jmp_bufp = &fmt_jmp_buf0; ++ if ((up_colon = setjmp(*fmt_jmp_bufp))) ++ ; ++@@ -1850,7 +1866,7 @@ fmt_conditional(bool colon, bool atsign) ++ object x; ++ int n=0; ++ bool done; ++- fmt_old; +++ fmt_old1; ++ ++ fmt_not_colon_atsign(colon, atsign); ++ if (colon) { ++@@ -1863,11 +1879,11 @@ fmt_conditional(bool colon, bool atsign) ++ if (ctl_string[--k] != ']' || ctl_string[--k] != '~') ++ fmt_error("~] expected"); ++ if (fmt_advance() == Cnil) { ++- fmt_save; +++ fmt_save1; ++ format(fmt_stream, ctl_origin + i, j - i); ++ fmt_restore1; ++ } else { ++- fmt_save; +++ fmt_save1; ++ format(fmt_stream, ctl_origin + j + 2, k - (j + 2)); ++ fmt_restore1; ++ } ++@@ -1880,7 +1896,7 @@ fmt_conditional(bool colon, bool atsign) ++ ; ++ else { ++ --fmt_index; ++- fmt_save; +++ fmt_save1; ++ format(fmt_stream, ctl_origin + i, j - i); ++ fmt_restore1; ++ } ++@@ -1899,7 +1915,7 @@ fmt_conditional(bool colon, bool atsign) ++ for (k = j; ctl_string[--k] != '~';) ++ ; ++ if (n == 0) { ++- fmt_save; +++ fmt_save1; ++ format(fmt_stream, ctl_origin + i, k - i); ++ fmt_restore1; ++ done = TRUE; ++@@ -1925,7 +1941,7 @@ fmt_conditional(bool colon, bool atsign) ++ if (ctl_string[--j] != ']' || ctl_string[--j] != '~') ++ fmt_error("~] expected"); ++ if (!done) { ++- fmt_save; +++ fmt_save1; ++ format(fmt_stream, ctl_origin + i, j - i); ++ fmt_restore1; ++ } ++@@ -2062,7 +2078,7 @@ fmt_justification(volatile bool colon, b ++ { ++ int mincol=0, colinc=0, minpad=0, padchar=0; ++ object fields[FORMAT_DIRECTIVE_LIMIT]; ++- fmt_old; +++ fmt_old1; ++ jmp_buf fmt_jmp_buf0; ++ VOL int i,j,n,j0; ++ int k,l,m,l0; ++@@ -2089,7 +2105,7 @@ fmt_justification(volatile bool colon, b ++ ; ++ fields[n] = make_string_output_stream(64); ++ vs_push(fields[n]); ++- fmt_save; +++ fmt_save1; ++ fmt_jmp_bufp = &fmt_jmp_buf0; ++ if ((up_colon = setjmp(*fmt_jmp_bufp))) { ++ --n; ++@@ -2116,7 +2132,7 @@ fmt_justification(volatile bool colon, b ++ special = 1; ++ for (j = j0; ctl_string[j] != '~'; --j) ++ ; ++- fmt_save; +++ fmt_save1; ++ format(fmt_stream, ctl_origin + j, j0 - j + 2); ++ fmt_restore1; ++ spare_spaces = fmt_spare_spaces; ++--- gcl-2.6.12.orig/o/gbc.c +++++ gcl-2.6.12/o/gbc.c ++@@ -24,7 +24,7 @@ ++ IMPLEMENTATION-DEPENDENT ++ */ ++ ++-/* #define DEBUG */ +++#define DEBUG ++ ++ #define IN_GBC ++ #define NEED_MP_H ++@@ -149,15 +149,6 @@ pageinfo_p(void *v) { ++ ++ } ++ ++-static inline bool ++-in_contblock_stack_list(void *p,void ***ap) { ++- void **a; ++- for (a=*ap;a && a[0]>p;a=a[1]); ++- *ap=a; ++- /* if (a && a[0]==p) fprintf(stderr,"Skipping %p\n",p); */ ++- return a && a[0]==p; ++-} ++- ++ static inline char ++ get_bit(char *v,struct pageinfo *pi,void *x) { ++ void *ve=CB_DATA_START(pi); ++@@ -168,15 +159,15 @@ get_bit(char *v,struct pageinfo *pi,void ++ return (v[i]>>s)&0x1; ++ } ++ ++-static inline void ++-set_bit(char *v,struct pageinfo *pi,void *x) { ++- void *ve=CB_DATA_START(pi); ++- fixnum off=(x-ve)>>LOG_BYTES_CONTBLOCK,i=off>>LOG_BITS_CHAR,s=off&~(~0UL<>LOG_BYTES_CONTBLOCK,i=off>>LOG_BITS_CHAR,s=off&~(~0UL<>s)&0x1) ++ #define bit_set(v,i,s) (v[i]|=(1UL<cb_link,ncb++); +++ +++ return ncb; +++ +++} +++ +++ ++ void ++ GBC(enum type t) { ++ ++@@ -1196,21 +1204,8 @@ GBC(enum type t) { ++ ++ if (gc_time >=0 && !gc_recursive++) {gc_start=runtime();} ++ ++- if (COLLECT_RELBLOCK_P) { ++- ++- char *new_start=heap_end+holepage*PAGESIZE,*new_end=new_start+nrbpage*PAGESIZE; ++- ++- if (new_start!=rb_start) { ++- rb_pointer=new_start; ++- rb_limit=new_end; ++- } else { ++- rb_pointer=(rb_pointer>PAGEWIDTH)); ++ printf("relblock: %ld bytes used %ld bytes free %ld pages\n", ++ (long)(rb_pointer - rb_start), (long)(rb_end - rb_pointer), nrbpage); ++ printf("GBC ended\n"); ++@@ -1425,10 +1421,10 @@ FFN(siLheap_report)(void) { ++ i=sizeof(fixnum)*CHAR_SIZE-2; ++ i=1<>1)); ++ vs_push(make_fixnum(CSTACK_ALIGNMENT)); ++- vs_push(make_fixnum(abs(cs_limit-cs_org)));/*CSSIZE*/ +++ vs_push(make_fixnum(labs(cs_limit-cs_org)));/*CSSIZE*/ ++ #if defined(IM_FIX_BASE) && defined(IM_FIX_LIM) ++ #ifdef LOW_IM_FIX ++ vs_push(make_fixnum(-LOW_IM_FIX)); ++@@ -1456,14 +1452,9 @@ FFN(siLroom_report)(void) { ++ vs_push(make_fixnum(available_pages)); ++ vs_push(make_fixnum(ncbpage)); ++ vs_push(make_fixnum(maxcbpage)); ++- { ++- ufixnum ncb; ++- struct contblock *cbp; ++- for (ncb=0,cbp=cb_pointer;cbp;cbp=cbp->cb_link,ncb++); ++- vs_push(make_fixnum(ncb)); ++- } +++ vs_push(make_fixnum(count_contblocks())); ++ vs_push(make_fixnum(cbgbccount)); ++- vs_push(make_fixnum(holepage)); +++ vs_push(make_fixnum((rb_start-heap_end)>>PAGEWIDTH)); ++ vs_push(make_fixnum(rb_pointer - (rb_pointerc.c_car,depth)^rtb[abs(depth%(sizeof(rtb)/sizeof(*rtb)))]; +++ h^=ihash_equal(x->c.c_car,depth)^rtb[abs((int)(depth%(sizeof(rtb)/sizeof(*rtb))))];/*FIXME: clang faulty warning*/ ++ x = x->c.c_cdr; ++ goto BEGIN; ++ break; ++--- gcl-2.6.12.orig/o/main.c +++++ gcl-2.6.12/o/main.c ++@@ -207,11 +207,19 @@ get_proc_meminfo_value_in_pages(const ch ++ ++ static ufixnum ++ get_phys_pages_no_malloc(char freep) { ++- return freep ? +++ ufixnum k=freep ? ++ get_proc_meminfo_value_in_pages("MemFree:")+ ++ get_proc_meminfo_value_in_pages("Buffers:")+ ++ get_proc_meminfo_value_in_pages("Cached:") : ++ get_proc_meminfo_value_in_pages("MemTotal:"); +++ const char *e=getenv("GCL_MEM_MULTIPLE"); +++ if (e) { +++ double d; +++ massert(sscanf(e,"%lf",&d)==1); +++ massert(d>=0.0); +++ k*=d; +++ } +++ return k; ++ } ++ ++ #endif ++@@ -221,9 +229,9 @@ void *initial_sbrk=NULL; ++ int ++ update_real_maxpage(void) { ++ ++- ufixnum i,j,k; +++ ufixnum i,j; ++ void *end,*cur,*beg; ++- ufixnum free_phys_pages=get_phys_pages_no_malloc(1),maxpages; +++ ufixnum maxpages; ++ #ifdef __MINGW32__ ++ static fixnum n; ++ ++@@ -233,7 +241,7 @@ update_real_maxpage(void) { ++ } ++ #endif ++ ++- phys_pages=get_phys_pages_no_malloc(1); +++ phys_pages=get_phys_pages_no_malloc(0); ++ ++ massert(cur=sbrk(0)); ++ beg=data_start ? data_start : cur; ++@@ -253,15 +261,14 @@ update_real_maxpage(void) { ++ ++ maxpages=real_maxpage-page(beg); ++ ++- free_phys_pages=free_phys_pages>maxpages ? maxpages : free_phys_pages; +++ phys_pages=phys_pages>maxpages ? maxpages : phys_pages; ++ ++ resv_pages=available_pages=0; ++ available_pages=check_avail_pages(); ++ ++- for (i=t_start,j=0;i>1); +++ if (j>1); ++ } ++ ++ new_holepage=0; ++@@ -297,15 +302,15 @@ minimize_image(void) { ++ fixnum i; ++ ++ empty_relblock(); ++- holepage=nrbpage=0; ++- core_end=rb_start=rb_end=rb_limit=rb_pointer=heap_end; +++ nrbpage=0; +++ resize_hole(0,t_relocatable); ++ ++ #ifdef GCL_GPROF ++ gprof_cleanup(); ++ #endif ++ ++ #if defined(BSD) || defined(ATT) ++- mbrk(core_end); +++ mbrk(core_end=heap_end); ++ #endif ++ ++ cbgbccount = tm_table[t_contiguous].tm_adjgbccnt = tm_table[t_contiguous].tm_opt_maxpage = 0; ++@@ -992,7 +997,6 @@ FFN(siLsave_system)(void) { ++ saving_system = FALSE; ++ ++ siLsave(); ++- alloc_page(-(holepage+2*nrbpage)); ++ ++ } ++ ++--- gcl-2.6.12.orig/o/nfunlink.c +++++ gcl-2.6.12/o/nfunlink.c ++@@ -212,19 +212,24 @@ IapplyVector(object fun, int nargs, obje ++ else { abase = vs_top; ++ for (i=0; i < nargs ; i++, atypes >>= F_TYPE_WIDTH) ++ { object next = base[i]; ++- int atyp = atypes & MASK_RANGE(0,F_TYPE_WIDTH); ++- if (atyp == F_object) ++- next = next; ++- else if (atyp == F_int) ++- { ASSURE_TYPE(next,t_fixnum); ++- next = COERCE_F_TYPE(next,F_object,F_int);} ++- else if (atyp == F_shortfloat) ++- { ASSURE_TYPE(next,t_shortfloat); ++- next = COERCE_F_TYPE(next,F_object,F_shortfloat);} ++- else if (atyp == F_double_ptr) ++- { ASSURE_TYPE(next,t_longfloat); ++- next = COERCE_F_TYPE(next,F_object,F_double_ptr);} ++- else {FEerror("cant get here!",0);} +++ switch (atypes & MASK_RANGE(0,F_TYPE_WIDTH)) { +++ case F_object: +++ break; +++ case F_int: +++ ASSURE_TYPE(next,t_fixnum); +++ next = COERCE_F_TYPE(next,F_object,F_int); +++ break; +++ case F_shortfloat: +++ ASSURE_TYPE(next,t_shortfloat); +++ next = COERCE_F_TYPE(next,F_object,F_shortfloat); +++ break; +++ case F_double_ptr: +++ ASSURE_TYPE(next,t_longfloat); +++ next = COERCE_F_TYPE(next,F_object,F_double_ptr); +++ break; +++ default: +++ FEerror("cant get here!",0); +++ } ++ vs_push(next);} ++ ++ } ++--- gcl-2.6.12.orig/o/nsocket.c +++++ gcl-2.6.12/o/nsocket.c ++@@ -204,7 +204,7 @@ CreateSocket(int port, char *host, int s ++ * attempt to do an async connect. Otherwise ++ * do a synchronous connect or bind. */ ++ { ++- int status, sock, asyncConnect, curState, origState; +++ int status, sock, /* asyncConnect, */curState, origState; ++ struct sockaddr_in sockaddr; /* socket address */ ++ struct sockaddr_in mysockaddr; /* Socket address for client */ ++ ++@@ -230,7 +230,7 @@ CreateSocket(int port, char *host, int s ++ ++ fcntl(sock, F_SETFD, FD_CLOEXEC); ++ ++- asyncConnect = 0; +++ /* asyncConnect = 0; */ ++ status = 0; ++ if (server) { ++ ++@@ -285,7 +285,7 @@ CreateSocket(int port, char *host, int s ++ sizeof(sockaddr)); ++ if (status < 0) { ++ if (errno == EINPROGRESS) { ++- asyncConnect = 1; +++ /* asyncConnect = 1; */ ++ status = 0; ++ } ++ } ++--- gcl-2.6.12.orig/o/prelink.c +++++ gcl-2.6.12/o/prelink.c ++@@ -5,8 +5,14 @@ ++ extern FILE *stdin __attribute__((weak)); ++ extern FILE *stderr __attribute__((weak)); ++ extern FILE *stdout __attribute__((weak)); +++ +++#if RL_READLINE_VERSION < 0x0600 +++extern Function *rl_completion_entry_function __attribute__((weak)); +++extern char *rl_readline_name __attribute__((weak)); +++#else ++ extern rl_compentry_func_t *rl_completion_entry_function __attribute__((weak)); ++ extern const char *rl_readline_name __attribute__((weak)); +++#endif ++ ++ void ++ prelink_init(void) { ++--- gcl-2.6.12.orig/o/print.d +++++ gcl-2.6.12/o/print.d ++@@ -341,7 +341,7 @@ truncate_double(char *b,double d,int dp) ++ for (p=c1;*p && *p!='e';p++); ++ pp=p>c1 && p[-1]!='.' ? p-1 : p; ++ for (;pp>c1 && pp[-1]=='0';pp--); ++- strcpy(pp,p); +++ memmove(pp,p,1+strlen(p)); ++ if (pp!=p && COMP(c1,&pp,d,dp)) ++ k=truncate_double(n=c1,d,dp); ++ ++--- gcl-2.6.12.orig/o/read.d +++++ gcl-2.6.12/o/read.d ++@@ -2476,6 +2476,7 @@ object in; ++ ++ /* to prevent longjmp clobber */ ++ i=(long)&vsp; +++ i+=i; ++ vsp=&vspo; ++ old_READtable = READtable; ++ old_READdefault_float_format = READdefault_float_format; ++--- gcl-2.6.12.orig/o/run_process.c +++++ gcl-2.6.12/o/run_process.c ++@@ -354,7 +354,6 @@ static int open_connection(host,server) ++ char *host; ++ int server; ++ { ++- int res; ++ int pid; ++ int sock; ++ struct hostent *hp; ++@@ -396,9 +395,9 @@ int server; ++ } ++ ++ #ifdef OVM_IO ++- res = fcntl(sock,F_SETFL,FASYNC | FNDELAY); +++ fcntl(sock,F_SETFL,FASYNC | FNDELAY); ++ #else ++- res = fcntl(sock,F_SETFL,FASYNC); +++ fcntl(sock,F_SETFL,FASYNC); ++ #endif ++ return(sock); ++ } ++--- gcl-2.6.12.orig/o/sockets.c +++++ gcl-2.6.12/o/sockets.c ++@@ -338,7 +338,7 @@ DEFUN_NEW("OUR-READ-WITH-OFFSET",object, ++ OO,OI,II,OO,(object fd,object buffer,fixnum offset,fixnum nbytes,fixnum timeout), ++ "Read from STATE-FD into string BUFFER putting data at OFFSET and reading NBYTES, waiting for TIMEOUT before failing") ++ ++-{ return make_fixnum(read1(OBJ_TO_CONNECTION_STATE(fd),&((buffer)->ust.ust_self[offset]),nbytes,timeout)); +++{ return make_fixnum(read1(OBJ_TO_CONNECTION_STATE(fd),&((buffer)->st.st_self[offset]),nbytes,timeout)); ++ } ++ ++ ++--- gcl-2.6.12.orig/o/unexelf.c +++++ gcl-2.6.12/o/unexelf.c ++@@ -660,7 +660,7 @@ unexec (char *new_name, char *old_name, ++ int n, nn; ++ int old_bss_index, old_sbss_index; ++ int old_data_index, new_data2_index; ++- int old_mdebug_index; +++ /* int old_mdebug_index; */ ++ struct stat stat_buf; ++ ++ /* Open the old file, allocate a buffer of the right size, and read ++@@ -703,8 +703,8 @@ unexec (char *new_name, char *old_name, ++ ++ /* Find the mdebug section, if any. */ ++ ++- old_mdebug_index = find_section (".mdebug", old_section_names, ++- old_name, old_file_h, old_section_h, 1); +++ /* old_mdebug_index = find_section (".mdebug", old_section_names, */ +++ /* old_name, old_file_h, old_section_h, 1); */ ++ ++ /* Find the old .bss section. Figure out parameters of the new ++ * data2 and bss sections. ++--- gcl-2.6.12.orig/xgcl-2/gcl_general.lsp +++++ gcl-2.6.12/xgcl-2/gcl_general.lsp ++@@ -61,7 +61,7 @@ ++ ++ ;; General routines. ++ (defCfun "object lisp_string(object a_string, fixnum c_string) " 0 ++- "extern long strlen(const char *);" +++ "extern unsigned long strlen(const char *);" ++ "fixnum len = strlen((void *)c_string);" ++ "a_string->st.st_dim = len;" ++ "a_string->st.st_fillp = len;" diff --cc debian/patches/Version_2_6_13pre13 index 00000000,00000000..f019ef78 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre13 @@@ -1,0 -1,0 +1,103 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-12) unstable; urgency=medium ++ . ++ * Version_2_6_13pre13 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/h/protoize.h +++++ gcl-2.6.12/h/protoize.h ++@@ -1918,7 +1918,7 @@ void ++ allocate_code_block_reserve(void); ++ ++ void * ++-alloc_contblock_no_gc(size_t); +++alloc_contblock_no_gc(size_t,char *); ++ ++ void ++ reset_contblock_freelist(void); ++--- gcl-2.6.12.orig/o/alloc.c +++++ gcl-2.6.12/o/alloc.c ++@@ -1047,7 +1047,7 @@ alloc_contblock(size_t n) { ++ } ++ ++ void * ++-alloc_contblock_no_gc(size_t n) { +++alloc_contblock_no_gc(size_t n,char *limit) { ++ ++ struct typemanager *tm=tm_of(t_contiguous); ++ void *p; ++@@ -1057,7 +1057,7 @@ alloc_contblock_no_gc(size_t n) { ++ if ((p=alloc_from_freelist(tm,n))) ++ return p; ++ ++- if (tpage(tm,n)<(rb_start-heap_end)>>PAGEWIDTH && (p=alloc_after_adding_pages(tm,n))) +++ if (tpage(tm,n)<(limit-heap_end)>>PAGEWIDTH && (p=alloc_after_adding_pages(tm,n))) ++ return p; ++ ++ return NULL; ++--- gcl-2.6.12.orig/o/gbc.c +++++ gcl-2.6.12/o/gbc.c ++@@ -431,29 +431,21 @@ collecting(void *p) { ++ ++ static ufixnum ngc_thresh; ++ static union {struct dummy d;ufixnum f;} rst={.f=-1}; ++-/* static object lcv=Cnil; */ +++static void *static_promotion_limit; ++ ++ static inline void ++ mark_leaf_data(object x,void **pp,ufixnum s,ufixnum r) { ++ ++- void *p=*pp,*dp/* ,*dpe */; +++ void *p=*pp,*dp; ++ ++ if (!marking(p)||!collecting(p)) ++ return; ++ ++- /* if (lcv!=Cnil && !collecting(lcv->st.st_self) && */ ++- /* (dp=PCEI(lcv->st.st_self,r)) && dp+s<=(dpe=lcv->st.st_self+lcv->st.st_dim) */ ++- /* && x && x->d.st>=ngc_thresh) { */ ++- ++ if (what_to_collect!=t_contiguous && ++ x && x->d.st>=ngc_thresh && ++- (dp=alloc_contblock_no_gc(s))) { +++ (dp=alloc_contblock_no_gc(s,static_promotion_limit))) { ++ ++- /* fprintf(stderr,"Promoting %p,%lu to %p\n",p,s,dp); */ ++- /* fflush(stderr); */ ++- ++ *pp=memcpy(dp,p,s); ++- /* lcv->st.st_fillp=lcv->st.st_dim=(dpe-(void *)(lcv->st.st_self=dp+s)); */ ++ x->d.st=0; ++ ++ return; ++@@ -1204,8 +1196,10 @@ GBC(enum type t) { ++ ++ if (gc_time >=0 && !gc_recursive++) {gc_start=runtime();} ++ ++- if (COLLECT_RELBLOCK_P) +++ if (COLLECT_RELBLOCK_P) { +++ static_promotion_limit=rb_start ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-12) unstable; urgency=medium ++ . ++ * Version_2_6_13pre13 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -2915,10 +2915,10 @@ case $canonical in ++ use=386-macosx ++ if test "$build_cpu" = "x86_64" ; then ++ CFLAGS="-m64 $CFLAGS"; ++- LDFLAGS="-m64 -Wl,-headerpad,72 $LDFLAGS"; +++ LDFLAGS="-m64 -Wl,-headerpad,72 -Wl,-no_pie $LDFLAGS"; ++ else ++ CFLAGS="-m32 $CFLAGS"; ++- LDFLAGS="-m32 -Wl,-headerpad,56 $LDFLAGS"; +++ LDFLAGS="-m32 -Wl,-headerpad,56 -Wl,-no_pie $LDFLAGS"; ++ fi;; ++ ++ alpha-dec-osf) ++@@ -4203,7 +4203,7 @@ if ac_fn_c_try_run "$LINENO"; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ $as_echo "yes" >&6; } ++ clang="yes" ++- TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body" +++ TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign" ++ ++ $as_echo "#define CLANG 1" >>confdefs.h ++ ++@@ -4246,7 +4246,12 @@ fi ++ if test "$GCC" = "yes" ; then ++ TCFLAGS="$TCFLAGS -pipe" ++ case $use in ++- *mingw*|*gnuwin*) +++ *mingw*) +++# echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." +++# echo " It is otherwise needed for the Unexec stuff to work." +++# if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi +++ TCFLAGS="$TCFLAGS -fno-zero-initialized-in-bss -mms-bitfields";; +++ *gnuwin*) ++ # echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." ++ # echo " It is otherwise needed for the Unexec stuff to work." ++ # if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi ++@@ -5193,7 +5198,7 @@ $as_echo_n "checking \"for leading under ++ cat>foo.c < ++ #include ++-int main() {FILE *f;double d=0.0;getc(f);cos(d);return 0;} +++int main() {FILE *f;double d=0.0;getc(f);d=cos(d);return 0;} ++ EOFF ++ $CC -c foo.c -o foo.o ++ if nm foo.o |grep " U " | grep "_cos" >/dev/null || nm foo.o |grep " U " | grep " _getc" >/dev/null ; then ++@@ -6071,7 +6076,50 @@ $as_echo "$ac_cv_lib_tirpc_xdr_double" > ++ if test "x$ac_cv_lib_tirpc_xdr_double" = xyes; then : ++ ++ $as_echo "#define HAVE_XDR 1" >>confdefs.h ++- TLIBS="$TLIBS -ltirpc" +++ +++ TLIBS="$TLIBS -ltirpc" TCFLAGS="$TCFLAGS -I/usr/include/tirpc" +++else +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -lgssrpc" >&5 +++$as_echo_n "checking for xdr_double in -lgssrpc... " >&6; } +++if ${ac_cv_lib_gssrpc_xdr_double+:} false; then : +++ $as_echo_n "(cached) " >&6 +++else +++ ac_check_lib_save_LIBS=$LIBS +++LIBS="-lgssrpc $LIBS" +++cat confdefs.h - <<_ACEOF >conftest.$ac_ext +++/* end confdefs.h. */ +++ +++/* Override any GCC internal prototype to avoid an error. +++ Use char because int might match the return type of a GCC +++ builtin and then its argument prototype would still apply. */ +++#ifdef __cplusplus +++extern "C" +++#endif +++char xdr_double (); +++int +++main () +++{ +++return xdr_double (); +++ ; +++ return 0; +++} +++_ACEOF +++if ac_fn_c_try_link "$LINENO"; then : +++ ac_cv_lib_gssrpc_xdr_double=yes +++else +++ ac_cv_lib_gssrpc_xdr_double=no +++fi +++rm -f core conftest.err conftest.$ac_objext \ +++ conftest$ac_exeext conftest.$ac_ext +++LIBS=$ac_check_lib_save_LIBS +++fi +++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gssrpc_xdr_double" >&5 +++$as_echo "$ac_cv_lib_gssrpc_xdr_double" >&6; } +++if test "x$ac_cv_lib_gssrpc_xdr_double" = xyes; then : +++ +++$as_echo "#define HAVE_XDR 1" >>confdefs.h +++ +++ TLIBS="$TLIBS -lgssrpc" TCFLAGS="$TCFLAGS -I/usr/include/gssrpc" ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -lrpc" >&5 ++ $as_echo_n "checking for xdr_double in -lrpc... " >&6; } ++@@ -6112,7 +6160,8 @@ $as_echo "$ac_cv_lib_rpc_xdr_double" >&6 ++ if test "x$ac_cv_lib_rpc_xdr_double" = xyes; then : ++ ++ $as_echo "#define HAVE_XDR 1" >>confdefs.h ++- TLIBS="$TLIBS -lrpc" +++ +++ TLIBS="$TLIBS -lrpc" TCFLAGS="$TCFLAGS -I/usr/include/rpc" ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -loncrpc" >&5 ++ $as_echo_n "checking for xdr_double in -loncrpc... " >&6; } ++@@ -6153,7 +6202,10 @@ $as_echo "$ac_cv_lib_oncrpc_xdr_double" ++ if test "x$ac_cv_lib_oncrpc_xdr_double" = xyes; then : ++ ++ $as_echo "#define HAVE_XDR 1" >>confdefs.h ++- TLIBS="$TLIBS -loncrpc" +++ +++ TLIBS="$TLIBS -loncrpc" TCFLAGS="$TCFLAGS -I/usr/include/oncrpc" +++fi +++ ++ fi ++ ++ fi ++@@ -6870,7 +6922,6 @@ else ++ ++ #include ++ #include ++- void gprof_cleanup() {}; ++ int main(int argc,char **argv,char **envp) { ++ #include "h/unrandomize.h" ++ return 0;} ++@@ -6899,7 +6950,6 @@ else ++ /* end confdefs.h. */ ++ #include ++ #include ++- void gprof_cleanup() {}; ++ int main(int argc,char * argv[],char * envp[]) { ++ FILE *f; ++ #ifdef CAN_UNRANDOMIZE_SBRK ++@@ -6930,7 +6980,6 @@ else ++ /* end confdefs.h. */ ++ #include ++ #include ++- void gprof_cleanup() {}; ++ int main(int argc,char * argv[],char * envp[]) { ++ FILE *f; ++ #ifdef CAN_UNRANDOMIZE_SBRK ++@@ -6997,7 +7046,6 @@ else ++ return (void *)&i; ++ } ++ ++- void gprof_cleanup() {}; ++ int main(int argc,char **argv,char **envp) { ++ void *v ; ++ FILE *fp = fopen("conftest1","w"); ++@@ -7055,7 +7103,6 @@ else ++ return (void *)&i; ++ } ++ ++- void gprof_cleanup() {}; ++ int main(int argc,char **argv,char **envp) { ++ void *v ; ++ FILE *fp = fopen("conftest1","w"); ++@@ -7108,7 +7155,6 @@ else ++ ++ #include ++ #include ++- void gprof_cleanup() {}; ++ int main(int argc,char **argv,char **envp) { ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++@@ -7147,7 +7193,6 @@ else ++ ++ #include ++ #include ++- void gprof_cleanup() {}; ++ int main(int argc,char **argv,char **envp) { ++ void *b,*c; ++ FILE *fp = fopen("conftest1","w"); ++@@ -7200,7 +7245,6 @@ else ++ return (void *)&i; ++ } ++ ++- void gprof_cleanup() {}; ++ int main(int argc,char **argv,char **envp) { ++ char *b; ++ FILE *fp = fopen("conftest1","w"); ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -195,10 +195,10 @@ case $canonical in ++ use=386-macosx ++ if test "$build_cpu" = "x86_64" ; then ++ CFLAGS="-m64 $CFLAGS"; ++- LDFLAGS="-m64 -Wl,-headerpad,72 $LDFLAGS"; +++ LDFLAGS="-m64 -Wl,-headerpad,72 -Wl,-no_pie $LDFLAGS"; ++ else ++ CFLAGS="-m32 $CFLAGS"; ++- LDFLAGS="-m32 -Wl,-headerpad,56 $LDFLAGS"; +++ LDFLAGS="-m32 -Wl,-headerpad,56 -Wl,-no_pie $LDFLAGS"; ++ fi;; ++ ++ alpha-dec-osf) ++@@ -502,7 +502,7 @@ if test "$GCC" = "yes" ; then ++ ;}]])], ++ [AC_MSG_RESULT([yes]) ++ clang="yes" ++- TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body" +++ TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign" ++ AC_DEFINE([CLANG],[1],[running clang compiler])], ++ [AC_MSG_RESULT([no]) ++ #FIXME -Wno-unused-but-set-variable when time ++@@ -517,7 +517,12 @@ fi ++ if test "$GCC" = "yes" ; then ++ TCFLAGS="$TCFLAGS -pipe" ++ case $use in ++- *mingw*|*gnuwin*) +++ *mingw*) +++# echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." +++# echo " It is otherwise needed for the Unexec stuff to work." +++# if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi +++ TCFLAGS="$TCFLAGS -fno-zero-initialized-in-bss -mms-bitfields";; +++ *gnuwin*) ++ # echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." ++ # echo " It is otherwise needed for the Unexec stuff to work." ++ # if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi ++@@ -889,7 +894,7 @@ AC_MSG_CHECKING("for leading underscore ++ cat>foo.c < ++ #include ++-int main() {FILE *f;double d=0.0;getc(f);cos(d);return 0;} +++int main() {FILE *f;double d=0.0;getc(f);d=cos(d);return 0;} ++ EOFF ++ $CC -c foo.c -o foo.o ++ if nm foo.o |grep " U " | grep "_cos" >/dev/null || nm foo.o |grep " U " | grep " _getc" >/dev/null ; then ++@@ -1160,9 +1165,14 @@ fi ++ ++ if test "$enable_xdr" = "yes" ; then ++ AC_CHECK_FUNC(xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]), ++- AC_CHECK_LIB(tirpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) TLIBS="$TLIBS -ltirpc", ++- AC_CHECK_LIB(rpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) TLIBS="$TLIBS -lrpc", ++- AC_CHECK_LIB(oncrpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) TLIBS="$TLIBS -loncrpc")))) +++ AC_CHECK_LIB(tirpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) +++ TLIBS="$TLIBS -ltirpc" TCFLAGS="$TCFLAGS -I/usr/include/tirpc", +++ AC_CHECK_LIB(gssrpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) +++ TLIBS="$TLIBS -lgssrpc" TCFLAGS="$TCFLAGS -I/usr/include/gssrpc", +++ AC_CHECK_LIB(rpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) +++ TLIBS="$TLIBS -lrpc" TCFLAGS="$TCFLAGS -I/usr/include/rpc", +++ AC_CHECK_LIB(oncrpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) +++ TLIBS="$TLIBS -loncrpc" TCFLAGS="$TCFLAGS -I/usr/include/oncrpc"))))) ++ fi ++ ++ ++@@ -1442,7 +1452,6 @@ if test "$HAVE_SBRK" = "1" ; then ++ AC_LANG_SOURCE([[ ++ #include ++ #include ++- void gprof_cleanup() {}; ++ int main(int argc,char **argv,char **envp) { ++ #include "h/unrandomize.h" ++ return 0;}]])], ++@@ -1453,7 +1462,6 @@ if test "$HAVE_SBRK" = "1" ; then ++ AC_MSG_CHECKING([that sbrk is (now) non-random]) ++ AC_TRY_RUN([#include ++ #include ++- void gprof_cleanup() {}; ++ int main(int argc,char * argv[],char * envp[]) { ++ FILE *f; ++ #ifdef CAN_UNRANDOMIZE_SBRK ++@@ -1468,7 +1476,6 @@ if test "$HAVE_SBRK" = "1" ; then ++ fi ++ AC_TRY_RUN([#include ++ #include ++- void gprof_cleanup() {}; ++ int main(int argc,char * argv[],char * envp[]) { ++ FILE *f; ++ #ifdef CAN_UNRANDOMIZE_SBRK ++@@ -1552,7 +1559,6 @@ AC_RUN_IFELSE([AC_LANG_SOURCE([[ ++ return (void *)&i; ++ } ++ ++- void gprof_cleanup() {}; ++ int main(int argc,char **argv,char **envp) { ++ void *v ; ++ FILE *fp = fopen("conftest1","w"); ++@@ -1586,7 +1592,6 @@ AC_RUN_IFELSE([AC_LANG_SOURCE([[ ++ return (void *)&i; ++ } ++ ++- void gprof_cleanup() {}; ++ int main(int argc,char **argv,char **envp) { ++ void *v ; ++ FILE *fp = fopen("conftest1","w"); ++@@ -1615,7 +1620,6 @@ AC_MSG_CHECKING(NEG_CSTACK_ADDRESS) ++ AC_RUN_IFELSE([AC_LANG_SOURCE([[ ++ #include ++ #include ++- void gprof_cleanup() {}; ++ int main(int argc,char **argv,char **envp) { ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++@@ -1632,7 +1636,6 @@ AC_MSG_CHECKING([finding CSTACK_ALIGNMEN ++ AC_RUN_IFELSE([AC_LANG_SOURCE([[ ++ #include ++ #include ++- void gprof_cleanup() {}; ++ int main(int argc,char **argv,char **envp) { ++ void *b,*c; ++ FILE *fp = fopen("conftest1","w"); ++@@ -1661,7 +1664,6 @@ AC_RUN_IFELSE([AC_LANG_SOURCE([[ ++ return (void *)&i; ++ } ++ ++- void gprof_cleanup() {}; ++ int main(int argc,char **argv,char **envp) { ++ char *b; ++ FILE *fp = fopen("conftest1","w"); ++--- gcl-2.6.12.orig/h/mingw.h +++++ gcl-2.6.12/h/mingw.h ++@@ -243,3 +243,6 @@ extern int mingwlisten(FILE *); ++ #include ++ ++ +++#define NO_FILE_LOCKING /*FIXME*/ +++ +++#define sleep(n) Sleep(1000*n) ++--- gcl-2.6.12.orig/h/object.h +++++ gcl-2.6.12/h/object.h ++@@ -340,15 +340,68 @@ EXTER long holepage; /* hole pages * ++ #define maxrbpage tm_table[t_relocatable].tm_maxpage ++ #define rbgbccount tm_table[t_relocatable].tm_gbccount ++ EXTER long new_holepage,starting_hole_div,starting_relb_heap_mult; ++- +++ +++EXTER ufixnum recent_allocation,wait_on_abort; +++EXTER double gc_alloc_min,mem_multiple,gc_page_min,gc_page_max; +++EXTER bool multiprocess_memory_pool; ++ ++ EXTER char *new_rb_start; /* desired relblock start after next gc */ ++ EXTER char *rb_start; /* relblock start */ ++ EXTER char *rb_end; /* relblock end */ ++ EXTER char *rb_limit; /* relblock limit */ ++ EXTER char *rb_pointer; /* relblock pointer */ ++-/* EXTER char *rb_start1; /\* relblock start in copy space *\/ */ ++-/* EXTER char *rb_pointer1; /\* relblock pointer in copy space *\/ */ +++ +++#ifndef INLINE +++#define INLINE +++#endif +++ +++INLINE ufixnum +++rb_size(void) { +++ return rb_end-rb_start; +++} +++ +++INLINE bool +++rb_high(void) { +++ return rb_pointer>=rb_end&&rb_size(); +++} +++ +++INLINE char * +++rb_begin(void) { +++ return rb_high() ? rb_end : rb_start; +++} +++ +++INLINE bool +++rb_emptyp(void) { +++ return rb_pointer == rb_begin(); +++} +++ +++INLINE ufixnum +++ufmin(ufixnum a,ufixnum b) { +++ return a<=b ? a : b; +++} +++ +++INLINE ufixnum +++ufmax(ufixnum a,ufixnum b) { +++ return a>=b ? a : b; +++} +++ +++#include +++#include +++#include +++INLINE int +++emsg(const char *s,...) { +++ va_list args; +++ ufixnum n=0; +++ void *v=NULL; +++ va_start(args,s); +++ n=vsnprintf(v,n,s,args)+1; +++ va_end(args); +++ v=alloca(n); +++ va_start(args,s); +++ vsnprintf(v,n,s,args); +++ va_end(args); +++ return write(2,v,n-1) ? n : -1; +++} ++ ++ EXTER char *heap_end; /* heap end */ ++ EXTER char *core_end; /* core end */ ++--- /dev/null +++++ gcl-2.6.12/h/pool.h ++@@ -0,0 +1,170 @@ +++static ufixnum +++data_pages(void) { +++ +++ return page(2*(rb_end-rb_start)+((void *)heap_end-data_start)); +++ +++} +++ +++#ifndef NO_FILE_LOCKING +++ +++#include +++#include +++#include +++#include +++#include +++ +++static int pool=-1; +++static struct pool { +++ ufixnum pid; +++ ufixnum n; +++ ufixnum s; +++} *Pool; +++ +++static struct flock pl; +++ +++static const char *gcl_pool="/tmp/gcl_pool"; +++ +++static int +++set_lock(void) { +++ +++ errno=0; +++ if (fcntl(pool,F_SETLKW,&pl)) { +++ if (errno==EINTR) +++ set_lock(); +++ return -1; +++ } +++ return 0; +++ +++} +++ +++static void +++lock_pool(void) { +++ +++ pl.l_type=F_WRLCK; +++ massert(!set_lock()); +++ +++} +++ +++static void +++unlock_pool(void) { +++ +++ pl.l_type=F_UNLCK; +++ massert(!set_lock()); +++ +++} +++ +++static void +++register_pool(int s) { +++ lock_pool(); +++ Pool->n+=s; +++ Pool->s+=s*data_pages(); +++ unlock_pool(); +++} +++ +++static void +++open_pool(void) { +++ +++ if (pool==-1) { +++ +++ struct flock f; +++ +++ massert((pool=open(gcl_pool,O_CREAT|O_RDWR,0644))!=-1); +++ massert(!ftruncate(pool,sizeof(struct pool))); +++ massert((Pool=mmap(NULL,sizeof(struct pool),PROT_READ|PROT_WRITE,MAP_SHARED,pool,0))!=(void *)-1); +++ +++ pl.l_type=F_WRLCK; +++ pl.l_whence=SEEK_SET; +++ pl.l_start=sizeof(Pool->pid);; +++ pl.l_len=0; +++ +++ f=pl; +++ f.l_start=0; +++ f.l_len=sizeof(Pool->pid); +++ +++ if (!fcntl(pool,F_SETLK,&f)) { +++ +++ Pool->pid=getpid(); +++ +++ lock_pool(); +++ Pool->n=0; +++ Pool->s=0; +++ unlock_pool(); +++ +++ f.l_type=F_UNLCK; +++ massert(!fcntl(pool,F_SETLK,&f)); +++ +++ fprintf(stderr,"Initializing pool\n"); +++ fflush(stderr); +++ +++ } +++ +++ f.l_type=F_RDLCK; +++ massert(!fcntl(pool,F_SETLK,&f)); +++ +++ register_pool(1); +++ massert(!atexit(close_pool)); +++ +++ } +++ +++} +++#endif +++ +++void +++close_pool(void) { +++ +++#ifndef NO_FILE_LOCKING +++ if (pool!=-1) { +++ register_pool(-1); +++ massert(!close(pool)); +++ massert(!munmap(Pool,sizeof(struct pool))); +++ pool=-1; +++ } +++#endif +++ +++} +++ +++static void +++update_pool(fixnum val) { +++ +++#ifndef NO_FILE_LOCKING +++ if (multiprocess_memory_pool) { +++ open_pool(); +++ lock_pool(); +++ Pool->s+=val; +++ unlock_pool(); +++ } +++#endif +++ +++} +++ +++static ufixnum +++get_pool(void) { +++ +++ ufixnum s; +++ +++#ifndef NO_FILE_LOCKING +++ if (multiprocess_memory_pool) { +++ +++ open_pool(); +++ lock_pool(); +++ s=Pool->s; +++ unlock_pool(); +++ +++ } else +++#endif +++ +++ s=data_pages(); +++ +++ return s; +++ +++} +++ +++ +++static void +++pool_check(void) { +++ +++ /* if (pool!=-1) */ +++ /* massert(get_pool()==data_pages() */ +++ /* ||!fprintf(stderr,"%lu %lu %lu\n",get_pool(),page((void *)heap_end-data_start),page(((rb_end-rb_start))))); */ +++ +++} ++--- gcl-2.6.12.orig/h/protoize.h +++++ gcl-2.6.12/h/protoize.h ++@@ -1951,7 +1951,16 @@ ufixnum ++ sum_maxpages(void); ++ ++ void ++-resize_hole(ufixnum,enum type); +++resize_hole(ufixnum,enum type,bool); ++ ++ void ++-setup_rb(void); +++setup_rb(bool); +++ +++void +++close_pool(void); +++ +++void +++gcl_cleanup(int); +++ +++void +++do_gcl_abort(void); ++--- gcl-2.6.12.orig/h/unrandomize.h +++++ gcl-2.6.12/h/unrandomize.h ++@@ -49,10 +49,10 @@ ++ } ++ n[k]="GCL_UNRANDOMIZE=t"; ++ n[k+1]=0; ++-#ifdef GCL_GPROF ++- gprof_cleanup(); ++-#endif ++ errno=0; +++#ifdef HAVE_GCL_CLEANUP +++ gcl_cleanup(0); +++#endif ++ execve(*a,a,n); ++ printf("execve failure %d\n",errno); ++ exit(-1); ++--- gcl-2.6.12.orig/lsp/gcl_top.lsp +++++ gcl-2.6.12/lsp/gcl_top.lsp ++@@ -89,7 +89,7 @@ ++ ++ (when (boundp '*system-banner*) ++ (format t *system-banner*) ++- (format t "Temporary directory for compiler files set to ~a~%" *tmp-dir*)) +++ (format t "Temporary directory for compiler files:~%~a~%" *tmp-dir*)) ++ ++ (loop ++ (setq +++ ++ ++ + + -) ++--- gcl-2.6.12.orig/o/alloc.c +++++ gcl-2.6.12/o/alloc.c ++@@ -38,6 +38,8 @@ Foundation, 675 Mass Ave, Cambridge, MA ++ static int ++ t_from_type(object); ++ +++#include "pool.h" +++ ++ ++ DEFVAR("*AFTER-GBC-HOOK*",sSAafter_gbc_hookA,SI,sLnil,""); ++ DEFVAR("*IGNORE-MAXIMUM-PAGES*",sSAignore_maximum_pagesA,SI,sLt,""); ++@@ -67,7 +69,6 @@ sbrk1(n) ++ ++ long starting_hole_div=10; ++ long starting_relb_heap_mult=2; ++-long new_holepage; ++ long resv_pages=0; ++ ++ #ifdef BSD ++@@ -317,7 +318,7 @@ empty_relblock(void) { ++ object o=sSAleaf_collection_thresholdA->s.s_dbind; ++ ++ sSAleaf_collection_thresholdA->s.s_dbind=make_fixnum(0); ++- for (;rb_pointer!=rb_start&&rb_pointer!=rb_end;) { +++ for (;!rb_emptyp();) { ++ tm_table[t_relocatable].tm_adjgbccnt--; ++ GBC(t_relocatable); ++ } ++@@ -326,40 +327,44 @@ empty_relblock(void) { ++ } ++ ++ void ++-setup_rb(void) { +++setup_rb(bool preserve_rb_pointerp) { ++ ++- int init=new_rb_start!=rb_start || rb_pointer>=rb_end; +++ int lowp=new_rb_start!=rb_start || rb_high(); ++ +++ update_pool(2*(nrbpage-page(rb_size()))); ++ rb_start=new_rb_start; ++ rb_end=rb_start+(nrbpage<>PAGEWIDTH))); ++ ++ } ++ ++ void ++-resize_hole(ufixnum hp,enum type tp) { +++resize_hole(ufixnum hp,enum type tp,bool in_placep) { ++ ++- char *start=rb_pointer=start) || (new_rb_start=start+size)) { ++- fprintf(stderr,"Toggling relblock when resizing hole to %lu\n",hp); ++- fflush(stderr); +++ if (!in_placep && +++ ((new_start<=start && starttm_adjgbccnt--; ++ GBC(tp); ++- } else ++- setup_rb(); +++ } ++ ++ } ++ ++@@ -378,11 +383,13 @@ alloc_page(long n) { ++ fixnum d=available_pages-nn; ++ ++ d*=0.2; ++- d=d<0.01*real_maxpage ? available_pages-n : d; +++ d=d<0.01*real_maxpage ? available_pages-nn : d; ++ d=d<0 ? 0 : d; ++- d=new_holepage(void *)core_end) { +++ update_pool(nn); +++ pool_check(); +++ +++ } else if (v>(void *)core_end) { ++ ++ massert(!mbrk(v)); ++ core_end=v; ++@@ -510,94 +519,6 @@ grow_linear(fixnum old, fixnum fract, fi ++ DEFVAR("*OPTIMIZE-MAXIMUM-PAGES*",sSAoptimize_maximum_pagesA,SI,sLnil,""); ++ #define OPTIMIZE_MAX_PAGES (sSAoptimize_maximum_pagesA ==0 || sSAoptimize_maximum_pagesA->s.s_dbind !=sLnil) ++ DEFVAR("*NOTIFY-OPTIMIZE-MAXIMUM-PAGES*",sSAnotify_optimize_maximum_pagesA,SI,sLnil,""); ++-#define MMAX_PG(a_) (a_)->tm_maxpage-(a_)->tm_alt_npage ++- ++-static int ++-rebalance_maxpages(struct typemanager *my_tm,fixnum z) { ++- ++- fixnum d; ++- ufixnum i,j,r=(my_tm->tm_type==t_relocatable ? 2 : 1); ++- ++- ++- d=(z-my_tm->tm_maxpage)*r; ++- j=sum_maxpages(); ++- ++- if (j+d>phys_pages) { ++- ++- ufixnum k,e=j+d-phys_pages; ++- double f; ++- ++- for (k=0,i=t_start;ik ? k : e; ++- if (e+phys_pages<=j) ++- return 0; ++- ++- f=k ? 1.0-(double)e/k : 1.0; ++- ++- for (i=t_start;itm_maxpage*r+(phys_pages-sum_maxpages()))/r)); ++- ++- return 1; ++- ++- } else ++- ++- return set_tm_maxpage(my_tm,z); ++- ++-} ++- ++-long ++-opt_maxpage(struct typemanager *my_tm) { ++- ++- double x=0.0,y=0.0,z,r; ++- long mmax_page; ++- struct typemanager *tm,*tme; ++- long mro=0,tro=0,j; ++- ++- if (page(core_end)>0.8*real_maxpage) ++- return 0; ++- ++- for (tm=tm_table,tme=tm+sizeof(tm_table)/sizeof(*tm_table);tmtm_adjgbccnt; ++- y+=MMAX_PG(tm); ++- } ++- mmax_page=MMAX_PG(my_tm); ++-#if 0 ++- if (sgc_enabled) { ++- y-=(tro=sgc_count_read_only_type(-1)); ++- mmax_page-=(mro=sgc_count_read_only_type(my_tm->tm_type)); ++- } ++-#endif ++- ++- z=my_tm->tm_adjgbccnt/* -1 */; ++- z/=(1+x-0.9*my_tm->tm_adjgbccnt); ++- z*=(y-mmax_page)*mmax_page; ++- z=sqrt(z); ++- z=z-mmax_page>available_pages ? mmax_page+available_pages : z; ++- my_tm->tm_opt_maxpage=(long)(z+my_tm->tm_alt_npage)>my_tm->tm_opt_maxpage ? (long)(z+my_tm->tm_alt_npage) : my_tm->tm_opt_maxpage; ++- ++- if (z<=mmax_page) ++- return 0; ++- ++- r=((x-my_tm->tm_adjgbccnt)+ my_tm->tm_adjgbccnt*mmax_page/z)*(y-mmax_page+z); ++- r/=x*y; ++- ++- j=r<=0.95 && rebalance_maxpages(my_tm,z+mro+my_tm->tm_alt_npage); ++- ++- if (sSAnotify_optimize_maximum_pagesA->s.s_dbind!=sLnil) ++- printf("[type %u max %lu(%lu) opt %lu y %lu(%lu) gbcrat %f sav %f new %lu sum %lu phys %lu]\n", ++- my_tm->tm_type,mmax_page,mro,(long)z,(long)y,tro,(my_tm->tm_adjgbccnt/* -1 */)/(1+x-0.9*my_tm->tm_adjgbccnt),r, ++- my_tm->tm_maxpage,sum_maxpages(),phys_pages); ++- ++- return j ? 1 : 0; ++- ++-} ++ ++ static object ++ exhausted_report(enum type t,struct typemanager *tm) { ++@@ -735,14 +656,12 @@ print_cb(int print) { ++ massert(**cbppp==cbp); ++ for (k=0;cbp && cbp->cb_size==(**cbppp)->cb_size;cbpp=&cbp->cb_link,cbp=cbp->cb_link,k++); ++ if (print) ++- fprintf(stderr,"%lu %p %p %lu %lu\n",(unsigned long)(cbppp-cbsrch1),*cbppp,**cbppp,(**cbppp)->cb_size,k); +++ emsg("%lu %p %p %lu %lu\n",(unsigned long)(cbppp-cbsrch1),*cbppp,**cbppp,(**cbppp)->cb_size,k); ++ } ++ massert(cbppp==cbsrche); ++ massert(*cbppp==cbpp); ++ massert(!**cbppp); ++ ++- fflush(stderr); ++- ++ } ++ ++ void ++@@ -808,8 +727,8 @@ alloc_from_freelist(struct typemanager * ++ break; ++ ++ case t_relocatable: ++- if (rb_pointer>rb_end && rb_pointer+n>rb_limit && rb_pointer+nrb_end && rb_pointer+n>rb_limit && rb_pointer+nn) ++ return ((rb_pointer+=n)-n); ++ break; ++@@ -847,7 +766,7 @@ too_full_p(struct typemanager *tm) { ++ ++ switch (tm->tm_type) { ++ case t_relocatable: ++- return 100*(rb_limit-rb_pointer)cb_link) k+=cbp->cb_size; ++@@ -867,10 +786,31 @@ too_full_p(struct typemanager *tm) { ++ ++ } ++ +++static inline bool +++do_gc_p(struct typemanager *tm,fixnum n) { +++ +++ ufixnum cpool,pp; +++ +++ if (!GBC_enable) +++ return FALSE; +++ +++ if (!sSAoptimize_maximum_pagesA || sSAoptimize_maximum_pagesA->s.s_dbind==Cnil) +++ return tm->tm_npage+tpage(tm,n)>tm->tm_maxpage; +++ +++ if ((cpool=get_pool())<=gc_page_min*phys_pages) +++ return FALSE; +++ +++ pp=gc_page_max*phys_pages; +++ +++ return page(recent_allocation)>(1.0+gc_alloc_min-(double)ufmin(cpool,pp)/pp)*data_pages(); +++ +++} +++ +++ ++ static inline void * ++ alloc_after_gc(struct typemanager *tm,fixnum n) { ++ ++- if (tm->tm_npage+tpage(tm,n)>tm->tm_maxpage && GBC_enable) { +++ if (do_gc_p(tm,n)) { ++ ++ switch (jmp_gmp) { ++ case 0: /* not in gmp call*/ ++@@ -911,21 +851,13 @@ add_pages(struct typemanager *tm,fixnum ++ ++ case t_relocatable: ++ ++- if (rb_pointer>rb_end && m>((rb_start-heap_end)>>PAGEWIDTH)) { ++- fprintf(stderr,"Moving relblock low before expanding relblock pages\n"); ++- fflush(stderr); +++ if (rb_high() && m>((rb_start-heap_end)>>PAGEWIDTH)) { +++ emsg("Moving relblock low before expanding relblock pages\n"); ++ tm_table[t_relocatable].tm_adjgbccnt--; ++ GBC(t_relocatable); ++ } ++ nrbpage+=m; ++- rb_limit+=m*PAGESIZE; ++- if (rb_pointer>rb_end) ++- rb_start-=m*PAGESIZE; ++- else ++- rb_end+=m*PAGESIZE; ++- ++- alloc_page(-(2*nrbpage+((rb_start-heap_end)>>PAGEWIDTH))); ++- +++ resize_hole(page(rb_start-heap_end)-(rb_high() ? m : 0),t_relocatable,1); ++ break; ++ ++ default: ++@@ -1011,6 +943,8 @@ alloc_mem(struct typemanager *tm,fixnum ++ ++ CHECK_INTERRUPT; ++ +++ recent_allocation+=n; +++ ++ if ((p=alloc_from_freelist(tm,n))) ++ return p; ++ if ((p=alloc_after_gc(tm,n))) ++@@ -1135,7 +1069,7 @@ DEFUNM_NEW("ALLOCATED",object,fSallocate ++ { struct typemanager *tm=(&tm_table[t_from_type(typ)]); ++ tm = & tm_table[tm->tm_type]; ++ if (tm->tm_type == t_relocatable) ++- { tm->tm_npage = (rb_end-rb_start)>>PAGEWIDTH; +++ { tm->tm_npage = page(rb_size()); ++ tm->tm_nfree = rb_limit -rb_pointer; ++ } ++ else if (tm->tm_type == t_contiguous) ++@@ -1262,7 +1196,7 @@ object malloc_list=Cnil; ++ void ++ maybe_set_hole_from_maxpages(void) { ++ if (rb_start==heap_end && rb_end==rb_start && rb_limit==rb_start && rb_pointer==rb_start) ++- resize_hole(new_holepage,t_relocatable); +++ resize_hole(available_pages/3,t_relocatable,0); ++ } ++ ++ void ++@@ -1361,10 +1295,10 @@ gcl_init_alloc(void *cs_start) { ++ initial_sbrk=data_start=heap_end; ++ first_data_page=page(data_start); ++ ++-#ifdef GCL_GPROF ++- if (new_holepage>PAGEWIDTH)); ++ } ++ ++ ++@@ -1751,9 +1685,7 @@ DEFUN_NEW("SET-STARTING-RELBLOCK-HEAP-MU ++ ++ DEFUNM_NEW("SET-HOLE-SIZE",object,fSset_hole_size,SI,1,2,NONE,OO,OO,OO,OO,(object onpages,...),"") { ++ ++- printf("This function is obsolete -- use SET-STARTING-HOLE-DIVISOR instead\n"); ++- ++- RETURN2(make_fixnum(new_holepage),make_fixnum(reserve_pages_for_signal_handler)); +++ RETURN2(make_fixnum((rb_start-heap_end)>>PAGEWIDTH),make_fixnum(reserve_pages_for_signal_handler)); ++ ++ } ++ ++@@ -1811,7 +1743,7 @@ static char *baby_malloc(n) ++ if ((res +m-baby_malloc_data) > sizeof(baby_malloc_data)) ++ { ++ printf("failed in baby malloc"); ++- exit(1); +++ do_gcl_abort(); ++ } ++ last_baby += m; ++ *((int *)res)=n; ++@@ -1904,18 +1836,16 @@ free(void *ptr) { ++ #endif ++ return; ++ } ++-#ifdef NOFREE_ERR ++- return; ++-#else ++ if (ptr!=initial_monstartup_pointer_echo) { ++ static void *old_ptr; ++ if (old_ptr==ptr) return; ++ old_ptr=ptr; +++#ifndef NOFREE_ERR ++ FEerror("free(3) error.",0); +++#endif ++ } ++ initial_monstartup_pointer_echo=NULL; ++ return; ++-#endif ++ } ++ ++ void * ++--- gcl-2.6.12.orig/o/error.c +++++ gcl-2.6.12/o/error.c ++@@ -40,8 +40,8 @@ assert_error(const char *a,unsigned l,co ++ make_simple_string(a),make_fixnum(l), ++ make_simple_string(f),make_simple_string(n)); ++ else { ++- fprintf(stderr,"The assertion %s on line %d of %s in function %s failed",a,l,f,n); ++- exit(-1); +++ emsg("The assertion %s on line %d of %s in function %s failed",a,l,f,n); +++ do_gcl_abort(); ++ } ++ ++ } ++@@ -386,7 +386,7 @@ DEFUN_NEW("UNIVERSAL-ERROR-HANDLER",obje ++ for (i = 0; i < error_fmt_string->st.st_fillp; i++) ++ fputc(error_fmt_string->st.st_self[i],stdout); ++ printf("\nLisp initialization failed.\n"); ++- exit(0); +++ do_gcl_abort(); ++ RETURN1(x0); ++ } ++ ++--- gcl-2.6.12.orig/o/fasldlsym.c +++++ gcl-2.6.12/o/fasldlsym.c ++@@ -84,7 +84,7 @@ fasload(object faslfile) { ++ massert(!psystem(b)); ++ ++ if (!(dlp = dlopen(buf,RTLD_NOW))) { ++- fputs(dlerror(),stderr); +++ emsg(dlerror()); ++ FEerror("Cannot open for dynamic link ~a",1,make_simple_string(filename)); ++ } ++ ++@@ -94,7 +94,7 @@ fasload(object faslfile) { ++ memcpy(b,x->st.st_self,x->st.st_fillp); ++ b[x->st.st_fillp]=0; ++ if (!(fptr=dlsym(dlp,b))) { ++- fputs(dlerror(),stderr); +++ emsg(dlerror()); ++ FEerror("Cannot lookup ~a in ~a",2,make_simple_string(b),make_simple_string(filename)); ++ } ++ ++--- gcl-2.6.12.orig/o/file.d +++++ gcl-2.6.12/o/file.d ++@@ -548,10 +548,8 @@ BEGIN: ++ ++ ++ case smm_socket: ++- if (SOCKET_STREAM_FD(strm) < 2) { ++- fprintf(stderr,"tried Clsing %d ! as scoket \n",SOCKET_STREAM_FD(strm)); ++- fflush(stderr); ++- } +++ if (SOCKET_STREAM_FD(strm) < 2) +++ emsg("tried Closing %d ! as socket \n",SOCKET_STREAM_FD(strm)); ++ else { ++ #ifdef HAVE_NSOCKET ++ if (GET_STREAM_FLAG(strm,gcl_sm_output)) ++@@ -2180,10 +2178,7 @@ FFN(siLfp_input_stream)() ++ #ifdef HAVE_NSOCKET ++ ++ #ifdef DODEBUG ++-#define dprintf(s,arg) \ ++- do {fprintf(stderr,s,arg); \ ++- fflush(stderr); }\ ++- while(0) +++#define dprintf(s,arg) emsg(s,arg) ++ #else ++ #define dprintf(s,arg) ++ #endif ++@@ -2457,7 +2452,7 @@ object x=Cnil; ++ exit(0); ++ break; ++ case -1: ++- abort(); +++ do_gcl_abort(); ++ break; ++ default: ++ close_stream(y); ++--- gcl-2.6.12.orig/o/gbc.c +++++ gcl-2.6.12/o/gbc.c ++@@ -85,11 +85,9 @@ cb_print(void) { ++ struct contblock **cbpp; ++ int i; ++ ++- for (cbpp=&cb_pointer,i=0;*cbpp;cbpp=&((*cbpp)->cb_link),i++) { ++- fprintf(stderr,"%lu at %p\n",(*cbpp)->cb_size,*cbpp); ++- fflush(stderr); ++- } ++- fprintf(stderr,"%u blocks\n",i); +++ for (cbpp=&cb_pointer,i=0;*cbpp;cbpp=&((*cbpp)->cb_link),i++) +++ emsg("%lu at %p\n",(*cbpp)->cb_size,*cbpp); +++ emsg("%u blocks\n",i); ++ return 0; ++ } ++ ++@@ -285,7 +283,6 @@ long first_protectable_page =0; ++ static char *copy_relblock(char *p, int s); ++ ++ long real_maxpage; ++-long new_holepage; ++ ++ struct apage { ++ char apage_self[PAGESIZE]; ++@@ -1122,7 +1119,8 @@ GBC(enum type t) { ++ } ++ ++ ngc_thresh=fix(sSAleaf_collection_thresholdA->s.s_dbind); ++- +++ recent_allocation=0; +++ ++ if (in_signal_handler && t == t_relocatable) ++ error("cant gc relocatable in signal handler"); ++ ++@@ -1198,7 +1196,7 @@ GBC(enum type t) { ++ ++ if (COLLECT_RELBLOCK_P) { ++ static_promotion_limit=rb_starts.s_dbind->v.v_self; ++@@ -1337,7 +1331,7 @@ GBC(enum type t) { ++ tm_table[(int)tm_table[i].tm_type].tm_name); ++ } ++ printf("contblock: %ld blocks %ld pages\n", count_contblocks(), ncbpage); ++- printf("hole: %ld pages\n", ((rb_start-heap_end)>>PAGEWIDTH)); +++ printf("hole: %lu pages\n", (ufixnum)page(rb_start-heap_end)); ++ printf("relblock: %ld bytes used %ld bytes free %ld pages\n", ++ (long)(rb_pointer - rb_start), (long)(rb_end - rb_pointer), nrbpage); ++ printf("GBC ended\n"); ++@@ -1362,34 +1356,6 @@ GBC(enum type t) { ++ ++ } ++ ++- { ++- extern long opt_maxpage(struct typemanager *); ++- ++-#define IGNORE_MAX_PAGES (sSAignore_maximum_pagesA ==0 || sSAignore_maximum_pagesA->s.s_dbind !=sLnil) ++-#define OPTIMIZE_MAX_PAGES (sSAoptimize_maximum_pagesA ==0 || sSAoptimize_maximum_pagesA->s.s_dbind !=sLnil) ++- ++- if (IGNORE_MAX_PAGES && OPTIMIZE_MAX_PAGES) ++- opt_maxpage(tm_table+t); ++- ++- } ++- ++- /* {static int mv; */ ++- /* if (!mv && COLLECT_RELBLOCK_P) { */ ++- /* mv=1; */ ++- /* if (relb_copied) { */ ++- /* sSAstatic_promotion_areaA->s.s_dbind=(VFUN_NARGS=4,fSmake_vector1(make_fixnum(relb_copied),make_fixnum(aet_char),Ct,make_fixnum(0))); */ ++- /* fprintf(stderr,"Making static promotion area %lu bytes\n",relb_copied); */ ++- /* fflush(stderr); */ ++- /* relb_copied=0; */ ++- /* } else { */ ++- /* fprintf(stderr,"Releasing static promotion area\n"); */ ++- /* fflush(stderr); */ ++- /* sSAstatic_promotion_areaA->s.s_dbind=Cnil; */ ++- /* } */ ++- /* mv=0; */ ++- /* } */ ++- /* } */ ++- ++ collect_both=0; ++ ++ END_NO_INTERRUPT; ++@@ -1449,8 +1415,8 @@ FFN(siLroom_report)(void) { ++ vs_push(make_fixnum(count_contblocks())); ++ vs_push(make_fixnum(cbgbccount)); ++ vs_push(make_fixnum((rb_start-heap_end)>>PAGEWIDTH)); ++- vs_push(make_fixnum(rb_pointer - (rb_pointercb_size,p=*cbpp;*cbpp && (*cbpp)->cb_size==s;i+=(*cbpp)->cb_size,j++,k++,cbpp=&(*cbpp)->cb_link); ++- fprintf(stderr,"%lu %lu starting at %p\n",k,s,p); +++ emsg("%lu %lu starting at %p\n",k,s,p); ++ } ++- fprintf(stderr,"\nTotal free %lu in %lu pieces\n\n",i,j); +++ emsg("\nTotal free %lu in %lu pieces\n\n",i,j); ++ ++ for (i=j=k=0;kv.v_fillp && (v=(void *)contblock_array->v.v_self[k]);k++,i+=v->in_use,j++) ++- fprintf(stderr,"%lu pages at %p\n",(unsigned long)v->in_use,v); ++- fprintf(stderr,"\nTotal pages %lu in %lu pieces\n\n",i,j); +++ emsg("%lu pages at %p\n",(unsigned long)v->in_use,v); +++ emsg("\nTotal pages %lu in %lu pieces\n\n",i,j); ++ ++ for (i=j=0,v=cell_list_head;v;v=v->next) ++ if (tm->tm_type==v->type) { ++@@ -1548,13 +1514,13 @@ DEFUN_NEW("CONTIGUOUS-REPORT",object,fSc ++ for (p=pagetochar(page(v)),k=0;ktm_nppage;k++,p+=tm->tm_size) { ++ object o=p; ++ if (!is_free(o) && type_of(o)==t_cfdata && (void *)o->cfd.cfd_start>=data_start) { ++- fprintf(stderr,"%lu code bytes at %p\n",(unsigned long)o->cfd.cfd_size,o->cfd.cfd_start); +++ emsg("%lu code bytes at %p\n",(unsigned long)o->cfd.cfd_size,o->cfd.cfd_start); ++ i+=o->cfd.cfd_size; ++ j++; ++ } ++ } ++ } ++- fprintf(stderr,"\nTotal code bytes %lu in %lu pieces\n",i,j); +++ emsg("\nTotal code bytes %lu in %lu pieces\n",i,j); ++ ++ for (i=j=0,v=cell_list_head;v;v=v->next) { ++ struct typemanager *tm=tm_of(v->type); ++@@ -1616,14 +1582,14 @@ DEFUN_NEW("CONTIGUOUS-REPORT",object,fSc ++ break; ++ } ++ if (d>=data_start && d<(void *)heap_end && s) { ++- fprintf(stderr,"%lu %s bytes at %p\n",s,tm_table[type_of(o)].tm_name,d); +++ emsg("%lu %s bytes at %p\n",s,tm_table[type_of(o)].tm_name,d); ++ i+=s; ++ j++; ++ } ++ } ++ } ++ } ++- fprintf(stderr,"\nTotal leaf bytes %lu in %lu pieces\n",i,j); +++ emsg("\nTotal leaf bytes %lu in %lu pieces\n",i,j); ++ ++ return Cnil; ++ ++--- gcl-2.6.12.orig/o/gcl_readline.d +++++ gcl-2.6.12/o/gcl_readline.d ++@@ -42,6 +42,8 @@ Foundation, 675 Mass Ave, Cambridge, MA ++ #include ++ #include ++ #include +++#include +++#include ++ #include ++ #include ++ ++--- gcl-2.6.12.orig/o/gmp.c +++++ gcl-2.6.12/o/gmp.c ++@@ -9,7 +9,7 @@ static void *gcl_gmp_realloc(void *oldme ++ { ++ unsigned int *old,*new; ++ if (!jmp_gmp) { /* No gc in alloc if jmp_gmp */ ++- if (MP_SELF(big_gcprotect)) abort(); +++ if (MP_SELF(big_gcprotect)) do_gcl_abort(); ++ MP_SELF(big_gcprotect)=oldmem; ++ MP_ALLOCATED(big_gcprotect)=oldsize/MP_LIMB_SIZE; ++ } ++--- gcl-2.6.12.orig/o/main.c +++++ gcl-2.6.12/o/main.c ++@@ -204,26 +204,89 @@ get_proc_meminfo_value_in_pages(const ch ++ massert(!strncmp(c+m," kB\n",4)); ++ return n>>(PAGEWIDTH-10); ++ } ++- +++ ++ static ufixnum ++ get_phys_pages_no_malloc(char freep) { ++- ufixnum k=freep ? +++ +++ return freep ? ++ get_proc_meminfo_value_in_pages("MemFree:")+ ++ get_proc_meminfo_value_in_pages("Buffers:")+ ++ get_proc_meminfo_value_in_pages("Cached:") : ++ get_proc_meminfo_value_in_pages("MemTotal:"); ++- const char *e=getenv("GCL_MEM_MULTIPLE"); ++- if (e) { ++- double d; ++- massert(sscanf(e,"%lf",&d)==1); ++- massert(d>=0.0); ++- k*=d; ++- } ++- return k; +++ ++ } ++ ++ #endif ++ +++static ufixnum +++get_phys_pages(char freep) { +++ +++ return get_phys_pages_no_malloc(freep); +++ +++} +++ +++static void +++get_gc_environ(void) { +++ +++ const char *e;; +++ +++ mem_multiple=1.0; +++ if ((e=getenv("GCL_MEM_MULTIPLE"))) { +++ massert(sscanf(e,"%lf",&mem_multiple)==1); +++ massert(mem_multiple>=0.0); +++ } +++ +++ gc_alloc_min=0.1; +++ if ((e=getenv("GCL_GC_ALLOC_MIN"))) { +++ massert(sscanf(e,"%lf",&gc_alloc_min)==1); +++ massert(gc_alloc_min>=0.0); +++ } +++ +++ gc_page_min=0.5; +++ if ((e=getenv("GCL_GC_PAGE_THRESH"))) { +++ massert(sscanf(e,"%lf",&gc_page_min)==1); +++ massert(gc_page_min>=0.0); +++ } +++ +++ gc_page_max=0.75; +++ if ((e=getenv("GCL_GC_PAGE_MAX"))) { +++ massert(sscanf(e,"%lf",&gc_page_max)==1); +++ massert(gc_page_max>=0.0); +++ } +++ +++ multiprocess_memory_pool=(e=getenv("GCL_MULTIPROCESS_MEMORY_POOL")) && *e; +++ +++ wait_on_abort=0; +++ if ((e=getenv("GCL_WAIT_ON_ABORT"))) +++ massert(sscanf(e,"%lu",&wait_on_abort)==1); +++ +++} +++ +++static void +++setup_maxpages(double scale) { +++ +++ void *beg=data_start ? data_start : sbrk(0); +++ ufixnum maxpages=real_maxpage-page(beg),npages,i; +++ +++ for (npages=0,i=t_start;i=npages); +++ +++ maxpages*=scale; +++ phys_pages*=scale; +++ real_maxpage=maxpages+page(beg); +++ +++ resv_pages=available_pages=0; +++ available_pages=check_avail_pages(); +++ +++ resv_pages=40PAGESIZE;j>>=1) ++@@ -253,44 +313,11 @@ update_real_maxpage(void) { ++ } ++ massert(!mbrk(cur)); ++ ++-/* phys_pages=get_phys_pages_no_malloc(0); */ ++- ++-/* #ifdef BRK_DOES_NOT_GUARANTEE_ALLOCATION */ ++-/* if (phys_pages>0 && real_maxpage>phys_pages+page(beg)) real_maxpage=phys_pages+page(beg); */ ++-/* #endif */ +++ phys_pages=ufmin(get_phys_pages(0)+page(beg),real_maxpage)-page(beg); ++ ++- maxpages=real_maxpage-page(beg); ++- ++- phys_pages=phys_pages>maxpages ? maxpages : phys_pages; ++- ++- resv_pages=available_pages=0; ++- available_pages=check_avail_pages(); +++ get_gc_environ(); +++ setup_maxpages(mem_multiple); ++ ++- for (i=t_start;is.s_dbind!=Cnil) { ++- ++- for (i=t_start,j=0;i>1); ++- } ++- ++- new_holepage=0; ++- for (i=t_start;i= dend) { ++ minimize_image(); ++- log_maxpage_bound=l; +++ log_maxpage_bound=l;/*FIXME maybe this should be under mem_multiple, not over*/ ++ update_real_maxpage(); ++ maybe_set_hole_from_maxpages(); ++ } ++@@ -384,6 +410,43 @@ gcl_mprotect(void *v,unsigned long l,int ++ ++ DEFVAR("*CODE-BLOCK-RESERVE*",sSAcode_block_reserveA,SI,Cnil,""); ++ +++#define HAVE_GCL_CLEANUP +++ +++void +++gcl_cleanup(int gc) { +++ +++ if (getenv("GCL_WAIT")) +++ sleep(30); +++ +++#ifdef CLEANUP_CODE +++ CLEANUP_CODE +++#elif defined(USE_CLEANUP) +++ {extern void _cleanup(void);_cleanup();} +++#endif +++ +++#ifdef GCL_GPROF +++ gprof_cleanup(); +++#endif +++ +++ if (gc) { +++ +++ saving_system=TRUE; +++ GBC(t_other); +++ saving_system=FALSE; +++ +++ minimize_image(); +++ +++ raw_image=FALSE; +++ cs_org=0; +++ initial_sbrk=core_end; +++ +++ } +++ +++ close_pool(); +++ +++} +++ +++ ++ int ++ main(int argc, char **argv, char **envp) { ++ ++@@ -497,6 +560,14 @@ void install_segmentation_catcher(void) ++ (void) gcl_signal(SIGBUS,segmentation_catcher); ++ } ++ +++void +++do_gcl_abort(void) { +++ if (wait_on_abort) +++ sleep(wait_on_abort); +++ gcl_cleanup(0); +++ abort(); +++} +++ ++ int catch_fatal=1; ++ void ++ error(char *s) ++@@ -512,7 +583,7 @@ error(char *s) ++ FEerror("Caught fatal error [memory may be damaged]",0); } ++ printf("\nUnrecoverable error: %s.\n", s); ++ fflush(stdout); ++- abort(); +++ do_gcl_abort(); ++ } ++ ++ static void ++@@ -529,7 +600,7 @@ initlisp(void) { ++ || NULL_OR_ON_C_STACK(pagetoinfo(first_data_page)) ++ || NULL_OR_ON_C_STACK(core_end-1)) { ++ /* check person has correct definition of above */ ++- fprintf(stderr,"%p %d " +++ emsg("%p %d " ++ #if defined(IM_FIX_BASE) ++ "%p %d %p %d " ++ #endif ++@@ -941,7 +1012,7 @@ static void ++ FFN(siLinitialization_failure)(void) { ++ check_arg(0); ++ printf("lisp initialization failed\n"); ++- exit(0); +++ do_gcl_abort(); ++ } ++ ++ DEFUNO_NEW("IDENTITY",object,fLidentity,LISP ++@@ -970,7 +1041,6 @@ DEFUN_NEW("LISP-IMPLEMENTATION-VERSION", ++ RETURN1((make_simple_string(LISP_IMPLEMENTATION_VERSION))); ++ } ++ ++- ++ static void ++ FFN(siLsave_system)(void) { ++ ++@@ -990,12 +1060,6 @@ FFN(siLsave_system)(void) { ++ DO_BEFORE_SAVE ++ #endif ++ ++- saving_system = TRUE; ++- ++- minimize_image(); ++- ++- saving_system = FALSE; ++- ++ siLsave(); ++ ++ } ++--- gcl-2.6.12.orig/o/makefile +++++ gcl-2.6.12/o/makefile ++@@ -91,6 +91,9 @@ $(DECL): $(HDIR)/make-decl.h $(INI_FILES ++ grab_defs: grab_defs.c ++ ${CC} $(OFLAGS) -o grab_defs grab_defs.c ++ +++wpool: wpool.c +++ $(CC) $(CFLAGS) $(DEFS) -o $@ $< +++ ++ $(GCLIB): ${ALIB} ++ rm -f gcllib.a ++ $(AR) gcllib.a ${ALIB} ++@@ -98,6 +101,6 @@ $(GCLIB): ${ALIB} ++ ++ clean: ++ rm -f $(OBJS) ${ALIB} new_init.o $(LAST_FILE) $(FIRST_FILE) *.a grab_defs$(EXE) *.ini tmpx foo.c ++- rm -f cmpinclude.h new_init.c $(DECL) def undef udef.h void.h TAGS boot.h +++ rm -f cmpinclude.h new_init.c $(DECL) def undef udef.h void.h TAGS boot.h wpool ++ ++ .INTERMEDIATE: $(patsubst %.d,%.c,$(shell ls -1 *.d)) ++--- gcl-2.6.12.orig/o/mingwin.c +++++ gcl-2.6.12/o/mingwin.c ++@@ -8,10 +8,7 @@ ++ #include "stdlib.h" ++ ++ #ifdef DODEBUG ++-#define dprintf(s,arg) \ ++- do {fprintf(stderr,s,arg); \ ++- fflush(stderr); }\ ++- while(0) +++#define dprintf(s,arg) emsg(s,arg) ++ #else ++ #define dprintf(s,arg) ++ #endif ++@@ -237,8 +234,7 @@ InitSockets() ++ * Initialize the winsock library and check the version number. ++ */ ++ if ((*winSock.WSAStartup)(MAKEWORD(2,2), &wsaData) != 0) { ++- fprintf(stderr,"unloading"); ++- fflush(stderr); +++ emsg("unloading"); ++ goto unloadLibrary; ++ } ++ #ifdef WSA_VERSION_REQD ++@@ -380,10 +376,8 @@ CreateSocketAddress(sockaddrPtr, host, p ++ #ifdef DEBUG ++ static void myerr(char *s,int d) ++ { ++- if (0) { ++- fprintf(stderr,s,d); ++- fflush(stderr); ++- } +++ if (0) +++ emsg(s,d); ++ ++ } ++ #else ++@@ -769,8 +763,7 @@ sigint() ++ #if 0 ++ BOOL WINAPI inthandler(DWORD i) ++ { ++- fprintf(stderr,"in handler %d",i); ++- fflush(stderr); +++ emsg("in handler %d",i); ++ terminal_interrupt(1); ++ return TRUE; ++ } ++@@ -812,14 +805,14 @@ void sigterm() ++ #ifdef SIGABRT ++ void sigabrt() ++ { ++- exit(SIGABRT); +++ do_gcl_abort(); ++ } ++ #endif ++ ++ ++ void sigkill() ++ { ++- exit(SIGKILL); +++ do_gcl_abort(); ++ } ++ ++ ++--- gcl-2.6.12.orig/o/nsocket.c +++++ gcl-2.6.12/o/nsocket.c ++@@ -4,10 +4,7 @@ ++ #include ++ ++ #ifdef DODEBUG ++-#define dprintf(s,arg) \ ++- do {fprintf(stderr,s,arg); \ ++- fflush(stderr); }\ ++- while(0) +++#define dprintf(s,arg) emsg(s,arg) ++ #else ++ #define dprintf(s,arg) ++ #endif ++@@ -65,7 +62,7 @@ ++ #endif ++ ++ #define VOID void ++-#define ERROR_MESSAGE(msg) do{ fprintf(stderr,msg); exit(1) ; } while(0) +++#define ERROR_MESSAGE(msg) do{ emsg(msg); do_gcl_abort() ; } while(0) ++ ++ #ifdef STAND ++ ++@@ -87,7 +84,7 @@ main(argc,argv) ++ fd = doConnect(argv[1],atoi(argv[2])); ++ if (fd < 0) { ++ perror("cant connect"); ++- exit(1); +++ do_gcl_abort(); ++ } ++ ++ while (1) { int high; ++@@ -512,8 +509,7 @@ getOneChar(FILE *fp) ++ int high; ++ /* fprintf(stderr,"",fp); ++ fflush(stderr); */ ++- fprintf(stderr,"in getOneChar, fd=%d,fp=%p",fd,fp); ++- fflush(stderr); +++ emsg("in getOneChar, fd=%d,fp=%p",fd,fp); ++ if (fd == 0) ++ { joe(fd); ++ return -1; ++@@ -529,16 +525,14 @@ getOneChar(FILE *fp) ++ if (high > 0) ++ { ++ int ch ; ++- fprintf(stderr,"in getOneChar, fd=%d,fp=%p",fd,fp); ++- fflush(stderr); +++ emsg("in getOneChar, fd=%d,fp=%p",fd,fp); ++ ch = getc(fp); ++ if ( ch != EOF || feof(fp) ) { ++ /* fprintf(stderr,"< 0x%x returning %d,%c>\n",fp,ch,ch); ++ fflush(stderr); ++ */ ++ } ++- fprintf(stderr,"in getOneChar, ch= %c,%d\n",ch,ch); ++- fflush(stderr); +++ emsg("in getOneChar, ch= %c,%d\n",ch,ch); ++ CHECK_INTERRUPT; ++ if (ch != EOF) return ch; ++ if (feof(fp)) return EOF; ++@@ -548,10 +542,7 @@ getOneChar(FILE *fp) ++ } ++ ++ #ifdef DODEBUG ++-#define dprintf(s,arg) \ ++- do {fprintf(stderr,s,arg); \ ++- fflush(stderr); }\ ++- while(0) +++#define dprintf(s,arg) emsg(s,arg) ++ #else ++ #define dprintf(s,arg) ++ #endif ++--- gcl-2.6.12.orig/o/prelink.c +++++ gcl-2.6.12/o/prelink.c ++@@ -2,6 +2,7 @@ ++ ++ #include "include.h" ++ +++#if !defined(__MINGW32__) && !defined(__CYGWIN__) ++ extern FILE *stdin __attribute__((weak)); ++ extern FILE *stderr __attribute__((weak)); ++ extern FILE *stdout __attribute__((weak)); ++@@ -13,6 +14,7 @@ extern char *rl_readline_name __attribu ++ extern rl_compentry_func_t *rl_completion_entry_function __attribute__((weak)); ++ extern const char *rl_readline_name __attribute__((weak)); ++ #endif +++#endif ++ ++ void ++ prelink_init(void) { ++--- gcl-2.6.12.orig/o/print.d +++++ gcl-2.6.12/o/print.d ++@@ -390,14 +390,14 @@ edit_double(int n, double d, int *sp, ch ++ ++ truncate_double(b,d,n!=7); ++ ++- if (isdigit(b[0])) { +++ if (isdigit((int)b[0])) { ++ b[1]=b[0]; ++ (*ep)++; ++ } ++ if (b[2]=='0') (*ep)++; ++ b[2] = b[1]; ++ p = b + 2; ++- for (i=0;i sizeof(buf)) ++- { fprintf(stderr,"wow that is badly defined regexp.."); ++- exit(1);} +++ { emsg("wow that is badly defined regexp.."); +++ do_gcl_abort();} ++ regcp --; ++ { char *p=buf; ++ ++@@ -567,8 +567,8 @@ regatom(int *flagp) ++ while (p < regcp) ++ { result[*(unsigned char *)p] = matches; ++ if (case_fold_search) ++- {result[tolower(*p)] = matches; ++- result[toupper(*p)] = matches; p++;} +++ {result[tolower((int)*p)] = matches; +++ result[toupper((int)*p)] = matches; p++;} ++ else ++ result[*(unsigned char *)p++] = matches; ++ ++@@ -912,9 +912,9 @@ regexec(register regexp *prog, register ++ if (prog->regstart != '\0') ++ /* We know what char it must start with. */ ++ { if (case_fold_search) ++- {char ch = tolower(prog->regstart); +++ {char ch = tolower((int)prog->regstart); ++ while (*s) ++- { if (tolower(*s)==ch) +++ { if (tolower((int)*s)==ch) ++ {if (regtry(prog, s)) ++ RETURN_VAL(1);} ++ s++;}} ++@@ -1025,12 +1025,12 @@ regmatch(char *prog) ++ scan = prog; ++ #ifdef DEBUG ++ if (scan != NULL && regnarrate) ++- fprintf(stderr, "%s(\n", regprop(scan)); +++ emsg("%s(\n", regprop(scan)); ++ #endif ++ while (scan != NULL) { ++ #ifdef DEBUG ++ if (regnarrate) ++- fprintf(stderr, "%s...\n", regprop(scan)); +++ emsg("%s...\n", regprop(scan)); ++ #endif ++ next = regnext(scan); ++ ++@@ -1055,7 +1055,7 @@ regmatch(char *prog) ++ opnd = OPERAND(scan); ++ if (case_fold_search) ++ while (*opnd ) ++- { if (tolower(*opnd) != tolower(*ch)) +++ { if (tolower((int)*opnd) != tolower((int)*ch)) ++ return 0; ++ else { ch++; opnd++;}} ++ else ++@@ -1175,7 +1175,7 @@ regmatch(char *prog) ++ if (OP(next) == EXACTLY) ++ nextch = *OPERAND(next); ++ if (case_fold_search) ++- nextch = tolower(nextch); +++ nextch = tolower((int)nextch); ++ min = (OP(scan) == STAR) ? 0 : 1; ++ save = reginput; ++ no = regrepeat(OPERAND(scan)); ++@@ -1184,7 +1184,7 @@ regmatch(char *prog) ++ if (nextch == '\0' || ++ *reginput == nextch ++ || (case_fold_search && ++- tolower(*reginput) == nextch)) +++ tolower((int)*reginput) == nextch)) ++ if (regmatch(next)) ++ return(1); ++ /* Couldn't or didn't -- back up. */ ++@@ -1237,8 +1237,8 @@ regrepeat(char *p) ++ case EXACTLY: ++ { char ch = *opnd; ++ if (case_fold_search) ++- { ch = tolower(*opnd); ++- while (ch == tolower(*scan)) +++ { ch = tolower((int)*opnd); +++ while (ch == tolower((int)*scan)) ++ { ++ count++; ++ scan++;}} ++@@ -1488,7 +1488,7 @@ min_initial_branch_length(regexp *x, uns ++ { op = OP(s); ++ next = (s) + NEXT(s); ++ if (op != END && op != BRANCH) ++- abort(); +++ do_gcl_abort(); ++ s = s+3; ++ { int this = 0; ++ int anythis =0; ++@@ -1509,8 +1509,8 @@ min_initial_branch_length(regexp *x, uns ++ n--; ++ while(1) ++ { if (case_fold_search) ++- {MINIMIZE(buf[tolower(*ss)],n); ++- MINIMIZE(buf[toupper(*ss)],n); +++ {MINIMIZE(buf[tolower((int)*ss)],n); +++ MINIMIZE(buf[toupper((int)*ss)],n); ++ } ++ else ++ { MINIMIZE(buf[*(unsigned char *)ss],n);} ++@@ -1575,7 +1575,7 @@ min_initial_branch_length(regexp *x, uns ++ void ++ regerror(char *s) ++ { ++- fprintf(stderr, "regexp error %s\n", s); +++ emsg("regexp error %s\n", s); ++ } ++ #endif ++ ++--- gcl-2.6.12.orig/o/run_process.c +++++ gcl-2.6.12/o/run_process.c ++@@ -140,19 +140,19 @@ void run_process ( char *name ) ++ if ( ! CloseHandle ( hChildStderrWrite ) ) DisplayError ( "CloseHandle: Error write" ); ++ ++ #if 0 ++- fprintf ( stderr, "Before write\n" ); +++ emsg("Before write\n" ); ++ WriteFile ( hChildStdinWrite, chBuf, strlen ( chBuf ), ++ &dwWritten, NULL); ++ FlushFileBuffers ( hChildStdinWrite ); ++ FlushFileBuffers ( hChildStdoutRead ); ++- fprintf ( stderr, "Before read\n" ); +++ emsg("Before read\n" ); ++ if ( ! ReadFile( hChildStdoutRead, chBuf, 2, &dwRead, NULL ) || ++ dwRead == 0 ) { ++ DisplayError ( "Nothing read\n" ); ++ } else { ++- fprintf ( stderr, "Got Back: %s\n", chBuf ); +++ emsg("Got Back: %s\n", chBuf ); ++ } ++- fprintf ( stderr, "After read\n" ); +++ emsg("After read\n" ); ++ #endif ++ ++ ++@@ -168,8 +168,7 @@ void run_process ( char *name ) ++ fprintf ( ifp, "button .wibble\n" ); ++ fflush (ifp); ++ fgets ( buf, 2, ofp ); ++- fprintf ( stderr, ++- "run_process: ofd = %x, ofp = %x, ifd = %x, ifp = %x, buf[0] = %x, buf[1] = %x, buf = %s\n", +++ emsg("run_process: ofd = %x, ofp = %x, ifd = %x, ifp = %x, buf[0] = %x, buf[1] = %x, buf = %s\n", ++ ofd, ofp, ifd, ifp, buf[0], buf[1], buf ); ++ } ++ #endif ++@@ -276,7 +275,7 @@ void siLrun_process() ++ strcat ( cmdline, " "); ++ } ++ strcat ( cmdline, vs_base[i]->st.st_self ); ++- fprintf ( stderr, "siLrun_process: cmdline=%s\n", cmdline ); +++ emsg("siLrun_process: cmdline=%s\n", cmdline ); ++ argc++; ++ } ++ signals_allowed = sig_at_read; ++@@ -540,12 +539,11 @@ char **argv; ++ massert(dup(fdin)>=0); ++ close(1); ++ massert(dup(fdout)>=0); ++- fprintf(stderr, "\n***** Spawning process %s ", pname); +++ emsg("\n***** Spawning process %s ", pname); ++ if (execvp(pname, argv) == -1) ++ { ++- fprintf(stderr, "\n***** Error in process spawning *******"); ++- fflush(stderr); ++- exit(1); +++ emsg("\n***** Error in process spawning *******"); +++ do_gcl_abort(); ++ } ++ } ++ ++@@ -604,7 +602,7 @@ getpagesize() ++ } ++ ++ dlclose() ++-{fprintf(stderr,"calling 'dl' function sun did not supply..exitting") ;exit(1);} +++{emsg("calling 'dl' function sun did not supply..exitting") ;do_gcl_abort();} ++ dgettext() ++ {dlclose();} ++ dlopen() ++--- gcl-2.6.12.orig/o/save.c +++++ gcl-2.6.12/o/save.c ++@@ -20,21 +20,12 @@ LFD(siLsave)(void) { ++ ++ char filename[256]; ++ extern char *kcl_self; ++- extern void *initial_sbrk; ++ ++ check_arg(1); ++ check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++ coerce_to_filename(vs_base[0], filename); ++ ++-#ifdef CLEANUP_CODE ++- CLEANUP_CODE ++-#elif defined(USE_CLEANUP) ++- _cleanup(); ++-#endif ++- ++- raw_image=FALSE; ++- cs_org=0; ++- initial_sbrk=core_end; +++ gcl_cleanup(1); ++ ++ #ifdef MEMORY_SAVE ++ MEMORY_SAVE(kcl_self,filename); ++--- gcl-2.6.12.orig/o/sfaslcoff.c +++++ gcl-2.6.12/o/sfaslcoff.c ++@@ -175,7 +175,7 @@ relocate_symbols(struct syment *sym,stru ++ if ((answ=find_sym_ptable(s))) ++ sym->n_value=answ->address; ++ else ++- massert(!fprintf(stderr,"Unrelocated non-local symbol: %s\n",s)); +++ massert(!emsg("Unrelocated non-local symbol: %s\n",s)); ++ ++ if (c) ++ sym->n.n_name[8]=c; ++--- gcl-2.6.12.orig/o/sfaslelf.c +++++ gcl-2.6.12/o/sfaslelf.c ++@@ -181,7 +181,7 @@ relocate(Sym *sym1,void *v,ul a,ul start ++ #include RELOC_H ++ ++ default: ++- fprintf(stderr, "Unknown reloc type %lu\n", tp); +++ emsg("Unknown reloc type %lu\n", tp); ++ massert(tp&~tp); ++ ++ } ++@@ -234,7 +234,7 @@ relocate_symbols(Sym *sym,Sym *syme,Shdr ++ sym->st_value=a->address; ++ ++ else if (ELF_ST_BIND(sym->st_info)!=STB_LOCAL) ++- massert(!fprintf(stderr,"Unrelocated non-local symbol: %s\n",st1+sym->st_name)); +++ massert(!emsg("Unrelocated non-local symbol: %s\n",st1+sym->st_name)); ++ ++ } ++ ++--- gcl-2.6.12.orig/o/sfasli.c +++++ gcl-2.6.12/o/sfasli.c ++@@ -146,6 +146,15 @@ use_symbols(double d,...) { ++ ++ } ++ #endif +++#else +++int +++use_symbols(double d,...) { +++ +++ d=sin(d)+cos(d); +++ +++ return (int)d; +++ +++} ++ #endif ++ ++ void ++--- gcl-2.6.12.orig/o/sfaslmacho.c +++++ gcl-2.6.12/o/sfaslmacho.c ++@@ -144,7 +144,7 @@ relocate_symbols(struct nlist *n1,struct ++ else if ((nd=find_sym_ptable(st1+n->n_un.n_strx))) ++ n->n_value=nd->address; ++ else if (n->n_type&(N_PEXT|N_EXT)) ++- massert(!fprintf(stderr,"Unrelocated non-local symbol: %s\n",st1+n->n_un.n_strx)); +++ massert(!emsg("Unrelocated non-local symbol: %s\n",st1+n->n_un.n_strx)); ++ ++ return 0; ++ ++--- gcl-2.6.12.orig/o/sfaslmacosx.c +++++ gcl-2.6.12/o/sfaslmacosx.c ++@@ -37,17 +37,7 @@ typedef int (*func) (); ++ /* Externalize the command line used to build loadable object files (a.k.a. bundles). */ ++ object sSAmacosx_ldcmdA = 0L; ++ ++-static void sfasl_error (char *format, ...) ++-{ ++- va_list ap; ++- ++- va_start (ap, format); ++- fprintf (stderr, "fasload: "); ++- vfprintf (stderr, format, ap); ++- fprintf (stderr, "\n"); ++- va_end (ap); ++- exit (1); ++-} +++#define sfasl_error(a,b...) {emsg(a,b);do_gcl_abort();} ++ ++ /* static void get_init_name (object faslfile, char *init_fun) */ ++ /* { */ ++--- gcl-2.6.12.orig/o/sgbc.c +++++ gcl-2.6.12/o/sgbc.c ++@@ -266,32 +266,32 @@ overlap_check(struct contblock *t1,struc ++ ++ if (!inheap(t1)) { ++ fprintf(stderr,"%p not in heap\n",t1); ++- exit(1); +++ do_gcl_abort(); ++ } ++ ++ for (p=t2;p;p=p->cb_link) { ++ ++ if (!inheap(p)) { ++ fprintf(stderr,"%p not in heap\n",t1); ++- exit(1); +++ do_gcl_abort(); ++ } ++ ++ if ((p<=t1 && (void *)p+p->cb_size>(void *)t1) || ++ (t1<=p && (void *)t1+t1->cb_size>(void *)p)) { ++ fprintf(stderr,"Overlap %u %p %u %p\n",t1->cb_size,t1,p->cb_size,p); ++- exit(1); +++ do_gcl_abort(); ++ } ++ ++ if (p==p->cb_link) { ++ fprintf(stderr,"circle detected at %p\n",p); ++- exit(1); +++ do_gcl_abort(); ++ } ++ ++ } ++ ++ if (t1==t1->cb_link) { ++ fprintf(stderr,"circle detected at %p\n",t1); ++- exit(1); +++ do_gcl_abort(); ++ } ++ ++ } ++@@ -365,7 +365,7 @@ memprotect_handler_test(int sig, long co ++ ++ if (memprotect_handler_invocations) { ++ memprotect_result=memprotect_multiple_invocations; ++- exit(-1); +++ do_gcl_abort(); ++ } ++ memprotect_handler_invocations=1; ++ if (faddr!=memprotect_test_address) ++@@ -387,7 +387,7 @@ memprotect_test(void) { ++ return memprotect_result!=memprotect_success; ++ if (atexit(memprotect_print)) { ++ fprintf(stderr,"Cannot setup memprotect_print on exit\n"); ++- exit(-1); +++ do_gcl_abort(); ++ } ++ ++ if (!(b1=alloca(2*p))) { ++--- gcl-2.6.12.orig/o/sockets.c +++++ gcl-2.6.12/o/sockets.c ++@@ -70,7 +70,7 @@ int w32_socket_init(void) ++ } else { ++ if (WSAStartup(0x0101, &WSAData)) { ++ w32_socket_initialisations = 0; ++- fprintf ( stderr, "WSAStartup failed\n" ); +++ emsg("WSAStartup failed\n" ); ++ WSACleanup(); ++ rv = -1; ++ } ++@@ -158,13 +158,9 @@ the socket. If PORT is zero do automati ++ #endif ++ (cRetry < BIND_MAX_RETRY)); ++ if (0) ++- { ++- fprintf(stderr, ++- "\nAssigned automatic address to socket : port(%d), errno(%d), bind_rc(%d), iLastAddressUsed(%d), retries(%d)\n" +++ emsg("\nAssigned automatic address to socket : port(%d), errno(%d), bind_rc(%d), iLastAddressUsed(%d), retries(%d)\n" ++ , addr.sin_port, errno, rc, iLastAddressUsed, cRetry ++ ); ++- fflush(stderr); ++- } ++ } ++ else ++ { ++@@ -221,8 +217,7 @@ and returns (list* named_socket fd name1 ++ fd = accept(fix(car(named_socket)) , (struct sockaddr *)&addr, &n); ++ if (fd < 0) ++ { ++- perror("ERROR ! accept on socket failed in sock_accept_connection"); ++- fflush(stderr); +++ emsg("ERROR ! accept on socket failed in sock_accept_connection"); ++ return Cnil; ++ } ++ x = alloc_simple_string(sizeof(struct connection_state)); ++@@ -432,7 +427,7 @@ fill pointer, and this will be advanced. ++ ++ ++ break; ++- default: abort(); +++ default: do_gcl_abort(); ++ } ++ ++ switch (t) { ++@@ -446,7 +441,7 @@ fill pointer, and this will be advanced. ++ if (downcase) ++ while (--len>=0) ++ { char c = *p++; ++- c=tolower(c); +++ c=tolower((int)c); ++ if(needs_quoting[(unsigned char)c]) ++ PUSH('\\'); ++ PUSH(c);} ++--- gcl-2.6.12.orig/o/unexelf.c +++++ gcl-2.6.12/o/unexelf.c ++@@ -401,7 +401,7 @@ Filesz Memsz Flags Alig ++ Instead we read the whole file, modify it, and write it out. */ ++ ++ #ifndef emacs ++-#define fatal(a, b...) fprintf (stderr, a, ##b), exit (1) +++#define fatal(a, b...) emsg(a,##b),do_gcl_abort() ++ #else ++ #include "config.h" ++ extern void fatal (char *, ...); ++@@ -604,7 +604,7 @@ find_section (char *name, char *section_ ++ for (idx = 1; idx < old_file_h->e_shnum; idx++) ++ { ++ #ifdef DEBUG ++- fprintf (stderr, "Looking for %s - found %s\n", name, +++ emsg("Looking for %s - found %s\n", name, ++ section_names + OLD_SECTION_H (idx).sh_name); ++ #endif ++ if (!strcmp (section_names + OLD_SECTION_H (idx).sh_name, ++@@ -752,13 +752,13 @@ unexec (char *new_name, char *old_name, ++ (new_data2_addr - OLD_SECTION_H (old_data_index).sh_addr); ++ ++ #ifdef DEBUG ++- fprintf (stderr, "old_bss_index %d\n", old_bss_index); ++- fprintf (stderr, "old_bss_addr %x\n", old_bss_addr); ++- fprintf (stderr, "old_bss_size %x\n", old_bss_size); ++- fprintf (stderr, "new_bss_addr %x\n", new_bss_addr); ++- fprintf (stderr, "new_data2_addr %x\n", new_data2_addr); ++- fprintf (stderr, "new_data2_size %x\n", new_data2_size); ++- fprintf (stderr, "new_data2_offset %x\n", new_data2_offset); +++ emsg("old_bss_index %d\n", old_bss_index); +++ emsg("old_bss_addr %x\n", old_bss_addr); +++ emsg("old_bss_size %x\n", old_bss_size); +++ emsg("new_bss_addr %x\n", new_bss_addr); +++ emsg("new_data2_addr %x\n", new_data2_addr); +++ emsg("new_data2_size %x\n", new_data2_size); +++ emsg("new_data2_offset %x\n", new_data2_offset); ++ #endif ++ ++ if ((unsigned) new_bss_addr < (unsigned) old_bss_addr + old_bss_size) ++@@ -806,10 +806,10 @@ unexec (char *new_name, char *old_name, ++ new_file_h->e_shnum += 1; ++ ++ #ifdef DEBUG ++- fprintf (stderr, "Old section offset %x\n", old_file_h->e_shoff); ++- fprintf (stderr, "Old section count %d\n", old_file_h->e_shnum); ++- fprintf (stderr, "New section offset %x\n", new_file_h->e_shoff); ++- fprintf (stderr, "New section count %d\n", new_file_h->e_shnum); +++ emsg("Old section offset %x\n", old_file_h->e_shoff); +++ emsg("Old section count %d\n", old_file_h->e_shnum); +++ emsg("New section offset %x\n", new_file_h->e_shoff); +++ emsg("New section count %d\n", new_file_h->e_shnum); ++ #endif ++ ++ /* Fix up a new program header. Extend the writable data segment so ++--- gcl-2.6.12.orig/o/unexmacosx.c +++++ gcl-2.6.12/o/unexmacosx.c ++@@ -299,18 +299,7 @@ unexec_copy (off_t dest, off_t src, ssiz ++ ++ /* Debugging and informational messages routines. */ ++ ++-static void ++-unexec_error (char *format, ...) ++-{ ++- va_list ap; ++- ++- va_start (ap, format); ++- fprintf (stderr, "unexec: "); ++- vfprintf (stderr, format, ap); ++- fprintf (stderr, "\n"); ++- va_end (ap); ++- exit (1); ++-} +++#define unexec_error(a,b...) emsg(a,##b),do_gcl_abort() ++ ++ /* More informational messages routines. */ ++ ++--- gcl-2.6.12.orig/o/unexnt.c +++++ gcl-2.6.12/o/unexnt.c ++@@ -108,7 +108,7 @@ void recreate_heap1() ++ if (GetModuleFileName (NULL, executable_path, MAX_PATH) == 0) ++ { ++ printf ("Failed to find path for executable.\n"); ++- exit (1); +++ do_gcl_abort(); ++ } ++ recreate_heap (executable_path); ++ } ++@@ -156,7 +156,7 @@ _start (void) ++ if (GetModuleFileName (NULL, executable_path, MAX_PATH) == 0) ++ { ++ printf ("Failed to find path for executable.\n"); ++- exit (1); +++ do_gcl_abort(); ++ } ++ ++ #if 1 ++@@ -214,7 +214,7 @@ unexec (char *new_name, char *old_name, ++ void *entry_address) ++ { ++ #ifdef __CYGWIN32__ ++- file_data in_file, out_file; +++ static file_data in_file, out_file; ++ char out_filename[MAX_PATH], in_filename[MAX_PATH]; ++ char filename[MAX_PATH]; ++ unsigned long size; ++@@ -244,7 +244,7 @@ unexec (char *new_name, char *old_name, ++ strcat(filename, (strcmp (ptr, ".exe") && strcmp (ptr, ".EXE"))?".exe":""); ++ cygwin_conv_to_full_win32_path(filename,out_filename); ++ #else ++- file_data in_file, out_file; +++ static file_data in_file, out_file; ++ char out_filename[MAX_PATH], in_filename[MAX_PATH]; ++ unsigned long size; ++ char *ptr; ++@@ -284,7 +284,7 @@ unexec (char *new_name, char *old_name, ++ { ++ printf ("Failed to open %s (%ld)...bailing.\n", ++ in_filename, GetLastError ()); ++- exit (1); +++ do_gcl_abort(); ++ } ++ ++ /* Get the interesting section info, like start and size of .bss... */ ++@@ -305,7 +305,7 @@ unexec (char *new_name, char *old_name, ++ { ++ printf ("Failed to open %s (%ld)...bailing.\n", ++ out_filename, GetLastError ()); ++- exit (1); +++ do_gcl_abort(); ++ } ++ ++ /* Set the flag (before dumping). */ ++@@ -452,7 +452,7 @@ get_bss_info_from_map_file (file_data *p ++ { ++ printf ("Failed to open map file %s, error %d...bailing out.\n", ++ map_filename, GetLastError ()); ++- exit (-1); +++ do_gcl_abort(); ++ } ++ ++ while (fgets (buffer, sizeof (buffer), map)) ++@@ -463,7 +463,7 @@ get_bss_info_from_map_file (file_data *p ++ if (n != 2) ++ { ++ printf ("Failed to scan the .bss section line:\n%s", buffer); ++- exit (-1); +++ do_gcl_abort(); ++ } ++ break; ++ } ++@@ -534,7 +534,7 @@ get_section_info (file_data *p_infile) ++ if (dos_header->e_magic != IMAGE_DOS_SIGNATURE) ++ { ++ printf ("Unknown EXE header in %s...bailing.\n", p_infile->name); ++- exit (1); +++ do_gcl_abort(); ++ } ++ nt_header = (PIMAGE_NT_HEADERS) (((unsigned long) dos_header) + ++ dos_header->e_lfanew); ++@@ -542,7 +542,7 @@ get_section_info (file_data *p_infile) ++ { ++ printf ("Failed to find IMAGE_NT_HEADER in %s...bailing.\n", ++ p_infile->name); ++- exit (1); +++ do_gcl_abort(); ++ } ++ ++ /* Check the NT header signature ... */ ++@@ -729,7 +729,7 @@ read_in_bss (char *filename) ++ if (file == INVALID_HANDLE_VALUE) ++ { ++ i = GetLastError (); ++- exit (1); +++ do_gcl_abort(); ++ } ++ ++ /* Seek to where the .bss section is tucked away after the heap... */ ++@@ -737,7 +737,7 @@ read_in_bss (char *filename) ++ if (SetFilePointer (file, index, NULL, FILE_BEGIN) == 0xFFFFFFFF) ++ { ++ i = GetLastError (); ++- exit (1); +++ do_gcl_abort(); ++ } ++ ++ ++@@ -746,7 +746,7 @@ read_in_bss (char *filename) ++ if (!ReadFile (file, bss_start, bss_size, &n_read, (void *)NULL)) ++ { ++ i = GetLastError (); ++- exit (1); +++ do_gcl_abort(); ++ } ++ ++ CloseHandle (file); ++@@ -767,7 +767,7 @@ map_in_heap (char *filename) ++ if (file == INVALID_HANDLE_VALUE) ++ { ++ i = GetLastError (); ++- exit (1); +++ do_gcl_abort(); ++ } ++ ++ size = GetFileSize (file, &upper_size); ++@@ -776,7 +776,7 @@ map_in_heap (char *filename) ++ if (!file_mapping) ++ { ++ i = GetLastError (); ++- exit (1); +++ do_gcl_abort(); ++ } ++ ++ size = get_committed_heap_size (); ++@@ -797,7 +797,7 @@ map_in_heap (char *filename) ++ MEM_RESERVE | MEM_COMMIT, PAGE_READWRITE) == NULL) ++ { ++ i = GetLastError (); ++- exit (1); +++ do_gcl_abort(); ++ } ++ ++ /* Seek to the location of the heap data in the executable. */ ++@@ -805,7 +805,7 @@ map_in_heap (char *filename) ++ if (SetFilePointer (file, i, NULL, FILE_BEGIN) == 0xFFFFFFFF) ++ { ++ i = GetLastError (); ++- exit (1); +++ do_gcl_abort(); ++ } ++ ++ /* Read in the data. */ ++@@ -813,7 +813,7 @@ map_in_heap (char *filename) ++ get_committed_heap_size (), &n_read, (void *)NULL)) ++ { ++ i = GetLastError (); ++- exit (1); +++ do_gcl_abort(); ++ } ++ ++ CloseHandle (file); ++@@ -1009,7 +1009,7 @@ sbrk (ptrdiff_t increment) ++ if (((unsigned long) data_region_base & ~VALMASK) != 0) ++ { ++ printf ("Error: The heap was allocated in upper memory.\n"); ++- exit (1); +++ do_gcl_abort(); ++ } ++ ++ data_region_end = data_region_base; ++@@ -1090,7 +1090,7 @@ recreate_heap (char *executable_path) { ++ MEM_RESERVE, ++ PAGE_NOACCESS); ++ if (!tmp) ++- exit (1); +++ do_gcl_abort(); ++ ++ /* We read in the data for the .bss section from the executable ++ first and map in the heap from the executable second to prevent ++--- gcl-2.6.12.orig/o/unixsave.c +++++ gcl-2.6.12/o/unixsave.c ++@@ -105,16 +105,16 @@ char *original_file, *save_file; ++ */ ++ ++ if (stdin != original || original->_file != 0) { ++- fprintf(stderr, "Can't open the original file.\n"); ++- exit(1); +++ emsg("Can't open the original file.\n"); +++ do_gcl_abort(); ++ } ++ setbuf(original, stdin_buf); ++ fclose(stdout); ++ unlink(save_file); ++ n = open(save_file, O_CREAT|O_WRONLY, 0777); ++ if (n != 1 || (save = fdopen(n, "w")) != stdout) { ++- fprintf(stderr, "Can't open the save file.\n"); ++- exit(1); +++ emsg("Can't open the save file.\n"); +++ do_gcl_abort(); ++ } ++ setbuf(save, stdout_buf); ++ ++--- gcl-2.6.12.orig/o/unixsys.c +++++ gcl-2.6.12/o/unixsys.c ++@@ -28,11 +28,6 @@ Foundation, 675 Mass Ave, Cambridge, MA ++ ++ #include "include.h" ++ ++-#ifdef _WIN32 ++-#include ++-#define sleep(n) Sleep(1000 * n) ++-#endif ++- ++ #ifdef ATT3B2 ++ #include ++ int ++--- gcl-2.6.12.orig/o/usig.c +++++ gcl-2.6.12/o/usig.c ++@@ -295,12 +295,18 @@ sigio(void) ++ {ifuncall1(sSsigio_interrupt,Cnil);} ++ ++ +++static void +++sigterm(void) +++{do_gcl_abort();} +++ +++ ++ ++ void ++ install_default_signals(void) ++ { gcl_signal(SIGFPE, sigfpe3); ++ gcl_signal(SIGPIPE, sigpipe); ++ gcl_signal(SIGINT, sigint); +++ gcl_signal(SIGTERM, sigterm); ++ gcl_signal(SIGUSR1, sigusr1); ++ gcl_signal(SIGIO, sigio); ++ gcl_signal(SIGALRM, sigalrm); ++--- gcl-2.6.12.orig/o/usig2.c +++++ gcl-2.6.12/o/usig2.c ++@@ -259,7 +259,7 @@ before_interrupt(struct save_for_interru ++ /* #define XS(a) *pp++ = * (void **) (&a); */ ++ #include "usig2_aux.c" ++ if ((pp - (&(p->save_objects)[0])) >= (sizeof(p->save_objects)/sizeof(void *))) ++- abort(); +++ do_gcl_abort(); ++ } ++ #define MINN(a,b) (atoken_st_dim = MINN(token->st.st_dim,tok_leng+1); ++--- /dev/null +++++ gcl-2.6.12/o/wpool.c ++@@ -0,0 +1,35 @@ +++#include +++ +++#define NO_PRELINK_UNEXEC_DIVERSION +++char *rb_end=NULL,*rb_start=NULL,*heap_end=NULL; +++void *data_start=NULL; +++int use_pool=1; +++ +++#include "include.h" +++#include "page.h" +++#include "pool.h" +++ +++/*lintian*/ +++void +++assert_error(const char *a,unsigned l,const char *f,const char *n) { +++ update_pool(0); +++ get_pool(); +++ pool_check(); +++} +++ +++int +++main(int argc,char * argv[],char * envp[]) { +++ +++ int s; +++ +++ sscanf(argv[1],"%d",&s); +++ open_pool(); +++ for (;;) { +++ lock_pool(); +++ fprintf(stderr,"master pid %lu %lu processess %lu pages\n",Pool->pid,Pool->n,Pool->s); +++ fflush(stderr); +++ unlock_pool(); +++ sleep(s); +++ } +++ return 0; +++} diff --cc debian/patches/Version_2_6_13pre17 index 00000000,00000000..354686f7 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre17 @@@ -1,0 -1,0 +1,76 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-13) unstable; urgency=medium ++ . ++ * Version_2_6_13pre16 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/o/alloc.c +++++ gcl-2.6.12/o/alloc.c ++@@ -749,11 +749,15 @@ alloc_from_freelist(struct typemanager * ++ static inline void ++ grow_linear1(struct typemanager *tm) { ++ ++- fixnum maxgro=resv_pages ? available_pages : 0; +++ if (!sSAoptimize_maximum_pagesA || sSAoptimize_maximum_pagesA->s.s_dbind==Cnil) { ++ ++- if (tm->tm_type==t_relocatable) maxgro>>=1; +++ fixnum maxgro=resv_pages ? available_pages : 0; ++ ++- set_tm_maxpage(tm,grow_linear(tm->tm_npage,tm->tm_growth_percent,tm->tm_min_grow, tm->tm_max_grow,maxgro)); +++ if (tm->tm_type==t_relocatable) maxgro>>=1; +++ +++ set_tm_maxpage(tm,grow_linear(tm->tm_npage,tm->tm_growth_percent,tm->tm_min_grow, tm->tm_max_grow,maxgro)); +++ +++ } ++ ++ } ++ ++@@ -802,7 +806,8 @@ do_gc_p(struct typemanager *tm,fixnum n) ++ ++ pp=gc_page_max*phys_pages; ++ ++- return page(recent_allocation)>(1.0+gc_alloc_min-(double)ufmin(cpool,pp)/pp)*data_pages(); +++ return page(recent_allocation)>(1.0+gc_alloc_min-(double)ufmin(cpool,pp)/pp)*data_pages() || +++ 2*tpage(tm,n)>available_pages; ++ ++ } ++ ++--- gcl-2.6.12.orig/o/main.c +++++ gcl-2.6.12/o/main.c ++@@ -236,7 +236,7 @@ get_gc_environ(void) { ++ massert(mem_multiple>=0.0); ++ } ++ ++- gc_alloc_min=0.1; +++ gc_alloc_min=0.05; ++ if ((e=getenv("GCL_GC_ALLOC_MIN"))) { ++ massert(sscanf(e,"%lf",&gc_alloc_min)==1); ++ massert(gc_alloc_min>=0.0); ++@@ -280,7 +280,7 @@ setup_maxpages(double scale) { ++ resv_pages=available_pages=0; ++ available_pages=check_avail_pages(); ++ ++- resv_pages=40 ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-14) unstable; urgency=medium ++ . ++ * Version_2_6_13pre17 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp ++@@ -82,7 +82,7 @@ ++ ++ (defun safe-system (string) ++ (multiple-value-bind ++- (code result) (system (ts string)) +++ (code result) (system (mysub (ts string) "$" "\\$")) ++ (unless (and (zerop code) (zerop result)) ++ (cerror "Continues anyway." ++ "(SYSTEM ~S) returned a non-zero value ~D." ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -715,6 +715,7 @@ infodir ++ docdir ++ oldincludedir ++ includedir +++runstatedir ++ localstatedir ++ sharedstatedir ++ sysconfdir ++@@ -821,6 +822,7 @@ datadir='${datarootdir}' ++ sysconfdir='${prefix}/etc' ++ sharedstatedir='${prefix}/com' ++ localstatedir='${prefix}/var' +++runstatedir='${localstatedir}/run' ++ includedir='${prefix}/include' ++ oldincludedir='/usr/include' ++ docdir='${datarootdir}/doc/${PACKAGE}' ++@@ -1073,6 +1075,15 @@ do ++ | -silent | --silent | --silen | --sile | --sil) ++ silent=yes ;; ++ +++ -runstatedir | --runstatedir | --runstatedi | --runstated \ +++ | --runstate | --runstat | --runsta | --runst | --runs \ +++ | --run | --ru | --r) +++ ac_prev=runstatedir ;; +++ -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ +++ | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ +++ | --run=* | --ru=* | --r=*) +++ runstatedir=$ac_optarg ;; +++ ++ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ++ ac_prev=sbindir ;; ++ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ ++@@ -1210,7 +1221,7 @@ fi ++ for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ ++ datadir sysconfdir sharedstatedir localstatedir includedir \ ++ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ ++- libdir localedir mandir +++ libdir localedir mandir runstatedir ++ do ++ eval ac_val=\$$ac_var ++ # Remove trailing slashes. ++@@ -1363,6 +1374,7 @@ Fine tuning of the installation director ++ --sysconfdir=DIR read-only single-machine data [PREFIX/etc] ++ --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] ++ --localstatedir=DIR modifiable single-machine data [PREFIX/var] +++ --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] ++ --libdir=DIR object code libraries [EPREFIX/lib] ++ --includedir=DIR C header files [PREFIX/include] ++ --oldincludedir=DIR C header files for non-gcc [/usr/include] ++@@ -4423,6 +4435,7 @@ case $use in ++ # if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi ++ ;; ++ mips*) +++ TCFLAGS="$TCFLAGS -mplt" ++ # if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 ++ ;; ++ ia64*) ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -640,6 +640,7 @@ case $use in ++ # if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi ++ ;; ++ mips*) +++ TCFLAGS="$TCFLAGS -mplt" ++ # if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 ++ ;; ++ ia64*) ++--- gcl-2.6.12.orig/h/elf32_mips_reloc.h +++++ gcl-2.6.12/h/elf32_mips_reloc.h ++@@ -19,10 +19,7 @@ ++ case R_MIPS_CALL16: ++ gote=got+sym->st_size-1; ++ store_val(where,MASK(16),((void *)gote-(void *)got)); ++- if (s>=ggot && sst_other) s=gpd=(ul)got-(sym->st_other==2 ? 0 : (ul)where); ++@@ -37,7 +34,8 @@ ++ a+=(a&0x8000)<<1; ++ store_val(where,MASK(16),a); ++ a=0x10000|(a>>16); ++- for (hr=hr ? hr : r;--r>=hr && ELF_R_TYPE(r->r_info)==R_MIPS_HI16;) ++- relocate(sym1,r,a,start,got,gote); +++ for (hr=hr ? hr : r;--r>=hr;) +++ if (ELF_R_TYPE(r->r_info)==R_MIPS_HI16) +++ relocate(sym1,r,a,start,got,gote); ++ hr=NULL;gpd=0; ++ break; ++--- gcl-2.6.12.orig/h/elf32_mips_reloc_special.h +++++ gcl-2.6.12/h/elf32_mips_reloc_special.h ++@@ -1,65 +1,9 @@ ++-static ul gpd,ggot,ggote; static Rel *hr; ++- ++-static int ++-write_stub(ul s,ul *got,ul *gote) { ++- ++- *gote=(ul)(gote+2); ++- *++gote=s; ++- s=((void *)gote-(void *)got); ++- *++gote=(0x23<<26)|(0x1c<<21)|(0x19<<16)|s; ++- *++gote=(0x23<<26)|(0x19<<21)|(0x19<<16)|0; ++- *++gote=0x03200008; ++- *++gote=0x00200825; ++- ++- return 0; ++- ++-} ++- ++-static int ++-make_got_room_for_stub(Shdr *sec1,Shdr *sece,Sym *sym,const char *st1,ul *gs) { ++- ++- Shdr *ssec=sec1+sym->st_shndx; ++- struct node *a; ++- if ((ssec>=sece || !ALLOC_SEC(ssec)) && ++- (a=find_sym_ptable(st1+sym->st_name)) && ++- a->address>=ggot && a->addresssh_addr,pe=p+sec->sh_size;psh_entsize) { ++- q=p; ++- if (q[0]==DT_MIPS_GOTSYM) ++- gotsym=q[1]; ++- if (q[0]==DT_MIPS_LOCAL_GOTNO) ++- locgotno=q[1]; ++- ++- } ++- massert(gotsym && locgotno); ++- ++- massert(sec=get_section(".MIPS.stubs",sec1,sece,sn)); ++- stub=sec->sh_addr; ++- stube=sec->sh_addr+sec->sh_size; ++- ++- massert(sec=get_section(".got",sec1,sece,sn)); ++- ggot=sec->sh_addr+locgotno*sec->sh_entsize; ++- ggote=sec->sh_addr+sec->sh_size; ++- ++- for (ds1+=gotsym,sym=ds1;symst_value || (sym->st_value>=stub && sym->st_valuest_value=ggot+(sym-ds1)*sec->sh_entsize; ++- ++ return 0; ++ ++ } ++@@ -74,7 +18,7 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ ul q; ++ ++ for (q=0,sym=sym1;symst_name; +++ const char *s=st1+sym->st_name; ++ if ((sym->st_other=strcmp(s,"_gp_disp") ? (strcmp(s,"__gnu_local_gp") ? 0 : 2) : 1)) { ++ q++; ++ sym->st_info=ELF_ST_INFO(STB_LOCAL,ELF_ST_TYPE(sym->st_info)); ++@@ -94,10 +38,8 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ ++ sym=sym1+ELF_R_SYM(r->r_info); ++ ++- if (!sym->st_size) { +++ if (!sym->st_size) ++ sym->st_size=++*gs; ++- massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); ++- } ++ ++ } ++ ++--- gcl-2.6.12.orig/h/elf64_mips_reloc.h +++++ gcl-2.6.12/h/elf64_mips_reloc.h ++@@ -15,10 +15,7 @@ ++ gote=got+(a>>32)-1; ++ a&=MASK(32); ++ store_val(where,MASK(16),((void *)gote-(void *)got)); ++- if (s>=ggot && s=hr && ELF_R_TYPE(ra->r_info)==R_MIPS_HI16;) ++- relocate(sym1,ra,ra->r_addend|(1L<<32)|(a<<32),start,got,gote); +++ for (hr=hr ? hr : (void *)ra;--ra>=hr;) +++ if (ELF_R_TYPE(ra->r_info)==R_MIPS_HI16) +++ relocate(sym1,ra,ra->r_addend|(1L<<32)|(a<<32),start,got,gote); ++ } ++ hr=NULL; ++ break; ++--- gcl-2.6.12.orig/h/elf64_mips_reloc_special.h +++++ gcl-2.6.12/h/elf64_mips_reloc_special.h ++@@ -1,4 +1,4 @@ ++-static ul ggot,ggote; static Rela *hr; +++static Rela *hr; ++ ++ #undef ELF_R_SYM ++ #define ELF_R_SYM(a_) (a_&0xffffffff) ++@@ -7,68 +7,9 @@ static ul ggot,ggote; static Rela *hr; ++ #define ELF_R_FTYPE(a_) ((a_>>56)&0xff) ++ ++ static int ++-write_stub(ul s,ul *got,ul *gote) { ++- ++- int *goti; ++- ++- ++- *gote=(ul)(goti=(void *)(gote+2)); ++- *++gote=s; ++- s=((void *)gote-(void *)got); ++- *goti++=(0x37<<26)|(0x1c<<21)|(0x19<<16)|s; ++- *goti++=(0x37<<26)|(0x19<<21)|(0x19<<16)|0; ++- *goti++=0x03200008; ++- *goti++=0x00200825; ++- ++- return 0; ++- ++-} ++- ++-static int ++-make_got_room_for_stub(Shdr *sec1,Shdr *sece,Sym *sym,const char *st1,ul *gs) { ++- ++- Shdr *ssec=sec1+sym->st_shndx; ++- struct node *a; ++- if ((ssec>=sece || !ALLOC_SEC(ssec)) && ++- (a=find_sym_ptable(st1+sym->st_name)) && ++- a->address>=ggot && a->addresssh_addr,pe=p+sec->sh_size;psh_entsize) { ++- q=p; ++- if (q[0]==DT_MIPS_GOTSYM) ++- gotsym=q[1]; ++- if (q[0]==DT_MIPS_LOCAL_GOTNO) ++- locgotno=q[1]; ++- ++- } ++- massert(gotsym && locgotno); ++- ++- massert(sec=get_section(".MIPS.stubs",sec1,sece,sn)); ++- stub=sec->sh_addr; ++- stube=sec->sh_addr+sec->sh_size; ++- ++- massert(sec=get_section(".got",sec1,sece,sn)); ++- ggot=sec->sh_addr+locgotno*sec->sh_entsize; ++- ggote=sec->sh_addr+sec->sh_size; ++- ++- for (ds1+=gotsym,sym=ds1;symst_value || (sym->st_value>=stub && sym->st_valuest_value=ggot+(sym-ds1)*sec->sh_entsize; ++- ++ return 0; ++ ++ } ++@@ -104,8 +45,6 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ sym->st_size|=(q<<(a*16)); ++ } ++ ++- massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); ++- ++ } ++ ++ b=sizeof(r->r_addend)*4; ++--- gcl-2.6.12.orig/h/mips-linux.h +++++ gcl-2.6.12/h/mips-linux.h ++@@ -21,5 +21,4 @@ ++ #define SPECIAL_RELOC_H "elf64_mips_reloc_special.h" ++ #endif ++ ++-/*Remove when .MIPS.stubs are replaced with callable .plt entries*/ ++-#define LD_BIND_NOW +++#define NEED_STACK_CHK_GUARD ++--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp +++++ gcl-2.6.12/lsp/gcl_iolib.lsp ++@@ -38,26 +38,24 @@ ++ ++ ++ (defmacro with-input-from-string ((var string &key index start end) . body) ++- (if index ++- (multiple-value-bind (ds b) ++- (find-declarations body) ++- `(let ((,var (make-string-input-stream ,string ,start ,end))) ++- ,@ds ++- (unwind-protect ++- (progn ,@b) ++- (setf ,index (si:get-string-input-stream-index ,var))))) ++- `(let ((,var (make-string-input-stream ,string ,start ,end))) ++- ,@body))) +++ (multiple-value-bind (ds b) +++ (find-declarations body) +++ `(let ((,var (make-string-input-stream ,string ,start ,end))) +++ ,@ds +++ (unwind-protect +++ (progn ,@b) +++ (when ,index (setf ,index (si:get-string-input-stream-index ,var))) +++ (when ,var (close ,var)))))) ++ +++(defmacro with-output-to-string ((var &optional string &key element-type) . body) +++ (multiple-value-bind (ds b) +++ (find-declarations body) +++ `(let ((,var ,(if string `(make-string-output-stream-from-string ,string) `(make-string-output-stream)))) +++ ,@ds +++ (unwind-protect +++ (progn ,@b ,@(unless string `((get-output-stream-string ,var)))) +++ (when ,var (close ,var)))))) ++ ++-(defmacro with-output-to-string ((var &optional string) . body) ++- (if string ++- `(let ((,var (make-string-output-stream-from-string ,string))) ++- ,@body) ++- `(let ((,var (make-string-output-stream))) ++- ,@body ++- (get-output-stream-string ,var)))) ++- ++ ++ (defun read-from-string (string ++ &optional (eof-error-p t) eof-value ++--- gcl-2.6.12.orig/lsp/gcl_numlib.lsp +++++ gcl-2.6.12/lsp/gcl_numlib.lsp ++@@ -71,29 +71,53 @@ ++ ++ (defun cis (x) (exp (* imag-one x))) ++ ++-(defun asin (x) ++- (let ((c (- (* imag-one ++- (log (+ (* imag-one x) ++- (sqrt (- 1.0d0 (* x x))))))))) ++- (if (or (and (not (complexp x)) ++- (<= x 1.0d0) ++- (>= x -1.0d0) ++- ) ++- (zerop (imagpart c))) ++- (realpart c) ++- c))) ++- ++-(defun acos (x) ++- (let ((c (- (* imag-one ++- (log (+ x (* imag-one ++- (sqrt (- 1.0d0 (* x x)))))))))) ++- (if (or (and (not (complexp x)) ++- (<= x 1.0d0) ++- (>= x -1.0d0) ++- ) ++- (zerop (imagpart c))) ++- (realpart c) ++- c))) +++(defun real-asinh (x) +++ (declare (real x)) +++ (float (log (+ x (sqrt (+ 1.0 (* x x))))) (float x))) +++ +++(defun asin (z) +++ (declare (optimize (safety 1))) +++ (check-type z number) +++ (if (unless (complexp z) (<= -1 z 1)) +++ (atan z (sqrt (- 1 (* z z)))) +++ (let* ((a (sqrt (- 1 z))) +++ (b (sqrt (+ 1 z)))) +++ (complex (atan (realpart z) (realpart (* a b))) +++ (real-asinh (imagpart (* (conjugate a) b))))))) +++ +++(defun acos (z) +++ (declare (optimize (safety 1))) +++ (check-type z number) +++ (if (unless (complexp z) (<= -1 z 1)) +++ (* 2 (atan (- 1 z) (sqrt (- 1 (* z z))))) +++ (let* ((a (sqrt (- 1 z))) +++ (b (sqrt (+ 1 z)))) +++ (complex (* 2 (atan (realpart a) (realpart b))) +++ (real-asinh (imagpart (* (conjugate b) a))))))) +++ +++(defun asinh (x) +++ (declare (optimize (safety 1))) +++ (check-type x number) +++ (if (realp x) +++ (real-asinh x) +++ (let* ((r (asin (complex (- (imagpart x)) (realpart x))))) +++ (complex (imagpart r) (- (realpart r)))))) +++ +++(defun acosh (z) +++ (declare (optimize (safety 1))) +++ (check-type z number) +++ (if (unless (complexp z) (>= z 1)) +++ (real-asinh (sqrt (- (* z z) 1))) +++ (let* ((a (sqrt (- z 1))) +++ (b (sqrt (+ z 1)))) +++ (complex (real-asinh (realpart (* (conjugate a) b))) (* 2 (atan (imagpart a) (realpart b))))))) +++ +++(defun atanh (x) +++ (declare (optimize (safety 1))) +++ (check-type x number) +++ (if (unless (complexp x) (< -1 x 1)) +++ (/ (log (/ (+ 1 x) (- 1 x))) 2) +++ (/ (- (log (+ 1 x)) (log (- 1 x))) 2))) ++ ++ ++ (defun sinh (z) ++@@ -140,27 +164,6 @@ ++ ;(defun cosh (x) (/ (+ (exp x) (exp (- x))) 2.0d0)) ++ (defun tanh (x) (/ (sinh x) (cosh x))) ++ ++-(defun asinh (x) (log (+ x (sqrt (+ 1.0d0 (* x x)))))) ++-;(defun acosh (x) ++-; (log (+ x ++-; (* (1+ x) ++-; (sqrt (/ (1- x) (1+ x))))))) ++-;(defun acosh (x) ++-; (log (+ x ++-; (sqrt (* (1- x) (1+ x)))))) ++-(defun acosh (x) ++- (* 2 (log (+ (sqrt (/ (1+ x) 2)) (sqrt (/ (1- x) 2)))))) ++-(defun atanh (x) ++- (when (or (= x 1.0d0) (= x -1.0d0)) ++- (error "The argument, ~s, is a logarithmic singularity.~ ++- ~%Don't be foolish, GLS." ++- x)) ++- (log (/ (1+ x) (sqrt (- 1 (* x x)))))) ++-;; (let ((y (log (/ (1+ x) (sqrt (- 1 (* x x))))))) ++-;; (if (and (= (imagpart x) 0) (complexp y)) ++-;; (complex (realpart y) (- (imagpart y))) ++-;; y))) ++- ++ ++ (defun rational (x) ++ (etypecase x ++--- gcl-2.6.12.orig/o/file.d +++++ gcl-2.6.12/o/file.d ++@@ -523,7 +523,41 @@ object if_exists, if_does_not_exist; ++ ++ static void ++ gclFlushSocket(object); ++-/* +++ +++ +++DEFUN_NEW("OPEN-STREAM-P",object,fLopen_stream_p,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ +++ check_type_stream(&x); +++ +++ switch(x->sm.sm_mode) { +++ case smm_output: +++ case smm_input: +++ case smm_io: +++ case smm_probe: +++ case smm_socket: +++ case smm_string_input: +++ case smm_string_output: +++ return x->d.tt==1 ? Cnil : Ct; +++ case smm_synonym: +++ return FFN(fLopen_stream_p)(symbol_value(x->sm.sm_object0)); +++ case smm_broadcast: +++ case smm_concatenated: +++ for (x=x->sm.sm_object0;!endp(x);x=x->c.c_cdr) +++ if (!FFN(fLopen_stream_p(x))) +++ return Cnil; +++ return Ct; +++ case smm_two_way: +++ case smm_echo: +++ if (FFN(fLopen_stream_p(STREAM_INPUT_STREAM(x)))==Cnil) +++ return Cnil; +++ return FFN(fLopen_stream_p(STREAM_OUTPUT_STREAM(x))); +++ default: +++ error("illegal stream mode"); +++ return Cnil; +++ } +++ +++} +++ /* ++ Close_stream(strm) closes stream strm. ++ The abort_flag is not used now. ++ */ ++@@ -535,6 +569,8 @@ object strm; ++ object x; ++ ++ BEGIN: +++ strm->d.tt=1; +++ ++ switch (strm->sm.sm_mode) { ++ case smm_output: ++ if (strm->sm.sm_fp == stdout) ++--- gcl-2.6.12.orig/o/main.c +++++ gcl-2.6.12/o/main.c ++@@ -471,12 +471,6 @@ main(int argc, char **argv, char **envp) ++ #include "unrandomize.h" ++ #endif ++ ++-#ifdef LD_BIND_NOW ++-#include ++-#include ++-#include "ld_bind_now.h" ++-#endif ++- ++ setbuf(stdin, stdin_buf); ++ setbuf(stdout, stdout_buf); ++ #ifdef _WIN32 ++--- gcl-2.6.12.orig/o/print.d +++++ gcl-2.6.12/o/print.d ++@@ -349,7 +349,7 @@ truncate_double(char *b,double d,int dp) ++ for (p=c;*p && *p!='e';p++); ++ if (p[-1]!='.' && char_inc(c,p-1) && COMP(c,&pp,d,dp)) { ++ j=truncate_double(c,d,dp); ++- if (j ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-15) unstable; urgency=medium ++ . ++ * Version_2_6_13pre18 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp +++++ gcl-2.6.12/lsp/gcl_iolib.lsp ++@@ -38,23 +38,28 @@ ++ ++ ++ (defmacro with-input-from-string ((var string &key index start end) . body) ++- (multiple-value-bind (ds b) ++- (find-declarations body) ++- `(let ((,var (make-string-input-stream ,string ,start ,end))) ++- ,@ds ++- (unwind-protect ++- (progn ,@b) ++- (when ,index (setf ,index (si:get-string-input-stream-index ,var))) ++- (when ,var (close ,var)))))) ++- +++ (let ((x (sgen "X"))) +++ (multiple-value-bind (ds b) +++ (find-declarations body) +++ `(let ((,var (make-string-input-stream ,string ,start ,end))) +++ ,@ds +++ (unwind-protect +++ ,(let ((f `(progn ,@b))) +++ (if index +++ `(let ((,x (multiple-value-list ,f))) (setf ,index (get-string-input-stream-index ,var)) (values-list ,x)) +++ f)) +++ (close ,var)))))) +++ ++ (defmacro with-output-to-string ((var &optional string &key element-type) . body) ++- (multiple-value-bind (ds b) ++- (find-declarations body) ++- `(let ((,var ,(if string `(make-string-output-stream-from-string ,string) `(make-string-output-stream)))) ++- ,@ds ++- (unwind-protect ++- (progn ,@b ,@(unless string `((get-output-stream-string ,var)))) ++- (when ,var (close ,var)))))) +++ (let ((s (sgen "STRING"))(bl (sgen "BLOCK"))(e (sgen "ELEMENT-TYPE"))(x (sgen "X"))) +++ (multiple-value-bind (ds b) +++ (find-declarations body) +++ `(let* ((,s ,string)(,e ,element-type) +++ (,var (if ,s (make-string-output-stream-from-string ,s) (make-string-output-stream :element-type ,e)))) +++ ,@ds +++ (unwind-protect +++ (let ((,x (multiple-value-list (progn ,@b)))) (if ,s (values-list ,x) (get-output-stream-string ,var))) +++ (close ,var)))))) ++ ++ ++ (defun read-from-string (string ++--- gcl-2.6.12.orig/o/file.d +++++ gcl-2.6.12/o/file.d ++@@ -1668,12 +1668,11 @@ for the string ~S.", ++ 3, istart, iend, strng); ++ @) ++ ++-static void ++-FFN(Lmake_string_output_stream)() ++-{ ++- check_arg(0); ++- vs_push(make_string_output_stream(64)); ++-} +++@(static defun make_string_output_stream (&k element_type) +++@ +++ element_type=Cnil;/*FIXME*/ +++ @(return `make_string_output_stream(64)`) +++@) ++ ++ LFD(Lget_output_stream_string)() ++ { diff --cc debian/patches/Version_2_6_13pre1a index 00000000,00000000..81441842 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre1a @@@ -1,0 -1,0 +1,86 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-2) unstable; urgency=medium ++ . ++ * Version_2_6_13pre1 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/o/alloc.c +++++ gcl-2.6.12/o/alloc.c ++@@ -1269,10 +1269,11 @@ gcl_init_alloc(void *cs_start) { ++ update_real_maxpage(); ++ ++ if (gcl_alloc_initialized) { ++- massert(rb_start==heap_end &&rb_end==heap_end && rb_limit==heap_end && rb_pointer==heap_end); ++- holepage=new_holepage; ++- alloc_page(-holepage); ++- rb_start=rb_end=rb_limit=rb_pointer=heap_end+(holepage<c.c_cdr),pp=pp->c.c_cdr) ++ if ((pp)->c.c_car->st.st_self == ptr) { ++- /* SGC contblock pages: Its possible this is on an old page CM 20030827 */ ++-/* #ifdef SGC */ ++-/* insert_maybe_sgc_contblock((pp)->c.c_car->st.st_self,(pp)->c.c_car->st.st_dim); */ ++-/* #else */ ++-/* insert_contblock((pp)->c.c_car->st.st_self,(pp)->c.c_car->st.st_dim); */ ++-/* #endif */ ++ (pp)->c.c_car->st.st_self = NULL; ++ *p = pp->c.c_cdr; ++ #ifdef GCL_GPROF ++ if (initial_monstartup_pointer==ptr) { +++ initial_monstartup_pointer_echo=ptr; ++ initial_monstartup_pointer=NULL; ++- if (core_end-heap_end>=sizeof(ptr)) ++- *(void **)heap_end=ptr; ++ } ++ #endif ++ return; ++@@ -1840,12 +1835,13 @@ free(void *ptr) { ++ #ifdef NOFREE_ERR ++ return; ++ #else ++- if (core_end-heap_end ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-2) unstable; urgency=medium ++ . ++ * Version_2_6_13pre1 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/makefile +++++ gcl-2.6.12/makefile ++@@ -195,7 +195,7 @@ install1: ++ if gcc --version | grep -i mingw >/dev/null 2>&1 ; then if grep -i oncrpc makedefs >/dev/null 2>&1 ; then cp /mingw/bin/oncrpc.dll $(DESTDIR)$(INSTALL_LIB_DIR)/$(PORTDIR); fi ; fi ++ cd $(DESTDIR)$(INSTALL_LIB_DIR)/$(PORTDIR) && \ ++ mv $(FLISP)$(EXE) temp$(EXE) && \ ++- echo '(reset-sys-paths "$(INSTALL_LIB_DIR)/")(si::save-system "$(FLISP)$(EXE)")' | ./temp$(EXE) && \ +++ echo '(si::reset-sys-paths "$(INSTALL_LIB_DIR)/")(si::save-system "$(FLISP)$(EXE)")' | ./temp$(EXE) && \ ++ rm -f temp$(EXE) ++ if [ -e "unixport/rsym$(EXE)" ] ; then cp unixport/rsym$(EXE) $(DESTDIR)$(INSTALL_LIB_DIR)/unixport/ ; fi ++ # ln $(SYMB) $(INSTALL_LIB_DIR)/$(PORTDIR)/$(FLISP)$(EXE) \ diff --cc debian/patches/Version_2_6_13pre2 index 00000000,00000000..c9a97635 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre2 @@@ -1,0 -1,0 +1,229 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-2) unstable; urgency=medium ++ . ++ * Version_2_6_13pre1 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/h/bsd.h +++++ gcl-2.6.12/h/bsd.h ++@@ -33,39 +33,7 @@ filecpy(save, original, stsize - sizeof( ++ ++ extern char etext; ++ ++- ++- ++- ++-/* #define SET_REAL_MAXPAGE do { struct rlimit data_rlimit; \ */ ++-/* extern char etext; \ */ ++-/* real_maxpage = MAXPAGE ; \ */ ++-/* getrlimit(RLIMIT_DATA, &data_rlimit); \ */ ++-/* real_maxpage = ((unsigned int)&etext/PAGESIZE + data_rlimit.rlim_cur/PAGESIZE); \ */ ++-/* if (real_maxpage > MAXPAGE) \ */ ++-/* real_maxpage = MAXPAGE ; } while(0) */ ++- ++-#define ROUND_UP_SBRK(x) \ ++- do {long i; \ ++- if ((i = ((long)x & (PAGESIZE - 1)))) \ ++- x=sbrk(PAGESIZE - i); } while(0); ++- ++-#define FIX_RANDOM_SBRK \ ++-do {char *x=sbrk(0); \ ++- if (core_end != x) \ ++- { ROUND_UP_SBRK(x); x=sbrk(0);\ ++- while (core_end < x) \ ++- { \ ++- core_end = core_end + PAGESIZE;} \ ++- if (core_end !=x) error("Someone allocated my memory");}} while (0) ++- ++- ++-#define INIT_ALLOC \ ++- heap_end = sbrk(0); ROUND_UP_SBRK(heap_end);\ ++- heap_end = core_end = sbrk(0); ++- ++-#define IF_ALLOCATE_ERR \ ++- FIX_RANDOM_SBRK; \ ++- if (core_end != sbrk(PAGESIZE*(n - m))) +++#define INIT_ALLOC heap_end = core_end = sbrk(0); ++ ++ #define SYM_EXTERNAL_P(sym) ((sym)->n_type & N_EXT) ++ ++--- gcl-2.6.12.orig/h/protoize.h +++++ gcl-2.6.12/h/protoize.h ++@@ -1935,3 +1935,6 @@ empty_relblock(void); ++ ++ fixnum ++ check_avail_pages(void); +++ +++inline int +++mbrk(void *); ++--- gcl-2.6.12.orig/o/alloc.c +++++ gcl-2.6.12/o/alloc.c ++@@ -223,61 +223,53 @@ resize_hole(ufixnum hp,enum type tp) { ++ inline void * ++ alloc_page(long n) { ++ ++- fixnum d,m; ++- ++- if (n>=0) { +++ bool s=n<0; +++ ufixnum nn=s ? -n : n; +++ void *v,*e; +++ +++ if (!s) { ++ ++- if (n>(holepage - (in_signal_handler? 0 : +++ if (nn>(holepage - (in_signal_handler? 0 : ++ available_pages-n<=reserve_pages_for_signal_handler ? 0 : ++ reserve_pages_for_signal_handler))) { ++ ++ ++- if (in_signal_handler) { ++- fprintf(stderr,"Cant do relocatable gc in signal handler. \ ++-Try to allocate more space to save for allocation during signals: \ ++-eg to add 20 more do (si::set-hole-size %ld %d)\n...start over ", ++- new_holepage, 20+ reserve_pages_for_signal_handler); fflush(stderr); exit(1); ++- } ++- +++ fixnum d=available_pages-nn; ++ ++- d=available_pages-n; ++ d*=0.2; ++ d=d<0.01*real_maxpage ? available_pages-n : d; ++ d=d<0 ? 0 : d; ++ d=new_holepagecb_size==(**cbppp)->cb_size;cbpp=&cbp->cb_link,cbp=cbp->cb_link,k++); ++ if (print) ++- fprintf(stderr,"%lu %p %p %lu %lu\n",cbppp-cbsrch1,*cbppp,**cbppp,(**cbppp)->cb_size,k); +++ fprintf(stderr,"%lu %p %p %lu %lu\n",(unsigned long)(cbppp-cbsrch1),*cbppp,**cbppp,(**cbppp)->cb_size,k); ++ } ++ massert(cbppp==cbsrche); ++ massert(*cbppp==cbpp); ++--- gcl-2.6.12.orig/o/main.c +++++ gcl-2.6.12/o/main.c ++@@ -120,6 +120,7 @@ fixnum log_maxpage_bound=sizeof(fixnum)* ++ ++ inline int ++ mbrk(void *v) { +++ ++ ufixnum uv=(ufixnum)v,uc=(ufixnum)sbrk(0),ux,um; ++ fixnum m=((1UL<<(sizeof(fixnum)*8-1))-1); ++ ++@@ -134,9 +135,12 @@ mbrk(void *v) { ++ um=uc; ++ ux=uv; ++ } +++ ++ if (((fixnum)(ux-um))<0) ++ return mbrk((void *)uc+(uvs.s_dbind=alloc_simple_string(n); ++- sSAcode_block_reserveA->s.s_dbind->st.st_self=alloc_memory(n); ++- ++-} ++- ++ static object ++ load_memory(Shdr *sec1,Shdr *sece,void *v1,ul **got,ul **gote) { ++ diff --cc debian/patches/Version_2_6_13pre20 index 00000000,00000000..66ade458 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre20 @@@ -1,0 -1,0 +1,45 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-16) unstable; urgency=medium ++ . ++ * Version_2_6_13pre19 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/o/file.d +++++ gcl-2.6.12/o/file.d ++@@ -543,14 +543,14 @@ DEFUN_NEW("OPEN-STREAM-P",object,fLopen_ ++ case smm_broadcast: ++ case smm_concatenated: ++ for (x=x->sm.sm_object0;!endp(x);x=x->c.c_cdr) ++- if (!FFN(fLopen_stream_p(x))) +++ if (!FFN(fLopen_stream_p)(x)) ++ return Cnil; ++ return Ct; ++ case smm_two_way: ++ case smm_echo: ++- if (FFN(fLopen_stream_p(STREAM_INPUT_STREAM(x)))==Cnil) +++ if (FFN(fLopen_stream_p)(STREAM_INPUT_STREAM(x))==Cnil) ++ return Cnil; ++- return FFN(fLopen_stream_p(STREAM_OUTPUT_STREAM(x))); +++ return FFN(fLopen_stream_p)(STREAM_OUTPUT_STREAM(x)); ++ default: ++ error("illegal stream mode"); ++ return Cnil; diff --cc debian/patches/Version_2_6_13pre22 index 00000000,00000000..cf61cc63 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre22 @@@ -1,0 -1,0 +1,357 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-17) unstable; urgency=medium ++ . ++ * Version_2_6_13pre20 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -6553,6 +6553,7 @@ else ++ ++ #include ++ #define EXTER +++ #define INLINE ++ #include "$MP_INCLUDE" ++ #include "./h/enum.h" ++ #define OBJ_ALIGN ++@@ -6681,6 +6682,7 @@ else ++ /* end confdefs.h. */ ++ #include ++ #define EXTER +++ #define INLINE ++ #include "$MP_INCLUDE" ++ #include "h/enum.h" ++ #include "h/type.h" ++@@ -6710,6 +6712,7 @@ else ++ /* end confdefs.h. */ ++ #include ++ #define EXTER +++ #define INLINE ++ #include "$MP_INCLUDE" ++ #include "`pwd`/h/enum.h" ++ #include "`pwd`/h/type.h" ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -1301,6 +1301,7 @@ AC_MSG_CHECKING([for required object ali ++ AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++ #include ++ #define EXTER +++ #define INLINE ++ #include "$MP_INCLUDE" ++ #include "./h/enum.h" ++ #define OBJ_ALIGN ++@@ -1341,6 +1342,7 @@ AC_MSG_CHECKING(sizeof struct contblock) ++ if test "$use" = "mingw" ; then ++ AC_TRY_RUN([#include ++ #define EXTER +++ #define INLINE ++ #include "$MP_INCLUDE" ++ #include "h/enum.h" ++ #include "h/type.h" ++@@ -1357,6 +1359,7 @@ AC_TRY_RUN([#include ++ else ++ AC_TRY_RUN([#include ++ #define EXTER +++ #define INLINE ++ #include "$MP_INCLUDE" ++ #include "`pwd`/h/enum.h" ++ #include "`pwd`/h/type.h" ++--- gcl-2.6.12.orig/gcl-tk/guis.h +++++ gcl-2.6.12/gcl-tk/guis.h ++@@ -7,6 +7,7 @@ ++ #define IMMNUM_H ++ #define GMP_WRAPPERS_H ++ #define ERROR_H +++#undef INLINE ++ ++ #include "include.h" ++ ++--- gcl-2.6.12.orig/h/elf64_mips_reloc.h +++++ gcl-2.6.12/h/elf64_mips_reloc.h ++@@ -15,7 +15,10 @@ ++ gote=got+(a>>32)-1; ++ a&=MASK(32); ++ store_val(where,MASK(16),((void *)gote-(void *)got)); ++- *gote=s+(a&~MASK(16))+((a&0x8000)<<1); +++ if (s>=ggot && s>56)&0xff) ++ ++ static int +++write_stub(ul s,ul *got,ul *gote) { +++ +++ int *goti; +++ +++ *gote=(ul)(goti=(void *)(gote+2)); +++ *++gote=s; +++ s=((void *)gote-(void *)got); +++ *goti++=(0x37<<26)|(0x1c<<21)|(0x19<<16)|s; +++ *goti++=(0x37<<26)|(0x19<<21)|(0x19<<16)|0; +++ *goti++=0x03200008; +++ *goti++=0x00200825; +++ +++ return 0; +++ +++} +++ +++static int +++make_got_room_for_stub(Shdr *sec1,Shdr *sece,Sym *sym,const char *st1,ul *gs) { +++ +++ Shdr *ssec=sec1+sym->st_shndx; +++ struct node *a; +++ if ((ssec>=sece || !ALLOC_SEC(ssec)) && +++ (a=find_sym_ptable(st1+sym->st_name)) && +++ a->address>=ggot && a->addresssh_addr,pe=p+sec->sh_size;psh_entsize) { +++ q=p; +++ if (q[0]==DT_MIPS_GOTSYM) +++ gotsym=q[1]; +++ if (q[0]==DT_MIPS_LOCAL_GOTNO) +++ locgotno=q[1]; +++ } +++ massert(gotsym && locgotno); +++ +++ massert(sec=get_section(".MIPS.stubs",sec1,sece,sn)); +++ stub=sec->sh_addr; +++ stube=sec->sh_addr+sec->sh_size; +++ +++ massert(sec=get_section(".got",sec1,sece,sn)); +++ ggot=sec->sh_addr+locgotno*sec->sh_entsize; +++ ggote=sec->sh_addr+sec->sh_size; +++ +++ for (ds1+=gotsym,sym=ds1;symst_value || (sym->st_value>=stub && sym->st_valuest_value=ggot+(sym-ds1)*sec->sh_entsize; +++ ++ return 0; ++ ++ } ++@@ -45,6 +102,8 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ sym->st_size|=(q<<(a*16)); ++ } ++ +++ massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); +++ ++ } ++ ++ b=sizeof(r->r_addend)*4; ++--- gcl-2.6.12.orig/h/notcomp.h +++++ gcl-2.6.12/h/notcomp.h ++@@ -364,3 +364,13 @@ extern bool writable_malloc; ++ #define pfork() prof_block(fork()) ++ ++ #include "error.h" +++ +++#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2) +++extern void __gmp_randget_mt (); +++extern void __gmp_randclear_mt (); +++extern void __gmp_randiset_mt (); +++ +++typedef struct {void *a,*b,*c,*d;} gmp_randfnptr_t; +++EXTER gmp_randfnptr_t Mersenne_Twister_Generator_Noseed; +++#endif +++ ++--- gcl-2.6.12.orig/h/object.h +++++ gcl-2.6.12/h/object.h ++@@ -349,11 +349,7 @@ EXTER char *new_rb_start; /* desired r ++ EXTER char *rb_start; /* relblock start */ ++ EXTER char *rb_end; /* relblock end */ ++ EXTER char *rb_limit; /* relblock limit */ ++-EXTER char *rb_pointer; /* relblock pointer */ ++- ++-#ifndef INLINE ++-#define INLINE ++-#endif +++EXTER char *rb_pointer; /* relblock pointer */ ++ ++ INLINE ufixnum ++ rb_size(void) { ++--- gcl-2.6.12.orig/o/big.c +++++ gcl-2.6.12/o/big.c ++@@ -70,6 +70,32 @@ DEFUN_NEW("SET-GMP-ALLOCATE-RELOCATABLE" ++ RETURN1(flag); ++ } ++ +++#ifndef GMP_USE_MALLOC +++object big_gcprotect; +++object big_fixnum1; +++ +++#include "gmp.c" +++ +++void +++gcl_init_big1(void) { +++ +++ mp_set_memory_functions( gcl_gmp_alloc,gcl_gmp_realloc,gcl_gmp_free); +++ jmp_gmp=0; +++ +++#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2) +++ Mersenne_Twister_Generator_Noseed.b=__gmp_randget_mt; +++ Mersenne_Twister_Generator_Noseed.c=__gmp_randclear_mt; +++ Mersenne_Twister_Generator_Noseed.d=__gmp_randiset_mt; +++#endif +++ +++} +++ +++#else +++gcl_init_big1() +++{ +++} +++#endif +++ ++ #ifdef GMP ++ #include "gmp_big.c" ++ #else ++@@ -93,7 +119,6 @@ void zero_big(object x) ++ ZERO_BIG(x); ++ } ++ ++- ++ #ifndef HAVE_MP_COERCE_TO_STRING ++ ++ double digitsPerBit[37]={ 0,0, ++--- gcl-2.6.12.orig/o/gmp_big.c +++++ gcl-2.6.12/o/gmp_big.c ++@@ -81,27 +81,6 @@ static object verify_big_or_zero(object ++ #define verify_big_or_zero(x) ++ #endif ++ ++- ++- ++- ++- ++-#ifndef GMP_USE_MALLOC ++-object big_gcprotect; ++-object big_fixnum1; ++- ++-#include "gmp.c" ++-void ++-gcl_init_big1(void) { ++- mp_set_memory_functions( gcl_gmp_alloc,gcl_gmp_realloc,gcl_gmp_free); ++- jmp_gmp=0; ++-} ++- ++-#else ++-gcl_init_big1() ++-{ ++-} ++-#endif ++- ++ object ++ new_bignum(void) ++ { object ans; ++--- gcl-2.6.12.orig/o/main.c +++++ gcl-2.6.12/o/main.c ++@@ -511,9 +511,7 @@ main(int argc, char **argv, char **envp) ++ ++ terminal_io->sm.sm_object0->sm.sm_fp = stdin; ++ terminal_io->sm.sm_object1->sm.sm_fp = stdout; ++-#ifdef LD_BIND_NOW /*FIXME currently mips only, verify that these two requirements are the same*/ ++- reinit_gmp(); ++-#endif +++ ++ gcl_init_big1(); ++ #ifdef HAVE_READLINE ++ gcl_init_readline_function(); ++--- gcl-2.6.12.orig/o/num_rand.c +++++ gcl-2.6.12/o/num_rand.c ++@@ -104,34 +104,6 @@ trap_gcl_gmp_allocfun(size_t size){ ++ } ++ #endif ++ ++-#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2) ++-extern void ++-__gmp_randget_mt (); ++-extern void ++-__gmp_randclear_mt (); ++-extern void ++-__gmp_randiset_mt (); ++- ++-typedef struct {void *a,*b,*c,*d;} gmp_randfnptr_t; ++-static gmp_randfnptr_t Mersenne_Twister_Generator_Noseed = { ++- NULL, ++- __gmp_randget_mt, ++- __gmp_randclear_mt, ++- __gmp_randiset_mt ++-}; ++-#endif ++- ++-void ++-reinit_gmp() { ++- ++-#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2) ++- Mersenne_Twister_Generator_Noseed.b=__gmp_randget_mt; ++- Mersenne_Twister_Generator_Noseed.c=__gmp_randclear_mt; ++- Mersenne_Twister_Generator_Noseed.d=__gmp_randiset_mt; ++-#endif ++- ++-} ++- ++ void ++ init_gmp_rnd_state(__gmp_randstate_struct *x) { ++ ++--- gcl-2.6.12.orig/unixport/sys_init.lsp.in +++++ gcl-2.6.12/unixport/sys_init.lsp.in ++@@ -66,9 +66,7 @@ ++ *opt-two* @LI-OPT-TWO@ ++ *init-lsp* @LI-INIT-LSP@) ++ ++-(import 'si::(clines defentry defcfun object void int double ++- quit bye gbc system commonp ++- *break-on-warnings* +++(import 'si::(commonp *break-on-warnings* ++ make-char char-bits char-font char-bit set-char-bit string-char-p int-char ++ char-font-limit char-bits-limit char-control-bit ++ char-meta-bit char-super-bit char-hyper-bit compiler-let) :cltl1-compat) ++@@ -79,3 +77,4 @@ ++ #-ansi-cl(do-symbols (s :cltl1-compat) (export s :lisp))) ++ ++ #+ansi-cl (use-package :pcl :user) +++(import 'si::(clines defentry defcfun object void int double quit bye gbc system) :user) diff --cc debian/patches/Version_2_6_13pre25 index 00000000,00000000..6e13958b new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre25 @@@ -1,0 -1,0 +1,185 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-19) unstable; urgency=medium ++ . ++ * Use-dpkg-buidflags-opt-levels-in-debian-rules, -O3 has bug in 5.2.1 ++ * Version_2_6_13pre24 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/config.guess +++++ gcl-2.6.12/config.guess ++@@ -1,8 +1,8 @@ ++ #! /bin/sh ++ # Attempt to guess a canonical system name. ++-# Copyright 1992-2014 Free Software Foundation, Inc. +++# Copyright 1992-2015 Free Software Foundation, Inc. ++ ++-timestamp='2014-03-23' +++timestamp='2015-08-20' ++ ++ # This file is free software; you can redistribute it and/or modify it ++ # under the terms of the GNU General Public License as published by ++@@ -24,12 +24,12 @@ timestamp='2014-03-23' ++ # program. This Exception is an additional permission under section 7 ++ # of the GNU General Public License, version 3 ("GPLv3"). ++ # ++-# Originally written by Per Bothner. +++# Originally written by Per Bothner; maintained since 2000 by Ben Elliston. ++ # ++ # You can get the latest version of this script from: ++ # http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD ++ # ++-# Please send patches with a ChangeLog entry to config-patches@gnu.org. +++# Please send patches to . ++ ++ ++ me=`echo "$0" | sed -e 's,.*/,,'` ++@@ -50,7 +50,7 @@ version="\ ++ GNU config.guess ($timestamp) ++ ++ Originally written by Per Bothner. ++-Copyright 1992-2014 Free Software Foundation, Inc. +++Copyright 1992-2015 Free Software Foundation, Inc. ++ ++ This is free software; see the source for copying conditions. There is NO ++ warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." ++@@ -168,20 +168,27 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ ++ # Note: NetBSD doesn't particularly care about the vendor ++ # portion of the name. We always set it to "unknown". ++ sysctl="sysctl -n hw.machine_arch" ++- UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \ ++- /usr/sbin/$sysctl 2>/dev/null || echo unknown)` +++ UNAME_MACHINE_ARCH=`(uname -p 2>/dev/null || \ +++ /sbin/$sysctl 2>/dev/null || \ +++ /usr/sbin/$sysctl 2>/dev/null || \ +++ echo unknown)` ++ case "${UNAME_MACHINE_ARCH}" in ++ armeb) machine=armeb-unknown ;; ++ arm*) machine=arm-unknown ;; ++ sh3el) machine=shl-unknown ;; ++ sh3eb) machine=sh-unknown ;; ++ sh5el) machine=sh5le-unknown ;; +++ earmv*) +++ arch=`echo ${UNAME_MACHINE_ARCH} | sed -e 's,^e\(armv[0-9]\).*$,\1,'` +++ endian=`echo ${UNAME_MACHINE_ARCH} | sed -ne 's,^.*\(eb\)$,\1,p'` +++ machine=${arch}${endian}-unknown +++ ;; ++ *) machine=${UNAME_MACHINE_ARCH}-unknown ;; ++ esac ++ # The Operating System including object format, if it has switched ++ # to ELF recently, or will in the future. ++ case "${UNAME_MACHINE_ARCH}" in ++- arm*|i386|m68k|ns32k|sh3*|sparc|vax) +++ arm*|earm*|i386|m68k|ns32k|sh3*|sparc|vax) ++ eval $set_cc_for_build ++ if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ ++ | grep -q __ELF__ ++@@ -197,6 +204,13 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ ++ os=netbsd ++ ;; ++ esac +++ # Determine ABI tags. +++ case "${UNAME_MACHINE_ARCH}" in +++ earm*) +++ expr='s/^earmv[0-9]/-eabi/;s/eb$//' +++ abi=`echo ${UNAME_MACHINE_ARCH} | sed -e "$expr"` +++ ;; +++ esac ++ # The OS release ++ # Debian GNU/NetBSD machines have a different userland, and ++ # thus, need a distinct triplet. However, they do not need ++@@ -207,13 +221,13 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ ++ release='-gnu' ++ ;; ++ *) ++- release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` +++ release=`echo ${UNAME_RELEASE} | sed -e 's/[-_].*//' | cut -d. -f1,2` ++ ;; ++ esac ++ # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: ++ # contains redundant information, the shorter form: ++ # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. ++- echo "${machine}-${os}${release}" +++ echo "${machine}-${os}${release}${abi}" ++ exit ;; ++ *:Bitrig:*:*) ++ UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` ++@@ -235,6 +249,9 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ ++ *:MirBSD:*:*) ++ echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} ++ exit ;; +++ *:Sortix:*:*) +++ echo ${UNAME_MACHINE}-unknown-sortix +++ exit ;; ++ alpha:OSF1:*:*) ++ case $UNAME_RELEASE in ++ *4.0) ++@@ -579,8 +596,9 @@ EOF ++ else ++ IBM_ARCH=powerpc ++ fi ++- if [ -x /usr/bin/oslevel ] ; then ++- IBM_REV=`/usr/bin/oslevel` +++ if [ -x /usr/bin/lslpp ] ; then +++ IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc | +++ awk -F: '{ print $3 }' | sed s/[0-9]*$/0/` ++ else ++ IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} ++ fi ++@@ -932,6 +950,9 @@ EOF ++ crisv32:Linux:*:*) ++ echo ${UNAME_MACHINE}-axis-linux-${LIBC} ++ exit ;; +++ e2k:Linux:*:*) +++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} +++ exit ;; ++ frv:Linux:*:*) ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} ++ exit ;; ++@@ -1020,7 +1041,7 @@ EOF ++ echo ${UNAME_MACHINE}-dec-linux-${LIBC} ++ exit ;; ++ x86_64:Linux:*:*) ++- echo ${UNAME_MACHINE}-unknown-linux-${LIBC} +++ echo ${UNAME_MACHINE}-pc-linux-${LIBC} ++ exit ;; ++ xtensa*:Linux:*:*) ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} ++--- gcl-2.6.12.orig/unixport/sys_init.lsp.in +++++ gcl-2.6.12/unixport/sys_init.lsp.in ++@@ -66,8 +66,9 @@ ++ *opt-two* @LI-OPT-TWO@ ++ *init-lsp* @LI-INIT-LSP@) ++ ++-(import 'si::(commonp *break-on-warnings* ++- make-char char-bits char-font char-bit set-char-bit string-char-p int-char +++(import 'si::(clines defentry defcfun object void int double quit bye gbc system +++ commonp *break-on-warnings* make-char char-bits char-font +++ char-bit set-char-bit string-char-p int-char ++ char-font-limit char-bits-limit char-control-bit ++ char-meta-bit char-super-bit char-hyper-bit compiler-let) :cltl1-compat) ++ (deftype cltl1-compat::string-char nil 'character) ++@@ -77,4 +78,4 @@ ++ #-ansi-cl(do-symbols (s :cltl1-compat) (export s :lisp))) ++ ++ #+ansi-cl (use-package :pcl :user) ++-(import 'si::(clines defentry defcfun object void int double quit bye gbc system) :user) +++#+ansi-cl (import 'si::(clines defentry defcfun object void int double quit bye gbc system) :user) diff --cc debian/patches/Version_2_6_13pre26 index 00000000,00000000..798646de new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre26 @@@ -1,0 -1,0 +1,235 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-20) unstable; urgency=medium ++ . ++ * Version_2_6_13pre25 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -4435,7 +4435,6 @@ case $use in ++ # if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi ++ ;; ++ mips*) ++- TCFLAGS="$TCFLAGS -mplt" ++ # if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 ++ ;; ++ ia64*) ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -640,7 +640,6 @@ case $use in ++ # if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi ++ ;; ++ mips*) ++- TCFLAGS="$TCFLAGS -mplt" ++ # if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 ++ ;; ++ ia64*) ++--- gcl-2.6.12.orig/h/elf32_mips_reloc.h +++++ gcl-2.6.12/h/elf32_mips_reloc.h ++@@ -4,7 +4,12 @@ ++ add_val(where,~0L,s+a-(ul)got); ++ break; ++ case R_MIPS_26: ++- add_val(where,MASK(26),(s+a)>>2); +++ if (((s+a)>>28)!=(((ul)where)>>28)) { +++ gote=got+sym->st_size-1; +++ massert(!write_26_stub(s+a,got,gote)); +++ store_val(where,MASK(26),((ul)gote)>>2); +++ } else +++ add_val(where,MASK(26),(s+a)>>2); ++ break; ++ case R_MIPS_32: ++ add_val(where,~0L,s+a); ++@@ -19,7 +24,10 @@ ++ case R_MIPS_CALL16: ++ gote=got+sym->st_size-1; ++ store_val(where,MASK(16),((void *)gote-(void *)got)); ++- *gote=s; +++ if (s>=ggot && sst_other) s=gpd=(ul)got-(sym->st_other==2 ? 0 : (ul)where); ++--- gcl-2.6.12.orig/h/elf32_mips_reloc_special.h +++++ gcl-2.6.12/h/elf32_mips_reloc_special.h ++@@ -1,9 +1,88 @@ ++-static ul gpd; static Rel *hr; +++#include +++ +++static ul gpd,ggot,ggote,can_gp; static Rel *hr; +++ +++typedef struct { +++ ul addr_hi,addr_lo,jr,nop; +++} mips_26_tramp; +++ +++static int +++write_26_stub(ul s,ul *got,ul *gote) { +++ +++ static mips_26_tramp t1={(0xf<<26)|(0x0<<21)|(0x19<<16), /*lui t9*/ +++ (0xe<<26)|(0x19<<21)|(0x19<<16), /*ori t9,t9 */ +++ 0x03200008, /*jr t9*/ +++ 0x00200825}; /*mv at,at */; +++ mips_26_tramp *t=(void *)gote; +++ +++ *t=t1; +++ t->addr_hi|=s>>16; +++ t->addr_lo|=s&0xffff; +++ +++ return 0; +++ +++} +++ +++typedef struct { +++ ul entry,addr_hi,addr_lo,lw,jr,lwcan; +++} call_16_tramp; +++ +++static int +++write_stub(ul s,ul *got,ul *gote) { +++ +++ static call_16_tramp t1={0, +++ (0xf<<26)|(0x0<<21)|(0x19<<16), /*lui t9*/ +++ (0xe<<26)|(0x19<<21)|(0x19<<16), /*ori t9,t9 */ +++ (0x23<<26)|(0x19<<21)|(0x19<<16), /*lw t9,(0)t9*/ +++ 0x03200008, /*jr t9*/ +++ /*stub addresses need veneer setting gp to canonical*/ +++ (0x23<<26)|(0x1c<<21)|(0x1c<<16)};/*lw gp,(0)gp*/ +++ call_16_tramp *t=(void *)gote++; +++ +++ *t=t1; +++ *got=can_gp; +++ +++ t->entry=(ul)gote; +++ t->addr_hi|=s>>16; +++ t->addr_lo|=s&0xffff; +++ +++ return 0; +++ +++} ++ ++ static int ++ find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, ++ const char *st1,Sym *ds1,Sym *dse,Sym *sym,Sym *syme) { ++ +++ Shdr *sec; +++ ul *q,gotsym=0,locgotno=0,stub,stube; +++ void *p,*pe; +++ +++ massert(sec=get_section(".dynamic",sec1,sece,sn)); +++ for (p=(void *)sec->sh_addr,pe=p+sec->sh_size;psh_entsize) { +++ q=p; +++ if (q[0]==DT_MIPS_GOTSYM) +++ gotsym=q[1]; +++ if (q[0]==DT_MIPS_LOCAL_GOTNO) +++ locgotno=q[1]; +++ if (q[0]==DT_PLTGOT) +++ can_gp=q[1]+0x7ff0; +++ +++ } +++ massert(gotsym && locgotno && can_gp); +++ +++ massert(sec=get_section(".MIPS.stubs",sec1,sece,sn)); +++ stub=sec->sh_addr; +++ stube=sec->sh_addr+sec->sh_size; +++ +++ massert(sec=get_section(".got",sec1,sece,sn)); +++ ggot=sec->sh_addr+locgotno*sec->sh_entsize; +++ ggote=sec->sh_addr+sec->sh_size; +++ +++ for (ds1+=gotsym,sym=ds1;symst_value || (sym->st_value>=stub && sym->st_valuest_value=ggot+(sym-ds1)*sec->sh_entsize; +++ ++ return 0; ++ ++ } ++@@ -13,9 +92,10 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ ++ Rel *r; ++ Sym *sym; ++- Shdr *sec; +++ Shdr *sec,*ssec; ++ void *v,*ve; ++ ul q; +++ struct node *a; ++ ++ for (q=0,sym=sym1;symst_name; ++@@ -29,20 +109,32 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ for (sym=sym1;symst_size=0; ++ ++- for (*gs=0,sec=sec1;secsh_type==SHT_REL) +++ for (*gs=1,sec=sec1;secsh_type==SHT_REL)/*no addend*/ ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++ ++- if (ELF_R_TYPE(r->r_info)==R_MIPS_CALL16|| ++- ELF_R_TYPE(r->r_info)==R_MIPS_GOT16) { +++ if (!(sym=sym1+ELF_R_SYM(r->r_info))->st_size) ++ ++- sym=sym1+ELF_R_SYM(r->r_info); +++ switch(ELF_R_TYPE(r->r_info)) { ++ ++- if (!sym->st_size) ++- sym->st_size=++*gs; +++ case R_MIPS_26: +++ if (((ul)(pagetochar(page(heap_end))+r->r_offset))>>28) { +++ sym->st_size=++*gs; +++ (*gs)+=sizeof(mips_26_tramp)/sizeof(ul)-1; +++ } +++ break; +++ case R_MIPS_CALL16: +++ sym->st_size=++*gs; +++ if (((ssec=sec1+sym->st_shndx)>=sece || !ALLOC_SEC(ssec)) && +++ (a=find_sym_ptable(st1+sym->st_name)) && +++ a->address>=ggot && a->addressst_size=++*gs; +++ break; +++ } ++ ++- } ++- ++ return 0; ++ ++ } ++--- gcl-2.6.12.orig/o/nsocket.c +++++ gcl-2.6.12/o/nsocket.c ++@@ -645,11 +645,11 @@ getCharGclSocket(object strm, object blo ++ { int high; ++ AGAIN: ++ /* under cygwin a too large timout like (1<<30) does not work */ ++- timeout.tv_sec = (block != Ct ? 0 : 0); +++ timeout.tv_sec = 0; ++ timeout.tv_usec = 10000; ++ FD_ZERO(&readfds); ++ FD_SET(fd,&readfds); ++- high = select(fd+1,&readfds,NULL,NULL,&timeout); +++ high = select(fd+1,&readfds,NULL,NULL,block==Ct ? NULL : &timeout); ++ if (high > 0) ++ { object bufp = SOCKET_STREAM_BUFFER(strm); ++ int n; diff --cc debian/patches/Version_2_6_13pre27 index 00000000,00000000..fea955b1 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre27 @@@ -1,0 -1,0 +1,161 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-21) unstable; urgency=medium ++ . ++ * Version_2_6_13pre26 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/h/att_ext.h +++++ gcl-2.6.12/h/att_ext.h ++@@ -217,6 +217,10 @@ frame_ptr frs_sch_catch(); ++ /* gbc.c */ ++ EXTER bool GBC_enable; ++ +++#ifdef CAN_UNRANDOMIZE_SBRK +++EXTER bool gcl_unrandomized; +++#endif +++ ++ /* let.c */ ++ ++ /* lex.c */ ++--- gcl-2.6.12.orig/h/gnuwin95.h +++++ gcl-2.6.12/h/gnuwin95.h ++@@ -7,15 +7,6 @@ ++ #define DBEGIN_TY unsigned long ++ extern DBEGIN_TY _dbegin; ++ ++- ++- ++-/* define if there is no _cleanup, do here what needs ++- to be done before calling unexec ++- */ ++-#define CLEANUP_CODE \ ++- setbuf(stdin,0); \ ++- setbuf(stdout,0); ++- ++ /* size to use for mallocs done */ ++ /* #define BABY_MALLOC_SIZE 0x5000 */ ++ ++--- gcl-2.6.12.orig/h/linux.h +++++ gcl-2.6.12/h/linux.h ++@@ -130,10 +130,6 @@ do { int c = 0; \ ++ ++ #define SET_SESSION_ID() (setpgrp() ? -1 : 0) ++ ++-#define CLEANUP_CODE \ ++- setbuf(stdin,0); \ ++- setbuf(stdout,0); ++- ++ #include ++ #include ++ #define GET_FULL_PATH_SELF(a_) do {\ ++--- gcl-2.6.12.orig/h/mingw.h +++++ gcl-2.6.12/h/mingw.h ++@@ -47,13 +47,6 @@ ++ #define DBEGIN_TY unsigned int ++ extern DBEGIN_TY _stacktop, _stackbottom, _dbegin; ++ ++-/* define if there is no _cleanup, do here what needs ++- to be done before calling unexec ++- */ ++-#define CLEANUP_CODE \ ++- setbuf(stdin,0); \ ++- setbuf(stdout,0); ++- ++ #define NO_SYS_PARAM_H ++ #define NO_SYS_TIMES_H ++ ++--- gcl-2.6.12.orig/o/alloc.c +++++ gcl-2.6.12/o/alloc.c ++@@ -1796,6 +1796,10 @@ malloc(size_t size) { ++ ++ if (!gcl_alloc_initialized) ++ gcl_init_alloc(&size); +++#ifdef CAN_UNRANDOMIZE_SBRK +++ else if (!gcl_unrandomized) +++ return sbrk(size); +++#endif ++ ++ CHECK_INTERRUPT; ++ ++--- gcl-2.6.12.orig/o/main.c +++++ gcl-2.6.12/o/main.c ++@@ -412,16 +412,18 @@ DEFVAR("*CODE-BLOCK-RESERVE*",sSAcode_bl ++ ++ #define HAVE_GCL_CLEANUP ++ +++#ifdef CAN_UNRANDOMIZE_SBRK +++bool gcl_unrandomized=FALSE; +++#endif +++ ++ void ++ gcl_cleanup(int gc) { ++ ++ if (getenv("GCL_WAIT")) ++ sleep(30); ++ ++-#ifdef CLEANUP_CODE ++- CLEANUP_CODE ++-#elif defined(USE_CLEANUP) ++- {extern void _cleanup(void);_cleanup();} +++#if defined(USE_CLEANUP) +++ {extern void _cleanup(void);_cleanup();} ++ #endif ++ ++ #ifdef GCL_GPROF ++@@ -440,6 +442,10 @@ gcl_cleanup(int gc) { ++ cs_org=0; ++ initial_sbrk=core_end; ++ +++#ifdef CAN_UNRANDOMIZE_SBRK +++ gcl_unrandomized=FALSE; +++#endif +++ ++ } ++ ++ close_pool(); ++@@ -450,6 +456,13 @@ gcl_cleanup(int gc) { ++ int ++ main(int argc, char **argv, char **envp) { ++ +++#ifdef CAN_UNRANDOMIZE_SBRK +++#include +++#include +++#include "unrandomize.h" +++ gcl_unrandomized=TRUE; +++#endif +++ ++ gcl_init_alloc(&argv); ++ ++ #ifdef GET_FULL_PATH_SELF ++@@ -465,12 +478,6 @@ main(int argc, char **argv, char **envp) ++ #endif ++ *argv=kcl_self; ++ ++-#ifdef CAN_UNRANDOMIZE_SBRK ++-#include ++-#include ++-#include "unrandomize.h" ++-#endif ++- ++ setbuf(stdin, stdin_buf); ++ setbuf(stdout, stdout_buf); ++ #ifdef _WIN32 diff --cc debian/patches/Version_2_6_13pre28 index 00000000,00000000..563b08d5 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre28 @@@ -1,0 -1,0 +1,353 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-23) unstable; urgency=medium ++ . ++ * Version_2_6_13pre28 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/h/linux.h +++++ gcl-2.6.12/h/linux.h ++@@ -132,20 +132,18 @@ do { int c = 0; \ ++ ++ #include ++ #include ++-#define GET_FULL_PATH_SELF(a_) do {\ ++- char b[20];\ ++- static char q[PATH_MAX];\ ++- struct stat ss;\ ++- if (snprintf(b,sizeof(b),"/proc/%d/exe",getpid())<=0)\ ++- error("Cannot write proc exe pathname");\ ++- if (stat(b,&ss)) \ ++- (a_)=argv[0];\ ++- else {\ ++- if (!realpath(b,q)) \ ++- error("realpath error");\ ++- (a_)=q;\ ++- }\ ++-} while(0) +++#define GET_FULL_PATH_SELF(a_) do { \ +++ static char q[PATH_MAX]; \ +++ const char *s="/proc/self/exe"; \ +++ struct stat ss; \ +++ if (stat(s,&ss)) \ +++ (a_)=argv[0]; \ +++ else { \ +++ if (!realpath(s,q)) \ +++ error("realpath error"); \ +++ (a_)=q; \ +++ } \ +++ } while(0) ++ ++ ++ #define UC(a_) ((ucontext_t *)a_) ++--- gcl-2.6.12.orig/h/unrandomize.h +++++ gcl-2.6.12/h/unrandomize.h ++@@ -23,6 +23,7 @@ ++ int i,j,k; ++ char **n,**a; ++ void *v; +++ argv[0]="/proc/self/exe"; ++ for (i=j=0;argv[i];i++) ++ j+=strlen(argv[i])+1; ++ for (k=0;envp[k];k++) ++--- gcl-2.6.12.orig/o/alloc.c +++++ gcl-2.6.12/o/alloc.c ++@@ -351,7 +351,8 @@ resize_hole(ufixnum hp,enum type tp,bool ++ ++ if (!in_placep && ++ ((new_start<=start && starts.s_dbind != Cnil) +++ emsg("Toggling relblock when resizing hole to %lu\n",hp); ++ tm_table[t_relocatable].tm_adjgbccnt--; ++ GBC(t_relocatable); ++ return resize_hole(hp,tp,in_placep); ++@@ -387,7 +388,8 @@ alloc_page(long n) { ++ d=d<0 ? 0 : d; ++ d=(available_pages/3)s.s_dbind != Cnil) +++ emsg("Hole overrun\n"); ++ ++ resize_hole(d+nn,t_relocatable,0); ++ ++@@ -857,7 +859,8 @@ add_pages(struct typemanager *tm,fixnum ++ case t_relocatable: ++ ++ if (rb_high() && m>((rb_start-heap_end)>>PAGEWIDTH)) { ++- emsg("Moving relblock low before expanding relblock pages\n"); +++ if (sSAnotify_gbcA->s.s_dbind != Cnil) +++ emsg("Moving relblock low before expanding relblock pages\n"); ++ tm_table[t_relocatable].tm_adjgbccnt--; ++ GBC(t_relocatable); ++ } ++@@ -1652,22 +1655,15 @@ DEFUN_NEW("GPROF-QUIT",object,fSgprof_qu ++ if (!gprof_on) ++ return Cnil; ++ ++- if (!getcwd(b,sizeof(b))) ++- FEerror("Cannot get working directory", 0); ++- if (chdir(P_tmpdir)) ++- FEerror("Cannot change directory to tmpdir", 0); +++ massert(getcwd(b,sizeof(b))); +++ massert(!chdir(P_tmpdir)); ++ _mcleanup(); ++- if (snprintf(b1,sizeof(b1),"gprof %s",kcl_self)<=0) ++- FEerror("Cannot write gprof command line", 0); ++- if (!(pp=popen(b1,"r"))) ++- FEerror("Cannot open gprof pipe", 0); +++ massert(snprintf(b1,sizeof(b1),"gprof %s",kcl_self)>0); +++ massert((pp=popen(b1,"r"))); ++ while ((n=fread(b1,1,sizeof(b1),pp))) ++- if (!fwrite(b1,1,n,stdout)) ++- FEerror("Cannot write gprof output",0); ++- if (pclose(pp)<0) ++- FEerror("Cannot close gprof pipe", 0); ++- if (chdir(b)) ++- FEerror("Cannot restore working directory", 0); +++ massert(fwrite(b1,1,n,stdout)); +++ massert(pclose(pp)>=0); +++ massert(!chdir(b)); ++ gprof_on=0; ++ ++ return Cnil; ++@@ -1785,28 +1781,37 @@ static char *baby_malloc(n) ++ ++ bool writable_malloc=0; ++ ++-void * ++-malloc(size_t size) { ++- ++- static bool in_malloc; ++- ++- if (in_malloc) ++- return NULL; ++- in_malloc=1; +++static void * +++malloc_internal(size_t size) { ++ ++- if (!gcl_alloc_initialized) ++- gcl_init_alloc(&size); ++ #ifdef CAN_UNRANDOMIZE_SBRK ++- else if (!gcl_unrandomized) ++- return sbrk(size); +++ if (core_end && core_end!=sbrk(0))/*malloc before main in saved_image*/ +++ return sbrk(size);/*will never get to gcl_init_alloc, so brk point irrelevant*/ ++ #endif ++- +++ if (!gcl_alloc_initialized) { +++ static bool recursive_malloc; +++ if (recursive_malloc) +++ error("Bad malloc"); +++ recursive_malloc=1; +++ gcl_init_alloc(&size); +++ recursive_malloc=0; +++ } +++ ++ CHECK_INTERRUPT; ++ ++ malloc_list = make_cons(alloc_simple_string(size), malloc_list); ++ malloc_list->c.c_car->st.st_self = alloc_contblock(size); ++ malloc_list->c.c_car->st.st_adjustable=writable_malloc; ++ +++ return(malloc_list->c.c_car->st.st_self); +++ +++} +++ +++void * +++malloc(size_t size) { +++ +++ void *v=malloc_internal(size);; +++ ++ /* FIXME: this is just to handle clean freeing of the ++ monstartup memory allocated automatically on raw image ++ startup. In saved images, monstartup memory is only ++@@ -1814,12 +1819,11 @@ malloc(size_t size) { ++ #ifdef GCL_GPROF ++ if (raw_image && size>(textend-textstart) && !initial_monstartup_pointer) { ++ massert(!atexit(gprof_cleanup)); ++- initial_monstartup_pointer=malloc_list->c.c_car->st.st_self; +++ initial_monstartup_pointer=v; ++ } ++ #endif ++ ++- in_malloc=0; ++- return(malloc_list->c.c_car->st.st_self); +++ return v; ++ ++ } ++ ++--- gcl-2.6.12.orig/o/error.c +++++ gcl-2.6.12/o/error.c ++@@ -35,7 +35,7 @@ object sSterminal_interrupt; ++ void ++ assert_error(const char *a,unsigned l,const char *f,const char *n) { ++ ++- if (!raw_image) +++ if (!raw_image && core_end && core_end==sbrk(0)) ++ FEerror("The assertion ~a on line ~a of ~a in function ~a failed",4, ++ make_simple_string(a),make_fixnum(l), ++ make_simple_string(f),make_simple_string(n)); ++--- gcl-2.6.12.orig/o/gbc.c +++++ gcl-2.6.12/o/gbc.c ++@@ -1170,15 +1170,15 @@ GBC(enum type t) { ++ gc_time=0; ++ ++ #ifdef SGC ++- printf("[%s for %ld %s pages..", ++- (sgc_enabled ? "SGC" : "GC"), ++- (sgc_enabled ? sgc_count_type(t) : tm_of(t)->tm_npage), ++- (tm_table[(int)t].tm_name)+1); +++ emsg("[%s for %ld %s pages..", +++ (sgc_enabled ? "SGC" : "GC"), +++ (sgc_enabled ? sgc_count_type(t) : tm_of(t)->tm_npage), +++ (tm_table[(int)t].tm_name)+1); ++ #else ++- printf("[%s for %ld %s pages..", ++- ("GC"), ++- (tm_of(t)->tm_npage), ++- (tm_table[(int)t].tm_name)+1); +++ emsg("[%s for %ld %s pages..", +++ ("GC"), +++ (tm_of(t)->tm_npage), +++ (tm_table[(int)t].tm_name)+1); ++ #endif ++ ++ #ifdef SGC ++@@ -1349,10 +1349,9 @@ GBC(enum type t) { ++ if (sSAnotify_gbcA->s.s_dbind != Cnil) { ++ ++ if (gc_recursive) ++- fprintf(stdout, "(T=...).GC finished]\n"); +++ emsg("(T=...).GC finished]\n"); ++ else ++- fprintf(stdout, "(T=%d).GC finished]\n",gc_start); ++- fflush(stdout); +++ emsg("(T=%d).GC finished]\n",gc_start); ++ ++ } ++ ++--- gcl-2.6.12.orig/o/main.c +++++ gcl-2.6.12/o/main.c ++@@ -205,21 +205,21 @@ get_proc_meminfo_value_in_pages(const ch ++ return n>>(PAGEWIDTH-10); ++ } ++ +++#include +++ ++ static ufixnum ++ get_phys_pages_no_malloc(char freep) { ++ ++- return freep ? ++- get_proc_meminfo_value_in_pages("MemFree:")+ ++- get_proc_meminfo_value_in_pages("Buffers:")+ ++- get_proc_meminfo_value_in_pages("Cached:") : ++- get_proc_meminfo_value_in_pages("MemTotal:"); +++ struct sysinfo s; +++ sysinfo(&s); +++ return (freep ? s.freeram : s.totalram)>>PAGEWIDTH; ++ ++ } ++ ++ #endif ++ ++ static ufixnum ++-get_phys_pages(char freep) { +++get_phys_pages1(char freep) { ++ ++ return get_phys_pages_no_malloc(freep); ++ ++@@ -313,7 +313,7 @@ update_real_maxpage(void) { ++ } ++ massert(!mbrk(cur)); ++ ++- phys_pages=ufmin(get_phys_pages(0)+page(beg),real_maxpage)-page(beg); +++ phys_pages=ufmin(get_phys_pages1(0)+page(beg),real_maxpage)-page(beg); ++ ++ get_gc_environ(); ++ setup_maxpages(mem_multiple); ++@@ -412,10 +412,6 @@ DEFVAR("*CODE-BLOCK-RESERVE*",sSAcode_bl ++ ++ #define HAVE_GCL_CLEANUP ++ ++-#ifdef CAN_UNRANDOMIZE_SBRK ++-bool gcl_unrandomized=FALSE; ++-#endif ++- ++ void ++ gcl_cleanup(int gc) { ++ ++@@ -442,10 +438,6 @@ gcl_cleanup(int gc) { ++ cs_org=0; ++ initial_sbrk=core_end; ++ ++-#ifdef CAN_UNRANDOMIZE_SBRK ++- gcl_unrandomized=FALSE; ++-#endif ++- ++ } ++ ++ close_pool(); ++@@ -460,7 +452,6 @@ main(int argc, char **argv, char **envp) ++ #include ++ #include ++ #include "unrandomize.h" ++- gcl_unrandomized=TRUE; ++ #endif ++ ++ gcl_init_alloc(&argv); ++--- gcl-2.6.12.orig/o/sfaslelf.c +++++ gcl-2.6.12/o/sfaslelf.c ++@@ -181,8 +181,7 @@ relocate(Sym *sym1,void *v,ul a,ul start ++ #include RELOC_H ++ ++ default: ++- emsg("Unknown reloc type %lu\n", tp); ++- massert(tp&~tp); +++ massert(!emsg("Unknown reloc type %lu\n", tp)); ++ ++ } ++ ++--- gcl-2.6.12.orig/o/sgbc.c +++++ gcl-2.6.12/o/sgbc.c ++@@ -789,10 +789,8 @@ sgc_start(void) { ++ sgc_enabled=1; ++ if (memory_protect(1)) ++ sgc_quit(); ++- if (sSAnotify_gbcA->s.s_dbind != Cnil) { ++- printf("[SGC on]"); ++- fflush(stdout); ++- } +++ if (sSAnotify_gbcA->s.s_dbind != Cnil) +++ emsg("[SGC on]"); ++ ++ sSAoptimize_maximum_pagesA->s.s_dbind=omp; ++ ++@@ -826,7 +824,7 @@ sgc_quit(void) { ++ memory_protect(0); ++ ++ if(sSAnotify_gbcA->s.s_dbind != Cnil) ++- printf("[SGC off]"); fflush(stdout); +++ emsg("[SGC off]"); ++ ++ if (sgc_enabled==0) ++ return 0; diff --cc debian/patches/Version_2_6_13pre29 index 00000000,00000000..9752a187 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre29 @@@ -1,0 -1,0 +1,47 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-23) unstable; urgency=medium ++ . ++ * Version_2_6_13pre28 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/o/alloc.c +++++ gcl-2.6.12/o/alloc.c ++@@ -1203,8 +1203,8 @@ object malloc_list=Cnil; ++ ++ void ++ maybe_set_hole_from_maxpages(void) { ++- if (rb_start==heap_end && rb_end==rb_start && rb_limit==rb_start && rb_pointer==rb_start) ++- resize_hole(available_pages/3,t_relocatable,0); +++ if (rb_pointer==rb_begin()) +++ resize_hole(ufmin(phys_pages,available_pages/3),t_relocatable,0); ++ } ++ ++ void ++@@ -1358,7 +1358,7 @@ gcl_init_alloc(void *cs_start) { ++ set_tm_maxpage(tm_table+t_relocatable,1); ++ nrbpage=0; ++ ++- resize_hole(ufmin(phys_pages,available_pages/3),t_relocatable,0); +++ maybe_set_hole_from_maxpages(); ++ #ifdef SGC ++ tm_table[(int)t_relocatable].tm_sgc = 50; ++ #endif diff --cc debian/patches/Version_2_6_13pre3 index 00000000,00000000..e3360795 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre3 @@@ -1,0 -1,0 +1,124 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-3) unstable; urgency=medium ++ . ++ * Version_2_6_13pre2 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/h/protoize.h +++++ gcl-2.6.12/h/protoize.h ++@@ -1938,3 +1938,6 @@ check_avail_pages(void); ++ ++ inline int ++ mbrk(void *); +++ +++void +++maybe_set_hole_from_maxpages(void); ++--- gcl-2.6.12.orig/o/alloc.c +++++ gcl-2.6.12/o/alloc.c ++@@ -259,19 +259,15 @@ eg to add 20 more do (si::set-hole-size ++ ++ holepage -= nn; ++ heap_end=v; ++- return e; ++ +++ } else if (v>(void *)core_end) { +++ +++ massert(!mbrk(v)); +++ core_end=v; +++ ++ } ++- ++- if (nn<=(core_end-heap_end)/PAGESIZE) ++- return(heap_end); ++- ++- if (mbrk(v)) ++- error("Can't allocate. Good-bye!"); ++- ++- core_end=v; ++- ++- return(heap_end); +++ +++ return(e); ++ ++ } ++ ++@@ -1177,6 +1173,15 @@ object malloc_list=Cnil; ++ #include ++ ++ void +++maybe_set_hole_from_maxpages(void) { +++ if (rb_start==heap_end && rb_end==rb_start && rb_limit==rb_start && rb_pointer==rb_start) { +++ holepage=new_holepage; +++ alloc_page(-holepage); +++ rb_start=rb_end=rb_limit=rb_pointer=heap_end+(holepage<s.s_fillp = i; ++ sym->s.s_self = alloc_relblock(i); +++ sym->s.s_fillp = i; ++ i=this_gensym_prefix->st.st_fillp; ++ for (j = 0; j < i; j++) ++ sym->s.s_self[j] = this_gensym_prefix->st.st_self[j]; ++--- gcl-2.6.12.orig/pcl/makefile +++++ gcl-2.6.12/pcl/makefile ++@@ -17,6 +17,7 @@ SETUP='(load "defsys.lisp")' \ ++ '(setq compiler::*default-c-file* t)'\ ++ '(setq compiler::*default-data-file* t)'\ ++ '(setq compiler::*default-system-p* t)' \ +++ '(setq si::*code-block-reserve* (make-array 10000000 :element-type (quote character) :static t) a nil)' \ ++ '(setq compiler::*keep-gaz* t compiler::*tmp-dir* "")' ++ ++ all: $(addsuffix .c,$(AFILES)) $(addsuffix .o,$(AFILES)) diff --cc debian/patches/Version_2_6_13pre30 index 00000000,00000000..20b2b33f new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre30 @@@ -1,0 -1,0 +1,111 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-23) unstable; urgency=medium ++ . ++ * Version_2_6_13pre29 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -4435,6 +4435,10 @@ case $use in ++ # if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi ++ ;; ++ mips*) +++ case $canonical in +++ mips64*linux*) +++ TLIBS="$TLIBS -Wl,-z -Wl,now";; +++ esac ++ # if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 ++ ;; ++ ia64*) ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -640,6 +640,10 @@ case $use in ++ # if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi ++ ;; ++ mips*) +++ case $canonical in +++ mips64*linux*) +++ TLIBS="$TLIBS -Wl,-z -Wl,now";; +++ esac ++ # if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 ++ ;; ++ ia64*) ++--- gcl-2.6.12.orig/h/elf64_mips_reloc_special.h +++++ gcl-2.6.12/h/elf64_mips_reloc_special.h ++@@ -6,18 +6,28 @@ static ul ggot,ggote; static Rela *hr; ++ #define ELF_R_TYPE(a_) (((a_>>40)&0xff) ? ((a_>>40)&0xff) : ((a_>>56)&0xff)) ++ #define ELF_R_FTYPE(a_) ((a_>>56)&0xff) ++ +++typedef struct { +++ ul entry,gotoff; +++ unsigned int ld_gotoff,lw,jr,lwcan; +++} call_16_tramp; +++ ++ static int ++ write_stub(ul s,ul *got,ul *gote) { ++ ++- int *goti; ++- ++- *gote=(ul)(goti=(void *)(gote+2)); ++- *++gote=s; ++- s=((void *)gote-(void *)got); ++- *goti++=(0x37<<26)|(0x1c<<21)|(0x19<<16)|s; ++- *goti++=(0x37<<26)|(0x19<<21)|(0x19<<16)|0; ++- *goti++=0x03200008; ++- *goti++=0x00200825; +++ static call_16_tramp t1={0,0, +++ (0x37<<26)|(0x1c<<21)|(0x19<<16), /*ld t9,(0)gp*/ +++ (0x37<<26)|(0x19<<21)|(0x19<<16), /*ld t9,(0)t9*/ +++ 0x03200008, /*jr t9*/ +++ 0 /*nop*/ +++ }; +++ call_16_tramp *t=(void *)gote; +++ +++ *t=t1; +++ *got=can_gp; +++ +++ t->entry=(ul)(gote+2); +++ t->gotoff=s; +++ t->ld_gotoff|=((void *)(gote+1)-(void *)got); ++ ++ return 0; ++ ++@@ -31,7 +41,7 @@ make_got_room_for_stub(Shdr *sec1,Shdr * ++ if ((ssec>=sece || !ALLOC_SEC(ssec)) && ++ (a=find_sym_ptable(st1+sym->st_name)) && ++ a->address>=ggot && a->address>PAGEWIDTH; +++ return ((freep ? s.freeram : s.totalram)>>PAGEWIDTH)*s.mem_unit; ++ ++ } ++ diff --cc debian/patches/Version_2_6_13pre31 index 00000000,00000000..4ec9d79b new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre31 @@@ -1,0 -1,0 +1,115 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-24) unstable; urgency=medium ++ . ++ * Version_2_6_13pre30 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/h/386-kfreebsd.h +++++ gcl-2.6.12/h/386-kfreebsd.h ++@@ -46,3 +46,4 @@ ++ #define RELOC_H "elf32_i386_reloc.h" ++ ++ #define BRK_DOES_NOT_GUARANTEE_ALLOCATION +++#define FREEBSD ++--- gcl-2.6.12.orig/h/amd64-kfreebsd.h +++++ gcl-2.6.12/h/amd64-kfreebsd.h ++@@ -23,3 +23,4 @@ ++ #define RELOC_H "elf64_i386_reloc.h" ++ ++ #define BRK_DOES_NOT_GUARANTEE_ALLOCATION +++#define FREEBSD ++--- gcl-2.6.12.orig/h/elf64_mips_reloc_special.h +++++ gcl-2.6.12/h/elf64_mips_reloc_special.h ++@@ -23,7 +23,6 @@ write_stub(ul s,ul *got,ul *gote) { ++ call_16_tramp *t=(void *)gote; ++ ++ *t=t1; ++- *got=can_gp; ++ ++ t->entry=(ul)(gote+2); ++ t->gotoff=s; ++--- gcl-2.6.12.orig/o/main.c +++++ gcl-2.6.12/o/main.c ++@@ -152,6 +152,7 @@ mbrk(void *v) { ++ ++ static ufixnum ++ get_phys_pages_no_malloc(char n) { +++ ++ MEMORYSTATUS m; ++ ++ m.dwLength=sizeof(m); ++@@ -166,6 +167,7 @@ get_phys_pages_no_malloc(char n) { ++ ++ static ufixnum ++ get_phys_pages_no_malloc(char n) { +++ ++ uint64_t s; ++ size_t z=sizeof(s); ++ int m[2]={CTL_HW,HW_MEMSIZE}; ++@@ -186,33 +188,30 @@ get_phys_pages_no_malloc(char n) { ++ ++ } ++ ++-#else +++#elif defined(FREEBSD) +++ +++#include +++#include +++ +++static ufixnum +++get_phys_pages_no_malloc(char n) { +++ +++ size_t i,len=sizeof(i); ++ ++-ufixnum ++-get_proc_meminfo_value_in_pages(const char *k) { ++- int l,m; ++- char b[PAGESIZE],*c; ++- ufixnum n; +++ return (sysctlbyname("hw.physmem",&i,&len,NULL,0) ? 0 : i)>>PAGEWIDTH; ++ ++- massert((l=open("/proc/meminfo",O_RDONLY))!=-1); ++- massert((n=read(l,b,sizeof(b)))>(PAGEWIDTH-10); ++ } ++ +++#else /*Linux*/ +++ ++ #include ++ ++ static ufixnum ++ get_phys_pages_no_malloc(char freep) { ++ ++ struct sysinfo s; ++- sysinfo(&s); ++- return ((freep ? s.freeram : s.totalram)>>PAGEWIDTH)*s.mem_unit; +++ +++ return sysinfo(&s) ? 0 : ((freep ? s.freeram : s.totalram)>>PAGEWIDTH)*s.mem_unit; ++ ++ } ++ diff --cc debian/patches/Version_2_6_13pre32 index 00000000,00000000..4c42fbf6 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre32 @@@ -1,0 -1,0 +1,57 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-25) unstable; urgency=medium ++ . ++ * Version_2_6_13pre31, kfreebsd and mips64 FTBFS fix ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/h/elf64_mips_reloc.h +++++ gcl-2.6.12/h/elf64_mips_reloc.h ++@@ -1,6 +1,7 @@ ++ case R_MIPS_JALR: ++ break; ++ case R_MIPS_64: +++ if (ELF_R_FTYPE(r->r_info)==R_MIPS_GPREL32) s-=(ul)got; ++ add_val(where,~0L,s+a); ++ break; ++ case R_MIPS_GPREL32: ++--- gcl-2.6.12.orig/h/elf64_mips_reloc_special.h +++++ gcl-2.6.12/h/elf64_mips_reloc_special.h ++@@ -3,7 +3,7 @@ static ul ggot,ggote; static Rela *hr; ++ #undef ELF_R_SYM ++ #define ELF_R_SYM(a_) (a_&0xffffffff) ++ #undef ELF_R_TYPE ++-#define ELF_R_TYPE(a_) (((a_>>40)&0xff) ? ((a_>>40)&0xff) : ((a_>>56)&0xff)) +++#define ELF_R_TYPE(a_) (((a_>>40)&0xff) ? ((a_>>40)&0xff) : (((a_>>48)&0xff) ? ((a_>>48)&0xff) : ((a_>>56)&0xff))) ++ #define ELF_R_FTYPE(a_) ((a_>>56)&0xff) ++ ++ typedef struct { ++--- gcl-2.6.12.orig/o/main.c +++++ gcl-2.6.12/o/main.c ++@@ -179,7 +179,7 @@ get_phys_pages_no_malloc(char n) { ++ ++ } ++ ++-#elif defined(__sun__) +++#elif defined(__sun__) || defined(__GNU__) ++ ++ static ufixnum ++ get_phys_pages_no_malloc(char n) { diff --cc debian/patches/Version_2_6_13pre33 index 00000000,00000000..3f918464 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre33 @@@ -1,0 -1,0 +1,232 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-26) unstable; urgency=medium ++ . ++ * Version_2_6_13pre32 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp ++@@ -161,7 +161,7 @@ ++ ++ ++ (defun compile-file1 (input-pathname ++- &key (output-file input-pathname) +++ &key (output-file (truename input-pathname)) ++ (o-file t) ++ (c-file *default-c-file*) ++ (h-file *default-h-file*) ++--- gcl-2.6.12.orig/h/elf64_mips_reloc.h +++++ gcl-2.6.12/h/elf64_mips_reloc.h ++@@ -1,18 +1,28 @@ ++ case R_MIPS_JALR: ++ break; ++- case R_MIPS_64: ++- if (ELF_R_FTYPE(r->r_info)==R_MIPS_GPREL32) s-=(ul)got; ++- add_val(where,~0L,s+a); ++- break; ++ case R_MIPS_GPREL32: +++ recurse(s+a-(ul)got); ++ add_val(where,MASK(32),s+a-(ul)got); ++ break; +++ case R_MIPS_GPREL16: +++ recurse(s+a-(ul)got); +++ add_val(where,MASK(16),s+a-(ul)got); +++ break; +++ case R_MIPS_SUB: +++ recurse(-(s+a)); +++ break;/*???*/ +++ case R_MIPS_64: +++ recurse(s+a); +++ add_val(where,~0L,s+a); +++ break; ++ case R_MIPS_32: +++ recurse(s+a); ++ add_val(where,MASK(32),s+a); ++ break; ++ case R_MIPS_GOT_DISP: ++ case R_MIPS_CALL16: ++ case R_MIPS_GOT_PAGE: +++ recurse(s+a); ++ gote=got+(a>>32)-1; ++ a&=MASK(32); ++ store_val(where,MASK(16),((void *)gote-(void *)got)); ++@@ -22,28 +32,27 @@ ++ *gote=s+(a&~MASK(16))+((a&0x8000)<<1); ++ break; ++ case R_MIPS_GOT_OFST: +++ recurse(s+a); ++ store_val(where,MASK(16),a); ++ break; ++ case R_MIPS_HI16: ++- s+=a&MASK(32); ++- if (ELF_R_FTYPE(r->r_info)==R_MIPS_GPREL16) s=(ul)got-s; +++ recurse(s+a); ++ if (!hr) hr=(void *)r; ++- if (a&(1L<<32)) add_vals(where,MASK(16),(s+(a>>32))>>16); +++ if (lr)/*==(Rela *)r*/ +++ add_vals(where,MASK(16),(s+a+la)>>16); ++ break; ++ case R_MIPS_LO16: +++ recurse(s+a); ++ s+=a; ++- if (ELF_R_FTYPE(r->r_info)==R_MIPS_GPREL16) s=(ul)got-s; ++ a=*where&MASK(16); ++ if (a&0x8000) a|=0xffffffffffff0000; ++ a+=s&MASK(16); ++ a+=(a&0x8000)<<1; ++ store_val(where,MASK(16),a); ++- a&=~MASK(16); ++- { ++- Rela *ra=(void *)r; ++- for (hr=hr ? hr : (void *)ra;--ra>=hr;) ++- if (ELF_R_TYPE(ra->r_info)==R_MIPS_HI16) ++- relocate(sym1,ra,ra->r_addend|(1L<<32)|(a<<32),start,got,gote); ++- } ++- hr=NULL; +++ for (la=a&~MASK(16),lr=(Rela *)r,hr=hr ? hr : lr;--lr>=hr;) +++ if (ELF_R_TYPE1(lr->r_info)==R_MIPS_HI16|| +++ ELF_R_TYPE2(lr->r_info)==R_MIPS_HI16|| +++ ELF_R_TYPE3(lr->r_info)==R_MIPS_HI16) +++ relocate(sym1,lr,lr->r_addend,start,got,gote); +++ hr=lr=NULL; ++ break; ++--- gcl-2.6.12.orig/h/elf64_mips_reloc_special.h +++++ gcl-2.6.12/h/elf64_mips_reloc_special.h ++@@ -1,10 +1,21 @@ ++-static ul ggot,ggote; static Rela *hr; +++static ul ggot,ggote,la; static Rela *hr,*lr; ++ ++ #undef ELF_R_SYM ++ #define ELF_R_SYM(a_) (a_&0xffffffff) +++#define ELF_R_TYPE1(a_) ((a_>>56)&0xff) +++#define ELF_R_TYPE2(a_) ((a_>>48)&0xff) +++#define ELF_R_TYPE3(a_) ((a_>>40)&0xff) +++#define recurse(val) ({ \ +++ if (ELF_R_TYPE2(r->r_info)) { \ +++ ul i=r->r_info; \ +++ r->r_info=(((r->r_info>>32)&MASK(24))<<40)|(r->r_info&MASK(32)); \ +++ relocate(sym1,r,(val)-s,start,got,gote); \ +++ r->r_info=i; \ +++ break; \ +++ }}) +++ ++ #undef ELF_R_TYPE ++-#define ELF_R_TYPE(a_) (((a_>>40)&0xff) ? ((a_>>40)&0xff) : (((a_>>48)&0xff) ? ((a_>>48)&0xff) : ((a_>>56)&0xff))) ++-#define ELF_R_FTYPE(a_) ((a_>>56)&0xff) +++#define ELF_R_TYPE(a_) ELF_R_TYPE1(a_) ++ ++ typedef struct { ++ ul entry,gotoff; ++--- gcl-2.6.12.orig/h/object.h +++++ gcl-2.6.12/h/object.h ++@@ -568,6 +568,12 @@ EXTER unsigned plong signals_allowed, si ++ ++ #define IMMNIL(x) (is_imm_fixnum(x)||x==Cnil) ++ ++-#define eql(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (!IMMNIL(_a)&&!IMMNIL(_b)&&eql1(_a,_b));}) ++-#define equal(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (!IMMNIL(_a)&&!IMMNIL(_b)&&equal1(_a,_b));}) ++-#define equalp(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (_a!=Cnil&&_b!=Cnil&&equalp1(_a,_b));}) +++/*gcc boolean expression tail position bug*/ +++ +++/* #define eql(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (!IMMNIL(_a)&&!IMMNIL(_b)&&eql1(_a,_b));}) */ +++/* #define equal(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (!IMMNIL(_a)&&!IMMNIL(_b)&&equal1(_a,_b));}) */ +++/* #define equalp(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (_a!=Cnil&&_b!=Cnil&&equalp1(_a,_b));}) */ +++ +++#define eql(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b ? TRUE : (IMMNIL(_a)||IMMNIL(_b) ? FALSE : eql1(_a,_b));}) +++#define equal(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b ? TRUE : (IMMNIL(_a)||IMMNIL(_b) ? FALSE : equal1(_a,_b));}) +++#define equalp(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b ? TRUE : (_a==Cnil||_b==Cnil ? FALSE : equalp1(_a,_b));}) ++--- gcl-2.6.12.orig/o/main.c +++++ gcl-2.6.12/o/main.c ++@@ -443,6 +443,23 @@ gcl_cleanup(int gc) { ++ ++ } ++ +++/*gcc boolean expression tail position bug*/ +++ +++void * +++cclear_stack(unsigned long size) { +++ void *v=alloca(size); +++ memset(v,0,size); +++ return v; +++} +++ +++DEFUN_NEW("EQUAL-TAIL-RECURSION-CHECK",object,fSequal_tail_recursion_check,SI,1,1,NONE,II,OO,OO,OO,(fixnum s),"") { +++ object x0=make_list(s/sizeof(object)),x1=make_list(s/sizeof(object)); +++ char *u=cclear_stack(s),*w; +++ fLequal(x0,x1); +++ for (w=u;wc.c_car,y->c.c_car)) { ++- x=x->c.c_cdr; ++- y=y->c.c_cdr; ++- if (x==y) return TRUE; ++- if (IMMNIL(x)||IMMNIL(y)) return FALSE; ++- goto BEGIN; ++- } else ++- return FALSE; ++- } ++-#else ++- ++- if (valid_cdr(x)) return valid_cdr(y)&&equal(x->c.c_car,y->c.c_car)&&equal(x->c.c_cdr,y->c.c_cdr); ++- ++-#endif +++ /*gcc boolean expression tail position bug*/ +++ /* if (valid_cdr(x)) return valid_cdr(y)&&equal(x->c.c_car,y->c.c_car)&&equal(x->c.c_cdr,y->c.c_cdr); */ +++ if (valid_cdr(x)) return !valid_cdr(y)||!equal(x->c.c_car,y->c.c_car) ? FALSE : equal(x->c.c_cdr,y->c.c_cdr); ++ ++ if (valid_cdr(y)) return FALSE; ++ ++@@ -524,7 +510,9 @@ equalp1(register object x, register obje ++ ++ /*x and y are not == and not Cnil*/ ++ ++- if (listp(x)) return listp(y)&&equalp(x->c.c_car,y->c.c_car)&&equalp(x->c.c_cdr,y->c.c_cdr); +++ /*gcc boolean expression tail position bug*/ +++ /* if (listp(x)) return listp(y)&&equalp(x->c.c_car,y->c.c_car)&&equalp(x->c.c_cdr,y->c.c_cdr); */ +++ if (listp(x)) return !listp(y)||!equalp(x->c.c_car,y->c.c_car) ? FALSE : equalp(x->c.c_cdr,y->c.c_cdr); ++ ++ if (listp(y)) return FALSE; ++ ++--- gcl-2.6.12.orig/unixport/sys_init.lsp.in +++++ gcl-2.6.12/unixport/sys_init.lsp.in ++@@ -79,3 +79,7 @@ ++ ++ #+ansi-cl (use-package :pcl :user) ++ #+ansi-cl (import 'si::(clines defentry defcfun object void int double quit bye gbc system) :user) +++ +++(let* ((i 4096)(j (si::equal-tail-recursion-check i))) +++ (unless (eql i j) +++ (warn "equal is not tail recursive ~s ~s" i j))) diff --cc debian/patches/Version_2_6_13pre34 index 00000000,00000000..15aa00d9 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre34 @@@ -1,0 -1,0 +1,34 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-27) unstable; urgency=medium ++ . ++ * Version_2_6_13pre33; mips64 relocs; stack saving tail-recursive equal. ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/unixport/sys_init.lsp.in +++++ gcl-2.6.12/unixport/sys_init.lsp.in ++@@ -81,5 +81,5 @@ ++ #+ansi-cl (import 'si::(clines defentry defcfun object void int double quit bye gbc system) :user) ++ ++ (let* ((i 4096)(j (si::equal-tail-recursion-check i))) ++- (unless (eql i j) +++ (unless (<= (ash i -1) j) ++ (warn "equal is not tail recursive ~s ~s" i j))) diff --cc debian/patches/Version_2_6_13pre35 index 00000000,00000000..90ea7eae new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre35 @@@ -1,0 -1,0 +1,40 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-27) unstable; urgency=medium ++ . ++ * Version_2_6_13pre34; mips64 relocs; stack saving tail-recursive equal. ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/o/predicate.c +++++ gcl-2.6.12/o/predicate.c ++@@ -501,6 +501,12 @@ oequal(object x,object y) { ++ DEFUN_NEW("EQUAL",object,fLequal,LISP,2,2,NONE,OO,OO,OO,OO,(object x0,object x1),"") { ++ RETURN1(equal(x0, x1) ? Ct : Cnil); ++ } +++#ifdef STATIC_FUNCTION_POINTERS +++object +++fLequal(object x,object y) { +++ return FFN(fLequal)(x,y); +++} +++#endif ++ ++ bool ++ equalp1(register object x, register object y) { diff --cc debian/patches/Version_2_6_13pre36 index 00000000,00000000..ac9a53ca new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre36 @@@ -1,0 -1,0 +1,89 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-28) unstable; urgency=medium ++ . ++ * Version_2_6_13pre35; restore hppa build ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/o/makefile +++++ gcl-2.6.12/o/makefile ++@@ -34,7 +34,7 @@ boot.o: boot.c $(DECL) boot.h ++ $(CC) -c $(CFLAGS) $(DEFS) -fPIC $*.c $(AUX_INFO) ++ ++ prelink.o: prelink.c $(DECL) ++- $(CC) -fPIE -c $(CFLAGS) $(DEFS) $*.c $(AUX_INFO) +++ $(CC) -fPIE -c $(filter-out -pg,$(CFLAGS)) $(DEFS) $*.c $(AUX_INFO) ++ ++ %.o: %.c $(DECL) ++ $(CC) -c $(CFLAGS) $(DEFS) $*.c $(AUX_INFO) ++--- gcl-2.6.12.orig/o/sfasli.c +++++ gcl-2.6.12/o/sfasli.c ++@@ -111,46 +111,17 @@ LFD(build_symbol_table)(void) { ++ ++ } ++ ++-extern int mcount(); ++-extern int _mcount(); ++-extern int __divdi3(); ++-extern int __moddi3(); ++-extern int __udivdi3(); ++-extern int __umoddi3(); ++-extern void sincos(double,double *,double *); ++-extern int __divsi3(); ++-extern int __modsi3(); ++-extern int __udivsi3(); ++-extern int __umodsi3(); ++-extern int $$divI(); ++-extern int $$divU(); ++-extern int $$remI(); ++-extern int $$remU(); ++-extern int __divq(); ++-extern int __divqu(); ++-extern int __remq(); ++-extern int __remqu(); ++- ++-#ifndef DARWIN ++ #ifndef _WIN32 ++ int ++ use_symbols(double d,...) { ++ ++- sincos(d,&d,&d); ++- ++-#ifdef GCL_GPROF ++- _mcount(); ++-#endif ++- ++- return (int)d; +++#ifndef DARWIN +++ extern void sincos(double,double *,double *); ++ ++-} ++-#endif +++ sincos(d,&d,&d); ++ #else ++-int ++-use_symbols(double d,...) { ++- ++ d=sin(d)+cos(d); +++#endif ++ ++ return (int)d; ++ diff --cc debian/patches/Version_2_6_13pre38 index 00000000,00000000..7feda75d new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre38 @@@ -1,0 -1,0 +1,308 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-29) unstable; urgency=medium ++ . ++ * Version_2_6_13pre35; support latest binutils ++ * Bug fix: "gcl ftbfs on amd64 and i386 with binutils from ++ experimental", thanks to Matthias Klose (Closes: #803214). ++Author: Camm Maguire ++Bug-Debian: https://bugs.debian.org/803214 ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpvs.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpvs.lsp ++@@ -75,8 +75,8 @@ ++ (defun wt-vs* (vs) ++ (wt "(" )(wt-vs vs) (wt "->c.c_car)")) ++ ++-(defun wt-ccb-vs (ccb-vs) ++- (wt "(fun->cc.cc_turbo[" (- *initial-ccb-vs* ccb-vs) "]->c.c_car)")) +++(defun wt-ccb-vs (ccb-vs);;FIXME harmonize *closure-p* with *clink* +++ (wt "(" (if *closure-p* "fun->cc.cc_turbo" "base0") "[" (- *initial-ccb-vs* ccb-vs) "]->c.c_car)")) ++ ++ (defun clink (vs) (setq *clink* vs)) ++ ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -7663,7 +7663,7 @@ fi ++ if test "${enable_ansi+set}" = set; then : ++ enableval=$enable_ansi; ++ else ++- enable_ansi="no" +++ enable_ansi="yes" ++ fi ++ ++ ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -2133,7 +2133,7 @@ AC_ARG_ENABLE(readline, ++ ++ # ansi lisp ++ AC_ARG_ENABLE(ansi,[--enable-ansi builds a large gcl aiming for ansi compliance, ++- --disable-ansi builds the smaller traditional CLtL1 image],,enable_ansi="no") +++ --disable-ansi builds the smaller traditional CLtL1 image],,enable_ansi="yes") ++ ++ if test "$enable_ansi" = "yes" ; then ++ SYSTEM=ansi_gcl ++--- gcl-2.6.12.orig/o/alloc.c +++++ gcl-2.6.12/o/alloc.c ++@@ -1241,7 +1241,7 @@ gcl_init_alloc(void *cs_start) { ++ ++ massert(!getrlimit(RLIMIT_STACK, &rl)); ++ if (rl.rlim_cur!=RLIM_INFINITY && (rl.rlim_max == RLIM_INFINITY || rl.rlim_max > rl.rlim_cur)) { ++- rl.rlim_cur = rl.rlim_max == RLIM_INFINITY ? rl.rlim_max : rl.rlim_max/64; +++ rl.rlim_cur = rl.rlim_max; ++ massert(!setrlimit(RLIMIT_STACK,&rl)); ++ } ++ cssize = rl.rlim_cur/sizeof(*cs_org) - sizeof(*cs_org)*CSGETA; ++--- gcl-2.6.12.orig/o/file.d +++++ gcl-2.6.12/o/file.d ++@@ -2407,17 +2407,18 @@ object x=Cnil; ++ inPort = (myport == Cnil ? 0 : fix(Iis_fixnum(myport))); ++ ++ #ifdef BSD +++ ++ if (isServer && daemon != Cnil) { ++ ++ long pid,i; ++ struct rlimit r; ++- struct sigaction sa; +++ struct sigaction sa,osa; ++ ++ sa.sa_handler=SIG_IGN; ++ sa.sa_flags=SA_NOCLDWAIT; ++ sigemptyset(&sa.sa_mask); ++ ++- sigaction(SIGCHLD,&sa,NULL); +++ massert(!sigaction(SIGCHLD,&sa,&osa)); ++ ++ switch((pid=pfork())) { ++ case -1: ++@@ -2425,8 +2426,7 @@ object x=Cnil; ++ break; ++ case 0: ++ ++- if (setsid()<0) ++- FEerror("setsid error", 0); +++ massert(setsid()>=0); ++ ++ if (daemon == sKpersistent) ++ switch(pfork()) { ++@@ -2440,23 +2440,17 @@ object x=Cnil; ++ break; ++ } ++ +++ massert(!chdir("/")); +++ ++ memset(&r,0,sizeof(r)); ++- if (getrlimit(RLIMIT_NOFILE,&r)) ++- FEerror("Cannot get resourse usage",0); +++ massert(!getrlimit(RLIMIT_NOFILE,&r)); ++ ++ for (i=0;i=0); +++ massert((i=dup(i))>=0); +++ massert((i=dup(i))>=0); ++ ++ umask(0); ++ ++@@ -2473,16 +2467,14 @@ object x=Cnil; ++ ++ FD_ZERO(&fds); ++ FD_SET(fd,&fds); ++- i=select(fd+1,&fds,NULL,NULL,NULL); ++ ++- if (i>0) { +++ if (select(fd+1,&fds,NULL,NULL,NULL)>0) { ++ ++ y=maccept(x); ++ ++- sigaction(SIGCHLD,&sa,NULL); ++- ++ switch((pid=pfork())) { ++ case 0: +++ massert(!sigaction(SIGCHLD,&osa,NULL)); ++ ifuncall1(server,y); ++ exit(0); ++ break; ++@@ -2506,6 +2498,8 @@ object x=Cnil; ++ break; ++ } ++ +++ massert(!sigaction(SIGCHLD,&osa,NULL)); +++ ++ } else ++ ++ #endif ++--- gcl-2.6.12.orig/o/main.c +++++ gcl-2.6.12/o/main.c ++@@ -227,9 +227,9 @@ get_phys_pages1(char freep) { ++ static void ++ get_gc_environ(void) { ++ ++- const char *e;; +++ const char *e; ++ ++- mem_multiple=1.0; +++ mem_multiple=0.85; ++ if ((e=getenv("GCL_MEM_MULTIPLE"))) { ++ massert(sscanf(e,"%lf",&mem_multiple)==1); ++ massert(mem_multiple>=0.0); ++--- gcl-2.6.12.orig/o/nsocket.c +++++ gcl-2.6.12/o/nsocket.c ++@@ -630,50 +630,43 @@ doReverse(char *s, int n) ++ of the buffer may be changed. ++ */ ++ int ++-getCharGclSocket(object strm, object block) ++-{ ++- object bufp = SOCKET_STREAM_BUFFER(strm); ++- if (bufp->ust.ust_fillp > 0) { ++- dprintf("getchar returns (%c)\n",bufp->ust.ust_self[-1+(bufp->ust.ust_fillp)]); +++getCharGclSocket(object strm, object block) { +++ +++ object bufp=SOCKET_STREAM_BUFFER(strm); +++ int fd=SOCKET_STREAM_FD(strm); +++ +++ if (bufp->ust.ust_fillp > 0) ++ return bufp->ust.ust_self[--(bufp->ust.ust_fillp)]; ++- } ++- else { +++ +++ if (fd>=0) { +++ ++ fd_set readfds; ++- struct timeval timeout; ++- int fd = SOCKET_STREAM_FD(strm); ++- if (1) ++- { int high; ++- AGAIN: ++- /* under cygwin a too large timout like (1<<30) does not work */ ++- timeout.tv_sec = 0; ++- timeout.tv_usec = 10000; ++- FD_ZERO(&readfds); ++- FD_SET(fd,&readfds); ++- high = select(fd+1,&readfds,NULL,NULL,block==Ct ? NULL : &timeout); ++- if (high > 0) ++- { object bufp = SOCKET_STREAM_BUFFER(strm); ++- int n; ++- n = SAFE_READ(fd,bufp->st.st_self ,bufp->ust.ust_dim); +++ struct timeval t,t1={0,10000},*tp=block==Ct ? NULL : &t; +++ int high,n; +++ +++ FD_ZERO(&readfds); +++ FD_SET(fd,&readfds); +++ +++ for (;(errno=0,t=t1,high=select(fd+1,&readfds,NULL,NULL,tp))==-1 && !tp && errno==EINTR;); +++ +++ if (high > 0) { +++ +++ massert((n=SAFE_READ(fd,bufp->st.st_self,bufp->ust.ust_dim))>=0); +++ +++ if (n) { ++ doReverse(bufp->st.st_self,n); ++ bufp->ust.ust_fillp=n; ++- if (n > 0) ++- { ++- dprintf("getchar returns (%c)\n",bufp->ust.ust_self[-1+(bufp->ust.ust_fillp)]); ++- return bufp->ust.ust_self[--(bufp->ust.ust_fillp)]; ++- } ++- else ++- { ++- SOCKET_STREAM_FD(strm)=-1; ++- return EOF; ++- FEerror("select said there was stuff there but there was not",0); ++- } ++- } ++- /* probably a signal interrupted us.. */ ++- if (block == Ct) ++- goto AGAIN; ++- return EOF; ++- } +++ } else +++ SOCKET_STREAM_FD(strm)=-1; +++ +++ return getCharGclSocket(strm,block); +++ +++ } +++ ++ } +++ +++ return EOF; +++ ++ } ++ ++ #else ++--- gcl-2.6.12.orig/o/prelink.c +++++ gcl-2.6.12/o/prelink.c ++@@ -7,6 +7,7 @@ extern FILE *stdin __attribute__((weak)) ++ extern FILE *stderr __attribute__((weak)); ++ extern FILE *stdout __attribute__((weak)); ++ +++#ifdef HAVE_READLINE ++ #if RL_READLINE_VERSION < 0x0600 ++ extern Function *rl_completion_entry_function __attribute__((weak)); ++ extern char *rl_readline_name __attribute__((weak)); ++@@ -15,6 +16,7 @@ extern rl_compentry_func_t *rl_completio ++ extern const char *rl_readline_name __attribute__((weak)); ++ #endif ++ #endif +++#endif ++ ++ void ++ prelink_init(void) { ++--- gcl-2.6.12.orig/o/sfasli.c +++++ gcl-2.6.12/o/sfasli.c ++@@ -116,14 +116,20 @@ int ++ use_symbols(double d,...) { ++ ++ #ifndef DARWIN +++ ++ extern void sincos(double,double *,double *); +++ double d2; +++ +++ sincos(d,&d,&d2); ++ ++- sincos(d,&d,&d); ++ #else +++ ++ d=sin(d)+cos(d); +++ d2=sin(d)+cos(d); +++ ++ #endif ++ ++- return (int)d; +++ return (int)(d+d2); ++ ++ } ++ #endif diff --cc debian/patches/Version_2_6_13pre39 index 00000000,00000000..5ffdcd04 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre39 @@@ -1,0 -1,0 +1,53 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-30) unstable; urgency=medium ++ . ++ * Version_2_6_13pre38 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -4379,7 +4379,10 @@ $as_echo "Reducing optimization on profi ++ enable_debug=yes;; ++ esac ++ TCFLAGS="$TCFLAGS -pg"; ++- TLIBS="$TLIBS -pg"; +++ case $use in +++ s390*) ;; # relocation truncation bug in gcc +++ *) TLIBS="$TLIBS -pg";; +++ esac ++ TFPFLAG="" ++ ++ $as_echo "#define GCL_GPROF 1" >>confdefs.h ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -587,7 +587,10 @@ if test "$enable_gprof" = "yes" ; then ++ enable_debug=yes;; ++ esac ++ TCFLAGS="$TCFLAGS -pg"; ++- TLIBS="$TLIBS -pg"; +++ case $use in +++ s390*) ;; # relocation truncation bug in gcc +++ *) TLIBS="$TLIBS -pg";; +++ esac ++ TFPFLAG="" ++ AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) ++ else diff --cc debian/patches/Version_2_6_13pre3a index 00000000,00000000..db3902c5 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre3a @@@ -1,0 -1,0 +1,62 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-4) unstable; urgency=medium ++ . ++ * Version_2_6_13pre3 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/h/bsd.h +++++ gcl-2.6.12/h/bsd.h ++@@ -33,7 +33,7 @@ filecpy(save, original, stsize - sizeof( ++ ++ extern char etext; ++ ++-#define INIT_ALLOC heap_end = core_end = sbrk(0); +++#define INIT_ALLOC heap_end = core_end = PCEI(sbrk(0),PAGESIZE); ++ ++ #define SYM_EXTERNAL_P(sym) ((sym)->n_type & N_EXT) ++ ++--- gcl-2.6.12.orig/o/alloc.c +++++ gcl-2.6.12/o/alloc.c ++@@ -229,9 +229,7 @@ alloc_page(long n) { ++ ++ if (!s) { ++ ++- if (nn>(holepage - (in_signal_handler? 0 : ++- available_pages-n<=reserve_pages_for_signal_handler ? 0 : ++- reserve_pages_for_signal_handler))) { +++ if (nn>holepage) { ++ ++ ++ fixnum d=available_pages-nn; ++@@ -241,12 +239,6 @@ alloc_page(long n) { ++ d=d<0 ? 0 : d; ++ d=new_holepage ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-4) unstable; urgency=medium ++ . ++ * Version_2_6_13pre3a ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/h/elf64_ppcle_reloc_special.h +++++ gcl-2.6.12/h/elf64_ppcle_reloc_special.h ++@@ -15,8 +15,6 @@ find_special_params(void *v,Shdr *sec1,S ++ Shdr *sec; ++ Rela *r; ++ void *ve; ++- ul j,*u; ++- ++ ++ massert((sec=get_section(".rela.plt",sec1,sece,sn))); ++ ++--- gcl-2.6.12.orig/h/page.h +++++ gcl-2.6.12/h/page.h ++@@ -88,7 +88,8 @@ extern int reserve_pages_for_signal_hand ++ /* #define CONT_MARK_PAGE (((page(heap_end)-first_data_page)*(PAGESIZE/(CPTR_SIZE*CHAR_SIZE))+PAGESIZE-1)/PAGESIZE) */ ++ /* #define available_pages ((fixnum)(real_maxpage-page(heap_end)-2*nrbpage-CONT_MARK_PAGE-resv_pages)) */ ++ ++-extern struct pageinfo *cell_list_head,*cell_list_tail,*contblock_list_head,*contblock_list_tail; +++extern struct pageinfo *cell_list_head,*cell_list_tail/* ,*contblock_list_head,*contblock_list_tail */; +++extern object contblock_array; ++ ++ #define PAGE_MAGIC 0x2e ++ ++@@ -114,7 +115,7 @@ EXTER void *data_start,*initial_sbrk; ++ #define CB_BITS CPTR_SIZE*CHAR_SIZE ++ #define ceil(a_,b_) (((a_)+(b_)-1)/(b_)) ++ #define npage(m_) ceil(m_,PAGESIZE) ++-#define cpage(m_) ({ufixnum _m=(m_);ceil(sizeof(struct pageinfo)+_m+2*ceil(_m,(CB_BITS-2)),PAGESIZE);}) +++#define cpage(m_) CEI(({ufixnum _m=(m_);ceil(sizeof(struct pageinfo)+_m+2*ceil(_m,(CB_BITS-2)),PAGESIZE);}),256) ++ #define mbytes(p_) ceil((p_)*PAGESIZE-sizeof(struct pageinfo),CB_BITS) ++ #define tpage(tm_,m_) (tm_->tm_type==t_relocatable ? npage(m_-(rb_limit-rb_pointer)+1) : (tm_->tm_type==t_contiguous ? cpage(m_) : npage(m_))) ++ ++--- gcl-2.6.12.orig/h/protoize.h +++++ gcl-2.6.12/h/protoize.h ++@@ -1941,3 +1941,12 @@ mbrk(void *); ++ ++ void ++ maybe_set_hole_from_maxpages(void); +++ +++void * +++alloc_code_space(size_t); +++ +++object +++fSmake_vector1_2(fixnum,fixnum,object,object); +++ +++inline struct pageinfo * +++get_pageinfo(void *); ++--- gcl-2.6.12.orig/o/alloc.c +++++ gcl-2.6.12/o/alloc.c ++@@ -78,6 +78,72 @@ struct rlimit data_rlimit; ++ #endif ++ #endif ++ +++static inline void * +++bsearchleq(void *i,void *v1,size_t n,size_t s,int (*c)(const void *,const void *)) { +++ +++ ufixnum nn=n>>1; +++ void *v=v1+nn*s; +++ int j=c(i,v); +++ +++ if (nn) +++ return !j ? v : (j>0 ? bsearchleq(i,v,n-nn,s,c) : bsearchleq(i,v1,nn,s,c)); +++ else +++ return j<=0 ? v : v+s; +++ +++} +++ +++ +++object contblock_array=Cnil; +++ +++static inline void +++expand_contblock_array(void) { +++ +++ if (contblock_array==Cnil) { +++ contblock_array=fSmake_vector1_2(16,aet_fix,Cnil,make_fixnum(0)); +++ contblock_array->v.v_self[0]=(object)&cb_pointer; +++ enter_mark_origin(&contblock_array); +++ } +++ +++ if (contblock_array->v.v_fillp==contblock_array->v.v_dim) { +++ +++ void *v=alloc_relblock(2*contblock_array->v.v_dim*sizeof(fixnum)); +++ +++ memcpy(v,contblock_array->v.v_self,contblock_array->v.v_dim*sizeof(fixnum)); +++ contblock_array->v.v_self=v; +++ contblock_array->v.v_dim*=2; +++ +++ } +++ +++} +++ +++static void +++contblock_array_push(void *p) { +++ +++ expand_contblock_array(); +++ contblock_array->v.v_self[contblock_array->v.v_fillp]=p; +++ contblock_array->v.v_fillp++; +++ +++} +++ +++static inline int +++acomp(const void *v1,const void *v2) { +++ +++ void *p1=*(void * const *)v1,*p2=*(void * const *)v2; +++ +++ return p1v.v_self,contblock_array->v.v_fillp,sizeof(*contblock_array->v.v_self),acomp); +++ struct pageinfo *p=(void *)pp>(void *)contblock_array->v.v_self ? pp[-1] : NULL; +++ +++ return p && (void *)p+p->in_use*PAGESIZE>x ? p : NULL; +++ +++} +++ ++ inline void ++ add_page_to_contblock_list(void *p,fixnum m) { ++ ++@@ -89,13 +155,8 @@ add_page_to_contblock_list(void *p,fixnu ++ massert(pp->in_use==m); ++ pp->magic=PAGE_MAGIC; ++ ++- if (contblock_list_head==NULL) ++- contblock_list_tail=contblock_list_head=p; ++- else if (pp > contblock_list_tail) { ++- contblock_list_tail->next=p; ++- contblock_list_tail=p; ++- } ++- +++ contblock_array_push(p); +++ ++ bzero(pagetochar(page(pp)),CB_DATA_START(pp)-(void *)pagetochar(page(pp))); ++ #ifdef SGC ++ if (sgc_enabled && tm_table[t_contiguous].tm_sgc) { ++@@ -458,7 +519,7 @@ rebalance_maxpages(struct typemanager *m ++ for (i=t_start;iv.v_self[0]=(object)&cb_pointer; ++ enter_mark_origin(&cbv); ++ } ++@@ -612,21 +673,6 @@ cbcomp(const void *v1,const void *v2) { ++ ++ } ++ ++-static inline void * ++-bsearchleq(void *i,void *v1,size_t n,size_t s,int (*c)(const void *,const void *)) { ++- ++- ufixnum nn=n>>1; ++- void *v=v1+nn*s; ++- int j=c(i,v); ++- ++- if (nn) ++- return !j ? v : (j>0 ? bsearchleq(i,v,n-nn,s,c) : bsearchleq(i,v1,nn,s,c)); ++- else ++- return j<=0 ? v : v+s; ++- ++-} ++- ++- ++ static inline struct contblock *** ++ find_cbppp(struct contblock *cbp) { ++ ++@@ -777,7 +823,7 @@ grow_linear1(struct typemanager *tm) { ++ static inline int ++ too_full_p(struct typemanager *tm) { ++ ++- fixnum j,k,pf=tm->tm_percent_free ? tm->tm_percent_free : 30; +++ fixnum i,j,k,pf=tm->tm_percent_free ? tm->tm_percent_free : 30; ++ struct contblock *cbp; ++ struct pageinfo *pi; ++ ++@@ -787,11 +833,13 @@ too_full_p(struct typemanager *tm) { ++ break; ++ case t_contiguous: ++ for (cbp=cb_pointer,k=0;cbp;cbp=cbp->cb_link) k+=cbp->cb_size; ++- for (pi=contblock_list_head,j=0;pi;pi=pi->next) +++ for (i=j=0;iv.v_fillp;i++) { +++ pi=(void *)contblock_array->v.v_self[i]; ++ #ifdef SGC ++ if (!sgc_enabled || pi->sgc_flags&SGC_PAGE_FLAG) ++ #endif ++ j+=pi->in_use; +++ } ++ return 100*ktm_maxpage-tm->tm_npage; */ ++ add_pages(tm,m); ++ ++ return alloc_from_freelist(tm,n); ++@@ -997,6 +1042,34 @@ alloc_contblock_no_gc(size_t n) { ++ ++ } ++ +++#ifndef MAX_CODE_ADDRESS +++#define MAX_CODE_ADDRESS -1UL +++#endif +++ +++void * +++alloc_code_space(size_t sz) { +++ +++ void *v; +++ +++ sz=CEI(sz,CPTR_SIZE); +++ +++ if (sSAcode_block_reserveA && +++ sSAcode_block_reserveA->s.s_dbind!=Cnil && sSAcode_block_reserveA->s.s_dbind->st.st_dim>=sz) { +++ +++ v=sSAcode_block_reserveA->s.s_dbind->st.st_self; +++ sSAcode_block_reserveA->s.s_dbind->st.st_self+=sz; +++ sSAcode_block_reserveA->s.s_dbind->st.st_dim-=sz; +++ sSAcode_block_reserveA->s.s_dbind->st.st_fillp=sSAcode_block_reserveA->s.s_dbind->st.st_dim; +++ +++ } else +++ v=alloc_contblock(sz); +++ +++ massert(v && (unsigned long)(v+sz)type==t_contiguous && p+v->in_use*PAGESIZE>x); ++- ++- return p; ++- ++-} ++- ++-/* inline struct pageinfo * */ ++-/* get_pageinfo(void *x) { */ ++-/* struct pageinfo *v=contblock_list_head;void *vv; */ ++-/* for (;(vv=v) && (vv>=x || vv+v->in_use*PAGESIZE<=x);v=v->next); */ ++-/* return v; */ ++-/* } */ ++- ++ inline char ++ get_bit(char *v,struct pageinfo *pi,void *x) { ++ void *ve=CB_DATA_START(pi); ++@@ -811,7 +784,7 @@ mark_stack_carefully(void *topv, void *b ++ ++ for (j=top ; j >= bottom ; j--) { ++ ++- void *v=(void *)(*j),**a; +++ void *v=(void *)(*j); ++ struct pageinfo *pi; ++ ++ if (!VALID_DATA_ADDRESS_P(v)) continue; ++@@ -822,7 +795,7 @@ mark_stack_carefully(void *topv, void *b ++ pi=pagetoinfo(p); ++ if (!pageinfo_p(pi)) continue; ++ ++- if ((a=contblock_stack_list) && in_contblock_stack_list(pi,&a)) continue; +++ if (get_pageinfo(pi)) continue; ++ ++ tm=tm_of(pi->type); ++ if (tm->tm_type>=t_end) continue; ++@@ -1067,14 +1040,24 @@ sweep_phase(void) { ++ static void ++ contblock_sweep_phase(void) { ++ +++ struct pageinfo *v; ++ STATIC char *s, *e, *p, *q; ++- STATIC struct pageinfo *v; +++ object o; +++ ufixnum i; ++ ++ reset_contblock_freelist(); ++- ++- for (v=contblock_list_head;v;v=v->next) { +++ +++ o=sSAleaf_collection_thresholdA->s.s_dbind; +++ sSAleaf_collection_thresholdA->s.s_dbind=make_fixnum(-1); +++ +++ for (i=0;iv.v_fillp && (v=(void *)contblock_array->v.v_self[i]);i++) { +++ ++ bool z; ++ +++#ifdef SGC +++ if (sgc_enabled && !(v->sgc_flags&SGC_PAGE_FLAG)) continue; +++#endif +++ ++ s=CB_DATA_START(v); ++ e=(void *)v+v->in_use*PAGESIZE; ++ ++@@ -1090,14 +1073,9 @@ contblock_sweep_phase(void) { ++ bzero(CB_MARK_START(v),CB_SGCF_START(v)-CB_MARK_START(v)); ++ ++ } ++-#ifdef DEBUG ++- if (debug) { ++- for (cbp = cb_pointer; cbp != NULL; cbp = cbp->cb_link) ++- printf("%lud-byte contblock\n", cbp->cb_size); ++- fflush(stdout); ++- } ++-#endif ++- +++ +++ sSAleaf_collection_thresholdA->s.s_dbind=o; +++ ++ sweep_link_array(); ++ ++ } ++@@ -1143,24 +1121,6 @@ GBC(enum type t) { ++ ++ ngc_thresh=fix(sSAleaf_collection_thresholdA->s.s_dbind); ++ ++- { /*FIXME try to get this below the setjmp in mark_c_stack*/ ++- struct pageinfo *v,*tv; ++- ufixnum i; ++- void *a; ++- ++- for (v=contblock_list_head,contblock_stack_list=NULL;v;v=v->next) ++- for (i=1;iin_use;i++) { ++- tv=pagetoinfo(page(v)+i); ++- if (pageinfo_p(tv)) { ++- a=contblock_stack_list; ++- /* fprintf(stderr,"pushing %p\n",tv); */ ++- contblock_stack_list=alloca(2*sizeof(a)); ++- contblock_stack_list[0]=tv; ++- contblock_stack_list[1]=a; ++- } ++- } ++- } ++- ++ if (in_signal_handler && t == t_relocatable) ++ error("cant gc relocatable in signal handler"); ++ ++@@ -1312,12 +1272,7 @@ GBC(enum type t) { ++ } ++ #endif ++ ++-#ifdef SGC ++- if (sgc_enabled) ++- sgc_contblock_sweep_phase(); ++- else ++-#endif ++- contblock_sweep_phase(); +++ contblock_sweep_phase(); ++ #ifdef DEBUG ++ if (debug) ++ printf("contblock sweep ended (%d)\n", ++@@ -1574,7 +1529,7 @@ mark_contblock(void *p, int s) { ++ sizeof(struct contblock). CM 20030827 */ ++ x = (char *)PFLR(p,CPTR_SIZE); ++ y = (char *)PCEI(q,CPTR_SIZE); ++- v=get_pageinfo(x); +++ massert(v=get_pageinfo(x)); ++ #ifdef SGC ++ if (!sgc_enabled || (v->sgc_flags&SGC_PAGE_FLAG)) ++ #endif ++@@ -1595,7 +1550,7 @@ DEFUN_NEW("CONTIGUOUS-REPORT",object,fSc ++ } ++ fprintf(stderr,"\nTotal free %lu in %lu pieces\n\n",i,j); ++ ++- for (i=j=0,v=contblock_list_head;v;i+=v->in_use,j++,v=v->next) +++ for (i=j=k=0;kv.v_fillp && (v=(void *)contblock_array->v.v_self[k]);k++,i+=v->in_use,j++) ++ fprintf(stderr,"%lu pages at %p\n",(unsigned long)v->in_use,v); ++ fprintf(stderr,"\nTotal pages %lu in %lu pieces\n\n",i,j); ++ ++--- gcl-2.6.12.orig/o/sfaslelf.c +++++ gcl-2.6.12/o/sfaslelf.c ++@@ -242,32 +242,6 @@ relocate_symbols(Sym *sym,Sym *syme,Shdr ++ ++ } ++ ++-#ifndef MAX_CODE_ADDRESS ++-#define MAX_CODE_ADDRESS -1UL ++-#endif ++- ++-static void * ++-alloc_memory(ul sz) { ++- ++- void *v; ++- ++- if (sSAcode_block_reserveA && ++- sSAcode_block_reserveA->s.s_dbind!=Cnil && sSAcode_block_reserveA->s.s_dbind->st.st_dim>=sz) { ++- ++- v=sSAcode_block_reserveA->s.s_dbind->st.st_self; ++- sSAcode_block_reserveA->s.s_dbind->st.st_self+=sz; ++- sSAcode_block_reserveA->s.s_dbind->st.st_dim-=sz; ++- sSAcode_block_reserveA->s.s_dbind->st.st_fillp=sSAcode_block_reserveA->s.s_dbind->st.st_dim; ++- ++- } else ++- v=alloc_contblock(sz); ++- ++- massert(v && (ul)(v+sz)cfd.cfd_size=sz; ++ memory->cfd.cfd_self=0; ++ memory->cfd.cfd_start=0; ++- memory->cfd.cfd_start=alloc_memory(sz); +++ memory->cfd.cfd_start=alloc_code_space(sz); ++ ++ a=(ul)memory->cfd.cfd_start; ++ a=(a+ma)&~ma; ++--- gcl-2.6.12.orig/o/sgbc.c +++++ gcl-2.6.12/o/sgbc.c ++@@ -99,7 +99,7 @@ sgc_mark_phase(void) { ++ ++ /* mark all non recent data on writable contiguous pages */ ++ if (what_to_collect == t_contiguous) ++- for (v=contblock_list_head;v;v=v->next) +++ for (i=0;iv.v_fillp && (v=(void *)contblock_array->v.v_self[i]);i++) ++ if (v->sgc_flags&SGC_PAGE_FLAG) { ++ void *s=CB_DATA_START(v),*e=CB_DATA_END(v),*p,*q; ++ bool z=get_sgc_bit(v,s); ++@@ -213,40 +213,6 @@ sgc_sweep_phase(void) { ++ } ++ } ++ ++- ++-static void ++-sgc_contblock_sweep_phase(void) { ++- ++- STATIC char *s, *e, *p, *q; ++- STATIC struct pageinfo *v; ++- ++- reset_contblock_freelist(); ++- ++- for (v=contblock_list_head;v;v=v->next) { ++- bool z; ++- ++- if (!(v->sgc_flags&SGC_PAGE_FLAG)) continue; ++- ++- s=CB_DATA_START(v); ++- e=CB_DATA_END(v); ++- ++- z=get_mark_bit(v,s); ++- for (p=s;pnext) { +++ for (i=0;iv.v_fillp && (pi=(void *)contblock_array->v.v_self[i]) && countv.v_fillp; ++ ++ if (maxcbpagev.v_fillp); ++ ++- contblock_list_tail->sgc_flags=SGC_PAGE_FLAG; +++ ((struct pageinfo *)contblock_array->v.v_self[fp])->sgc_flags=SGC_PAGE_FLAG; ++ ++ } ++ ++@@ -743,17 +709,19 @@ sgc_start(void) { ++ { ++ ++ struct pageinfo *pi; ++- +++ ufixnum j; +++ ++ { ++ ++ struct contblock **cbpp; ++ void *p=NULL,*pe; ++ struct pageinfo *pi; +++ ufixnum i; ++ ++ old_cb_pointer=cb_pointer; ++ reset_contblock_freelist(); ++ ++- for (pi=contblock_list_head;pi;pi=pi->next) { +++ for (i=0;iv.v_fillp && (pi=(void *)contblock_array->v.v_self[i]);i++) { ++ ++ if (pi->sgc_flags!=SGC_PAGE_FLAG) continue; ++ ++@@ -786,7 +754,7 @@ sgc_start(void) { ++ else ++ tm_of(pi->type)->tm_alt_npage++; ++ } ++- for (pi=contblock_list_head;pi;pi=pi->next)/*FIXME*/ +++ for (j=0;jv.v_fillp && (pi=(void *)contblock_array->v.v_self[j]);j++) ++ if (pi->sgc_flags&SGC_WRITABLE) ++ for (i=0;iin_use;i++) ++ SET_WRITABLE(page(pi)+i); ++@@ -932,7 +900,7 @@ sgc_quit(void) { ++ ((object) p)->d.s=SGC_NORMAL; ++ #endif ++ ++- for (v=contblock_list_head;v;v=v->next) +++ for (i=0;iv.v_fillp &&(v=(void *)contblock_array->v.v_self[i]);i++) ++ if (v->sgc_flags&SGC_PAGE_FLAG) ++ bzero(CB_SGCF_START(v),CB_DATA_START(v)-CB_SGCF_START(v)); ++ ++@@ -940,7 +908,7 @@ sgc_quit(void) { ++ struct pageinfo *pi; ++ for (pi=cell_list_head;pi;pi=pi->next) ++ pi->sgc_flags&=SGC_PERM_WRITABLE; ++- for (pi=contblock_list_head;pi;pi=pi->next) +++ for (i=0;iv.v_fillp &&(pi=(void *)contblock_array->v.v_self[i]);i++) ++ pi->sgc_flags&=SGC_PERM_WRITABLE; ++ } ++ diff --cc debian/patches/Version_2_6_13pre41 index 00000000,00000000..67e553ec new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre41 @@@ -1,0 -1,0 +1,185 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-32) unstable; urgency=medium ++ . ++ * Version_2_6_13pre40 ++ * Bug fix: "[INTL:pt_BR] Brazilian Portuguese debconf templates ++ translation", thanks to Adriano Rafael Gomes (Closes: #811523). ++Author: Camm Maguire ++Bug-Debian: https://bugs.debian.org/811523 ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/h/notcomp.h +++++ gcl-2.6.12/h/notcomp.h ++@@ -300,7 +300,8 @@ gcl_init_cmp_anon(void); ++ ++ #include "gmp_wrappers.h" ++ ++-#define massert(a_) if (!(a_)) assert_error(#a_,__LINE__,__FILE__,__FUNCTION__) +++#include +++#define massert(a_) ({errno=0;if (!(a_)||errno) assert_error(#a_,__LINE__,__FILE__,__FUNCTION__);}) ++ ++ extern bool writable_malloc; ++ #define writable_malloc_wrap(f_,rt_,a_...) ({rt_ v;bool w=writable_malloc;writable_malloc=1;v=f_(a_);writable_malloc=w;v;}) ++--- gcl-2.6.12.orig/lsp/gcl_mislib.lsp +++++ gcl-2.6.12/lsp/gcl_mislib.lsp ++@@ -131,7 +131,7 @@ x)) ++ *gcl-major-version* *gcl-minor-version* *gcl-extra-version* ++ (if (member :ansi-cl *features*) "ANSI" "CLtL1") ++ (if (member :gprof *features*) "profiling" "") ++- (gcl-compile-time) +++ *gcl-release-date* ++ "Source License: LGPL(gcl,gmp), GPL(unexec,bfd,xgcl)" ++ "Binary License: " ++ (if gpled-modules (format nil "GPL due to GPL'ed components: ~a" gpled-modules) ++--- gcl-2.6.12.orig/lsp/gcl_predlib.lsp +++++ gcl-2.6.12/lsp/gcl_predlib.lsp ++@@ -777,6 +777,7 @@ ++ (defvar *gcl-extra-version* nil) ++ (defvar *gcl-minor-version* nil) ++ (defvar *gcl-major-version* nil) +++(defvar *gcl-release-date* nil) ++ ++ (defun warn-version (majvers minvers extvers) ++ (and *gcl-major-version* *gcl-minor-version* *gcl-extra-version* ++--- gcl-2.6.12.orig/makefile +++++ gcl-2.6.12/makefile ++@@ -34,9 +34,9 @@ TESTDIR = ansi-tests ++ ++ VERSION=`cat majvers`.`cat minvers` ++ ++-all: $(BUILD_BFD) system command cmpnew/gcl_collectfn.o lsp/gcl_info.o do-gcl-tk # do-info +++all: $(BUILD_BFD) system command cmpnew/gcl_collectfn.o lsp/gcl_info.o do-gcl-tk release # do-info ++ ++-ASRC:=$(shell ls -1 o/*.c lsp/*.lsp cmpnew/*.lsp mod/*.lsp pcl/*sp clcs/*sp xgcl-2/*p) #o/*.d o/*.h h/*.h +++ASRC:=$(shell ls -1 o/*.c lsp/*.lsp cmpnew/*.lsp pcl/*sp clcs/*sp xgcl-2/*p) #o/*.d o/*.h h/*.h ++ TAGS: $(ASRC) ++ etags --regex='/\#.`(defun[ \n\t]+\([^ \n\t]+\)/' $^ ++ ++@@ -44,6 +44,9 @@ system: $(PORTDIR)/$(FLISP) ++ # [ "$(X_LIBS)" == "" ] || (cd xgcl-2 && make saved_xgcl LISP=../$< && mv saved_xgcl ../$(PORTDIR)/$(FLISP)) ++ touch $@ ++ +++release: majvers minvers +++ date >$@ +++ ++ xgcl: $(PORTDIR)/saved_xgcl ++ ++ $(PORTDIR)/saved_xgcl: $(PORTDIR)/saved_gcl ++--- gcl-2.6.12.orig/o/error.c +++++ gcl-2.6.12/o/error.c ++@@ -27,6 +27,7 @@ Foundation, 675 Mass Ave, Cambridge, MA ++ */ ++ ++ #include +++#include ++ #include "include.h" ++ object siSuniversal_error_handler; ++ ++@@ -36,11 +37,11 @@ void ++ assert_error(const char *a,unsigned l,const char *f,const char *n) { ++ ++ if (!raw_image && core_end && core_end==sbrk(0)) ++- FEerror("The assertion ~a on line ~a of ~a in function ~a failed",4, +++ FEerror("The assertion ~a on line ~a of ~a in function ~a failed: ~a",5, ++ make_simple_string(a),make_fixnum(l), ++- make_simple_string(f),make_simple_string(n)); +++ make_simple_string(f),make_simple_string(n),make_simple_string(strerror(errno))); ++ else { ++- emsg("The assertion %s on line %d of %s in function %s failed",a,l,f,n); +++ emsg("The assertion %s on line %d of %s in function %s failed: %s",a,l,f,n,strerror(errno)); ++ do_gcl_abort(); ++ } ++ ++--- gcl-2.6.12.orig/o/main.c +++++ gcl-2.6.12/o/main.c ++@@ -242,7 +242,7 @@ get_gc_environ(void) { ++ } ++ ++ gc_page_min=0.5; ++- if ((e=getenv("GCL_GC_PAGE_THRESH"))) { +++ if ((e=getenv("GCL_GC_PAGE_MIN"))) { ++ massert(sscanf(e,"%lf",&gc_page_min)==1); ++ massert(gc_page_min>=0.0); ++ } ++@@ -1028,12 +1028,6 @@ DEFUNO_NEW("IDENTITY",object,fLidentity, ++ RETURN1 (x0); ++ } ++ ++-DEFUNO_NEW("GCL-COMPILE-TIME",object,fSgcl_compile_time,SI ++- ,0,0,NONE,OO,OO,OO,OO,void,Lgcl_compile_time,(void),"") ++-{ ++- RETURN1 (make_simple_string(__DATE__ " " __TIME__)); ++-} ++- ++ DEFUNO_NEW("LDB1",object,fSldb1,SI ++ ,3,3,NONE,OI,II,OO,OO,void,Lldb1,(fixnum a,fixnum b, fixnum c),"") ++ { ++--- gcl-2.6.12.orig/o/sfasli.c +++++ gcl-2.6.12/o/sfasli.c ++@@ -115,10 +115,9 @@ LFD(build_symbol_table)(void) { ++ int ++ use_symbols(double d,...) { ++ +++ double d2; ++ #ifndef DARWIN ++- ++ extern void sincos(double,double *,double *); ++- double d2; ++ ++ sincos(d,&d,&d2); ++ ++--- /dev/null +++++ gcl-2.6.12/release ++@@ -0,0 +1 @@ +++Fri Apr 22 15:51:11 UTC 2016 ++--- gcl-2.6.12.orig/unixport/makefile +++++ gcl-2.6.12/unixport/makefile ++@@ -72,10 +72,11 @@ $(LSPDIR)/auto_new.lsp: $(LSPDIR)/auto.l ++ sys_init.lsp: sys_init.lsp.in ++ ++ cat $< | sed \ ++- -e "s#@LI-VERS@#(`cat ../majvers`.`cat ../minvers`) `date`#1" \ +++ -e "s#@LI-VERS@#(`cat ../majvers`.`cat ../minvers`) `cat ../release`#1" \ ++ -e "s#@LI-EXTVERS@#`cat ../minvers | cut -f2 -d.`#1" \ ++ -e "s#@LI-MINVERS@#`cat ../minvers | cut -f1 -d.`#1" \ ++ -e "s#@LI-MAJVERS@#`cat ../majvers`#1" \ +++ -e "s#@LI-RELEASE@#`cat ../release`#1" \ ++ -e "s#@LI-CC@#\"$(CC) -c $(FINAL_CFLAGS)\"#1" \ ++ -e "s#@LI-LD@#\"$(CC) $(LD_FLAGS) -o \"#1" \ ++ -e "s#@LI-LD-LIBS@#\" $(LD_LIBS_PRE) -l$* $(LD_LIBS_POST)\"#1" \ ++--- gcl-2.6.12.orig/unixport/sys_init.lsp.in +++++ gcl-2.6.12/unixport/sys_init.lsp.in ++@@ -51,7 +51,8 @@ ++ ++ (setq *gcl-extra-version* @LI-EXTVERS@ ++ *gcl-minor-version* @LI-MINVERS@ ++- *gcl-major-version* @LI-MAJVERS@) +++ *gcl-major-version* @LI-MAJVERS@ +++ *gcl-release-date* "@LI-RELEASE@") ++ ++ (defvar *system-banner* (default-system-banner)) ++ (setq *optimize-maximum-pages* t) ++@@ -83,3 +84,5 @@ ++ (let* ((i 4096)(j (si::equal-tail-recursion-check i))) ++ (unless (<= (ash i -1) j) ++ (warn "equal is not tail recursive ~s ~s" i j))) +++ +++(format t "~s heap words available~%" (multiple-value-bind (a b c d) (si::heap-report) (/ (- d c) (/ a 8)))) diff --cc debian/patches/Version_2_6_13pre45 index 00000000,00000000..4adb1a28 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre45 @@@ -1,0 -1,0 +1,253 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-34) unstable; urgency=medium ++ . ++ * Version_2_6_13pre45 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2016-09-23 ++ ++--- gcl-2.6.12.orig/h/unrandomize.h +++++ gcl-2.6.12/h/unrandomize.h ++@@ -23,7 +23,6 @@ ++ int i,j,k; ++ char **n,**a; ++ void *v; ++- argv[0]="/proc/self/exe"; ++ for (i=j=0;argv[i];i++) ++ j+=strlen(argv[i])+1; ++ for (k=0;envp[k];k++) ++--- gcl-2.6.12.orig/lsp/gcl_serror.lsp +++++ gcl-2.6.12/lsp/gcl_serror.lsp ++@@ -174,7 +174,7 @@ ++ (format *error-output* "~&If continued: ") ++ (funcall (restart-report-function correctable) *error-output*)) ++ (force-output *error-output*) ++- (break-level condition))) +++ (when *break-enable* (break-level condition)))) ++ ++ ++ (defun dbl-eval (- &aux (break-command t)) ++@@ -186,54 +186,51 @@ ++ (t (setq break-command nil) (evalhook - nil nil *break-env*)))))) ++ (cons break-command val-list))) ++ ++-(defun do-break-level (at env p-e-p debug-level break-level &aux (first t)) +++(defun dbl-rpl-loop (p-e-p) ++ ++- (do nil (nil) ++- ++- (unless ++- (with-simple-restart ++- (abort "Return to debug level ~D." debug-level) ++- (not ++- (catch 'step-continue ++- (let* ((*break-level* break-level) ++- (*break-enable* (unless p-e-p *break-enable*)) ++- (*readtable* (or *break-readtable* *readtable*)) ++- *break-env* *read-suppress*); *error-stack*) ++- ++- (setq +++ ++ ++ + + -) ++- ++- (when first ++- (catch-fatal 1) ++- (setq *interrupt-enable* t first nil) ++- (cond (p-e-p ++- (format *debug-io* "~&~A~2%" at) ++- (set-current) ++- (setq *no-prompt* nil) ++- (show-restarts)) ++- ((set-back at env)))) ++- ++- (if *no-prompt* ++- (setq *no-prompt* nil) ++- (format *debug-io* "~&~a~a>~{~*>~}" ++- (if p-e-p "" "dbl:") ++- (if (eq *package* (find-package 'user)) "" (package-name *package*)) ++- break-level)) ++- (force-output *error-output*) ++- ++- (setq - (dbl-read *debug-io* nil *top-eof*)) ++- (when (eq - *top-eof*) (bye -1)) ++- (let* ((ev (dbl-eval -)) ++- (break-command (car ev)) ++- (values (cdr ev))) ++- (and break-command (eq (car values) :resume)(return)) ++- (setq /// // // / / values *** ** ** * * (car /)) ++- (fresh-line *debug-io*) ++- (dolist (val /) ++- (prin1 val *debug-io*) ++- (terpri *debug-io*))) ++- nil)))) ++- (terpri *debug-io*) ++- (break-current)))) +++ (setq +++ ++ ++ + + -) +++ +++ (if *no-prompt* +++ (setq *no-prompt* nil) +++ (format *debug-io* "~&~a~a>~{~*>~}" +++ (if p-e-p "" "dbl:") +++ (if (eq *package* (find-package 'user)) "" (package-name *package*)) +++ *break-level*)) +++ (force-output *error-output*) +++ +++ (setq - (dbl-read *debug-io* nil *top-eof*)) +++ (when (eq - *top-eof*) (bye -1)) +++ (let* ((ev (dbl-eval -)) +++ (break-command (car ev)) +++ (values (cdr ev))) +++ (unless (and break-command (eq (car values) :resume)) +++ (setq /// // // / / values *** ** ** * * (car /)) +++ (fresh-line *debug-io*) +++ (dolist (val /) +++ (prin1 val *debug-io*) +++ (terpri *debug-io*)) +++ (dbl-rpl-loop p-e-p)))) +++ +++(defun do-break-level (at env p-e-p debug-level); break-level +++ +++ (unless +++ (with-simple-restart +++ (abort "Return to debug level ~D." debug-level) +++ +++ (catch-fatal 1) +++ (setq *interrupt-enable* t) +++ (cond (p-e-p +++ (format *debug-io* "~&~A~2%" at) +++ (set-current) +++ (setq *no-prompt* nil) +++ (show-restarts)) +++ ((set-back at env))) +++ +++ (not (catch 'step-continue (dbl-rpl-loop p-e-p)))) +++ +++ (terpri *debug-io*) +++ (break-current) +++ (do-break-level at env p-e-p debug-level))) ++ ++ ++ (defun break-level (at &optional env) ++@@ -242,10 +239,10 @@ ++ (- -) ++ (* *) (** **) (*** ***) ++ (/ /) (// //) (/// ///) ++- (break-level (if p-e-p (cons t *break-level*) *break-level*)) ++ (debug-level *debug-level*) ++ (*quit-tags* (cons (cons *break-level* *quit-tag*) *quit-tags*)) ++ *quit-tag* +++ (*break-level* (if p-e-p (cons t *break-level*) *break-level*)) ++ (*ihs-base* (1+ *ihs-top*)) ++ (*ihs-top* (ihs-top)) ++ (*frs-base* (or (sch-frs-base *frs-top* *ihs-base*) (1+ (frs-top)))) ++@@ -255,9 +252,11 @@ ++ (*debug-restarts* (compute-restarts)) ++ (*debug-abort* (find-restart 'abort)) ++ (*debug-continue* (find-restart 'continue)) ++- (*abort-restarts* (remove-if-not (lambda (x) (eq 'abort (restart-name x))) *debug-restarts*))) +++ (*abort-restarts* (remove-if-not (lambda (x) (eq 'abort (restart-name x))) *debug-restarts*)) +++ (*readtable* (or *break-readtable* *readtable*)) +++ *break-env* *read-suppress*) ++ ++- (do-break-level at env p-e-p debug-level break-level))) +++ (do-break-level at env p-e-p debug-level))) ++ ++ (putprop 'break-level t 'compiler::cmp-notinline) ++ ++@@ -278,6 +277,6 @@ ++ (setq message "")))) ++ (with-simple-restart ++ (continue "Return from break.") ++- (let ((*break-enable* t)) (break-level message))) +++ (break-level message)) ++ nil) ++ (putprop 'break t 'compiler::cmp-notinline) ++--- gcl-2.6.12.orig/lsp/sys-proclaim.lisp +++++ gcl-2.6.12/lsp/sys-proclaim.lisp ++@@ -4,7 +4,7 @@ ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ ANSI-LOOP::LOOP-EMIT-FINAL-VALUE SYSTEM::INSPECT-CHARACTER ++- SYSTEM::INSPECT-STRUCTURE SYSTEM::PRINT-IHS +++ SYSTEM::INSPECT-STRUCTURE SYSTEM::PRINT-IHS SYSTEM::DBL-RPL-LOOP ++ SYSTEM::RESTART-FUNCTION COMMON-LISP::TANH COMMON-LISP::FIFTH ++ SLOOP::PARSE-LOOP-INITIALLY SYSTEM::NEXT-STACK-FRAME ++ SYSTEM::IDESCRIBE SYSTEM::PROCESS-ARGS SYSTEM::LEAP-YEAR-P ++@@ -268,7 +268,7 @@ ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::T) ++- SLOOP::FIRST-USE-SLOOP-FOR SYSTEM::COERCE-TO-CONDITION +++ SLOOP::FIRST-USE-SLOOP-FOR SYSTEM::COERCE-TO-CONDITION SYSTEM::DO-BREAK-LEVEL ++ SLOOP::FIRST-SLOOP-FOR ANSI-LOOP::LOOP-FOR-ARITHMETIC ++ SYSTEM::MAYBE-BREAK SYSTEM::SETF-STRUCTURE-ACCESS ++ SYSTEM::CALL-TEST SYSTEM::FIND-LINE-IN-FUN)) ++@@ -334,7 +334,7 @@ ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- SYSTEM::MAKE-PREDICATE SYSTEM::DO-BREAK-LEVEL +++ SYSTEM::MAKE-PREDICATE ++ SYSTEM::MAKE-CONSTRUCTOR)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++@@ -519,4 +519,4 @@ ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM) ++ COMMON-LISP::FIXNUM) ++- SYSTEM::ROUND-UP)) ++\ No newline at end of file +++ SYSTEM::ROUND-UP)) ++--- gcl-2.6.12.orig/o/main.c +++++ gcl-2.6.12/o/main.c ++@@ -464,19 +464,12 @@ DEFUN_NEW("EQUAL-TAIL-RECURSION-CHECK",o ++ int ++ main(int argc, char **argv, char **envp) { ++ ++-#ifdef CAN_UNRANDOMIZE_SBRK ++-#include ++-#include ++-#include "unrandomize.h" ++-#endif ++- ++- gcl_init_alloc(&argv); ++- ++ #ifdef GET_FULL_PATH_SELF ++ GET_FULL_PATH_SELF(kcl_self); ++ #else ++ kcl_self = argv[0]; ++ #endif +++ ++ #ifdef __MINGW32__ ++ { ++ char *s=kcl_self; ++@@ -485,6 +478,14 @@ main(int argc, char **argv, char **envp) ++ #endif ++ *argv=kcl_self; ++ +++#ifdef CAN_UNRANDOMIZE_SBRK +++#include +++#include +++#include "unrandomize.h" +++#endif +++ +++ gcl_init_alloc(&argv); +++ ++ setbuf(stdin, stdin_buf); ++ setbuf(stdout, stdout_buf); ++ #ifdef _WIN32 diff --cc debian/patches/Version_2_6_13pre46 index 00000000,00000000..9551eed6 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre46 @@@ -1,0 -1,0 +1,237 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-34) unstable; urgency=medium ++ . ++ * Version_2_6_13pre45 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2016-09-30 ++ ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp ++@@ -28,7 +28,7 @@ ++ ++ ++ (export '(*compile-print* *compile-verbose*)) ++-(import 'si::*tmp-dir* 'compiler) +++(import 'si::(*tmp-dir* *cc* *ld* *objdump*)) ++ (import 'si::*error-p* 'compiler) ++ ++ ;;; This had been true with Linux 1.2.13 a.out or even older ++@@ -85,9 +85,8 @@ ++ (code result) (system (mysub (ts string) "$" "\\$")) ++ (unless (and (zerop code) (zerop result)) ++ (cerror "Continues anyway." ++- "(SYSTEM ~S) returned a non-zero value ~D." ++- string ++- result) +++ "(SYSTEM ~S) returned a non-zero value ~D ~D." +++ string code result) ++ (setq *error-p* t)) ++ (values result))) ++ ++@@ -428,8 +427,8 @@ Cannot compile ~a.~%" ++ (si::copy-stream st *standard-output*)) ++ (with-open-file (st hn) ++ (si::copy-stream st *standard-output*)) ++- (when (zerop (system "which objdump >/dev/null")) ++- (safe-system (si::string-concatenate "objdump --source " (namestring on)))) +++ (when (eql (aref *objdump* 0) #\/);program found at startup in path +++ (safe-system (si::string-concatenate *objdump* (namestring on)))) ++ (mdelete-file cn) ++ (mdelete-file dn) ++ (mdelete-file hn) ++@@ -470,8 +469,6 @@ Cannot compile ~a.~%" ++ (terpri *compiler-output2*))))) ++ ++ ++-(defvar *cc* "cc") ++-(defvar *ld* "ld") ++ (defvar *ld-libs* "ld-libs") ++ (defvar *opt-three* "") ++ (defvar *opt-two* "") ++@@ -489,7 +486,7 @@ Cannot compile ~a.~%" ++ (setq na (namestring ++ (make-pathname :name name :type (pathname-type(first args))))) ++ #+(or dos winnt) ++- (format nil "~a -I~a ~a ~a -c -w ~s -o ~s" +++ (format nil "~a -I~a ~a ~a -c -w ~a -o ~a" ++ *cc* ++ (concatenate 'string si::*system-directory* "../h") ++ (if (and (boundp '*c-debug*) *c-debug*) " -g " "") ++@@ -502,7 +499,7 @@ Cannot compile ~a.~%" ++ ) ++ ++ #-(or dos winnt) ++- (format nil "~a -I~a ~a ~a -c ~s -o ~s ~a" +++ (format nil "~a -I~a ~a ~a -c ~a -o ~a ~a" ++ *cc* ++ (concatenate 'string si::*system-directory* "../h") ++ (if (and (boundp '*c-debug*) *c-debug*) " -g " "") ++--- gcl-2.6.12.orig/h/elf32_mips_reloc_special.h +++++ gcl-2.6.12/h/elf32_mips_reloc_special.h ++@@ -147,3 +147,6 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ (*(a_))->address=p->st_value; \ ++ break; \ ++ }}}) +++ +++#undef LOAD_SYM_BY_NAME +++#define LOAD_SYM_BY_NAME(sym,st1) (!strncmp(st1+sym->st_name,"__moddi3",8)) ++--- gcl-2.6.12.orig/h/notcomp.h +++++ gcl-2.6.12/h/notcomp.h ++@@ -361,7 +361,7 @@ extern bool writable_malloc; ++ #define prof_block(x) x ++ #endif ++ ++-#define psystem(x) prof_block(system(x)) +++#define psystem(x) prof_block(vsystem(x)) ++ #define pfork() prof_block(fork()) ++ ++ #include "error.h" ++--- gcl-2.6.12.orig/lsp/gcl_top.lsp +++++ gcl-2.6.12/lsp/gcl_top.lsp ++@@ -601,9 +601,21 @@ First directory is checked for first nam ++ :device (pathname-device x) ++ :directory (append (pathname-directory x) y))))))))) ++ +++(defun get-path (s &aux (m (string-match "([^/ ]*)( |$)" s))(b (match-beginning 1))(e (match-end 1)) +++ (r (with-open-file (s (concatenate 'string "|which " (subseq s b e))) (read s nil 'eof)))) +++ (if (eq r 'eof) s (concatenate 'string (string-downcase r) (subseq s e)))) +++ +++ +++(defvar *cc* "cc") +++(defvar *ld* "ld") +++(defvar *objdump* "objdump --source ") +++ ++ (defun set-up-top-level (&aux (i (argc)) tem) ++ (declare (fixnum i)) ++- (setq *tmp-dir* (get-temp-dir)) +++ (setq *tmp-dir* (get-temp-dir) +++ *cc* (get-path *cc*) +++ *ld* (get-path *ld*) +++ *objdump* (get-path *objdump*)) ++ (dotimes (j i) (push (argv j) tem)) ++ (setq *command-args* (nreverse tem)) ++ (setq tem *lib-directory*) ++--- gcl-2.6.12.orig/o/file.d +++++ gcl-2.6.12/o/file.d ++@@ -613,7 +613,8 @@ BEGIN: ++ else ++ fclose(strm->sm.sm_fp); ++ strm->sm.sm_fp = NULL; ++- if (type_of(strm->sm.sm_object0 ) == t_cons && +++ if (strm->sm.sm_object0 && +++ type_of(strm->sm.sm_object0 ) == t_cons && ++ Mcar(strm->sm.sm_object0 ) == sSAallow_gzipped_fileA) ++ fLdelete_file(Mcdr(strm->sm.sm_object0)); ++ break; ++--- gcl-2.6.12.orig/o/run_process.c +++++ gcl-2.6.12/o/run_process.c ++@@ -502,6 +502,7 @@ make_socket_pair() ++ stream_in->sm.sm_buffer = 0; ++ stream_in->sm.sm_int0 = sockets_in[1]; ++ stream_in->sm.sm_int1 = 0; +++ stream_in->sm.sm_object0=stream_in->sm.sm_object1=OBJNULL; ++ stream_out = (object) alloc_object(t_stream); ++ stream_out->sm.sm_mode = smm_output; ++ stream_out->sm.sm_fp = fp2; ++@@ -510,6 +511,7 @@ make_socket_pair() ++ setup_stream_buffer(stream_out); ++ stream_out->sm.sm_int0 = sockets_out[1]; ++ stream_out->sm.sm_int1 = 0; +++ stream_out->sm.sm_object0=stream_out->sm.sm_object1=OBJNULL; ++ stream = make_two_way_stream(stream_in, stream_out); ++ return(stream); ++ } ++--- gcl-2.6.12.orig/o/sfaslelf.c +++++ gcl-2.6.12/o/sfaslelf.c ++@@ -54,9 +54,10 @@ License for more details. ++ ++ #define ulmax(a_,b_) ({ul _a=a_,_b=b_;_a<_b ? _b : _a;}) ++ #define ALLOC_SEC(sec) (sec->sh_flags&SHF_ALLOC && (sec->sh_type==SHT_PROGBITS || sec->sh_type==SHT_NOBITS)) ++-#define LOAD_SEC(sec) (sec->sh_flags&SHF_ALLOC && sec->sh_type==SHT_PROGBITS) ++-#define LOAD_SYM(sym) ({ul _b=ELF_ST_BIND(sym->st_info),_t=ELF_ST_TYPE(sym->st_info); \ ++- sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK || (_t>=STT_LOPROC && _t<=STT_HIPROC));}) +++#define LOAD_SEC(sec) (sec->sh_flags&SHF_ALLOC && sec->sh_type==SHT_PROGBITS) +++#define LOAD_SYM_BY_BIND(sym) ({ul _b=ELF_ST_BIND(sym->st_info); sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK);}) +++#define LOAD_SYM_BY_NAME(sym,st1) 0 +++#define LOAD_SYM(sym,st1) (LOAD_SYM_BY_BIND(sym)||LOAD_SYM_BY_NAME(sym,st1)) ++ ++ #define MASK(n) (~(~0ULL << (n))) ++ ++@@ -410,7 +411,7 @@ calc_space(ul *ns,ul *sl,Sym *sym1,Sym * ++ ++ for (sym=sym1;sym ++ #include ++ #include ++- +++#include ++ ++ #include "include.h" ++ +++int +++vsystem(const char *command) { +++ +++ unsigned j,n=strlen(command); +++ char *z=alloca(n+1),**p1,**pp,*c; +++ int s; +++ pid_t pid; +++ +++ memcpy(z,command,n+1); +++ for (j=0,c=z;strtok(c," \n\t");c=NULL,j++); +++ +++ memcpy(z,command,n+1); +++ p1=alloca((j+1)*sizeof(*p1)); +++ for (pp=p1,c=z;(*pp=strtok(c," \n\t"));c=NULL,pp++); +++ +++ if (!(pid=vfork())) { +++ execvp(*p1,p1); +++ _exit(2); +++ } +++ +++ massert(pid>0); +++ massert(pid==waitpid(pid,&s,0)); +++ +++ return s; +++ +++} +++ +++ ++ #ifdef ATT3B2 ++ #include ++ int diff --cc debian/patches/Version_2_6_13pre47 index 00000000,00000000..ba92ac2b new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre47 @@@ -1,0 -1,0 +1,36 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-35) unstable; urgency=medium ++ . ++ * Version_2_6_13pre46 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2016-09-30 ++ ++--- gcl-2.6.12.orig/o/main.c +++++ gcl-2.6.12/o/main.c ++@@ -229,7 +229,7 @@ get_gc_environ(void) { ++ ++ const char *e; ++ ++- mem_multiple=0.85; +++ mem_multiple=1.0; ++ if ((e=getenv("GCL_MEM_MULTIPLE"))) { ++ massert(sscanf(e,"%lf",&mem_multiple)==1); ++ massert(mem_multiple>=0.0); diff --cc debian/patches/Version_2_6_13pre48 index 00000000,00000000..e3a07616 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre48 @@@ -1,0 -1,0 +1,59 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-35) unstable; urgency=medium ++ . ++ * Version_2_6_13pre47 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2016-10-01 ++ ++--- gcl-2.6.12.orig/h/elf32_hppa_reloc_special.h +++++ gcl-2.6.12/h/elf32_hppa_reloc_special.h ++@@ -39,3 +39,6 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ return 0; ++ ++ } +++ +++#undef LOAD_SYM_BY_NAME +++#define LOAD_SYM_BY_NAME(sym,st1) (!strncmp(st1+sym->st_name,"$$dyncall",8)) ++--- gcl-2.6.12.orig/o/unixsys.c +++++ gcl-2.6.12/o/unixsys.c ++@@ -31,16 +31,16 @@ Foundation, 675 Mass Ave, Cambridge, MA ++ int ++ vsystem(const char *command) { ++ ++- unsigned j,n=strlen(command); ++- char *z=alloca(n+1),**p1,**pp,*c; +++ unsigned j,n=strlen(command)+1; +++ char *z=alloca(n),**p1,**pp,*c; ++ int s; ++ pid_t pid; ++ ++- memcpy(z,command,n+1); ++- for (j=0,c=z;strtok(c," \n\t");c=NULL,j++); +++ memcpy(z,command,n); +++ for (j=1,c=z;strtok(c," \n\t");c=NULL,j++); ++ ++- memcpy(z,command,n+1); ++- p1=alloca((j+1)*sizeof(*p1)); +++ memcpy(z,command,n); +++ p1=alloca(j*sizeof(*p1)); ++ for (pp=p1,c=z;(*pp=strtok(c," \n\t"));c=NULL,pp++); ++ ++ if (!(pid=vfork())) { diff --cc debian/patches/Version_2_6_13pre49 index 00000000,00000000..74117076 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre49 @@@ -1,0 -1,0 +1,33 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-36) unstable; urgency=medium ++ . ++ * Version_2_6_13pre48 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2016-10-03 ++ ++--- gcl-2.6.12.orig/h/elf32_hppa_reloc_special.h +++++ gcl-2.6.12/h/elf32_hppa_reloc_special.h ++@@ -41,4 +41,4 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ } ++ ++ #undef LOAD_SYM_BY_NAME ++-#define LOAD_SYM_BY_NAME(sym,st1) (!strncmp(st1+sym->st_name,"$$dyncall",8)) +++#define LOAD_SYM_BY_NAME(sym,st1) (!strncmp(st1+sym->st_name,"$$",2)) diff --cc debian/patches/Version_2_6_13pre5 index 00000000,00000000..b1643483 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre5 @@@ -1,0 -1,0 +1,83 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-5) unstable; urgency=medium ++ . ++ * Version_2_6_13pre4 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/h/page.h +++++ gcl-2.6.12/h/page.h ++@@ -85,10 +85,8 @@ extern int sgc_enabled; ++ ++ extern long resv_pages; ++ extern int reserve_pages_for_signal_handler; ++-/* #define CONT_MARK_PAGE (((page(heap_end)-first_data_page)*(PAGESIZE/(CPTR_SIZE*CHAR_SIZE))+PAGESIZE-1)/PAGESIZE) */ ++-/* #define available_pages ((fixnum)(real_maxpage-page(heap_end)-2*nrbpage-CONT_MARK_PAGE-resv_pages)) */ ++ ++-extern struct pageinfo *cell_list_head,*cell_list_tail/* ,*contblock_list_head,*contblock_list_tail */; +++extern struct pageinfo *cell_list_head,*cell_list_tail; ++ extern object contblock_array; ++ ++ #define PAGE_MAGIC 0x2e ++--- gcl-2.6.12.orig/o/alloc.c +++++ gcl-2.6.12/o/alloc.c ++@@ -506,31 +506,25 @@ rebalance_maxpages(struct typemanager *m ++ ++ if (j+d>phys_pages) { ++ ++- ufixnum k=0; +++ ufixnum k,e=j+d-phys_pages; +++ double f; ++ ++- for (i=t_start;ik+phys_pages-j ? k+phys_pages-j : d; ++- if (d<=0) +++ e=e>k ? k : e; +++ if (e+phys_pages-j<=0) ++ return 0; ++ +++ f=1.0-(double)e/k; +++ ++ for (i=t_start;i((double)phys_pages/(j+d))*(tm_table+i==my_tm ? z : tm_table[i].tm_maxpage)) */ ++- /* return 0; */ ++- /* for (i=t_start;itm_maxpage+(phys_pages-sum_maxpages()))/(my_tm->tm_type==t_relocatable ? 2 : 1))); ++ ++ return 1; ++ diff --cc debian/patches/Version_2_6_13pre50 index 00000000,00000000..e17b6272 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre50 @@@ -1,0 -1,0 +1,223 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-37) unstable; urgency=medium ++ . ++ * Version_2_6_13pre49 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2016-10-04 ++ ++--- gcl-2.6.12.orig/o/array.c +++++ gcl-2.6.12/o/array.c ++@@ -850,31 +850,33 @@ raw_aet_ptr(object x, short int typ) ++ */ ++ ++ void ++-gset(void *p1, void *val, int n, int typ) ++-{ if (val==0) +++gset(void *p1, void *val, int n, int typ) { +++ +++ if (val==0) ++ val = aet_types[typ].dflt; ++- switch (typ){ +++ +++ switch (typ){ ++ ++ #define GSET(p,n,typ,val) {typ x = *((typ *) val); GSET1(p,n,typ,x)} ++-#define GSET1(p,n,typ,val) while (n-- > 0) \ +++#define GSET1(p,n,typ,val) while (n-- > 0) \ ++ { *((typ *) p) = val; \ ++- p = p + sizeof(typ); \ ++- } break; +++ p = p + sizeof(typ); \ +++ } break; ++ ++- case aet_object: GSET(p1,n,object,val); ++- case aet_ch: GSET(p1,n,char,val); ++- /* Note n is number of fixnum WORDS for bit */ ++- case aet_bit: GSET(p1,n,fixnum,val); ++- case aet_fix: GSET(p1,n,fixnum,val); ++- case aet_sf: GSET(p1,n,shortfloat,val); ++- case aet_lf: GSET(p1,n,longfloat,val); ++- case aet_char: GSET(p1,n,char,val); ++- case aet_uchar: GSET(p1,n,unsigned char,val); ++- case aet_short: GSET(p1,n,short,val); ++- case aet_ushort: GSET(p1,n,unsigned short,val); ++- default: FEerror("bad elttype",0); ++- } +++ case aet_object: GSET(p1,n,object,val); +++ case aet_ch: GSET(p1,n,char,val); +++ /* Note n is number of fixnum WORDS for bit */ +++ case aet_bit: GSET(p1,n,fixnum,val); +++ case aet_fix: GSET(p1,n,fixnum,val); +++ case aet_sf: GSET(p1,n,shortfloat,val); +++ case aet_lf: GSET(p1,n,longfloat,val); +++ case aet_char: GSET(p1,n,char,val); +++ case aet_uchar: GSET(p1,n,unsigned char,val); +++ case aet_short: GSET(p1,n,short,val); +++ case aet_ushort: GSET(p1,n,unsigned short,val); +++ default: FEerror("bad elttype",0); ++ } +++} ++ ++ ++ #define W_SIZE (BV_BITS*sizeof(fixnum)) ++@@ -894,38 +896,43 @@ implementation dependent results.") ++ int n1=fix(n1o),nc; ++ if (VFUN_NARGS==4) ++ { n1 = x->v.v_dim - i1;} ++- if (typ1==aet_bit) ++- {if (i1 % CHAR_SIZE) ++- badcopy: ++- FEerror("Bit copies only if aligned",0); ++- else ++- {int rest=n1%CHAR_SIZE; ++- if (rest!=0 ) ++- {if (typ2!=aet_bit) ++- goto badcopy; ++- {while(rest> 0) ++- { fSaset1(y,i2+n1-rest,(fLrow_major_aref(x,i1+n1-rest))); ++- rest--;} ++- }} ++- i1=i1/CHAR_SIZE ; ++- n1=n1/CHAR_SIZE; ++- typ1=aet_char; ++- }}; ++- if (typ2==aet_bit) ++- {if (i2 % CHAR_SIZE) ++- goto badcopy; ++- i2=i2/CHAR_SIZE ;} ++- if ((typ1 ==aet_object || ++- typ2 ==aet_object) && typ1 != typ2) +++ if (typ1==aet_bit) { +++ if (i1 % CHAR_SIZE) +++ badcopy: +++ FEerror("Bit copies only if aligned",0); +++ else { +++ int rest=n1%CHAR_SIZE; +++ if (rest!=0) { +++ if (typ2!=aet_bit) +++ goto badcopy; +++ while(rest> 0) { +++ fSaset1(y,i2+n1-rest,(fLrow_major_aref(x,i1+n1-rest))); +++ rest--; +++ } +++ } +++ i1=i1/CHAR_SIZE ; +++ n1=n1/CHAR_SIZE; +++ typ1=aet_char; +++ } +++ } +++ +++ if (typ2==aet_bit) { +++ if (i2 % CHAR_SIZE) +++ goto badcopy; +++ i2=i2/CHAR_SIZE ; +++ } +++ +++ if ((typ1 ==aet_object || typ2 ==aet_object) && typ1 != typ2) ++ FEerror("Can't copy between different array types",0); ++ nc=n1 * aet_sizes[(int)typ1]; ++- if (i1+n1 > x->a.a_dim ++- || ((y->a.a_dim - i2) *aet_sizes[(int)typ2]) < nc) +++ if (i1+n1 > x->a.a_dim || ((y->a.a_dim - i2) *aet_sizes[(int)typ2]) < nc) ++ FEerror("Copy out of bounds",0); ++ bcopy(x->ust.ust_self + (i1*aet_sizes[(int)typ1]), ++ y->ust.ust_self + (i2*aet_sizes[(int)typ2]), ++ nc); +++ ++ return x; +++ ++ } ++ ++ /* X is the header of an array. This supplies the body which ++--- gcl-2.6.12.orig/o/predicate.c +++++ gcl-2.6.12/o/predicate.c ++@@ -744,14 +744,13 @@ BEGIN: ++ if (tx == t_complex) ++ return(contains_sharp_comma(x->cmp.cmp_real) || ++ contains_sharp_comma(x->cmp.cmp_imag)); ++- if (tx == t_vector) ++- { ++- int i; ++- if (x->v.v_elttype == aet_object) ++- for (i = 0; i < x->v.v_fillp; i++) ++- if (contains_sharp_comma(x->v.v_self[i])) ++- return(TRUE); ++- return(FALSE); +++ if (tx == t_vector) { +++ int i; +++ if (x->v.v_elttype == aet_object) +++ for (i = 0; i < x->v.v_fillp; i++) +++ if (contains_sharp_comma(x->v.v_self[i])) +++ return(TRUE); +++ return(FALSE); ++ } ++ if (tx == t_cons) { ++ if (x->c.c_car == siSsharp_comma) ++--- gcl-2.6.12.orig/o/unixsys.c +++++ gcl-2.6.12/o/unixsys.c ++@@ -32,25 +32,39 @@ int ++ vsystem(const char *command) { ++ ++ unsigned j,n=strlen(command)+1; ++- char *z=alloca(n),**p1,**pp,*c; +++ char *z,*c; +++ const char *x1[]={"/bin/sh","-c",NULL,NULL},*spc=" \n\t",**p1,**pp; ++ int s; ++ pid_t pid; ++ ++- memcpy(z,command,n); ++- for (j=1,c=z;strtok(c," \n\t");c=NULL,j++); +++ if (strpbrk(command,"\"'$<>")) ++ ++- memcpy(z,command,n); ++- p1=alloca(j*sizeof(*p1)); ++- for (pp=p1,c=z;(*pp=strtok(c," \n\t"));c=NULL,pp++); +++ (p1=x1)[2]=command; +++ +++ else { +++ +++ z=alloca(n); +++ memcpy(z,command,n); +++ for (j=1,c=z;strtok(c,spc);c=NULL,j++); +++ +++ memcpy(z,command,n); +++ p1=alloca(j*sizeof(*p1)); +++ for (pp=p1,c=z;(*pp=strtok(c,spc));c=NULL,pp++); +++ +++ } ++ ++ if (!(pid=vfork())) { ++- execvp(*p1,p1); ++- _exit(2); +++ errno=0; +++ execvp(*p1,(void *)p1); +++ _exit(128|(errno&0x7f)); ++ } ++ ++ massert(pid>0); ++ massert(pid==waitpid(pid,&s,0)); ++ +++ if ((s>>8)&128) +++ emsg("execvp failure when executing '%s': %s\n",command,strerror((s>>8)&0x7f)); +++ ++ return s; ++ ++ } diff --cc debian/patches/Version_2_6_13pre52 index 00000000,00000000..ea69e84b new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre52 @@@ -1,0 -1,0 +1,36 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-65) unstable; urgency=medium ++ . ++ * list_order.25 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-02-22 ++ ++--- gcl-2.6.12.orig/makefile +++++ gcl-2.6.12/makefile ++@@ -149,7 +149,7 @@ command: ++ merge: ++ $(CC) -o merge merge.c ++ ++-LISP_LIB=cmpnew/gcl_collectfn.o cmpnew/gcl_collectfn.lsp xgcl-2/sysdef.lisp xgcl-2/gcl_dwtest.lsp xgcl-2/gcl_dwtestcases.lsp lsp/gcl_gprof.lsp lsp/gcl_info.o lsp/gcl_profile.lsp lsp/gcl_export.lsp lsp/gcl_autoload.lsp cmpnew/gcl_cmpmain.lsp cmpnew/gcl_cmpopt.lsp cmpnew/gcl_lfun_list.lsp lsp/gcl_auto_new.lsp h/cmpinclude.h unixport/sys_init.lsp unixport/lib$(SYSTEM).a unixport/libgclp.a gcl-tk/tk-package.lsp $(TK_LISP_LIB) $(RL_LIB) $(FIRST_FILE) $(LAST_FILE) $(addsuffix /sys-proclaim.lisp,lsp cmpnew pcl clcs) unixport/gcl.script +++LISP_LIB=cmpnew/gcl_collectfn.o cmpnew/gcl_collectfn.lsp xgcl-2/package.lisp pcl/package.lisp clcs/package.lisp xgcl-2/sysdef.lisp xgcl-2/gcl_dwtest.lsp xgcl-2/gcl_dwtestcases.lsp lsp/gcl_gprof.lsp lsp/gcl_info.o lsp/gcl_profile.lsp lsp/gcl_export.lsp lsp/gcl_autoload.lsp cmpnew/gcl_cmpmain.lsp cmpnew/gcl_cmpopt.lsp cmpnew/gcl_lfun_list.lsp lsp/gcl_auto_new.lsp h/cmpinclude.h unixport/sys_init.lsp unixport/lib$(SYSTEM).a unixport/libgclp.a gcl-tk/tk-package.lsp $(TK_LISP_LIB) $(RL_LIB) $(FIRST_FILE) $(LAST_FILE) $(addsuffix /sys-proclaim.lisp,lsp cmpnew xgcl-2 pcl clcs) unixport/gcl.script ++ ++ install-command: ++ rm -f $(DESTDIR)$(prefix)/bin/gcl diff --cc debian/patches/Version_2_6_13pre54 index 00000000,00000000..d5d69f71 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre54 @@@ -1,0 -1,0 +1,2878 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-65) unstable; urgency=medium ++ . ++ * Version_2_6_13pre52 ++ * Bug fix: "FTBFS on hurd-i386", thanks to svante.signell@gmail.com; ++ (Closes: #802593). ++Author: Camm Maguire ++Bug-Debian: https://bugs.debian.org/802593 ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-03-02 ++ ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpenv.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpenv.lsp ++@@ -49,7 +49,6 @@ ++ (setq *reservations* nil) ++ (setq *closures* nil) ++ (setq *top-level-forms* nil) ++- (setq *non-package-operation* nil) ++ (setq *function-declarations* nil) ++ (setq *inline-functions* nil) ++ (setq *inline-blocks* 0) ++@@ -71,12 +70,10 @@ ++ (defun add-symbol (symbol) (add-object symbol)) ++ ++ (defun add-object2 (object) ++- (let* ((init (when (si::contains-sharp-comma object) ++- (if (when (consp object) (eq (car object) 'si::|#,|)) ++- (cdr object) (si::string-to-object (wt-to-string object))))) +++ (let* ((init (if (when (consp object) (eq (car object) '|#,|)) (cdr object) `',object)) ++ (object (if (when (consp init) (eq (car init) 'si::nani)) (si::nani (cadr init)) object))) ++ (cond ((gethash object *objects*)) ++- ((push-data-incf (unless init object)) +++ ((push-data-incf nil) ++ (when init (add-init `(si::setvv ,*next-vv* ,init))) ++ (setf (gethash object *objects*) *next-vv*))))) ++ ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp ++@@ -180,7 +180,7 @@ ++ (*compile-print* (or print *compile-print*)) ++ (*package* *package*) ++ (*DEFAULT-PATHNAME-DEFAULTS* #p"") ++- (*data* (list (make-array 50 :fill-pointer 0 :adjustable t) nil nil)) +++ (*data* (list nil)) ++ *init-name* ++ (*fasd-data* *fasd-data*) ++ (*error-count* 0)) ++@@ -281,10 +281,8 @@ Cannot compile ~a.~%" ++ (if (consp *split-files*) ++ (dolist (v (fourth *split-files*)) (t1expr v))) ++ (unwind-protect ++- (do ((form (read *compiler-input* nil eof) ++- (read *compiler-input* nil eof)) ++- (load-flag (or (eq :defaults *eval-when-defaults*) ++- (member 'load *eval-when-defaults*)))) +++ (do ((form (read *compiler-input* nil eof)(read *compiler-input* nil eof)) +++ (load-flag (if *eval-when-defaults* (member 'load *eval-when-defaults*) t))) ++ (nil) ++ (cond ++ ((eq form eof)) ++@@ -292,7 +290,7 @@ Cannot compile ~a.~%" ++ ((maybe-eval nil form))) ++ (cond ++ ((and *split-files* (check-end form eof)) ++- (setf (fourth *split-files*) (reverse (third *data*))) +++ (setf (fourth *split-files*) nil);(reverse (third *data*)) ;FIXME check this ++ (return nil)) ++ ((eq form eof) (return nil)))) ++ ++--- gcl-2.6.12.orig/cmpnew/gcl_cmptop.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmptop.lsp ++@@ -72,7 +72,6 @@ ++ ++ ++ (defvar *top-level-forms* nil) ++-(defvar *non-package-operation* nil) ++ ++ ;;; *top-level-forms* holds ( { top-level-form }* ). ++ ;;; ++@@ -99,18 +98,7 @@ ++ ++ ;;; Package operations. ++ ++-(si:putprop 'make-package t 'package-operation) ++-(si:putprop 'in-package t 'package-operation) ++-(si:putprop 'shadow t 'package-operation) ++-(si:putprop 'shadowing-import t 'package-operation) ++-(si:putprop 'export t 'package-operation) ++-(si:putprop 'unexport t 'package-operation) ++-(si:putprop 'use-package t 'package-operation) ++-(si:putprop 'unuse-package t 'package-operation) ++-(si:putprop 'import t 'package-operation) ++-(si:putprop 'provide t 'package-operation) ++-(si:putprop 'require t 'package-operation) ++-(si:putprop 'defpackage:defpackage t 'package-operation) +++(si:putprop 'in-package t 'eval-at-compile) ++ ++ ;;; Pass 1 top-levels. ++ ++@@ -135,6 +123,7 @@ ++ ;;; Pass 2 initializers. ++ ++ (si:putprop 'defun 't2defun 't2) +++(si:putprop 'progn 't2progn 't2) ++ (si:putprop 'declare 't2declare 't2) ++ (si:putprop 'defentry 't2defentry 't2) ++ (si:putprop 'si:putprop 't2putprop 't2) ++@@ -142,6 +131,7 @@ ++ ;;; Pass 2 C function generators. ++ ++ (si:putprop 'defun 't3defun 't3) +++(si:putprop 'progn 't3progn 't3) ++ (si:putprop 'ordinary 't3ordinary 't3) ++ (si:putprop 'sharp-comma 't3sharp-comma 't3) ++ (si:putprop 'clines 't3clines 't3) ++@@ -242,15 +232,6 @@ ++ ((symbolp fun) ++ (cond ((eq fun 'si:|#,|) ++ (cmperr "Sharp-comma-macro is in a bad place.")) ++- ((get fun 'package-operation) ++- (when *non-package-operation* ++- (cmpwarn "The package operation ~s was in a bad place." ++- form)) ++- (let ((res (if (setq fd (macro-function fun)) ++- (cmp-expand-macro fd fun (copy-list (cdr form))) ++- form))) ++- (maybe-eval t res) ++- (wt-data-package-operation res))) ++ ((setq fd (get fun 't1)) ++ (when *compile-print* (print-current-form)) ++ (funcall fd args)) ++@@ -278,11 +259,24 @@ ++ (defvar *vaddress-list*) ;; hold addresses of C functions, and other data ++ (defvar *vind*) ;; index in the VV array where the address is. ++ (defvar *Inits*) +++ +++(defun t23expr (form prop &aux (def (when (consp form) (get (car form) prop))) +++ *local-funs* (*first-error* t) *vcs-used*) +++ (when def +++ (apply def (cdr form))) +++ (when (eq prop 't3) +++ ;;; Local function and closure function definitions. +++ (block +++ nil +++ (loop +++ (when (endp *local-funs*) (return)) +++ (let (*vcs-used*) +++ (apply 't3local-fun (pop *local-funs*))))))) +++ ++ (defun ctop-write (name &aux ++- def ++- (*function-links* nil) *c-vars* (*volatile* " VOL ") ++- *vaddress-list* (*vind* 0) *inits* ++- *current-form* *vcs-used*) +++ (*function-links* nil) *c-vars* (*volatile* " VOL ") +++ *vaddress-list* (*vind* 0) *inits* +++ *current-form* *vcs-used*) ++ (declare (special *current-form* *vcs-used*)) ++ ++ (setq *top-level-forms* (nreverse *top-level-forms*)) ++@@ -295,32 +289,19 @@ ++ ++ ++ ;; write all the inits. ++- (dolist* (*current-form* *top-level-forms*) ++- (setq *first-error* t) ++- (setq *vcs-used* nil) ++- (when (setq def (get (car *current-form*) 't2)) ++- (apply def (cdr *current-form*)))) ++- +++ (dolist (*current-form* *top-level-forms*) +++ (t23expr *current-form* 't2)) ++ ++ ;;; C function definitions. ++- (dolist* (*current-form* *top-level-forms*) ++- (setq *first-error* t) ++- (setq *vcs-used* nil) ++- (when (setq def (get (car *current-form*) 't3)) ++- (apply def (cdr *current-form*)))) ++- ++- ;;; Local function and closure function definitions. ++- (let (lf) ++- (block local-fun-process ++- (loop ++- (when (endp *local-funs*) (return-from local-fun-process)) ++- (setq lf (car *local-funs*)) ++- (pop *local-funs*) ++- (setq *vcs-used* nil) ++- (apply 't3local-fun lf)))) +++ (dolist (*current-form* *top-level-forms*) +++ (let* ((inits (data-inits))) +++ (t23expr *current-form* 't3) +++ (unless (or (eq (data-inits) inits) (eq (cdr (data-inits)) inits)) +++ (let ((di (data-inits))) +++ (setf (data-inits) inits) +++ (add-init (cons 'progn (nreverse (mapcar 'cdr (ldiff di inits))))))))) ++ ++ ;;; Global entries for directly called functions. ++- ++ (dolist* (x *global-entries*) ++ (setq *vcs-used* nil) ++ (apply 'wt-global-entry x)) ++@@ -400,31 +381,27 @@ ++ ;; as I can make it. Valid values of *eval-when-defaults* are ++ ;; a sublist of '(compile eval load) ++ ++-(defvar *eval-when-defaults* :defaults) ++- ++-(defun maybe-eval (default-action form) ++- (or default-action (and (symbolp (car form)) ++- (setq default-action (get (car form) 'eval-at-compile)))) ++- (cond ((or (and default-action (eq :defaults *eval-when-defaults*)) ++- (and (consp *eval-when-defaults*)(member 'compile *eval-when-defaults* ))) ++- (if form (cmp-eval form)) ++- t))) +++(defvar *eval-when-defaults* nil);:defaults ++ +++(defun maybe-eval (def form) +++ (when (or def +++ (intersection '(compile :compile-toplevel) *eval-when-defaults*) +++ (let ((c (car form))) (when (symbolp c) (get c 'eval-at-compile)))) +++ (when form +++ (cmp-eval form)) +++ t)) ++ ++ (defun t1eval-when (args &aux load-flag compile-flag) ++ (when (endp args) (too-few-args 'eval-when 1 0)) ++- (dolist** (situation (car args)) +++ (dolist (situation (car args)) ++ (case situation ++ ((load :load-toplevel) (setq load-flag t)) ++ ((compile :compile-toplevel) (setq compile-flag t)) ++ ((eval :execute)) ++- (otherwise (cmperr "The EVAL-WHEN situation ~s is illegal." ++- situation)))) ++- (let ((*eval-when-defaults* (car args))) ++- (cond (load-flag ++- (t1progn (cdr args))) ++- (compile-flag ++- (cmp-eval (cons 'progn (cdr args))))))) +++ (otherwise (cmperr "The EVAL-WHEN situation ~s is illegal." situation)))) +++ (let ((*eval-when-defaults* (or *eval-when-defaults* (car args)))) +++ (cond (load-flag (t1progn (cdr args))) +++ (compile-flag (cmp-eval (cons 'progn (cdr args))))))) ++ ++ (defun t1macrolet(args &aux (*funs* *funs*)) ++ (dolist (def (car args)) ++@@ -441,7 +418,17 @@ ++ (let ((*compile-ordinaries* t)) ++ (t1progn (cdr args)))) ++ (t ++- (dolist** (form args) (t1expr form))))) +++ (let ((f *top-level-forms*)) +++ (dolist (form args) (t1expr form)) +++ (setq *top-level-forms* (cons `(progn ,(nreverse (ldiff *top-level-forms* f))) f)))))) +++ +++(defun t3progn (args) +++ (dolist (arg args) +++ (t23expr arg 't3))) +++ +++(defun t2progn (args) +++ (dolist (arg args) +++ (t23expr arg 't2))) ++ ++ ;; (defun foo (x) .. -> (defun foo (g102 &aux (x g102)) ... ++ (defun cmpfix-args (args bind &aux tem (lam (copy-list (second args)))) ++@@ -464,7 +451,6 @@ ++ (unless (macro-function (car args)) (maybe-eval nil (cons 'defun args))) ++ (tagbody ++ top ++- (setq *non-package-operation* t) ++ (setq *local-functions* nil) ++ (let ((*vars* nil) (*funs* nil) (*blocks* nil) (*tags* nil) lambda-expr ++ (*special-binding* nil) ++@@ -681,8 +667,8 @@ ++ (push (list a) *vaddress-list*) ++ (prog1 *vind* (incf *vind*))) ++ ++-(defun t2defun (fname cfun lambda-expr doc sp) ++- (declare (ignore cfun lambda-expr doc sp)) +++(defun t2defun (fname cfun lambda-expr doc sp &optional macro-p) +++ (declare (ignore cfun lambda-expr doc sp macro-p)) ++ (cond ((get fname 'no-global-entry)(return-from t2defun nil))) ++ (cond ((< *space* 2) ++ (setf (get fname 'debug-prop) t) ++@@ -716,8 +702,7 @@ ++ (t (wt-h cfun "();") ++ (add-init `(si::mf ',fname ,(add-address (c-function-name "" cfun fname))))))) ++ ++-(defun t3defun (fname cfun lambda-expr doc sp &aux inline-info ++- (macro-p (equal `(mflag ,fname) (cadr (member *current-form* *top-level-forms*)))) +++(defun t3defun (fname cfun lambda-expr doc sp &optional macro-p &aux inline-info ++ (*current-form* (list 'defun fname)) ++ (*volatile* (volatile (second lambda-expr))) ++ *downward-closures*) ++@@ -1333,47 +1318,29 @@ ++ (maybe-eval (not (macro-function n)) (cons 'defmacro w));FIXME? ++ (t1expr `(defun ,n ,@(if macp args (cddr (caddr (si::defmacro* n (pop args) args)))))) ++ (setf (symbol-plist n) l) ++- (push `(mflag ,n) *top-level-forms*)) +++ (nconc (car *top-level-forms*) '(t))) +++ +++(defvar *compiling-ordinary* nil) ++ ++-(defun t1ordinary (form &aux tem ) ++- (setq *non-package-operation* t) ++- ;; check for top level functions ++- (cond ((or *compile-ordinaries* (when (listp form) (member (car form) '(let let* flet labels)))) +++(defun compile-ordinary-p (form) +++ (when (consp form) +++ (or (member (car form) '(lambda defun defmacro flet labels)) +++ (compile-ordinary-p (car form)) +++ (compile-ordinary-p (cdr form))))) +++ +++(defun t1ordinary (form) +++ (cond ((unless *compiling-ordinary* +++ (or *compile-ordinaries* (compile-ordinary-p form))) ++ (maybe-eval nil form) ++- (let ((gen (gensym "progn 'compile"))) +++ (let ((gen (gensym))(*compiling-ordinary* t)) ++ (proclaim `(function ,gen nil t)) ++- (t1expr `(defun ,gen (), form nil)) ++- (push (list 'ordinary `(,gen) ) *top-level-forms*))) ++- ;;Hack to things like (setq bil #'(lambda () ...)) or (foo nil #'(lambda () ..)) ++- ;; but not (let ((x ..)) (setq bil #'(lambda () ..))) ++- ;; for the latter you must use (progn 'compile ...) ++- ((and (consp form) ++- (symbolp (car form)) ++- (or (eq (car form) 'setq) ++- (not (special-operator-p (car form)))) ++- (do ((v (cdr form) (and (consp v) (cdr v))) ++- (i 1 (the fixnum (+ 1 i)))) ++- ((or (>= i 1000) ++- (not (consp v))) nil) ++- (declare (fixnum i)) ++- (cond ((and (consp (car v)) ++- (eq (caar v) 'function) ++- (consp (setq tem (second (car v)))) ++- (eq (car tem) 'lambda)) ++- (let ((gen (gensym))) ++- (t1expr `(defun ,gen ,@ (cdr tem))) ++- (return-from t1ordinary ++- (t1ordinary (append ++- (subseq form 0 i) ++- `((symbol-function ', gen)) ++- (nthcdr (+ 1 i) form)))))))))) +++ (t1expr `(progn (defun ,gen nil ,form nil) (,gen))))) ++ (t ++ (maybe-eval nil form) ++ (let ((*vars* nil) (*funs* nil) (*blocks* nil) (*tags* nil) ++ (*sharp-commas* nil)) ++ (push (list 'ordinary form) *top-level-forms*) ++- nil ++- )))) +++ nil)))) ++ ++ (defun t3ordinary (form) ++ (cond ((atom form)) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmputil.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmputil.lsp ++@@ -217,7 +217,7 @@ ++ (dolist (v '(si::cdefn lfun inline-safe inline-unsafe ++ inline-always c1conditional c2 c1 c1+ co1 ++ si::structure-access co1special ++- top-level-macro t3 t2 t1 package-operation)) +++ top-level-macro t3 t2 t1)) ++ (si::putprop v t 'compiler-prop )) ++ ++ (defun compiler-def-hook (symbol code) symbol code nil) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpwt.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpwt.lsp ++@@ -25,9 +25,7 @@ ++ (require 'FASDMACROS "../cmpnew/gcl_fasdmacros.lsp") ++ ++ ++-(defmacro data-vector () `(car *data*)) ++-(defmacro data-inits () `(second *data*)) ++-(defmacro data-package-ops () `(third *data*)) +++(defmacro data-inits () `(first *data*)) ++ ++ ) ++ ++@@ -69,7 +67,7 @@ ++ (defvar *fasd-data*) ++ ++ (defvar *hash-eq* nil) ++-(defvar *run-hash-equal-data-checking* nil) +++(defvar *run-hash-equal-data-checking* t) ++ (defun memoized-hash-equal (x depth);FIXME implement all this in lisp ++ (declare (fixnum depth)) ++ (when *run-hash-equal-data-checking* ++@@ -85,7 +83,6 @@ ++ (si::hash-equal x depth))))))) ++ ++ (defun push-data-incf (x) ++- (vector-push-extend (cons (memoized-hash-equal x -1000) x) (data-vector)) ++ (incf *next-vv*)) ++ ++ (defun wt-data1 (expr) ++@@ -105,58 +102,36 @@ ++ (terpri *compiler-output-data*) ++ (prin1 expr *compiler-output-data*))) ++ ++-(defun verify-data-vector(vec &aux v) ++- (dotimes (i (length vec)) ++- (setq v (aref vec i)) ++- (let ((has (memoized-hash-equal (cdr v) -1000))) ++- (cond ((not (eql (car v) has)) ++- (cmpwarn "A form or constant:~% ~s ~%has changed during the eval compile procedure!.~% The changed form will be the one put in the compiled file" (cdr v))))) ++- (setf (aref vec i) (cdr v))) ++- vec ++- ) +++(defun add-init (x &optional endp &aux (tem (cons (memoized-hash-equal x -1000) x))) +++ (if endp +++ (nconc (data-inits) (list tem)) +++ (push tem (data-inits))) +++ x) +++ +++(defun verify-datum (v) +++ (unless (eql (pop v) (memoized-hash-equal v -1000)) +++ (cmpwarn "A form or constant:~% ~s ~%has changed during the eval compile procedure!.~% The changed form will be the one put in the compiled file" v)) +++ v) +++ +++(defun wt-fasd-element (x) +++ (si::find-sharing-top x (fasd-table (car *fasd-data*))) +++ (si::write-fasd-top x (car *fasd-data*))) ++ ++-(defun add-init (x &optional endp) ++- (let ((tem (cons (memoized-hash-equal x -1000) x))) ++- (setf (data-inits) ++- (if endp ++- (nconc (data-inits) (list tem)) ++- (cons tem (data-inits) ))) ++- x)) +++(defun wt-data2 (x) +++ (if *fasd-data* +++ (wt-fasd-element x) +++ (wt-data1 x))) ++ ++-(defun wt-data-file () +++(defun wt-data-file nil ++ (when *prof-p* (add-init `(si::mark-memory-as-profiling))) ++- (verify-data-vector (data-vector)) ++- (let* ((vec (coerce (nreverse (data-inits)) 'vector))) ++- (verify-data-vector vec) ++- (setf (aref (data-vector) (- (length (data-vector)) 1)) ++- (cons 'si::%init vec)) ++- (setf (data-package-ops) (nreverse (data-package-ops))) ++- (cond (*fasd-data* ++- (wt-fasd-data-file)) ++- (t ++- (format *compiler-output-data* " ~%#(") ++- (dolist (v (data-package-ops)) ++- (format *compiler-output-data* "#! ") ++- (wt-data1 v)) ++- (wt-data1 (data-vector)) ++- (format *compiler-output-data* "~%)~%") ++- )))) +++ (wt-data2 (1+ *next-vv*)) +++ (dolist (v (nreverse (data-inits))) +++ (wt-data2 (verify-datum v))) +++ (when *fasd-data* +++ (si::close-fasd (car *fasd-data*)))) ++ ++-(defun wt-fasd-data-file ( &aux (x (data-vector)) tem) ++-; (si::find-sharing-top (data-package-ops) (fasd-table (car *fasd-data*))) ++- (si::find-sharing-top x (fasd-table (car *fasd-data*))) ++- (cond ((setq tem (data-package-ops)) ++- (dolist (v tem) ++- (put-op d_eval_skip *compiler-output-data*) ++- (si::write-fasd-top v (car *fasd-data*))))) ++- (si::write-fasd-top x (car *fasd-data*)) ++-; (sloop::sloop for (k v) in-table (fasd-table (car *fasd-data*)) ++-; when (>= v 0) do (print (list k v))) ++- (si::close-fasd (car *fasd-data*))) ++ (defun wt-data-begin ()) ++ (defun wt-data-end ()) ++-(defun wt-data-package-operation (x) ++- (push x (data-package-ops))) ++ ++ (defmacro wt (&rest forms &aux (fl nil)) ++ (dolist** (form forms (cons 'progn (reverse (cons nil fl)))) ++--- gcl-2.6.12.orig/cmpnew/sys-proclaim.lisp +++++ gcl-2.6.12/cmpnew/sys-proclaim.lisp ++@@ -2,197 +2,163 @@ ++ (COMMON-LISP::IN-PACKAGE "COMPILER") ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++- COMPILER::TAG-REF-CLB COMPILER::SET-TOP ++- COMPILER::C1MULTIPLE-VALUE-BIND COMPILER::C1LIST-NTH ++- COMPILER::C1RPLACA-NTHCDR COMPILER::C1DEFINE-STRUCTURE ++- COMPILER::BLK-REF-CLB COMPILER::WT-VV COMPILER::C1LENGTH ++- COMPILER::C1MAPC COMPILER::C1LOCAL-CLOSURE ++- COMPILER::CHECK-VREF COMPILER::WT-VAR-DECL COMPILER::C1TAGBODY ++- COMPILER::BLK-REF-CCB COMPILER::C1LOAD-TIME-VALUE ++- COMPILER::C1ASH COMPILER::FUN-LEVEL COMPILER::COPY-INFO ++- COMPILER::INLINE-POSSIBLE COMPILER::WT-VS-BASE ++- COMPILER::T1DEFENTRY COMPILER::CHARACTER-LOC-P ++- COMPILER::C2RPLACA COMPILER::RESET-INFO-TYPE ++- COMPILER::TYPE-FILTER COMPILER::TAG-SWITCH ++- COMPILER::DECL-BODY-SAFETY COMPILER::C1AND ++- COMPILER::C1FMLA-CONSTANT COMPILER::C2GO-CLB ++- COMPILER::C1FUNCTION COMPILER::C1MAPLIST COMPILER::VAR-TYPE ++- COMPILER::CLINK COMPILER::UNWIND-NO-EXIT COMPILER::VAR-LOC ++- COMPILER::C2RPLACD COMPILER::VERIFY-DATA-VECTOR ++- COMPILER::TAG-REF-CCB COMPILER::C1RETURN-FROM ++- COMPILER::T1DEFINE-STRUCTURE COMPILER::MDELETE-FILE ++- COMPILER::OBJECT-TYPE COMPILER::WT-CAR COMPILER::TAG-P ++- COMPILER::ADD-LOOP-REGISTERS COMPILER::C1MEMQ ++- COMPILER::C2FUNCTION COMPILER::CMP-MACRO-FUNCTION ++- COMPILER::C1BOOLE-CONDITION COMPILER::REP-TYPE COMPILER::C2GET ++- COMPILER::C2VAR COMPILER::C2EXPR* COMPILER::C1ADD-GLOBALS ++- COMPILER::WT1 COMPILER::C1BLOCK COMPILER::C1MAPL ++- COMPILER::C1MAPCAR COMPILER::FSET-FN-NAME COMPILER::C2GO-CCB ++- COMPILER::T1DEFLA COMPILER::C1NTH-CONDITION ++- COMPILER::ADD-OBJECT2 COMPILER::VAR-NAME COMPILER::C1EXPR ++- COMPILER::FUN-REF COMPILER::SCH-LOCAL-FUN ++- COMPILER::FIXNUM-LOC-P COMPILER::BLK-VAR ++- COMPILER::C1UNWIND-PROTECT COMPILER::C2BIND ++- COMPILER::PARSE-CVSPECS COMPILER::C1NTH ++- COMPILER::WT-SWITCH-CASE SYSTEM::UNDEF-COMPILER-MACRO ++- COMPILER::SET-UP-VAR-CVS COMPILER::C1ECASE ++- COMPILER::C1STRUCTURE-REF COMPILER::FUN-INFO ++- COMPILER::C1MEMBER COMPILER::C1GET COMPILER::WT-FUNCTION-LINK ++- COMPILER::C1ASH-CONDITION COMPILER::WT-CCB-VS COMPILER::INFO-P ++- COMPILER::REGISTER COMPILER::TAG-VAR COMPILER::C1VAR ++- COMPILER::C1TERPRI COMPILER::LTVP ++- COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::C1MAPCON ++- COMPILER::PUSH-ARGS-LISPCALL COMPILER::C1SETQ ++- COMPILER::C2DOWNWARD-FUNCTION COMPILER::T3ORDINARY ++- COMPILER::C1VREF COMPILER::WT-VS COMPILER::CONSTANT-FOLD-P ++- COMPILER::C1MULTIPLE-VALUE-PROG1 COMPILER::BLK-EXIT ++- COMPILER::T1DEFUN COMPILER::C1LABELS COMPILER::C1FSET ++- COMPILER::T1MACROLET COMPILER::FUN-NAME COMPILER::C1APPLY ++- COMPILER::FUN-P COMPILER::WT-DATA-PACKAGE-OPERATION ++- COMPILER::C1FUNOB COMPILER::WT-SYMBOL-FUNCTION ++- COMPILER::GET-RETURN-TYPE COMPILER::ADD-CONSTANT ++- COMPILER::SAFE-SYSTEM COMPILER::BLK-VALUE-TO-GO ++- COMPILER::NEED-TO-SET-VS-POINTERS COMPILER::C2TAGBODY-LOCAL ++- COMPILER::C1DECLARE COMPILER::C1OR COMPILER::C1ASSOC ++- COMPILER::ADD-ADDRESS COMPILER::VAR-KIND ++- COMPILER::PROCLAMATION COMPILER::FIX-OPT COMPILER::WT-DATA1 ++- COMPILER::INFO-SP-CHANGE COMPILER::ARGS-CAUSE-SIDE-EFFECT ++- COMPILER::WRITE-BLOCK-OPEN COMPILER::C2TAGBODY-BODY ++- COMPILER::CONS-TO-LISTA COMPILER::SAVE-FUNOB COMPILER::VAR-REF ++- COMPILER::C1LOCAL-FUN COMPILER::VAR-REP-LOC ++- COMPILER::SET-PUSH-CATCH-FRAME COMPILER::CTOP-WRITE ++- COMPILER::C2TAGBODY-CLB COMPILER::T1CLINES ++- COMPILER::ADD-OBJECT COMPILER::GET-LOCAL-RETURN-TYPE ++- COMPILER::DEFAULT-INIT COMPILER::FUNCTION-ARG-TYPES ++- COMPILER::C1STRUCTURE-SET COMPILER::CMP-MACROEXPAND-1 ++- COMPILER::INLINE-TYPE COMPILER::VAR-REGISTER ++- COMPILER::DECLARATION-TYPE COMPILER::C1CATCH COMPILER::C1LET ++- COMPILER::T3CLINES COMPILER::UNDEFINED-VARIABLE COMPILER::C1GO ++- COMPILER::TAG-NAME COMPILER::SCH-GLOBAL COMPILER::C1IF ++- COMPILER::C1FLET COMPILER::INLINE-BOOLE3-STRING ++- COMPILER::INFO-CHANGED-ARRAY COMPILER::C2FUNCALL-AUX ++- COMPILER::FUN-REF-CCB COMPILER::WT-CADR COMPILER::FUN-CFUN ++- COMPILER::WT-VS* COMPILER::WT-DOWN COMPILER::C2GETHASH ++- COMPILER::ADD-REG1 COMPILER::REPLACE-CONSTANT ++- COMPILER::C2DM-RESERVE-V COMPILER::RESULT-TYPE ++- COMPILER::C1FUNCALL COMPILER::C1THE COMPILER::VARARG-P ++- COMPILER::INFO-REFERRED-ARRAY COMPILER::C1PROGV ++- COMPILER::T2DECLARE COMPILER::T1DEFCFUN COMPILER::C2VALUES ++- COMPILER::C1SWITCH COMPILER::C1MAPCAN ++- COMPILER::CMP-MACROEXPAND COMPILER::TAG-LABEL ++- COMPILER::TAG-UNWIND-EXIT COMPILER::C1PRINC COMPILER::C1THROW ++- COMPILER::SAVE-AVMA COMPILER::VOLATILE COMPILER::FLAGS-POS ++- COMPILER::INFO-TYPE COMPILER::C1NTHCDR-CONDITION ++- COMPILER::C1MULTIPLE-VALUE-SETQ COMPILER::WT-FUNCALL-C ++- COMPILER::PUSH-ARGS COMPILER::C1DM-BAD-KEY ++- COMPILER::T1ORDINARY COMPILER::C1PSETQ COMPILER::BLK-REF ++- COMPILER::C2DM-RESERVE-VL COMPILER::C1MACROLET ++- COMPILER::C1SHARP-COMMA COMPILER::C1RPLACA ++- COMMON-LISP::PROCLAIM COMPILER::PUSH-DATA-INCF ++- COMPILER::MACRO-DEF-P COMPILER::BLK-NAME COMPILER::C1VALUES ++- COMPILER::C1DOWNWARD-FUNCTION COMPILER::T1DEFMACRO ++- COMPILER::GET-ARG-TYPES COMPILER::ADD-SYMBOL ++- COMPILER::NAME-SD1 COMPILER::C2GO-LOCAL ++- COMPILER::C2TAGBODY-CCB COMPILER::WT-LIST ++- COMPILER::GET-LOCAL-ARG-TYPES COMPILER::C1BOOLE3 ++- COMPILER::C1STACK-LET COMPILER::WT-CDR COMPILER::C1QUOTE ++- COMPILER::C1EVAL-WHEN COMPILER::VAR-P COMPILER::CHECK-DOWNWARD ++- COMPILER::T1PROGN COMPILER::BLK-P COMPILER::C2LOCATION ++- COMPILER::THE-PARAMETER COMPILER::C2VAR-KIND ++- COMPILER::C1GETHASH COMPILER::LTVP-EVAL COMPILER::C1RPLACD ++- COMPILER::INFO-VOLATILE COMPILER::LONG-FLOAT-LOC-P ++- COMPILER::FUNCTION-RETURN-TYPE COMPILER::SHORT-FLOAT-LOC-P ++- COMPILER::WT-H1 COMPILER::C1MULTIPLE-VALUE-CALL ++- COMPILER::NAME-TO-SD COMPILER::C1PROGN COMPILER::SET-RETURN ++- COMPILER::C1LET* COMPILER::AET-C-TYPE COMPILER::C1COMPILER-LET ++- COMPILER::MAXARGS COMPILER::VAR-REF-CCB COMPILER::VV-STR ++- COMPILER::C1NTHCDR COMPILER::TAG-REF COMPILER::GET-INCLUDED)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++- COMPILER::INLINE-BOOLE3)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++- COMMON-LISP::*)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++- COMPILER::TS COMPILER::DASH-TO-UNDERSCORE)) +++ COMPILER::CMPERR COMPILER::CMPWARN COMPILER::WT-CVAR +++ COMPILER::ADD-INIT COMPILER::INIT-NAME +++ COMPILER::FAST-LINK-PROCLAIMED-TYPE-P COMPILER::C1CASE +++ COMPILER::WT-INTEGER-LOC COMPILER::CMPNOTE +++ COMPILER::UNWIND-EXIT COMPILER::WT-COMMENT +++ COMPILER::C1LAMBDA-EXPR)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T) ++- COMMON-LISP::T) ++- COMPILER::C2CALL-UNKNOWN-GLOBAL COMPILER::WT-IF-PROCLAIMED ++- COMPILER::MY-CALL COMPILER::WT-GLOBAL-ENTRY ++- COMPILER::T3DEFUN-NORMAL COMPILER::C2STRUCTURE-REF ++- COMPILER::C2SWITCH COMPILER::C2CALL-GLOBAL ++- COMPILER::T3DEFUN-VARARG COMPILER::C1MAKE-VAR)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ COMPILER::C2RETURN-LOCAL COMPILER::WT-INLINE-LOC +++ COMPILER::C1SYMBOL-FUN COMPILER::C2DECL-BODY +++ COMPILER::COMPILER-BUILD COMPILER::NCONC-FILES +++ COMPILER::C2BLOCK COMPILER::C1BODY COMPILER::C2BLOCK-LOCAL)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ (COMMON-LISP::T +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807)) ++ COMMON-LISP::T) ++- COMPILER::LINK COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL ++- COMPILER::INLINE-ARGS)) +++ COMPILER::MEMOIZED-HASH-EQUAL)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::T) ++- COMPILER::WT-INLINE-INTEGER COMPILER::ADD-FUNCTION-DECLARATION ++- COMPILER::C1STRUCTURE-REF1 COMPILER::ADD-FAST-LINK ++- COMPILER::AND-FORM-TYPE COMPILER::C2PRINC COMPILER::C2MAPCAN ++- COMPILER::CJT COMPILER::C2CASE COMPILER::WT-INLINE-LONG-FLOAT ++- COMPILER::SUBLIS1-INLINE COMPILER::MYSUB ++- COMPILER::ADD-FUNCTION-PROCLAMATION COMPILER::FIX-DOWN-ARGS ++- COMPILER::TOO-MANY-ARGS COMPILER::CMP-EXPAND-MACRO ++- COMPILER::C2MULTIPLE-VALUE-BIND COMPILER::C2GO ++- COMPILER::WT-INLINE-FIXNUM COMPILER::WT-INLINE-COND ++- COMPILER::C1MAP-FUNCTIONS COMPILER::C1DM ++- COMPILER::WT-MAKE-CCLOSURE COMPILER::CAN-BE-REPLACED* ++- COMPILER::C-FUNCTION-NAME COMPILER::C2LET* COMPILER::CJF ++- COMPILER::TOO-FEW-ARGS COMPILER::BOOLE3 COMPILER::T3DEFCFUN ++- COMPILER::C2FUNCALL-SFUN COMPILER::C2MAPC ++- COMPILER::CHECK-FORM-TYPE COMPILER::SET-VAR ++- COMPILER::C2TAGBODY COMPILER::CHECK-VDECL ++- COMPILER::GET-INLINE-INFO COMPILER::ASSIGN-DOWN-VARS ++- COMPILER::C2LET COMPILER::INLINE-TYPE-MATCHES ++- COMPILER::COMPILER-PASS2 COMPILER::C2PROGV COMPILER::C2MAPCAR ++- COMPILER::MAKE-INLINE-STRING COMPILER::WT-INLINE-CHARACTER ++- COMPILER::WT-INLINE-SHORT-FLOAT)) +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) +++ COMPILER::MAKE-INIT-STRING)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ ((COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807) +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807)) ++ COMMON-LISP::T) ++- COMPILER::T2DEFENTRY COMPILER::DEFSYSFUN COMPILER::T3DEFENTRY)) +++ COMPILER::MLIN)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::T) ++- COMPILER::T3DEFUN-LOCAL-ENTRY COMPILER::T3INIT-FUN ++- COMPILER::T2DEFUN COMPILER::T3DEFUN COMPILER::C2STRUCTURE-SET ++- COMPILER::C1APPLY-OPTIMIZE)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::FIXNUM) +++ COMPILER::PROCLAIMED-ARGD COMPILER::ANALYZE-REGS +++ COMPILER::ANALYZE-REGS1)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::*) ++- COMMON-LISP::T) ++- COMPILER::GET-OUTPUT-PATHNAME COMPILER::WT-SIMPLE-CALL)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +++ COMPILER::DECL-BODY-SAFETY COMPILER::C2FUNCTION +++ COMPILER::C1PROGN COMPILER::C1MAPCAR COMPILER::C1FLET +++ COMPILER::C1EXPR COMPILER::C1LET COMPILER::ADD-OBJECT +++ COMPILER::C1LABELS COMPILER::C1FMLA-CONSTANT COMPILER::C1ECASE +++ COMPILER::C1LENGTH COMPILER::C1APPLY COMPILER::THE-PARAMETER +++ COMPILER::C1TAGBODY COMPILER::T3CLINES +++ COMPILER::VERIFY-DATA-VECTOR COMPILER::VAR-KIND +++ COMPILER::INLINE-TYPE COMPILER::C1MULTIPLE-VALUE-CALL +++ COMPILER::C2GET COMPILER::ADD-CONSTANT COMPILER::T1DEFMACRO +++ COMPILER::C2EXPR* COMPILER::TAG-UNWIND-EXIT +++ COMPILER::CHECK-DOWNWARD COMPILER::WT-CADR +++ COMPILER::CHARACTER-LOC-P COMPILER::C1DECLARE +++ COMPILER::AET-C-TYPE COMPILER::C1QUOTE COMPILER::CHECK-VREF +++ COMPILER::VAR-LOC COMPILER::INLINE-POSSIBLE COMPILER::SET-TOP +++ COMPILER::T1ORDINARY COMPILER::BLK-VAR COMPILER::SAVE-AVMA +++ COMPILER::C1VREF COMPILER::WT-VV COMPILER::C2GO-LOCAL +++ COMPILER::C1MEMBER COMPILER::LTVP-EVAL COMPILER::VV-STR +++ COMPILER::TAG-REF-CLB COMPILER::T2DECLARE +++ COMPILER::CMP-MACROEXPAND-1 COMPILER::T1DEFINE-STRUCTURE +++ COMPILER::T1DEFENTRY COMPILER::ADD-OBJECT2 COMPILER::FUN-LEVEL +++ COMPILER::VAR-P COMPILER::WT-DATA-PACKAGE-OPERATION +++ COMPILER::PUSH-ARGS-LISPCALL COMPILER::C1PSETQ COMPILER::C1OR +++ COMPILER::C1LOCAL-FUN COMPILER::WT-VS-BASE +++ COMPILER::DEFAULT-INIT COMPILER::C1MAPCON COMPILER::C1GO +++ COMPILER::INFO-REFERRED-ARRAY COMPILER::BLK-REF +++ COMPILER::T1DEFLA COMPILER::INFO-CHANGED-ARRAY +++ COMPILER::WT-VAR-DECL COMPILER::UNWIND-NO-EXIT +++ COMPILER::BLK-VALUE-TO-GO COMPILER::C2GO-CLB +++ COMPILER::FUNCTION-ARG-TYPES COMPILER::C1MAPC +++ COMPILER::C2DOWNWARD-FUNCTION COMPILER::CMP-MACRO-FUNCTION +++ COMPILER::C1SHARP-COMMA COMPILER::ADD-ADDRESS +++ COMPILER::GET-LOCAL-RETURN-TYPE COMPILER::T1DEFUN +++ COMPILER::C1ADD-GLOBALS COMPILER::C2DM-RESERVE-V +++ COMPILER::C1ASH COMPILER::C1STACK-LET +++ COMPILER::WT-SYMBOL-FUNCTION COMPILER::C2TAGBODY-CLB +++ COMPILER::C1MAPLIST COMPILER::PUSH-DATA-INCF +++ COMPILER::C2TAGBODY-LOCAL COMPILER::C1FSET COMPILER::WT1 +++ COMPILER::VAR-REF-CCB COMPILER::INFO-P COMPILER::C1ASSOC +++ COMPILER::C2GETHASH COMPILER::C1RPLACD COMPILER::C1EVAL-WHEN +++ COMPILER::REP-TYPE COMPILER::C1FUNOB COMPILER::BLK-REF-CLB +++ COMPILER::WT-VS* COMPILER::C1GET COMPILER::SCH-LOCAL-FUN +++ COMPILER::SET-PUSH-CATCH-FRAME COMPILER::C1BOOLE3 +++ COMPILER::BLK-EXIT COMPILER::T1DEFCFUN COMPILER::GET-ARG-TYPES +++ COMPILER::WRITE-BLOCK-OPEN COMPILER::C1COMPILER-LET +++ COMPILER::ADD-LOOP-REGISTERS COMPILER::INLINE-BOOLE3-STRING +++ COMPILER::C1LOAD-TIME-VALUE COMPILER::VAR-TYPE +++ COMPILER::REGISTER COMPILER::RESET-INFO-TYPE +++ COMPILER::C1UNWIND-PROTECT COMPILER::C1IF +++ COMPILER::SHORT-FLOAT-LOC-P COMPILER::C1VAR +++ COMPILER::WT-FUNCALL-C COMPILER::C1THE COMPILER::FIX-OPT +++ COMPILER::UNDEFINED-VARIABLE COMPILER::C2RPLACD +++ COMPILER::C1BOOLE-CONDITION COMPILER::C1NTH COMPILER::VARARG-P +++ COMPILER::OBJECT-TYPE COMPILER::VOLATILE COMPILER::FUN-P +++ COMPILER::VAR-REF COMPILER::C1DEFINE-STRUCTURE +++ COMPILER::MAXARGS COMPILER::LONG-FLOAT-LOC-P +++ COMPILER::REPLACE-CONSTANT COMPILER::C2TAGBODY-BODY +++ COMPILER::TAG-P COMPILER::C1RETURN-FROM COMPILER::WT-VS +++ COMPILER::ARGS-CAUSE-SIDE-EFFECT COMPILER::C1LIST-NTH +++ COMPILER::FSET-FN-NAME COMPILER::SAVE-FUNOB COMPILER::C1BLOCK +++ COMPILER::C1AND COMPILER::C2TAGBODY-CCB COMPILER::GET-INCLUDED +++ COMPILER::TAG-REF COMPILER::NEED-TO-SET-VS-POINTERS +++ COMPILER::C1VALUES COMPILER::BLK-P COMPILER::COPY-INFO +++ COMPILER::WT-CAR COMPILER::FUN-CFUN +++ COMPILER::C1MULTIPLE-VALUE-PROG1 SYSTEM::UNDEF-COMPILER-MACRO +++ COMPILER::C1DM-BAD-KEY COMPILER::FUN-REF COMPILER::NAME-SD1 +++ COMPILER::MDELETE-FILE COMPILER::SAFE-SYSTEM +++ COMPILER::WT-DATA2 COMPILER::WT-CDR COMPILER::C2GO-CCB +++ COMPILER::C1ASH-CONDITION COMPILER::C1RPLACA +++ COMPILER::WT-DATA1 COMPILER::C1RPLACA-NTHCDR +++ COMPILER::NAME-TO-SD COMPILER::WT-LIST +++ COMPILER::CMP-MACROEXPAND COMPILER::WT-SWITCH-CASE +++ COMPILER::GET-LOCAL-ARG-TYPES COMPILER::SET-UP-VAR-CVS +++ COMPILER::WT-FASD-ELEMENT COMPILER::RESULT-TYPE +++ COMPILER::C1SWITCH COMPILER::FIXNUM-LOC-P +++ COMPILER::C1NTHCDR-CONDITION COMPILER::TAG-VAR +++ COMPILER::C1NTHCDR COMPILER::CLINK COMPILER::LTVP +++ COMPILER::C1LET* COMPILER::TAG-NAME COMPILER::C1FUNCALL +++ COMPILER::C2RPLACA COMPILER::MACRO-DEF-P +++ COMPILER::C1STRUCTURE-REF COMPILER::GET-RETURN-TYPE +++ COMPILER::C1DOWNWARD-FUNCTION COMPILER::T1CLINES +++ COMPILER::TYPE-FILTER COMPILER::C1FUNCTION +++ COMPILER::CONS-TO-LISTA COMPILER::C1NTH-CONDITION +++ COMPILER::FUN-NAME COMPILER::PROCLAMATION COMPILER::VAR-NAME +++ COMPILER::WT-CCB-VS COMPILER::FLAGS-POS COMPILER::C1CATCH +++ COMPILER::CTOP-WRITE COMPILER::TAG-LABEL COMPILER::C1MEMQ +++ COMPILER::C1GETHASH COMPILER::TAG-REF-CCB COMPILER::TAG-SWITCH +++ COMPILER::C2BIND COMPILER::VERIFY-DATUM COMPILER::C1MAPCAN +++ COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::C1TERPRI +++ COMPILER::FUN-REF-CCB COMMON-LISP::PROCLAIM +++ COMPILER::INFO-VOLATILE COMPILER::T3ORDINARY +++ COMPILER::C2LOCATION COMPILER::BLK-NAME +++ COMPILER::C1STRUCTURE-SET COMPILER::C2VAR +++ COMPILER::C1LOCAL-CLOSURE COMPILER::C1MACROLET +++ COMPILER::WT-FUNCTION-LINK COMPILER::C2VALUES +++ COMPILER::T1MACROLET COMPILER::C1MULTIPLE-VALUE-BIND +++ COMPILER::C2FUNCALL-AUX COMPILER::C1MULTIPLE-VALUE-SETQ +++ COMPILER::PUSH-ARGS COMPILER::BLK-REF-CCB COMPILER::C1SETQ +++ COMPILER::ADD-SYMBOL COMPILER::C2VAR-KIND COMPILER::C1THROW +++ COMPILER::DECLARATION-TYPE COMPILER::C1PROGV +++ COMPILER::INFO-TYPE COMPILER::CONSTANT-FOLD-P +++ COMPILER::C1PRINC COMPILER::WT-DOWN COMPILER::SCH-GLOBAL +++ COMPILER::T1PROGN COMPILER::INFO-SP-CHANGE +++ COMPILER::C2DM-RESERVE-VL COMPILER::C1MAPL +++ COMPILER::FUNCTION-RETURN-TYPE COMPILER::ADD-REG1 +++ COMPILER::PARSE-CVSPECS COMPILER::FUN-INFO +++ COMPILER::VAR-REGISTER COMPILER::SET-RETURN COMPILER::WT-H1 +++ COMPILER::VAR-REP-LOC)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::T) ++- COMPILER::T3LOCAL-DCFUN COMPILER::T3LOCAL-FUN)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) +++ COMPILER::INLINE-BOOLE3)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++@@ -206,8 +172,8 @@ ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::*) ++- COMPILER::C2RETURN-FROM COMPILER::C2DM COMPILER::C1DM-VL ++- COMPILER::C2APPLY-OPTIMIZE COMPILER::C1DM-V)) +++ COMPILER::C1DM-V COMPILER::C1DM-VL COMPILER::C2APPLY-OPTIMIZE +++ COMPILER::C2RETURN-FROM COMPILER::C2DM)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++@@ -216,40 +182,85 @@ ++ COMPILER::T3DEFUN-AUX)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++- COMPILER::C2PROGN COMPILER::WT-LONG-FLOAT-LOC ++- COMPILER::WT-CHARACTER-LOC COMPILER::WT-TO-STRING ++- COMPILER::WT-LOC COMPILER::MEXPAND-DEFTYPE ++- COMPILER::CMP-TOPLEVEL-EVAL COMPILER::T1EVAL-WHEN ++- COMPILER::T1EXPR COMPILER::C2OR COMPILER::WT-FIXNUM-LOC ++- COMPILER::C2EXPR COMPILER::C2AND COMPILER::CMP-EVAL ++- COMPILER::SET-LOC COMPILER::WT-SHORT-FLOAT-LOC)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++- COMPILER::MAKE-INFO COMPILER::FCALLN-INLINE ++- COMPILER::LIST-INLINE COMPILER::LIST*-INLINE ++- COMPILER::COMPILER-COMMAND COMPILER::MAKE-BLK ++- COMPILER::MAKE-FUN COMPILER::WT-CLINK COMPILER::C2FSET ++- COMPILER::MAKE-TAG COMPILER::CS-PUSH COMPILER::MAKE-VAR ++- COMMON-LISP::COMPILE-FILE)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++ COMPILER::F-TYPE)) ++-(COMMON-LISP::MAPC ++- (COMMON-LISP::LAMBDA (COMPILER::X) ++- (COMMON-LISP::SETF ++- (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) ++- COMMON-LISP::T)) ++- '(COMMON-LISP::DISASSEMBLE COMPILER::CMP-TMP-MACRO ++- COMPILER::CMP-ANON COMMON-LISP::COMPILE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- ((COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*))) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- COMPILER::COPY-ARRAY)) +++ COMPILER::C2RETURN-CCB +++ COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES +++ COMPILER::DO-CHANGED COMPILER::CO1STRUCTURE-PREDICATE +++ COMPILER::RESULT-TYPE-FROM-ARGS COMPILER::CMPFIX-ARGS +++ COMPILER::T3SHARP-COMMA COMPILER::FLAGS +++ COMPILER::CO1WRITE-BYTE COMPILER::CHECK-FNAME-ARGS +++ COMPILER::C2ASSOC!2 COMPILER::CK-SPEC +++ COMPILER::COERCE-LOC-STRUCTURE-REF COMPILER::ADD-DEBUG-INFO +++ COMPILER::C2LAMBDA-EXPR-WITH-KEY COMPILER::PRIN1-CMP +++ COMPILER::PUSH-CHANGED-VARS COMPILER::SHIFT>> +++ COMPILER::ARGS-INFO-REFERRED-VARS +++ COMPILER::C2MULTIPLE-VALUE-CALL +++ COMPILER::ARGS-INFO-CHANGED-VARS COMPILER::CO1SCHAR +++ COMPILER::NEXT-CVAR COMPILER::C2RETURN-CLB +++ COMPILER::CO1WRITE-CHAR COMPILER::SET-VS SYSTEM::SWITCH +++ COMPILER::FLAG-P COMPILER::DO-ARRAY COMPILER::INLINE-PROC +++ COMPILER::CO1CONS COMPILER::C2EXPR-TOP +++ COMPILER::CHANGED-LENGTH COMPILER::C2MULTIPLE-VALUE-PROG1 +++ COMPILER::REMOVE-FLAG COMPILER::CO1SUBLIS COMPILER::ADD-INFO +++ COMPILER::C2BIND-INIT COMPILER::C2DM-BIND-VL COMPILER::C1FMLA +++ COMPILER::C2CATCH COMPILER::WT-MAKE-DCLOSURE +++ COMPILER::UNWIND-BDS COMPILER::IS-REP-REFERRED +++ COMPILER::WT-LONG-FLOAT-VALUE COMPILER::WT-GO +++ COMPILER::FAST-READ COMPILER::WT COMPILER::SAFE-COMPILE +++ COMPILER::WT-H COMPILER::STRUCT-TYPE-OPT +++ COMPILER::REFERRED-LENGTH COMPILER::TYPE-AND COMPILER::C2THROW +++ COMPILER::NEED-TO-PROTECT COMPILER::COERCE-LOC +++ COMPILER::TYPE>= COMPILER::WT-NL1 COMPILER::CHECK-END +++ COMPILER::C2BLOCK-CCB COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY +++ COMPILER::SET-BDS-BIND COMPILER::C2DM-BIND-INIT +++ COMPILER::CAN-BE-REPLACED COMPILER::MAYBE-EVAL +++ COMPILER::WT-VAR COMPILER::WT-REQUIREDS +++ COMPILER::CONVERT-CASE-TO-SWITCH COMPILER::CO1TYPEP +++ COMPILER::C1DECL-BODY COMPILER::DOWNWARD-FUNCTION +++ COMPILER::MULTIPLE-VALUE-CHECK COMPILER::NEXT-CFUN +++ SYSTEM::SWITCH-FINISH COMPILER::CO1READ-CHAR +++ COMPILER::COMPILER-CC COMPILER::C1PROGN* +++ COMPILER::C1LAMBDA-FUN COMPILER::MAKE-USER-INIT +++ COMPILER::SHIFT<< COMPILER::C1ARGS COMPILER::CK-VL +++ COMPILER::T23EXPR COMPILER::IS-CHANGED COMPILER::PUSH-REFERRED +++ COMPILER::WT-CHARACTER-VALUE +++ COMPILER::PUSH-REFERRED-WITH-START COMPILER::NEXT-LABEL* +++ COMPILER::CMPCK COMPILER::C2DM-BIND-LOC +++ COMPILER::WT-SHORT-FLOAT-VALUE +++ COMPILER::PUSH-CHANGED-WITH-START COMPILER::C2EXPR-TOP* +++ COMPILER::DOLIST* COMPILER::WT-LABEL COMPILER::PUSH-CHANGED +++ COMPILER::BASE-USED COMPILER::CO1VECTOR-PUSH +++ COMPILER::WT-V*-MACROS COMPILER::CO1CONSTANT-FOLD +++ COMPILER::WT-FIXNUM-VALUE COMPILER::C2BLOCK-CLB +++ SYSTEM::DEFINE-INLINE-FUNCTION COMPILER::SET-JUMP-TRUE +++ COMPILER::C2BIND-LOC COMPILER::IN-ARRAY +++ COMPILER::SET-JUMP-FALSE COMPILER::PROCLAIM-VAR +++ COMMON-LISP::DEFINE-COMPILER-MACRO COMPILER::C1CONSTANT-VALUE +++ COMPILER::COMPILER-DEF-HOOK COMPILER::CO1READ-BYTE +++ COMPILER::MAYBE-WT-C2DM-BIND-VL COMPILER::IS-REFERRED +++ COMPILER::DOTIMES** SYSTEM::ADD-DEBUG COMPILER::DO-REFERRED +++ COMPILER::NEXT-LABEL COMPILER::C2CALL-LAMBDA COMPILER::C2APPLY +++ COMPILER::C1EXPR* COMPILER::C2SETQ COMPILER::MIA +++ COMPILER::C2PSETQ COMPILER::C1SETQ1 +++ COMPILER::C2LIST-NTH-IMMEDIATE COMPILER::WT-NL +++ COMPILER::CO1EQL COMPILER::CFAST-WRITE COMPILER::CO1LDB +++ COMPILER::EQL-NOT-NIL COMPILER::JUMPS-TO-P +++ COMPILER::C2CALL-LOCAL COMPILER::BIGNUM-EXPANSION-STORAGE +++ COMPILER::STACK-LET COMPILER::C2MULTIPLE-VALUE-SETQ +++ COMPILER::C2MEMBER!2 COMPILER::C2UNWIND-PROTECT +++ COMPILER::DOLIST** COMPILER::SET-DBIND COMPILER::DOTIMES* +++ COMPILER::NEXT-CMACRO COMPILER::GET-INLINE-LOC +++ COMPILER::C2STACK-LET)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ COMPILER::COMPILE-FILE1)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++@@ -257,9 +268,11 @@ ++ (COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*)) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807) ++ COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++- COMPILER::PUSH-ARRAY)) +++ COMPILER::BSEARCHLEQ)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++@@ -267,11 +280,16 @@ ++ (COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*)) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++- (COMMON-LISP::INTEGER -9223372036854775808 ++- 9223372036854775807) ++ COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++- COMPILER::BSEARCHLEQ)) +++ COMPILER::PUSH-ARRAY)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER +++ COMMON-LISP::*)) +++ COMMON-LISP::T) +++ COMPILER::TS COMPILER::DASH-TO-UNDERSCORE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++@@ -285,130 +303,121 @@ ++ COMPILER::DASH-TO-UNDERSCORE-INT)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +++ COMPILER::VS-PUSH COMPILER::WFS-ERROR COMPILER::MACRO-ENV +++ COMPILER::C1T COMPILER::WT-CVARS COMPILER::WT-DATA-END +++ COMPILER::GAZONK-NAME COMPILER::INIT-ENV +++ COMPILER::ADD-LOAD-TIME-SHARP-COMMA COMPILER::CCB-VS-PUSH +++ COMPILER::WT-DATA-FILE COMPILER::WT-FASD-DATA-FILE +++ COMPILER::INC-INLINE-BLOCKS COMPILER::PRINT-CURRENT-FORM +++ COMPILER::CLOSE-INLINE-BLOCKS COMPILER::WT-DATA-BEGIN +++ COMPILER::BABOON COMPILER::WT-C-PUSH COMPILER::WT-NEXT-VAR-ARG +++ COMPILER::WT-FIRST-VAR-ARG COMPILER::CVS-PUSH +++ COMPILER::TAIL-RECURSION-POSSIBLE COMPILER::RESET-TOP +++ COMPILER::C1NIL COMPILER::PRINT-COMPILER-INFO)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- ((COMMON-LISP::INTEGER -9223372036854775808 ++- 9223372036854775807) ++- (COMMON-LISP::INTEGER -9223372036854775808 ++- 9223372036854775807)) +++ ((COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*))) ++ COMMON-LISP::T) ++- COMPILER::MLIN)) +++ COMPILER::COPY-ARRAY)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) +++ COMPILER::T1EXPR COMPILER::WT-TO-STRING COMPILER::C2OR +++ COMPILER::WT-LOC COMPILER::SET-LOC COMPILER::MEXPAND-DEFTYPE +++ COMPILER::C2EXPR COMPILER::C2PROGN COMPILER::C2AND +++ COMPILER::WT-SHORT-FLOAT-LOC COMPILER::WT-CHARACTER-LOC +++ COMPILER::CMP-EVAL COMPILER::T1EVAL-WHEN +++ COMPILER::WT-LONG-FLOAT-LOC COMPILER::CMP-TOPLEVEL-EVAL +++ COMPILER::WT-FIXNUM-LOC)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +++ COMPILER::FCALLN-INLINE COMPILER::CS-PUSH COMPILER::WT-CLINK +++ COMPILER::COMPILER-COMMAND COMPILER::MAKE-INFO +++ COMPILER::T2PROGN COMPILER::MAKE-TAG COMPILER::C2FSET +++ COMPILER::MAKE-BLK COMPILER::LIST-INLINE +++ COMMON-LISP::COMPILE-FILE COMPILER::MAKE-FUN +++ COMPILER::MAKE-VAR COMPILER::T3PROGN COMPILER::LIST*-INLINE)) +++(COMMON-LISP::MAPC +++ (COMMON-LISP::LAMBDA (COMPILER::X) +++ (COMMON-LISP::SETF +++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) +++ COMMON-LISP::T)) +++ '(COMMON-LISP::COMPILE COMMON-LISP::DISASSEMBLE COMPILER::CMP-ANON +++ COMPILER::CMP-TMP-MACRO)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T ++- (COMMON-LISP::INTEGER -9223372036854775808 ++- 9223372036854775807)) +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) ++ COMMON-LISP::T) ++- COMPILER::MEMOIZED-HASH-EQUAL)) +++ COMPILER::T3DEFUN-VARARG COMPILER::T3DEFUN-NORMAL +++ COMPILER::C2CALL-GLOBAL COMPILER::C2SWITCH COMPILER::MY-CALL +++ COMPILER::C1MAKE-VAR COMPILER::WT-IF-PROCLAIMED +++ COMPILER::C2STRUCTURE-REF COMPILER::C2CALL-UNKNOWN-GLOBAL +++ COMPILER::WT-GLOBAL-ENTRY)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++- COMPILER::MACRO-ENV COMPILER::C1T COMPILER::PRINT-CURRENT-FORM ++- COMPILER::CCB-VS-PUSH COMPILER::C1NIL ++- COMPILER::WT-FASD-DATA-FILE COMPILER::INIT-ENV ++- COMPILER::WT-CVARS COMPILER::CVS-PUSH ++- COMPILER::WT-FIRST-VAR-ARG COMPILER::WT-NEXT-VAR-ARG ++- COMPILER::WT-DATA-FILE COMPILER::WT-C-PUSH ++- COMPILER::GAZONK-NAME COMPILER::WT-DATA-END ++- COMPILER::INC-INLINE-BLOCKS COMPILER::TAIL-RECURSION-POSSIBLE ++- COMPILER::RESET-TOP COMPILER::CLOSE-INLINE-BLOCKS ++- COMPILER::PRINT-COMPILER-INFO COMPILER::WFS-ERROR ++- COMPILER::VS-PUSH COMPILER::BABOON COMPILER::WT-DATA-BEGIN ++- COMPILER::ADD-LOAD-TIME-SHARP-COMMA)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ COMPILER::T2DEFENTRY COMPILER::T3DEFENTRY COMPILER::DEFSYSFUN)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::FIXNUM) ++- COMPILER::PROCLAIMED-ARGD COMPILER::ANALYZE-REGS1 ++- COMPILER::ANALYZE-REGS)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ COMPILER::C2PROGV COMPILER::WT-INLINE-COND COMPILER::C2TAGBODY +++ COMPILER::CAN-BE-REPLACED* COMPILER::WT-INLINE-FIXNUM +++ COMPILER::MAKE-INLINE-STRING COMPILER::WT-INLINE-SHORT-FLOAT +++ COMPILER::C2LET* COMPILER::ADD-FAST-LINK +++ COMPILER::C1STRUCTURE-REF1 COMPILER::GET-INLINE-INFO +++ COMPILER::CHECK-FORM-TYPE COMPILER::C2MAPCAN +++ COMPILER::FIX-DOWN-ARGS COMPILER::CMP-EXPAND-MACRO +++ COMPILER::SUBLIS1-INLINE COMPILER::ADD-FUNCTION-PROCLAMATION +++ COMPILER::ADD-FUNCTION-DECLARATION COMPILER::SET-VAR +++ COMPILER::BOOLE3 COMPILER::CJF COMPILER::C2PRINC +++ COMPILER::INLINE-TYPE-MATCHES COMPILER::C1MAP-FUNCTIONS +++ COMPILER::C1DM COMPILER::WT-INLINE-CHARACTER +++ COMPILER::WT-MAKE-CCLOSURE COMPILER::TOO-MANY-ARGS +++ COMPILER::COMPILER-PASS2 COMPILER::WT-INLINE-INTEGER +++ COMPILER::T3DEFCFUN COMPILER::MYSUB +++ COMPILER::WT-INLINE-LONG-FLOAT COMPILER::TOO-FEW-ARGS +++ COMPILER::CHECK-VDECL COMPILER::C2GO COMPILER::C2LET +++ COMPILER::ASSIGN-DOWN-VARS COMPILER::C2CASE +++ COMPILER::C2FUNCALL-SFUN COMPILER::AND-FORM-TYPE +++ COMPILER::C-FUNCTION-NAME COMPILER::C2MAPCAR COMPILER::CJT +++ COMPILER::C2MULTIPLE-VALUE-BIND COMPILER::C2MAPC)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- COMPILER::UNWIND-EXIT COMPILER::WT-COMMENT COMPILER::CMPERR ++- COMPILER::WT-CVAR COMPILER::FAST-LINK-PROCLAIMED-TYPE-P ++- COMPILER::C1CASE COMPILER::CMPWARN COMPILER::ADD-INIT ++- COMPILER::INIT-NAME COMPILER::WT-INTEGER-LOC COMPILER::CMPNOTE ++- COMPILER::C1LAMBDA-EXPR)) +++ COMPILER::C1APPLY-OPTIMIZE COMPILER::T3DEFUN-LOCAL-ENTRY +++ COMPILER::T3INIT-FUN COMPILER::C2STRUCTURE-SET)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::*) ++- COMPILER::C2BLOCK COMPILER::C1SYMBOL-FUN ++- COMPILER::C2BLOCK-LOCAL COMPILER::C2DECL-BODY ++- COMPILER::COMPILER-BUILD COMPILER::NCONC-FILES ++- COMPILER::WT-INLINE-LOC COMPILER::C2RETURN-LOCAL ++- COMPILER::C1BODY)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ COMPILER::T3DEFUN COMPILER::T2DEFUN COMPILER::T3LOCAL-FUN +++ COMPILER::T3LOCAL-DCFUN)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++- COMPILER::WT-FIXNUM-VALUE COMPILER::DOLIST** COMPILER::CO1LDB ++- COMPILER::PUSH-REFERRED-WITH-START COMPILER::C2ASSOC!2 ++- COMPILER::ADD-DEBUG-INFO COMPILER::WT-CHARACTER-VALUE ++- COMPILER::MAYBE-WT-C2DM-BIND-VL COMPILER::C2BIND-LOC ++- COMPILER::C2CATCH COMPILER::DO-REFERRED COMPILER::C2BLOCK-CLB ++- COMPILER::CO1CONSTANT-FOLD COMPILER::C2CALL-LOCAL ++- COMPILER::SHIFT<< COMPILER::C2UNWIND-PROTECT ++- COMPILER::C2MULTIPLE-VALUE-SETQ COMPILER::C2DM-BIND-VL ++- COMPILER::DOTIMES* COMPILER::REFERRED-LENGTH COMPILER::C1ARGS ++- COMPILER::CK-SPEC COMPILER::C2MULTIPLE-VALUE-CALL ++- COMPILER::C2CALL-LAMBDA COMPILER::CO1READ-BYTE ++- COMPILER::CO1VECTOR-PUSH COMPILER::STACK-LET COMPILER::CMPCK ++- COMPILER::MAYBE-EVAL COMPILER::COERCE-LOC COMPILER::C2PSETQ ++- SYSTEM::DEFINE-INLINE-FUNCTION COMPILER::WT-MAKE-DCLOSURE ++- COMPILER::COMPILER-CC COMPILER::WT-GO COMPILER::C1LAMBDA-FUN ++- COMPILER::C2RETURN-CLB COMPILER::C1DECL-BODY ++- COMPILER::PUSH-CHANGED-VARS COMPILER::GET-INLINE-LOC ++- COMPILER::CO1SUBLIS COMPILER::CHANGED-LENGTH COMPILER::CO1CONS ++- COMPILER::ARGS-INFO-REFERRED-VARS COMPILER::SET-JUMP-FALSE ++- COMPILER::MAKE-USER-INIT COMPILER::NEXT-CVAR ++- COMPILER::CAN-BE-REPLACED COMPILER::WT-V*-MACROS ++- COMPILER::NEXT-CMACRO COMPILER::C2RETURN-CCB ++- COMPILER::CO1SCHAR COMPILER::IS-CHANGED ++- COMMON-LISP::DEFINE-COMPILER-MACRO COMPILER::SET-DBIND ++- COMPILER::WT-H COMPILER::COERCE-LOC-STRUCTURE-REF ++- COMPILER::C1EXPR* COMPILER::IS-REFERRED COMPILER::SHIFT>> ++- COMPILER::WT COMPILER::TYPE-AND COMPILER::PRIN1-CMP ++- COMPILER::C2BIND-INIT COMPILER::RESULT-TYPE-FROM-ARGS ++- COMPILER::EQL-NOT-NIL COMPILER::C2APPLY COMPILER::C2BLOCK-CCB ++- COMPILER::WT-NL1 COMPILER::CO1WRITE-CHAR COMPILER::CFAST-WRITE ++- COMPILER::NEED-TO-PROTECT COMPILER::T3SHARP-COMMA ++- SYSTEM::ADD-DEBUG COMPILER::BIGNUM-EXPANSION-STORAGE ++- COMPILER::C2SETQ COMPILER::FLAG-P ++- COMPILER::PUSH-CHANGED-WITH-START COMPILER::CMPFIX-ARGS ++- COMPILER::CO1STRUCTURE-PREDICATE COMPILER::FAST-READ ++- COMPILER::C1CONSTANT-VALUE COMPILER::BASE-USED ++- COMPILER::PROCLAIM-VAR COMPILER::CO1TYPEP ++- COMPILER::SET-JUMP-TRUE COMPILER::TYPE>= COMPILER::DOTIMES** ++- COMPILER::CONVERT-CASE-TO-SWITCH COMPILER::C2MEMBER!2 ++- COMPILER::DO-CHANGED COMPILER::ADD-INFO COMPILER::SET-VS ++- COMPILER::CHECK-FNAME-ARGS ++- COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES ++- COMPILER::C2MULTIPLE-VALUE-PROG1 COMPILER::NEXT-LABEL* ++- COMPILER::WT-VAR COMPILER::C2THROW COMPILER::INLINE-PROC ++- COMPILER::PUSH-REFERRED COMPILER::C2LIST-NTH-IMMEDIATE ++- COMPILER::C1FMLA COMPILER::PUSH-CHANGED ++- COMPILER::MULTIPLE-VALUE-CHECK COMPILER::MIA ++- COMPILER::WT-LABEL COMPILER::WT-NL ++- COMPILER::WT-SHORT-FLOAT-VALUE COMPILER::SET-BDS-BIND ++- COMPILER::DO-ARRAY COMPILER::WT-REQUIREDS ++- COMPILER::C2EXPR-TOP* COMPILER::C2DM-BIND-LOC ++- COMPILER::DOLIST* SYSTEM::SWITCH-FINISH ++- COMPILER::IS-REP-REFERRED COMPILER::WT-LONG-FLOAT-VALUE ++- COMPILER::C1SETQ1 COMPILER::FLAGS COMPILER::CO1EQL ++- COMPILER::CHECK-END COMPILER::NEXT-LABEL COMPILER::CK-VL ++- COMPILER::ARGS-INFO-CHANGED-VARS COMPILER::C1PROGN* ++- COMPILER::C2DM-BIND-INIT COMPILER::STRUCT-TYPE-OPT ++- COMPILER::UNWIND-BDS COMPILER::SAFE-COMPILE ++- COMPILER::CO1READ-CHAR COMPILER::JUMPS-TO-P SYSTEM::SWITCH ++- COMPILER::NEXT-CFUN COMPILER::CO1WRITE-BYTE ++- COMPILER::DOWNWARD-FUNCTION COMPILER::COMPILER-DEF-HOOK ++- COMPILER::C2STACK-LET COMPILER::C2EXPR-TOP ++- COMPILER::C2LAMBDA-EXPR-WITH-KEY COMPILER::IN-ARRAY ++- COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY)) +++ COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL COMPILER::LINK +++ COMPILER::INLINE-ARGS)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::*) ++- COMPILER::COMPILE-FILE1)) ++\ No newline at end of file +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::T) +++ COMPILER::WT-SIMPLE-CALL COMPILER::GET-OUTPUT-PATHNAME)) ++\ No newline at end of file ++--- gcl-2.6.12.orig/h/object.h +++++ gcl-2.6.12/h/object.h ++@@ -255,6 +255,21 @@ struct freelist { ++ ++ #define FREE (-1) /* free object */ ++ +++struct fasd { +++ object stream; /* lisp object of type stream */ +++ object table; /* hash table used in dumping or vector on input*/ +++ object eof; /* lisp object to be returned on coming to eof mark */ +++ object direction; /* holds Cnil or sKinput or sKoutput */ +++ object package; /* the package symbols are in by default */ +++ object index; /* integer. The current_dump index on write */ +++ object filepos; /* nil or the position of the start */ +++ object table_length; /* On read it is set to the size dump array needed +++ or 0 +++ */ +++ object evald_items; /* a list of items which have been eval'd and must +++ not be walked by fasd_patch_sharp */ +++}; +++ ++ /* ++ Storage manager for each type. ++ */ ++--- gcl-2.6.12.orig/h/protoize.h +++++ gcl-2.6.12/h/protoize.h ++@@ -144,7 +144,7 @@ struct key {short n,allow_other_keys; ++ /* cmpaux.c:185:OF */ extern fixnum object_to_fixnum (object x); /* (x) object x; */ ++ /* cmpaux.c:263:OF */ extern char *object_to_string (object x); /* (x) object x; */ ++ typedef int (*FUNC)(); ++-/* cmpaux.c:294:OF */ extern void call_init (int init_address, object memory, object fasl_vec, FUNC fptr); /* (init_address, memory, fasl_vec, fptr) int init_address; object memory; object fasl_vec; FUNC fptr; */ +++/* cmpaux.c:294:OF */ extern void call_init (int init_address,object memory,object faslfile); /* (init_address, memory, fasl_vec, fptr) int init_address; object memory; object fasl_vec; FUNC fptr; */ ++ /* cmpaux.c:339:OF */ extern void do_init (object *statVV); /* (statVV) object *statVV; */ ++ /* cmpaux.c:416:OF */ extern void gcl_init_or_load1 (void (*fn) (void), const char *file); /* (fn, file) int (*fn)(); char *file; */ ++ /* conditional.c:200:OF */ extern void gcl_init_conditional (void); /* () */ ++--- gcl-2.6.12.orig/o/cmpaux.c +++++ gcl-2.6.12/o/cmpaux.c ++@@ -324,63 +324,18 @@ object_to_string(object x) { ++ /* } */ ++ /* #endif */ ++ +++ ++ void ++-call_init(int init_address, object memory, object fasl_vec, FUNC fptr) ++-{object form; ++- FUNC at; ++-/* #ifdef CLEAR_CACHE */ ++-/* static int n; */ ++-/* static sigset_t ss; */ ++- ++-/* if (!n) { */ ++-/* struct sigaction sa={{(void *)sigh},{{0}},SA_RESTART|SA_SIGINFO,NULL}; */ ++- ++-/* sigaction(SIGILL,&sa,NULL); */ ++-/* sigemptyset(&ss); */ ++-/* sigaddset(&ss,SIGILL); */ ++-/* sigprocmask(SIG_BLOCK,&ss,NULL); */ ++-/* n=1; */ ++-/* } */ ++-/* #endif */ +++call_init(int init_address,object memory,object faslfile) { ++ +++ bds_bind(sSPmemory,memory); +++ bds_bind(sSPinit,faslfile); +++ ((FUNC)(memory->cfd.cfd_start+init_address))(); +++ bds_unwind1; +++ bds_unwind1; ++ ++- check_type(fasl_vec,t_vector); ++- form=(fasl_vec->v.v_self[fasl_vec->v.v_fillp -1]); +++} ++ ++- if (fptr) at = fptr; ++- else ++- at=(FUNC)(memory->cfd.cfd_start+ init_address ); ++- ++-#ifdef VERIFY_INIT ++- VERIFY_INIT ++-#endif ++- ++- if (type_of(form)==t_cons && ++- form->c.c_car == sSPinit) ++- {bds_bind(sSPinit,fasl_vec); ++- bds_bind(sSPmemory,memory); ++-/* #ifdef CLEAR_CACHE */ ++-/* sigprocmask(SIG_UNBLOCK,&ss,NULL); */ ++-/* #endif */ ++- (*at)(); ++-/* #ifdef CLEAR_CACHE */ ++-/* sigprocmask(SIG_BLOCK,&ss,NULL); */ ++-/* #endif */ ++- bds_unwind1; ++- bds_unwind1; ++- } ++- else ++- /* old style three arg init, with all init being done by C code. */ ++- {memory->cfd.cfd_self = fasl_vec->v.v_self; ++- memory->cfd.cfd_fillp = fasl_vec->v.v_fillp; ++-/* #ifdef CLEAR_CACHE */ ++-/* sigprocmask(SIG_UNBLOCK,&ss,NULL); */ ++-/* #endif */ ++- (*at)(memory->cfd.cfd_start, memory->cfd.cfd_size, memory); ++-/* #ifdef CLEAR_CACHE */ ++-/* sigprocmask(SIG_BLOCK,&ss,NULL); */ ++-/* #endif */ ++-}} ++ ++ /* statVV is the address of some static storage, which is used by the ++ cfunctions to refer to global variables,.. ++@@ -393,48 +348,46 @@ call_init(int init_address, object memor ++ ++ */ ++ ++-DEFUN_NEW("MARK-MEMORY-AS-PROFILING",object,fSmark_memory_as_profiling,SI,0,0, ++- NONE,OO,OO,OO,OO,(void),"") { ++- ++- sSPmemory->s.s_dbind->cfd.cfd_prof=1; ++- ++- return Cnil; ++- ++-} ++- ++ void ++-do_init(object *statVV) ++-{object fasl_vec=sSPinit->s.s_dbind; ++- object data = sSPmemory->s.s_dbind; ++- {object *p,*q,y; ++- int n=fasl_vec->v.v_fillp -1; ++- int i; ++- object form; ++- check_type(fasl_vec,t_vector); ++- form = fasl_vec->v.v_self[n]; ++- dcheck_type(form,t_cons); +++do_init(object *statVV) { +++ +++ object faslfile=sSPinit->s.s_dbind; +++ object data=sSPmemory->s.s_dbind; +++ object *p,*q,y; +++ int i,n; +++ object fasl_vec; +++ char ch; +++ +++ ch=readc_stream(faslfile); +++ unreadc_stream(ch,faslfile); +++ +++ if (ch!='\n') { +++ struct fasd * fd; +++ faslfile=FFN(fSopen_fasd)(faslfile,sKinput,OBJNULL,Cnil); +++ fd=(struct fasd *)faslfile->v.v_self; +++ n=fix(fd->table_length); +++ fd->table->v.v_self=alloca(n*sizeof(object)); +++ memset(fd->table->v.v_self,0,n*sizeof(object)); +++ fd->table->v.v_dim=faslfile->v.v_self[1]->v.v_fillp=n; +++ } ++ +++ n=fix(type_of(faslfile)==t_stream ? read_object(faslfile) : FFN(fSread_fasd_top)(faslfile)); +++ sSPinit->s.s_dbind=fasl_vec=fSmake_vector1_1(n,aet_object,Cnil); ++ ++ /* switch SPinit to point to a vector of function addresses */ ++- +++ ++ fasl_vec->v.v_elttype = aet_fix; ++- fasl_vec->v.v_dim *= (sizeof(object)/sizeof(fixnum)); ++- fasl_vec->v.v_fillp *= (sizeof(object)/sizeof(fixnum)); ++- +++ ++ /* swap the entries */ ++- p = fasl_vec->v.v_self; +++ for (i=0,p=fasl_vec->v.v_self,q=statVV;icfd.cfd_self = statVV; ++- data->cfd.cfd_fillp= n+1; ++- statVV[n] = data; ++- +++ data->cfd.cfd_fillp= n; +++ statVV[n-1] = data; ++ ++ /* So now the fasl_vec is a fixnum array, containing random addresses of c ++ functions and other stuff from the compiled code. ++@@ -442,16 +395,20 @@ do_init(object *statVV) ++ */ ++ /* Now we can run the forms f1 f2 in form= (%init f1 f2 ...) */ ++ ++- form=form->c.c_cdr; ++- {object *top=vs_top; ++- ++- for(i=0 ; i< form->v.v_fillp; i++) ++- { ++- eval(form->v.v_self[i]); ++- vs_top=top; ++- } ++- } ++-}} +++ FFN(fSload_stream)(faslfile,Cnil); +++ if (type_of(faslfile)!=t_stream) +++ FFN(fSclose_fasd)(faslfile); +++ +++} +++ +++DEFUN_NEW("MARK-MEMORY-AS-PROFILING",object,fSmark_memory_as_profiling,SI,0,0, +++ NONE,OO,OO,OO,OO,(void),"") { +++ +++ sSPmemory->s.s_dbind->cfd.cfd_prof=1; +++ +++ return Cnil; +++ +++} ++ ++ #ifdef DOS ++ #define PATH_LIM 8 ++@@ -498,14 +455,15 @@ gcl_init_or_load1(void (*fn)(void),const ++ if (file[strlen(file)-1]=='o') { ++ ++ object memory; ++- object fasl_data; +++ object faslfile; ++ file=FIX_PATH_STRING(file); ++ ++ memory=new_cfdata(); ++ memory->cfd.cfd_start= (char *)fn; ++ printf("Initializing %s\n",file); fflush(stdout); ++- fasl_data = read_fasl_data(file); ++- call_init(0,memory,fasl_data,0); +++ faslfile=open_stream(make_simple_string(file),smm_input,Cnil,sKerror); +++ SEEK_TO_END_OFILE(faslfile->sm.sm_fp); +++ call_init(0,memory,faslfile); ++ ++ } else { ++ printf("loading %s\n",file); ++--- gcl-2.6.12.orig/o/fasdump.c +++++ gcl-2.6.12/o/fasdump.c ++@@ -35,22 +35,6 @@ object make_pathname (); ++ ++ static int needs_patching; ++ ++- ++-struct fasd { ++- object stream; /* lisp object of type stream */ ++- object table; /* hash table used in dumping or vector on input*/ ++- object eof; /* lisp object to be returned on coming to eof mark */ ++- object direction; /* holds Cnil or sKinput or sKoutput */ ++- object package; /* the package symbols are in by default */ ++- object index; /* integer. The current_dump index on write */ ++- object filepos; /* nil or the position of the start */ ++- object table_length; /* On read it is set to the size dump array needed ++- or 0 ++- */ ++- object evald_items; /* a list of items which have been eval'd and must ++- not be walked by fasd_patch_sharp */ ++-}; ++- ++ struct fasd current_fasd; ++ ++ ++@@ -599,7 +583,7 @@ DEFUN_NEW("OPEN-FASD",object,fSopen_fasd ++ else ++ check_type(tabl,t_hashtable);} ++ massert(str==stream); ++- result=alloc_simple_vector(sizeof(struct fasd)/sizeof(int),aet_object); +++ result=alloc_simple_vector(sizeof(struct fasd)/sizeof(object),aet_object); ++ array_allocself(result,1,Cnil); ++ {struct fasd *fd= (struct fasd *)result->v.v_self; ++ fd->table=tabl; ++@@ -631,6 +615,7 @@ DEFUN_NEW("OPEN-FASD",object,fSopen_fasd ++ fd->index=make_fixnum(dump_index); ++ fd->filepos=current_fasd.filepos; ++ fd->package=current_fasd.package; +++ fd->table_length=current_fasd.table_length; ++ return result; ++ }} ++ ++@@ -642,7 +627,7 @@ DEFUN_NEW("CLOSE-FASD",object,fSclose_fa ++ if (type_of(fd->table)==t_vector) ++ /* input uses a vector */ ++ {if (fd->table->v.v_self) ++- gset(fd->table->v.v_self,0,fix(fd->index),aet_object); +++ fd->table->v.v_dim=0;/*self can be on the stack, and others write there*/ ++ } ++ else ++ if(fd->direction==sKoutput) ++@@ -1402,66 +1387,6 @@ clrhash(object table) ++ table->ht.ht_self[i].hte_value = OBJNULL;} ++ table->ht.ht_nent =0;} ++ ++- ++- ++-object read_fasl_vector1(); ++-object ++-read_fasl_vector(object in) ++-{char ch; ++- object orig = in; ++- object d; ++- int tem; ++- if (((tem=getc(((FILE *)in->sm.sm_fp))) == EOF) && feof(((FILE *)in->sm.sm_fp))) ++- { char *pf; ++- coerce_to_filename(in,FN1); ++- for (pf=FN1+strlen(FN1);pf>FN1 && pf[-1]!='.';pf--); ++- if (pf==FN1) {pf=FN1+strlen(FN1);*pf++='.';} ++- snprintf(pf,sizeof(FN1)-(pf-FN1),"data"); ++- d=make_simple_string(FN1); ++- in = open_stream(d,smm_input,Cnil,Cnil); ++- if (in == Cnil) ++- FEerror("Can't open file ~s",1,d); ++- } ++- else if (tem != EOF) ++- { ungetc(tem,in->sm.sm_fp);} ++- while (1) ++- { ch=readc_stream(in); ++- if (ch=='#') ++- {unreadc_stream(ch,in); ++- return read_fasl_vector1(in);} ++- if (ch== d_begin_dump){ ++- unreadc_stream(ch,in); ++- break;}} ++- {object ar=FFN(fSopen_fasd)(in,sKinput,0,Cnil); ++- int n=fix(current_fasd.table_length); ++- object result,last; ++- { BEGIN_NO_INTERRUPT; ++-#ifdef HAVE_ALLOCA ++- current_fasd.table->v.v_self ++- = (object *)alloca(n*sizeof(object)); ++-#else ++- current_fasd.table->v.v_self ++- = (object *)alloc_relblock(n*sizeof(object)); ++-#endif ++- current_fasd.table->v.v_dim=n; ++- current_fasd.table->v.v_fillp=n; ++- gset( current_fasd.table->v.v_self,0,n,aet_object); ++- END_NO_INTERRUPT; ++- } ++- result=FFN(fSread_fasd_top)(ar); ++- if (type_of(result) !=t_vector) goto ERROR; ++- last=result->v.v_self[result->v.v_fillp-1]; ++- if(type_of(last)!=t_cons || last->c.c_car !=sSPinit) ++- goto ERROR; ++- current_fasd.table->v.v_self = 0; ++- FFN(fSclose_fasd)(ar); ++- if (orig != in) ++- close_stream(in); ++- return result; ++- ERROR: FEerror("Bad fasd stream ~a",1,in); ++- return Cnil; ++-}} ++- ++ object IfaslInStream; ++ /* static void */ ++ /* IreadFasdData(void) */ ++--- gcl-2.6.12.orig/o/file.d +++++ gcl-2.6.12/o/file.d ++@@ -1645,7 +1645,7 @@ DEFUN_NEW("LOAD-STREAM",object,fSload_st ++ for (;;) { ++ preserving_whitespace_flag = FALSE; ++ detect_eos_flag = TRUE; ++- x = read_object_non_recursive(strm); +++ x = type_of(strm)==t_stream ? read_object_non_recursive(strm) : FFN(fSread_fasd_top)(strm); ++ if (x == OBJNULL) ++ break; ++ { ++@@ -2371,75 +2371,3 @@ gcl_init_file_function() ++ gcl_init_readline_function(); ++ #endif ++ } ++- ++- ++-object ++-read_fasl_data(const char *str) { ++- ++- object faslfile, data; ++-#ifndef SEEK_TO_END_OFILE ++-#if defined(BSD) && defined(UNIX) ++- FILE *fp; ++- int i; ++-#ifdef HAVE_AOUT ++- struct exec header; ++-#endif ++-#endif ++-#ifdef HAVE_FILEHDR ++- struct filehdr fileheader; ++-#endif ++-#ifdef E15 ++- struct exec header; ++-#endif ++-#endif ++- vs_mark; ++- ++- faslfile = make_simple_string(str); ++- vs_push(faslfile); ++- faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); ++- vs_push(faslfile); ++- ++-#ifdef SEEK_TO_END_OFILE ++- SEEK_TO_END_OFILE(faslfile->sm.sm_fp); ++-#else ++- ++-#ifdef BSD ++- fp = faslfile->sm.sm_fp; ++- fread(&header, sizeof(header), 1, fp); ++- fseek(fp, ++- header.a_text+header.a_data+ ++- header.a_syms+header.a_trsize+header.a_drsize, ++- 1); ++- fread(&i, sizeof(i), 1, fp); ++- fseek(fp, i - sizeof(i), 1); ++-#endif ++- ++-#ifdef HAVE_FILEHDR ++- fp = faslfile->sm.sm_fp; ++- fread(&fileheader, sizeof(fileheader), 1, fp); ++- fseek(fp, ++- fileheader.f_symptr+fileheader.f_nsyms*SYMESZ, ++- 0); ++- fread(&i, sizeof(i), 1, fp); ++- fseek(fp, i - sizeof(i), 1); ++- while ((i = getc(fp)) == 0) ++- ; ++- ungetc(i, fp); ++-#endif ++- ++-#ifdef E15 ++- fp = faslfile->sm.sm_fp; ++- fread(&header, sizeof(header), 1, fp); ++- fseek(fp, ++- header.a_text+header.a_data+ ++- header.a_syms+header.a_trsize+header.a_drsize, ++- 1); ++-#endif ++-#endif ++- data = read_fasl_vector(faslfile); ++- ++- vs_push(data); ++- close_stream(faslfile); ++- vs_reset; ++- return(data); ++-} ++--- gcl-2.6.12.orig/o/gprof.c +++++ gcl-2.6.12/o/gprof.c ++@@ -5,6 +5,10 @@ ++ ++ static unsigned long gprof_on; ++ +++#ifdef DARWIN +++void _mcleanup() {} +++#endif +++ ++ DEFUN_NEW("MCLEANUP",object,fSmcleanup,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { ++ ++ extern void _mcleanup(void); ++--- gcl-2.6.12.orig/o/read.d +++++ gcl-2.6.12/o/read.d ++@@ -333,16 +333,16 @@ setup_READ() ++ backq_level = 0; ++ } ++ ++-static void ++-setup_standard_READ() ++-{ ++- READtable = standard_readtable; ++- READdefault_float_format = 'F'; ++- READbase = 10; ++- READsuppress = FALSE; ++- sSAsharp_eq_contextA->s.s_dbind=Cnil; ++- backq_level = 0; ++-} +++/* static void */ +++/* setup_standard_READ() */ +++/* { */ +++/* READtable = standard_readtable; */ +++/* READdefault_float_format = 'F'; */ +++/* READbase = 10; */ +++/* READsuppress = FALSE; */ +++/* sSAsharp_eq_contextA->s.s_dbind=Cnil; */ +++/* backq_level = 0; */ +++/* } */ ++ ++ object ++ read_char(in) ++@@ -1393,28 +1393,6 @@ FFN(siLsharp_comma_reader_for_compiler)( ++ vs_base[0] = make_cons(siSsharp_comma, vs_base[0]); ++ } ++ ++-/* ++- For fasload. ++-*/ ++-static void ++-Lsharp_exclamation_reader() ++-{ ++- check_arg(3); ++- if(vs_base[2] != Cnil && !READsuppress) ++- extra_argument('!'); ++- vs_popp; ++- vs_popp; ++- if (READsuppress) { ++- vs_base[0] = Cnil; ++- return; ++- } ++- vs_base[0] = read_object(vs_base[0]); ++- if (sSAsharp_eq_contextA->s.s_dbind!=Cnil) ++- vs_base[0]=patch_sharp(vs_base[0]); ++- ieval(vs_base[0]); ++- vs_popp; ++-} ++- ++ static void ++ Lsharp_B_reader() ++ { ++@@ -2327,8 +2305,6 @@ gcl_init_read() ++ dtab['*'] = make_cf(Lsharp_asterisk_reader); ++ dtab[':'] = make_cf(Lsharp_colon_reader); ++ dtab['.'] = make_cf(Lsharp_dot_reader); ++- dtab['!'] = make_cf(Lsharp_exclamation_reader); ++- /* Used for fasload only. */ ++ dtab[','] = make_cf(Lsharp_comma_reader); ++ dtab['B'] = dtab['b'] = make_cf(Lsharp_B_reader); ++ dtab['O'] = dtab['o'] = make_cf(Lsharp_O_reader); ++@@ -2441,96 +2417,96 @@ gcl_init_read_function() ++ ++ object sSPinit; ++ ++-object ++-read_fasl_vector1(in) ++-object in; ++-{ ++- int dimcount, dim; ++- VOL object *vsp; ++- object vspo; ++- VOL object x; ++- long i; ++- bool e; ++- object old_READtable; ++- int old_READdefault_float_format; ++- int old_READbase; ++- int old_READsuppress; ++- volatile object old_READcontext; ++- int old_backq_level; ++- ++- /* to prevent longjmp clobber */ ++- i=(long)&vsp; ++- i+=i; ++- vsp=&vspo; ++- old_READtable = READtable; ++- old_READdefault_float_format = READdefault_float_format; ++- old_READbase = READbase; ++- old_READsuppress = READsuppress; ++- old_READcontext=sSAsharp_eq_contextA->s.s_dbind; ++- /* BUG FIX by Toshiba */ ++- vs_push(old_READtable); ++- old_backq_level = backq_level; ++- ++- setup_standard_READ(); ++- ++- frs_push(FRS_PROTECT, Cnil); ++- if (nlj_active) { ++- e = TRUE; ++- goto L; ++- } ++- ++- while (readc_stream(in) != '#') ++- ; ++- while (readc_stream(in) != '(') ++- ; ++- vsp = vs_top; ++- dimcount = 0; ++- for (;;) { ++- sSAsharp_eq_contextA->s.s_dbind=Cnil; ++- backq_level = 0; ++- delimiting_char = code_char(')'); ++- preserving_whitespace_flag = FALSE; ++- detect_eos_flag = FALSE; ++- x = read_object(in); ++- if (x == OBJNULL) ++- break; ++- vs_check_push(x); ++- if (sSAsharp_eq_contextA->s.s_dbind!=Cnil) ++- x = vs_head = patch_sharp(x); ++- dimcount++; ++- } ++- if(dimcount==1 && type_of(vs_head)==t_vector) ++- {/* new style where all read at once */ ++- x=vs_head; ++- goto DONE;} ++- /* old style separately sharped, and no %init */ ++- {BEGIN_NO_INTERRUPT; ++- x=alloc_simple_vector(dimcount,aet_object); ++- vs_push(x); ++- x->v.v_self ++- = (object *)alloc_relblock(dimcount * sizeof(object)); ++- END_NO_INTERRUPT;} ++- for (dim = 0; dim < dimcount; dim++) ++- {SGC_TOUCH(x); ++- x->cfd.cfd_self[dim] = vsp[dim];} +++/* object */ +++/* read_fasl_vector1(in) */ +++/* object in; */ +++/* { */ +++/* int dimcount, dim; */ +++/* VOL object *vsp; */ +++/* object vspo; */ +++/* VOL object x; */ +++/* long i; */ +++/* bool e; */ +++/* object old_READtable; */ +++/* int old_READdefault_float_format; */ +++/* int old_READbase; */ +++/* int old_READsuppress; */ +++/* volatile object old_READcontext; */ +++/* int old_backq_level; */ +++ +++/* /\* to prevent longjmp clobber *\/ */ +++/* i=(long)&vsp; */ +++/* i+=i; */ +++/* vsp=&vspo; */ +++/* old_READtable = READtable; */ +++/* old_READdefault_float_format = READdefault_float_format; */ +++/* old_READbase = READbase; */ +++/* old_READsuppress = READsuppress; */ +++/* old_READcontext=sSAsharp_eq_contextA->s.s_dbind; */ +++/* /\* BUG FIX by Toshiba *\/ */ +++/* vs_push(old_READtable); */ +++/* old_backq_level = backq_level; */ +++ +++/* setup_standard_READ(); */ +++ +++/* frs_push(FRS_PROTECT, Cnil); */ +++/* if (nlj_active) { */ +++/* e = TRUE; */ +++/* goto L; */ +++/* } */ +++ +++/* while (readc_stream(in) != '#') */ +++/* ; */ +++/* while (readc_stream(in) != '(') */ +++/* ; */ +++/* vsp = vs_top; */ +++/* dimcount = 0; */ +++/* for (;;) { */ +++/* sSAsharp_eq_contextA->s.s_dbind=Cnil; */ +++/* backq_level = 0; */ +++/* delimiting_char = code_char(')'); */ +++/* preserving_whitespace_flag = FALSE; */ +++/* detect_eos_flag = FALSE; */ +++/* x = read_object(in); */ +++/* if (x == OBJNULL) */ +++/* break; */ +++/* vs_check_push(x); */ +++/* if (sSAsharp_eq_contextA->s.s_dbind!=Cnil) */ +++/* x = vs_head = patch_sharp(x); */ +++/* dimcount++; */ +++/* } */ +++/* if(dimcount==1 && type_of(vs_head)==t_vector) */ +++/* {/\* new style where all read at once *\/ */ +++/* x=vs_head; */ +++/* goto DONE;} */ +++/* /\* old style separately sharped, and no %init *\/ */ +++/* {BEGIN_NO_INTERRUPT; */ +++/* x=alloc_simple_vector(dimcount,aet_object); */ +++/* vs_push(x); */ +++/* x->v.v_self */ +++/* = (object *)alloc_relblock(dimcount * sizeof(object)); */ +++/* END_NO_INTERRUPT;} */ +++/* for (dim = 0; dim < dimcount; dim++) */ +++/* {SGC_TOUCH(x); */ +++/* x->cfd.cfd_self[dim] = vsp[dim];} */ ++ ++ ++- DONE: ++- e = FALSE; +++/* DONE: */ +++/* e = FALSE; */ ++ ++-L: ++- frs_pop(); +++/* L: */ +++/* frs_pop(); */ ++ ++- READtable = old_READtable; ++- READdefault_float_format = old_READdefault_float_format; ++- READbase = old_READbase; ++- READsuppress = old_READsuppress; ++- sSAsharp_eq_contextA->s.s_dbind=old_READcontext; ++- backq_level = old_backq_level; ++- if (e) { ++- nlj_active = FALSE; ++- unwind(nlj_fr, nlj_tag); ++- } ++- vs_top = (object *)vsp; ++- return(x); ++-} +++/* READtable = old_READtable; */ +++/* READdefault_float_format = old_READdefault_float_format; */ +++/* READbase = old_READbase; */ +++/* READsuppress = old_READsuppress; */ +++/* sSAsharp_eq_contextA->s.s_dbind=old_READcontext; */ +++/* backq_level = old_backq_level; */ +++/* if (e) { */ +++/* nlj_active = FALSE; */ +++/* unwind(nlj_fr, nlj_tag); */ +++/* } */ +++/* vs_top = (object *)vsp; */ +++/* return(x); */ +++/* } */ ++--- gcl-2.6.12.orig/o/sfasl.c +++++ gcl-2.6.12/o/sfasl.c ++@@ -80,619 +80,5 @@ DEFUN_NEW("FIND-SYM-PTABLE",object,fSfin ++ #ifdef SEPARATE_SFASL_FILE ++ #include SEPARATE_SFASL_FILE ++ #else ++- ++-#include "ext_sym.h" ++-struct node * find_sym(); ++-int node_compare(); ++-#ifndef _WIN32 ++-void *malloc(); ++-void *bsearch(); ++-#endif ++- ++-struct reloc relocation_info; ++-/* next 5 static after debug */ ++- ++-int debug; ++- ++-#ifdef DEBUG ++-#define debug sfasldebug ++-int sfasldebug=0; ++-#define dprintf(s,ar) if(debug) { printf(" ( s )",ar) ; fflush(stdout);} ++-#define STAT ++- ++-#else /* end debug */ ++-#define dprintf(s,ar) ++-#define STAT static ++-#endif ++- ++-#ifndef MAXPATHLEN ++-#define MAXPATHLEN 256 ++-#endif ++-#define PTABLE_EXTRA 20 ++- ++-struct sfasl_info { ++- struct syment *s_symbol_table; ++- char *s_start_address; ++- char *s_start_data; ++- char *s_start_bss; ++- char *s_my_string_table; ++- int s_extra_bss; ++- char *s_the_start; ++- ++-}; ++-struct sfasl_info *sfaslp; ++- ++-#define symbol_table sfaslp->s_symbol_table ++-#define start_address sfaslp->s_start_address ++-#define my_string_table sfaslp->s_my_string_table ++-#define extra_bss sfaslp->s_extra_bss ++-#define the_start sfaslp->s_the_start ++- ++- ++-#ifndef describe_sym ++-#define describe_sym(a) ++-#endif ++- ++-#ifdef STAND ++-#include "rel_stand.c" ++-#endif ++- ++-/* begin reloc_file */ ++-#include RELOC_FILE ++- ++-/* end reloc_file */ ++-int get_extra_bss ( struct syment *sym_table, int length, int start, int *ptr, int bsssize); ++-void relocate_symbols ( unsigned int length ); ++-void set_symbol_address ( struct syment *sym, char *string ); ++- ++-int ++-fasload(faslfile) ++-object faslfile; ++-{ long fasl_vector_start; ++- struct filehdr fileheader; ++- struct sfasl_info sfasl_info_buf; ++-#ifdef COFF ++- struct scnhdr section[10]; ++- struct aouthdr header; ++-#endif ++- int textsize, datasize, bsssize,nsyms; ++-#if defined ( READ_IN_STRING_TABLE ) || defined ( HPUX ) ++- int string_size=0; ++-#endif ++- ++- object memory, data; ++- FILE *fp; ++- char filename[MAXPATHLEN]; ++- int i; ++- int init_address=0; ++-#ifndef STAND ++- object *old_vs_base = vs_base; ++- object *old_vs_top = vs_top; ++-#endif ++- sfaslp = &sfasl_info_buf; ++- ++- extra_bss=0; ++-#ifdef STAND ++- strcpy(filename,faslfile); ++- fp=fopen(filename,"r"); ++-#else ++- coerce_to_filename(faslfile, filename); ++- faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); ++- vs_push(faslfile); ++- fp = faslfile->sm.sm_fp; ++-#endif ++- ++- HEADER_SEEK(fp); ++- if(!fread((char *)&fileheader, sizeof(struct filehdr), 1, fp)) ++- FEerror("Could not get the header",0,0); ++- nsyms = NSYMS(fileheader); ++-#ifdef COFF ++- ++-#ifdef AIX3 ++- setup_for_aix_load(); ++-#endif ++- ++- fread(&header,1,fileheader.f_opthdr,fp); ++- ++- fread(§ion[1],fileheader.f_nscns,sizeof (struct scnhdr),fp); ++- textsize = section[TEXT_NSCN].s_size; ++- datasize = section[DATA_NSCN].s_size; ++- if (strcmp(section[BSS_NSCN].s_name, ".bss") == 0) ++- bsssize=section[BSS_NSCN].s_size; ++- else bsssize=section[BSS_NSCN].s_size = 0; ++-#endif ++- ++-#ifdef BSD ++- textsize=fileheader.a_text; ++- datasize=fileheader.a_data; ++- bsssize=fileheader.a_bss; ++-#endif ++- symbol_table = ++- (struct syment *) OUR_ALLOCA(sizeof(struct syment)* ++- (unsigned int)nsyms); ++- fseek(fp,(int)( N_SYMOFF(fileheader)), 0); ++- { ++- for (i = 0; i < nsyms; i++) ++- { fread((char *)&symbol_table[i], SYMESZ, 1, fp); ++- dprintf( symbol table %d , i); ++- if (debug) describe_sym(i); ++- dprintf( at %d , &symbol_table[i]); ++-#ifdef HPUX ++- symbol_table[i].n_un.n_strx = string_size; ++- dprintf(string_size %d, string_size); ++- string_size += symbol_table[i].n_length + 1; ++- fseek(fp,(int)symbol_table[i].n_length,1); ++-#endif ++- } ++- } ++-/* ++-on MP386 ++-The sizeof(struct syment) = 20, while only SYMESZ =18. So we had to read ++-one at a time. ++-fread((char *)symbol_table, SYMESZ*fileheader.f_nsyms,1,fp); ++-*/ ++- ++-#ifdef READ_IN_STRING_TABLE ++- ++-my_string_table=READ_IN_STRING_TABLE(fp,string_size); ++- ++-#else ++-#ifdef MUST_SEEK_TO_STROFF ++- fseek(fp,N_STROFF(fileheader),0); ++-#endif ++- {int ii=0; ++- if (!fread((char *)&ii,sizeof(int),1,fp)) ++- {FEerror("The string table of this file did not have any length",0, ++- 0);} ++- fseek(fp,-4,1); ++- /* at present the string table is located just after the symbols */ ++- my_string_table=OUR_ALLOCA((unsigned int)ii); ++- dprintf( string table leng = %d, ii); ++- ++- if(ii!=fread(my_string_table,1,ii,fp)) ++- FEerror("Could not read whole string table",0,0) ; ++- } ++-#endif ++-#ifdef SEEK_TO_END_OFILE ++-SEEK_TO_END_OFILE(fp); ++-#else ++- while ((i = getc(fp)) == 0) ++- ; ++- ungetc(i, fp); ++-#endif ++- ++- fasl_vector_start=ftell(fp); ++- ++- if (!((c_table.ptable) && *(c_table.ptable))) ++- build_symbol_table(); ++- ++-/* figure out if there is more bss space needed */ ++- extra_bss=get_extra_bss(symbol_table,nsyms,datasize+textsize+bsssize, ++- &init_address,bsssize); ++- ++-/* allocate some memory */ ++-#ifndef STAND ++- {BEGIN_NO_INTERRUPT; ++- memory=new_cfdata(); ++- memory->cfd.cfd_size = datasize+textsize+bsssize + extra_bss; ++- vs_push(memory); ++- the_start=start_address= ++- memory->cfd.cfd_start= ++- alloc_contblock(memory->cfd.cfd_size); ++- sfaslp->s_start_data = start_address + textsize; ++- sfaslp->s_start_bss = start_address + textsize + datasize; ++- END_NO_INTERRUPT; ++- } ++-#else ++- the_start = start_address ++- = malloc ( datasize + textsize + bsssize + extra_bss ); ++- sfaslp->s_start_data = start_address + textsize; ++- sfaslp->s_start_bss = start_address + textsize + datasize; ++-#endif ++- ++- dprintf( code size %d , datasize+textsize+bsssize + extra_bss); ++- if (fseek(fp,N_TXTOFF(fileheader) ,0) < 0) ++- FEerror("file seek error",0,0); ++- SAFE_FREAD(the_start, textsize + datasize, 1, fp); ++- dprintf(read into memory text +data %d bytes, textsize + datasize); ++-/* relocate the actual loaded text */ ++- ++- dprintf( the_start %x, the_start); ++- ++- /* record which symbols are used */ ++- ++-#ifdef SYM_USED ++- {int j=0; ++- for(j=1; j< BSS_NSCN ; j++) ++- { dprintf( relocating section %d \n,j); ++- if (section[j].s_nreloc) fseek(fp,section[j].s_relptr,0); ++- for(i=0; i < section[j].s_nreloc; i++) ++- { struct syment *sym; ++- fread(&relocation_info, RELSZ, 1, fp); ++- sym = & symbol_table[relocation_info.r_symndx]; ++- if (TC_SYMBOL_P(sym)) ++- SYM_USED(sym) = 1; ++- }}} ++-#endif ++- ++- ++- /* this looks up symbols in c.ptable and also adds new externals to ++- that c.table */ ++- relocate_symbols(NSYMS(fileheader)); ++- ++-#ifdef COFF ++- {int j=0; ++- for(j=1; j< BSS_NSCN ; j++) ++- { dprintf( relocating section %d \n,j); ++- if (section[j].s_nreloc) fseek(fp,section[j].s_relptr,0); ++-#ifdef ADJUST_RELOC_START ++-ADJUST_RELOC_START(j) ++-#endif ++- for(i=0; i < section[j].s_nreloc; i++) ++- /* RELSZ = sizeof(relocation_info) */ ++- {fread(&relocation_info, RELSZ, 1, fp); ++- dprintf(relocating %d,i); ++- relocate();}; ++- }}; ++-#endif ++-#ifdef BSD ++- fseek(fp,N_RELOFF(fileheader),0); ++- {int nrel = (fileheader.a_trsize/sizeof(struct reloc)); ++- for (i=0; i < nrel; i++) ++- {fread((char *)&relocation_info, sizeof(struct reloc), ++- 1, fp); ++- dprintf(relocating %d,i); ++- relocate(); ++- } ++- } ++-#ifdef N_DRELOFF ++- fseek (fp, N_DRELOFF(fileheader), 0); ++-#endif ++- {int nrel = (fileheader.a_drsize/sizeof(struct reloc)); ++- the_start += fileheader.a_text; ++- for (i=0; i < nrel; i++) ++- ++- {fread((char *)&relocation_info, sizeof(struct reloc), ++- 1, fp); ++- dprintf(relocating %d,i); ++- relocate(); ++- } ++- } ++-#endif ++- ++-/* end of relocation */ ++- dprintf( END OF RELOCATION \n,0); ++- dprintf( invoking init function at %x, start_address) ++- dprintf( textsize is %x,textsize); ++- dprintf( datasize is %x,datasize); ++- ++-/* read in the fasl vector */ ++- fseek(fp,fasl_vector_start,0); ++- if (feof(fp)) ++- {data=0;} ++- else{ ++- data = read_fasl_vector(faslfile); ++- vs_push(data); ++-#ifdef COFF ++- dprintf( read fasl now symbols %d , fileheader.f_nsyms); ++-#endif ++- } ++- close_stream(faslfile); ++- ++-/* ++- { ++- int fd; ++- ++- fd = creat ("xsgcl.bits", 0777); ++- write (fd, memory->cfd.cfd_start, textsize + datasize); ++- close (fd); ++- ++- fd = open ("xsl2.bits", 0); ++- read (fd, memory->cfd.cfd_start, memory->cfd.cfd_size); ++- close (fd); ++- } ++-*/ ++- ++-#ifndef STAND ++- ALLOCA_FREE(my_string_table); ++- ALLOCA_FREE(symbol_table); ++- ++- ++-#ifdef CLEAR_CACHE ++- CLEAR_CACHE; ++-#endif ++- call_init(init_address,memory,data,0); ++- ++- vs_base = old_vs_base; ++- vs_top = old_vs_top; ++- if(symbol_value(sLAload_verboseA)!=Cnil) ++- printf("start address -T %x ", memory->cfd.cfd_start); ++- return(memory->cfd.cfd_size); ++-#endif ++- {FILE *out; ++- out=fopen("/tmp/sfasltest","w"); ++- fwrite((char *)&fileheader, sizeof(struct filehdr), 1, out); ++- fwrite(start_address,sizeof(char),datasize+textsize,out); ++- fclose(out);} ++- printf("\n(start %x)\n",start_address); ++- ++-} ++- ++-int get_extra_bss(sym_table,length,start,ptr,bsssize) ++- int length,bsssize; ++- struct syment *sym_table; ++- int *ptr; /* store init address offset here */ ++-{ ++- int result = start; ++- ++-#ifdef AIX3 ++- int next_bss = start - bsssize; ++-#endif ++- ++- struct syment *end,*sym; ++- ++-#ifdef BSD ++- char tem[SYMNMLEN +1]; ++-#endif ++- ++- end =sym_table + length; ++- for(sym=sym_table; sym < end; sym++) ++- { ++- ++-#ifdef FIND_INIT ++- FIND_INIT ++-#endif ++- ++-#ifdef AIX3 ++- /* we later go through the relocation entries making this 1 ++- for symbols used */ ++-#ifdef SYM_USED ++- if(TC_SYMBOL_P(sym)) ++- {SYM_USED(sym) = 0;} ++-#endif ++- ++- /* fix up the external refer to _ptrgl to be local ref */ ++- if (sym->n_scnum == 0 && ++- strcmp(sym->n_name,"_ptrgl")==0) ++- {struct syment* s = ++- get_symbol("._ptrgl",TEXT_NSCN,sym_table,length); ++- if (s ==0) FEerror("bad glue",0,0); ++- sym->n_value = next_bss ; ++- ptrgl_offset = next_bss; ++- ptrgl_text = s->n_value; ++- next_bss += 0xc; ++- sym->n_scnum = DATA_NSCN; ++- ((union auxent *)(sym+1))->x_csect.x_scnlen = 0xc; ++- ++- } ++- ++- if(sym->n_scnum != BSS_NSCN) goto NEXT; ++- if(SYM_EXTERNAL_P(sym)) ++- {int val=sym->n_value; ++- struct node joe; ++- if (val && c_table.ptable) ++- {struct node *answ; ++- answ= find_sym(sym,0); ++- if(answ) ++- {sym->n_value = answ->address ; ++- sym->n_scnum = N_UNDEF; ++- val= ((union auxent *)(sym+1))->x_csect.x_scnlen; ++- result -= val; ++- goto NEXT; ++- }} ++- } ++- /* reallocate the bss space */ ++- if (sym->n_value == 0) ++- {result += ((union auxent *)(sym+1))->x_csect.x_scnlen;} ++- sym->n_value = next_bss; ++- next_bss += ((union auxent *)(sym+1))->x_csect.x_scnlen; ++- NEXT: ++- ; ++- /* end aix3 */ ++-#endif ++- ++- ++- ++-#ifdef BSD ++- tem; /* ignored */ ++- if(SYM_EXTERNAL_P(sym) && SYM_UNDEF_P(sym)) ++-#endif ++-#ifdef COFF ++- if(0) ++- /* what we really want is ++- if (sym->n_scnum==0 && sym->n_sclass == C_EXT ++- && !(bsearch(..in ptable for this symbol))) ++- Since this won't allow loading in of a new external array ++- char foo[10] not ok ++- static foo[10] ok. ++- for the moment we give undefined symbol warning.. ++- Should really go through the symbols, recording the external addr ++- for ones found in ptable, and for the ones not in ptable ++- set some flag, and add up the extra_bss required. Then ++- when you have the new memory chunk in hand, ++- you could make the pass setting the relative addresses. ++- for the ones you flagged last time. ++- */ ++-#endif ++- /* external bss so not included in size of bss for file */ ++- {int val=sym->n_value; ++- if (val && c_table.ptable ++- && (0== find_sym(sym,0))) ++- { sym->n_value=result; ++- result += val;}} ++- ++- sym += NUM_AUX(sym); ++- ++- } ++- return (result-start); ++-} ++- ++- ++- ++-/* go through the symbol table changing the addresses of the symbols ++-to reflect the current cfd_start */ ++- ++- ++-void ++-relocate_symbols(length) ++-unsigned int length; ++-{struct syment *end,*sym; ++- unsigned int typ; ++- char *str; ++- char tem[SYMNMLEN +1]; ++- tem[SYMNMLEN]=0; ++- int n_value=(int)start_address; ++- ++- end =symbol_table + length; ++- for(sym=symbol_table; sym < end; sym++) { ++- typ=NTYPE(sym); ++-#ifdef BSD ++-#ifdef N_STAB ++- if (N_STAB & sym->n_type) continue;/* skip: It is for dbx only */ ++-#endif ++- typ=N_SECTION(sym); ++-/* if(sym->n_type & N_EXT) should add the symbol name, ++- so it would be accessible by future loads */ ++-#endif ++- switch (typ) { ++-#ifdef BSD ++- case N_ABS : case N_TEXT: case N_DATA: case N_BSS: ++-#endif ++-#ifdef COFF ++- case TEXT_NSCN : case DATA_NSCN: case BSS_NSCN : ++-#ifdef _WIN32 ++- if (typ==DATA_NSCN) ++- n_value = (int)sfaslp->s_start_data; ++- if (typ==BSS_NSCN) ++- n_value = (int)sfaslp->s_start_bss; ++- if (typ==TEXT_NSCN) ++- n_value = (int)start_address; ++-#endif /* _WIN32 */ ++-#endif /* COFF */ ++- str=SYM_NAME(sym); ++- dprintf( for sym %s ,str) ++- dprintf( new value will be start %x, start_address); ++- ++-#ifdef AIX3 ++- if(N_SECTION(sym) == DATA_NSCN ++- && NUM_AUX(sym) ++- && allocate_toc(sym)) ++- break; ++-#endif ++- sym->n_value = n_value; ++- break; ++- case N_UNDEF: ++- str=SYM_NAME(sym); ++- dprintf( undef symbol %s ,str); ++- dprintf( symbol diff %d , sym - symbol_table); ++- describe_sym(sym-symbol_table); ++- set_symbol_address(sym,str); ++- describe_sym(sym-symbol_table); ++- break; ++- default: ++-#ifdef COFF ++- dprintf(am ignoring a scnum %d,(sym->n_scnum)); ++-#endif ++- break; ++- } ++- sym += NUM_AUX(sym); ++- } ++-} ++- ++-/* ++-STEPS: ++-1) read in the symbol table from the file, ++-2) go through the symbol table, relocating external entries. ++-3) for i <=2 go thru the relocation information for this section ++- relocating the text. ++-4) done. ++-*/ ++- ++-struct node * ++-find_sym(sym,name) ++- struct syment *sym; ++- char *name; ++-{ char tem[SYMNMLEN +1]; ++- tem [SYMNMLEN] = 0; ++- if (name==0) name = SYM_NAME(sym); ++- return find_sym_ptable(name);} ++- ++-void ++-set_symbol_address(sym,string) ++-struct syment *sym; ++-char *string; ++-{struct node *answ; ++- if (c_table.ptable) ++- { ++- dprintf(string %s, string); ++- answ = find_sym(sym,string); ++- dprintf(answ %d , (answ ? answ->address : -1)); ++- if(answ) ++- { ++-#ifdef COFF ++-#ifdef _AIX370 ++- if (NTYPE(sym) == N_UNDEF) ++- sym->n_value = answ->address; ++- else ++-#endif ++- sym->n_value = answ->address -sym->n_value; ++- /* for symbols in the local data,text and bss this gets added ++- on when we add the current value */ ++-#endif ++-#ifdef BSD ++- /* the old value of sym->n_value is the length of the common area ++- starting at this address */ ++- sym->n_value = answ->address; ++-#endif ++-#ifdef AIX3 ++- fix_undef_toc_address(answ,sym,string); ++-#endif ++- ++-} ++- else ++- { ++-/* ++-#ifdef BSD ++- {char *name; ++- name=malloc(1+strlen(string)); ++- strcpy(name,string); ++- sym->n_value = sym->n_value + (unsigned int) the_start; ++- add_symbol(name,sym->n_value,NULL); ++- } ++-#endif ++-*/ ++- fprintf(stdout,"undefined %s symbol",string) ++- ;fflush(stdout); ++- ++- }} ++- ++- else{FEerror("symbol table not loaded",0,0);}} ++- ++-/* include the machine independent stuff */ ++-#include "sfasli.c" ++- ++- ++-#ifdef DEBUG ++-print_name(p) ++- struct syment *p; ++-{char tem[10],*name; ++- name=SYM_NAME(p); ++- name= (((p)->_n._n_n._n_zeroes == 0) ? ++- &my_string_table[(p)->_n._n_n._n_offset] : ++- ((p)->_n._n_name[SYMNMLEN -1] ? ++- (strncpy(tem,(p)->_n._n_name, ++- SYMNMLEN), ++- (char *)tem) : ++- (p)->_n._n_name )); ++- ++- printf("(name:|%s|)",name); ++- printf("(sclass 0x%x)",p->n_sclass); ++- printf("(external_p 0x%x)",SYM_EXTERNAL_P(p)); ++- printf("(n_type 0x%x)",p->n_type); ++- printf("(n_value 0x%x)",p->n_value); ++- printf("(numaux 0x%x)\n",NUM_AUX(p)); ++- fflush(stdout); ++-} ++-#endif ++- +++#error must define SEPARATE_SFASL_FILE ++ #endif /* SEPARATE_SFASL_FILE */ ++--- gcl-2.6.12.orig/o/sfaslcoff.c +++++ gcl-2.6.12/o/sfaslcoff.c ++@@ -443,7 +443,6 @@ fasload(object faslfile) { ++ fseek(fp,(void *)ste-st,0); ++ while ((i = getc(fp)) == 0); ++ ungetc(i, fp); ++- data = read_fasl_vector(faslfile); ++ ++ massert(!un_mmap(st,est)); ++ ++@@ -451,7 +450,7 @@ fasload(object faslfile) { ++ CLEAR_CACHE; ++ #endif ++ ++- call_init(init_address,memory,data,0); +++ call_init(init_address,memory,faslfile); ++ ++ if(symbol_value(sLAload_verboseA)!=Cnil) ++ printf("start address -T %p ", memory->cfd.cfd_start); ++--- gcl-2.6.12.orig/o/sfaslelf.c +++++ gcl-2.6.12/o/sfaslelf.c ++@@ -550,7 +550,7 @@ fasload(object faslfile) { ++ FILE *fp; ++ char *sn,*st1,*dst1; ++ ul init_address=0,end,gs=0,*got=&gs,*gote=got+1; ++- object memory,data; +++ object memory; ++ Shdr *sec1,*sece; ++ Sym *sym1,*syme,*dsym1,*dsyme; ++ void *v1,*ve; ++@@ -574,7 +574,6 @@ fasload(object faslfile) { ++ massert(!relocate_code(v1,sec1,sece,sym1,got,gote)); ++ ++ massert(!fseek(fp,end,SEEK_SET)); ++- data=feof(fp) ? 0 : read_fasl_vector(faslfile); ++ ++ massert(!un_mmap(v1,ve)); ++ ++@@ -587,7 +586,7 @@ fasload(object faslfile) { ++ #endif ++ ++ init_address-=(ul)memory->cfd.cfd_start; ++- call_init(init_address,memory,data,0); +++ call_init(init_address,memory,faslfile); ++ ++ if(symbol_value(sLAload_verboseA)!=Cnil) ++ printf("start address -T %p ",memory->cfd.cfd_start); ++--- gcl-2.6.12.orig/o/sfaslmacho.c +++++ gcl-2.6.12/o/sfaslmacho.c ++@@ -421,7 +421,7 @@ load_self_symbols() { ++ ++ for (a=c_table.ptable,sym=sym1;symn_type & N_STAB || !(sym->n_type & N_EXT)) +++ if ((sym->n_type & N_STAB) || !(sym->n_type & N_EXT)) ++ continue; ++ ++ a->address=sym->n_value; ++@@ -435,10 +435,9 @@ load_self_symbols() { ++ c_table.length=a-c_table.ptable; ++ qsort(c_table.ptable,c_table.length,sizeof(*c_table.ptable),node_compare); ++ ++- c_table.local_ptable=a; ++- for (a=c_table.ptable,sym=sym1;symn_type & N_STAB || sym->n_type & N_EXT) +++ if ((sym->n_type & N_STAB) || sym->n_type & N_EXT) ++ continue; ++ ++ a->address=sym->n_value; ++@@ -536,7 +535,6 @@ int ++ fasload(object faslfile) { ++ ++ FILE *fp; ++- object data; ++ ul init_address=-1; ++ object memory; ++ void *v1,*ve,*p; ++@@ -564,7 +562,6 @@ fasload(object faslfile) { ++ relocate_code(v1,sec1,sece,&p,io1,n1,got,gote,start); ++ ++ fseek(fp,(void *)ste-v1,SEEK_SET); ++- data = feof(fp) ? 0 : read_fasl_vector(faslfile); ++ ++ massert(!clear_protect_memory(memory)); ++ ++@@ -575,7 +572,7 @@ fasload(object faslfile) { ++ massert(!un_mmap(v1,ve)); ++ ++ init_address-=(ul)memory->cfd.cfd_start; ++- call_init(init_address,memory,data,0); +++ call_init(init_address,memory,faslfile); ++ ++ if(symbol_value(sLAload_verboseA)!=Cnil) ++ printf("start address -T %p ",memory->cfd.cfd_start); ++--- gcl-2.6.12.orig/o/sfaslmacosx.c +++++ gcl-2.6.12/o/sfaslmacosx.c ++@@ -228,8 +228,6 @@ int fasload (object faslfile) ++ sfasl_error ("error seeking to end of object file"); ++ } ++ ++- data = read_fasl_vector (faslstream); ++- ++ close_stream (faslstream); ++ ++ memory=new_cfdata(); ++@@ -237,7 +235,7 @@ int fasload (object faslfile) ++ if (symbol_value (sLAload_verboseA) != Cnil) ++ printf (" start address (dynamic) %p ", fptr); ++ ++- call_init (0, memory, data, fptr); +++ call_init (0,memory,faslstream); ++ ++ unlink (tmpfile); ++ ++--- gcl-2.6.12.orig/o/unixfasl.c +++++ gcl-2.6.12/o/unixfasl.c ++@@ -78,197 +78,7 @@ Foundation, 675 Mass Ave, Cambridge, MA ++ #endif ++ ++ #ifndef SFASL ++-int ++-fasload(faslfile) ++-object faslfile; ++-{ ++- ++-#ifdef BSD ++- struct exec header, newheader; ++-#endif ++- ++-#ifdef ATT ++- struct filehdr fileheader; ++- struct scnhdr sectionheader; ++- int textsize, datasize, bsssize; ++- int textstart; ++-#endif ++- ++-#ifdef E15 ++- struct exec header; ++-#define textsize header.a_text ++-#define datasize header.a_data ++-#define bsssize header.a_bss ++-#define textstart sizeof(header) ++-#endif ++- ++- object memory, data, tempfile; ++- FILE *fp; ++- char filename[MAXPATHLEN]; ++- char tempfilename[32]; ++- char command[MAXPATHLEN * 2]; ++- int i; ++- object *old_vs_base = vs_base; ++- object *old_vs_top = vs_top; ++-#ifdef IBMRT ++- ++-#endif ++- ++- coerce_to_filename(faslfile, filename); ++- ++- faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); ++- vs_push(faslfile); ++- fp = faslfile->sm.sm_fp; ++- /* seek to beginning of the header */ ++- ++- HEADER_SEEK(fp); ++- ++-#ifdef BSD ++- fread(&header, sizeof(header), 1, fp); ++-#endif ++-#ifdef ATT ++- fread(&fileheader, sizeof(fileheader), 1, fp); ++-#ifdef S3000 ++- if(fileheader.f_opthdr != 0) fseek(fp,fileheader.f_opthdr,1); ++-#endif ++- fread(§ionheader, sizeof(sectionheader), 1, fp); ++- textsize = sectionheader.s_size; ++- textstart = sectionheader.s_scnptr; ++- fread(§ionheader, sizeof(sectionheader), 1, fp); ++- datasize = sectionheader.s_size; ++- fread(§ionheader, sizeof(sectionheader), 1, fp); ++- if (strcmp(sectionheader.s_name, ".bss") == 0) ++- bsssize = sectionheader.s_size; ++- else ++- bsssize = 0; ++-#endif ++-#ifdef E15 ++- fread(&header, sizeof(header), 1, fp); ++-#endif ++- ++- memory=new_cfdata(); ++- memory->cfd.cfd_size = textsize + datasize + bsssize; ++- vs_push(memory); ++- /* If the file is smaller than the space asked for, typically the file ++- is an invalid object file */ ++- if (file_len(fp)*4 < memory->cfd.cfd_size) ++- FEerror("Invalid object file stream: ~a",1,faslfile); ++- memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock, ++- memory->cfd.cfd_size,sizeof(double)); ++- ++-#ifdef SEEK_TO_END_OFILE ++-SEEK_TO_END_OFILE(fp); ++-#else ++-#ifdef BSD ++- fseek(fp, ++- header.a_text+header.a_data+ ++- header.a_syms+header.a_trsize+header.a_drsize, ++- 1); ++- fread(&i, sizeof(i), 1, fp); ++- fseek(fp, i - sizeof(i), 1); ++-#endif ++- ++-#ifdef ATT ++- fseek(fp, ++- fileheader.f_symptr + SYMESZ*fileheader.f_nsyms, ++- 0); ++- fread(&i, sizeof(i), 1, fp); ++- fseek(fp, i - sizeof(i), 1); ++- while ((i = getc(fp)) == 0) ++- ; ++- ungetc(i, fp); ++-#endif ++- ++-#ifdef E15 ++- fseek(fp, ++- header.a_text+header.a_data+ ++- header.a_syms+header.a_trsize+header.a_drsize, ++- 1); ++-#endif ++-#endif ++- data = read_fasl_vector(faslfile); ++- vs_push(data); ++- close_stream(faslfile); ++- ++- sprintf(tempfilename, "/tmp/fasltemp%d", getpid()); ++- ++-AGAIN: ++- ++-#ifdef BSD ++- LD_COMMAND(command, ++- kcl_self, ++- memory->cfd.cfd_start, ++- filename, ++- " ", ++- tempfilename); ++- if(symbol_value(sLAload_verboseA)!=Cnil) ++- printf("start address -T %x ",memory->cfd.cfd_start); ++-#endif ++-#ifdef ATT ++- coerce_to_filename(symbol_value(sSAsystem_directoryA), ++- system_directory); ++- sprintf(command, ++- "%sild %s %d %s %s", ++- system_directory, ++- kcl_self, ++- memory->cfd.cfd_start, ++- filename, ++- tempfilename); ++-#endif ++-#ifdef E15 ++- coerce_to_filename(symbol_value(sSAsystem_directoryA), ++- system_directory); ++- sprintf(command, ++- "%sild %s %d %s %s", ++- system_directory, ++- kcl_self, ++- memory->cfd.cfd_start, ++- filename, ++- tempfilename); ++-#endif ++- ++- if (system(command) != 0) ++- FEerror("The linkage editor failed.", 0); ++- ++- tempfile = make_simple_string(tempfilename); ++- vs_push(tempfile); ++- tempfile = open_stream(tempfile, smm_input, Cnil, sKerror); ++- vs_push(tempfile); ++- fp = tempfile->sm.sm_fp; ++- ++- HEADER_SEEK(fp); ++- ++-#ifdef BSD ++- fread(&newheader, sizeof(header), 1, fp); ++- if (newbsssize != bsssize) { ++- insert_contblock(memory->cfd.cfd_start, memory->cfd.cfd_size); ++- bsssize = newbsssize; ++- memory->cfd.cfd_start = NULL; ++- memory->cfd.cfd_size = textsize + datasize + bsssize; ++- memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock,memory->cfd.cfd_size, ++- sizeof( double)); ++- close_stream(tempfile); ++- unlink(tempfilename); ++- goto AGAIN; ++- } ++-#endif ++- ++- if (fseek(fp, textstart, 0) < 0) ++- error("file seek error"); ++- ++- fread(memory->cfd.cfd_start, textsize + datasize, 1, fp); ++- ++- close_stream(tempfile); ++- ++- unlink(tempfilename); ++- ++- call_init(0,memory,data,0); ++- ++- vs_base = old_vs_base; ++- vs_top = old_vs_top; ++- ++- return(memory->cfd.cfd_size); ++-} +++#error must define SFASL ++ #endif /* ifndef SFASL */ ++ ++ #ifndef __svr4__ diff --cc debian/patches/Version_2_6_13pre55 index 00000000,00000000..6b4b7828 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre55 @@@ -1,0 -1,0 +1,132 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-67) unstable; urgency=medium ++ . ++ * Version_2_6_13pre55 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-03-03 ++ ++--- gcl-2.6.12.orig/h/notcomp.h +++++ gcl-2.6.12/h/notcomp.h ++@@ -374,3 +374,5 @@ EXTER gmp_randfnptr_t Mersenne_Twister_G ++ #endif ++ ++ #define collect(p_,f_) (p_)=&(*(p_)=(f_))->c.c_cdr +++#define READ_STREAM_OR_FASD(strm_) \ +++ type_of(strm_)==t_stream ? read_object_non_recursive(strm_) : fSread_fasd_top(strm_) ++--- gcl-2.6.12.orig/o/cmpaux.c +++++ gcl-2.6.12/o/cmpaux.c ++@@ -363,7 +363,7 @@ do_init(object *statVV) { ++ ++ if (ch!='\n') { ++ struct fasd * fd; ++- faslfile=FFN(fSopen_fasd)(faslfile,sKinput,OBJNULL,Cnil); +++ faslfile=fSopen_fasd(faslfile,sKinput,OBJNULL,Cnil); ++ fd=(struct fasd *)faslfile->v.v_self; ++ n=fix(fd->table_length); ++ fd->table->v.v_self=alloca(n*sizeof(object)); ++@@ -371,7 +371,7 @@ do_init(object *statVV) { ++ fd->table->v.v_dim=faslfile->v.v_self[1]->v.v_fillp=n; ++ } ++ ++- n=fix(type_of(faslfile)==t_stream ? read_object(faslfile) : FFN(fSread_fasd_top)(faslfile)); +++ n=fix(READ_STREAM_OR_FASD(faslfile)); ++ sSPinit->s.s_dbind=fasl_vec=fSmake_vector1_1(n,aet_object,Cnil); ++ ++ /* switch SPinit to point to a vector of function addresses */ ++@@ -395,9 +395,9 @@ do_init(object *statVV) { ++ */ ++ /* Now we can run the forms f1 f2 in form= (%init f1 f2 ...) */ ++ ++- FFN(fSload_stream)(faslfile,Cnil); +++ fSload_stream(faslfile,Cnil); ++ if (type_of(faslfile)!=t_stream) ++- FFN(fSclose_fasd)(faslfile); +++ fSclose_fasd(faslfile); ++ ++ } ++ ++--- gcl-2.6.12.orig/o/fasdump.c +++++ gcl-2.6.12/o/fasdump.c ++@@ -561,6 +561,13 @@ DEFUN_NEW("READ-FASD-TOP",object,fSread_ ++ { RESTORE_FASD; ++ return result;} ++ } +++#ifdef STATIC_FUNCTION_POINTERS +++object +++fSread_fasd_top(object x) { +++ return FFN(fSread_fasd_top)(x); +++} +++#endif +++ ++ ++ object sLeq; ++ object sSPinit; ++@@ -618,6 +625,12 @@ DEFUN_NEW("OPEN-FASD",object,fSopen_fasd ++ fd->table_length=current_fasd.table_length; ++ return result; ++ }} +++#ifdef STATIC_FUNCTION_POINTERS +++object +++fSopen_fasd(object stream, object direction, object eof, object tabl) { +++ return FFN(fSopen_fasd)(stream,direction,eof,tabl); +++} +++#endif ++ ++ DEFUN_NEW("CLOSE-FASD",object,fSclose_fasd,SI,1,1,NONE,OO,OO,OO,OO,(object ar),"") ++ /* static object */ ++@@ -649,6 +662,12 @@ DEFUN_NEW("CLOSE-FASD",object,fSclose_fa ++ return ar; ++ ++ } +++#ifdef STATIC_FUNCTION_POINTERS +++object +++fSclose_fasd(object ar) { +++ return FFN(fSclose_fasd)(ar); +++} +++#endif ++ ++ ++ #define HASHP(x) 1 ++--- gcl-2.6.12.orig/o/file.d +++++ gcl-2.6.12/o/file.d ++@@ -1645,8 +1645,7 @@ DEFUN_NEW("LOAD-STREAM",object,fSload_st ++ for (;;) { ++ preserving_whitespace_flag = FALSE; ++ detect_eos_flag = TRUE; ++- x = type_of(strm)==t_stream ? read_object_non_recursive(strm) : FFN(fSread_fasd_top)(strm); ++- if (x == OBJNULL) +++ if ((x = READ_STREAM_OR_FASD(strm))==OBJNULL) ++ break; ++ { ++ object *base = vs_base, *top = vs_top, *lex = lex_env; ++@@ -1672,6 +1671,12 @@ DEFUN_NEW("LOAD-STREAM",object,fSload_st ++ RETURN1(Ct); ++ ++ } +++#ifdef STATIC_FUNCTION_POINTERS +++object +++fSload_stream(object strm,object print) { +++ return FFN(fSload_stream)(strm,print); +++} +++#endif ++ ++ DEFUN_NEW("LOAD-FASL",object,fSload_fasl,SI,2,2,NONE,OO,OO,OO,OO,(object fasl_filename,object print),"") { ++ diff --cc debian/patches/Version_2_6_13pre56 index 00000000,00000000..94a7be89 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre56 @@@ -1,0 -1,0 +1,107 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-67) unstable; urgency=medium ++ . ++ * Version_2_6_13pre55 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-03-04 ++ ++--- gcl-2.6.12.orig/h/elf64_alpha_reloc.h +++++ gcl-2.6.12/h/elf64_alpha_reloc.h ++@@ -22,16 +22,14 @@ ++ store_val(where,MASK(32),s+a); ++ break; ++ case R_ALPHA_LITERAL: ++- s+=a; ++- if (a || !(sym->st_other&0x1)) {gotp+=1+(sym->st_other>>1);sym->st_other|=1;} ++- gote=got+(a ? gotp : sym->st_size)-1; ++- massert(s); +++ gote=got+(a>>32)-1; +++ a&=MASK(32); ++ if (s>=ggot1 && sst_other=sym->st_size=0; ++ +++ for (sec=sec1;secsh_type==SHT_RELA) +++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) +++ if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { +++ +++ sym=sym1+ELF_R_SYM(r->r_info); +++ +++ /*unlikely to save got space by recording possible holes in addend range*/ +++ if ((a=r->r_addend+1)>sym->st_other) +++ sym->st_other=a; +++ +++ } +++ ++ for (*gs=0,sec=sec1;secsh_type==SHT_RELA) ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++@@ -78,13 +90,19 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ ++ sym=sym1+ELF_R_SYM(r->r_info); ++ ++- if (!sym->st_size || r->r_addend) { ++- q=++*gs; ++- if (!sym->st_size) sym->st_size=q; +++ if (sym->st_other) { +++ sym->st_size=++*gs; ++ massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); ++- sym->st_other=(*gs-q)<<1; +++ massert((*gs-sym->st_size) || !r->r_addend); +++ if (sym->st_other>1) +++ (*gs)+=sym->st_other-1; +++ sym->st_other=0; ++ } ++ +++ b=sizeof(r->r_addend)*4; +++ massert(!(r->r_addend>>b)); +++ r->r_addend|=((sym->st_size+r->r_addend)< ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-68) unstable; urgency=medium ++ . ++ * Version_2_6_13pre57 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-03-04 ++ ++--- gcl-2.6.12.orig/h/elf64_alpha_reloc_special.h +++++ gcl-2.6.12/h/elf64_alpha_reloc_special.h ++@@ -93,7 +93,7 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ if (sym->st_other) { ++ sym->st_size=++*gs; ++ massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); ++- massert((*gs-sym->st_size) || !r->r_addend); +++ massert(!(*gs-sym->st_size) || !r->r_addend); ++ if (sym->st_other>1) ++ (*gs)+=sym->st_other-1; ++ sym->st_other=0; diff --cc debian/patches/Version_2_6_13pre58 index 00000000,00000000..ec37b831 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre58 @@@ -1,0 -1,0 +1,86 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-68) unstable; urgency=medium ++ . ++ * Version_2_6_13pre57 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-03-09 ++ ++--- gcl-2.6.12.orig/h/elf64_alpha_reloc_special.h +++++ gcl-2.6.12/h/elf64_alpha_reloc_special.h ++@@ -65,7 +65,7 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ Sym *sym; ++ Shdr *sec; ++ void *v,*ve; ++- ul q=0,a; +++ ul a,b; ++ ++ for (sym=sym1;symst_other=sym->st_size=0; ++--- gcl-2.6.12.orig/o/cmpaux.c +++++ gcl-2.6.12/o/cmpaux.c ++@@ -348,6 +348,8 @@ call_init(int init_address,object memory ++ ++ */ ++ +++object *min_cfd_self=NULL; +++ ++ void ++ do_init(object *statVV) { ++ ++@@ -386,6 +388,8 @@ do_init(object *statVV) { ++ } ++ ++ data->cfd.cfd_self = statVV; +++ if (!min_cfd_self || data->cfd.cfd_selfcfd.cfd_self; ++ data->cfd.cfd_fillp= n; ++ statVV[n-1] = data; ++ ++--- gcl-2.6.12.orig/o/fasdump.c +++++ gcl-2.6.12/o/fasdump.c ++@@ -640,7 +640,7 @@ DEFUN_NEW("CLOSE-FASD",object,fSclose_fa ++ if (type_of(fd->table)==t_vector) ++ /* input uses a vector */ ++ {if (fd->table->v.v_self) ++- fd->table->v.v_dim=0;/*self can be on the stack, and others write there*/ +++ gset(fd->table->v.v_self,0,fix(fd->index),aet_object); ++ } ++ else ++ if(fd->direction==sKoutput) ++--- gcl-2.6.12.orig/o/gbc.c +++++ gcl-2.6.12/o/gbc.c ++@@ -446,6 +446,7 @@ mark_object_address(object *o,int f) { ++ ++ static ufixnum lp; ++ static ufixnum lr; +++ extern object *min_cfd_self; ++ ++ ufixnum p=page(o); ++ ++@@ -455,7 +456,7 @@ mark_object_address(object *o,int f) { ++ #ifdef SGC ++ sgc_enabled ? WRITABLE_PAGE_P(lp) : ++ #endif ++- 1; +++ (o>=min_cfd_self && o<((object *)core_end)); ++ } ++ ++ if (lr) diff --cc debian/patches/Version_2_6_13pre59 index 00000000,00000000..a5e7a2d9 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre59 @@@ -1,0 -1,0 +1,88 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-69) unstable; urgency=medium ++ . ++ * Version_2_6_13pre58 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-03-12 ++ ++--- gcl-2.6.12.orig/h/elf64_alpha_reloc_special.h +++++ gcl-2.6.12/h/elf64_alpha_reloc_special.h ++@@ -61,47 +61,30 @@ find_special_params(void *v,Shdr *sec1,S ++ static int ++ label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,const char *sn,ul *gs) { ++ ++- Rela *r; +++ Rela *r,*rr; ++ Sym *sym; ++ Shdr *sec; ++- void *v,*ve; ++- ul a,b; ++- ++- for (sym=sym1;symst_other=sym->st_size=0; ++- ++- for (sec=sec1;secsh_type==SHT_RELA) ++- for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++- if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { ++- ++- sym=sym1+ELF_R_SYM(r->r_info); ++- ++- /*unlikely to save got space by recording possible holes in addend range*/ ++- if ((a=r->r_addend+1)>sym->st_other) ++- sym->st_other=a; ++- ++- } +++ void *v,*ve,*vv; +++ ul b,q; ++ ++ for (*gs=0,sec=sec1;secsh_type==SHT_RELA) ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++ if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { ++ ++- sym=sym1+ELF_R_SYM(r->r_info); ++- ++- if (sym->st_other) { ++- sym->st_size=++*gs; ++- massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); ++- massert(!(*gs-sym->st_size) || !r->r_addend); ++- if (sym->st_other>1) ++- (*gs)+=sym->st_other-1; ++- sym->st_other=0; ++- } +++ for (rr=vv=v-sec->sh_entsize; +++ vv>=v1 && +++ (ELF_R_TYPE(rr->r_info)!=ELF_R_TYPE(r->r_info) || +++ ELF_R_SYM(rr->r_info)!=ELF_R_SYM(r->r_info) || +++ rr->r_addend!=r->r_addend); +++ vv-=sec->sh_entsize,rr=vv); ++ ++ b=sizeof(r->r_addend)*4; +++ q=vv>=v1 ? (rr->r_addend>>b) : ++*gs; +++ massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); +++ massert(*gs==q || !r->r_addend); ++ massert(!(r->r_addend>>b)); ++- r->r_addend|=((sym->st_size+r->r_addend)<r_addend|=(q< ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-6) unstable; urgency=medium ++ . ++ * Version_2_6_13pre5 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/o/alloc.c +++++ gcl-2.6.12/o/alloc.c ++@@ -254,8 +254,10 @@ empty_relblock(void) { ++ object o=sSAleaf_collection_thresholdA->s.s_dbind; ++ ++ sSAleaf_collection_thresholdA->s.s_dbind=make_fixnum(0); ++- for (;rb_pointer!=rb_start&&rb_pointer!=rb_end;) +++ for (;rb_pointer!=rb_start&&rb_pointer!=rb_end;) { +++ tm_table[t_relocatable].tm_adjgbccnt--; ++ GBC(t_relocatable); +++ } ++ sSAleaf_collection_thresholdA->s.s_dbind=o; ++ ++ } ++@@ -498,10 +500,10 @@ static int ++ rebalance_maxpages(struct typemanager *my_tm,fixnum z) { ++ ++ fixnum d; ++- ufixnum i,j; +++ ufixnum i,j,r=(my_tm->tm_type==t_relocatable ? 2 : 1); ++ ++ ++- d=(z-my_tm->tm_maxpage)*(my_tm->tm_type==t_relocatable ? 2 : 1); +++ d=(z-my_tm->tm_maxpage)*r; ++ j=sum_maxpages(); ++ ++ if (j+d>phys_pages) { ++@@ -517,14 +519,14 @@ rebalance_maxpages(struct typemanager *m ++ if (e+phys_pages-j<=0) ++ return 0; ++ ++- f=1.0-(double)e/k; +++ f=k ? 1.0-(double)e/k : 1.0; ++ ++ for (i=t_start;itm_maxpage+(phys_pages-sum_maxpages()))/(my_tm->tm_type==t_relocatable ? 2 : 1))); +++ massert(set_tm_maxpage(my_tm,(my_tm->tm_maxpage*r+(phys_pages-sum_maxpages()))/r)); ++ ++ return 1; ++ ++@@ -624,7 +626,12 @@ expand_contblock_index_space(void) { ++ ++ if (cbv->v.v_fillp+1==cbv->v.v_dim) { ++ ++- void *v=alloc_relblock(2*cbv->v.v_dim*sizeof(fixnum)); +++ void *v; +++ object o=sSAleaf_collection_thresholdA->s.s_dbind; +++ +++ sSAleaf_collection_thresholdA->s.s_dbind=make_fixnum(-1); +++ v=alloc_relblock(2*cbv->v.v_dim*sizeof(fixnum)); +++ sSAleaf_collection_thresholdA->s.s_dbind=o; ++ ++ memcpy(v,cbv->v.v_self,cbv->v.v_dim*sizeof(fixnum)); ++ cbv->v.v_self=v; ++@@ -731,13 +738,14 @@ insert_contblock(void *p,ufixnum s) { ++ ++ cbp->cb_size=s; ++ cbp->cb_link=*cbpp; ++- *cbpp=cbp; ++ ++ if ((!cbp->cb_link || cbp->cb_link->cb_size!=s)) { ++ cbppp=expand_contblock_index(cbppp); ++ cbppp[1]=&cbp->cb_link; ++ } ++ +++ *cbpp=cbp; +++ ++ } ++ ++ static inline void ++@@ -890,6 +898,7 @@ add_pages(struct typemanager *tm,fixnum ++ if (rb_pointer>rb_end) { ++ fprintf(stderr,"Moving relblock low before expanding relblock pages\n"); ++ fflush(stderr); +++ tm_table[t_relocatable].tm_adjgbccnt--; ++ GBC(t_relocatable); ++ } ++ nrbpage+=m; ++--- gcl-2.6.12.orig/o/gbc.c +++++ gcl-2.6.12/o/gbc.c ++@@ -1042,14 +1042,10 @@ contblock_sweep_phase(void) { ++ ++ struct pageinfo *v; ++ STATIC char *s, *e, *p, *q; ++- object o; ++ ufixnum i; ++ ++ reset_contblock_freelist(); ++ ++- o=sSAleaf_collection_thresholdA->s.s_dbind; ++- sSAleaf_collection_thresholdA->s.s_dbind=make_fixnum(-1); ++- ++ for (i=0;iv.v_fillp && (v=(void *)contblock_array->v.v_self[i]);i++) { ++ ++ bool z; ++@@ -1074,8 +1070,6 @@ contblock_sweep_phase(void) { ++ ++ } ++ ++- sSAleaf_collection_thresholdA->s.s_dbind=o; ++- ++ sweep_link_array(); ++ ++ } ++@@ -1646,14 +1640,18 @@ DEFUN_NEW("GBC",object,fSgbc,SI,1,1,NONE ++ ++ /* 1 args */ ++ ++- if (x0 == Ct) +++ if (x0 == Ct) { +++ tm_table[t_contiguous].tm_adjgbccnt--; ++ GBC(t_other); ++- else if (x0 == Cnil) +++ } else if (x0 == Cnil) { +++ tm_table[t_cons].tm_adjgbccnt--; ++ GBC(t_cons); ++- else if (eql(small_fixnum(0),x0)) +++ } else if (eql(small_fixnum(0),x0)) { +++ tm_table[t_contiguous].tm_adjgbccnt--; ++ GBC(t_contiguous); ++- else { +++ } else { ++ x0 = small_fixnum(1); +++ tm_table[t_relocatable].tm_adjgbccnt--; ++ GBC(t_relocatable); ++ } ++ RETURN1(x0); diff --cc debian/patches/Version_2_6_13pre60 index 00000000,00000000..e5808329 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre60 @@@ -1,0 -1,0 +1,61 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-70) unstable; urgency=medium ++ . ++ * Version_2_6_13pre59 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-03-12 ++ ++--- gcl-2.6.12.orig/h/elf64_alpha_reloc.h +++++ gcl-2.6.12/h/elf64_alpha_reloc.h ++@@ -29,7 +29,7 @@ ++ } else ++ *gote=s+a; ++ s=(gote-got)*sizeof(*got); ++- massert(!(s&~MASK(16))); +++ massert(!(s&~MASK(15))); ++ store_val(where,MASK(16),s); ++ break; ++ case R_ALPHA_GPRELHIGH: ++--- gcl-2.6.12.orig/h/elf64_alpha_reloc_special.h +++++ gcl-2.6.12/h/elf64_alpha_reloc_special.h ++@@ -62,7 +62,6 @@ static int ++ label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,const char *sn,ul *gs) { ++ ++ Rela *r,*rr; ++- Sym *sym; ++ Shdr *sec; ++ void *v,*ve,*vv; ++ ul b,q; ++@@ -80,8 +79,12 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ vv-=sec->sh_entsize,rr=vv); ++ ++ b=sizeof(r->r_addend)*4; ++- q=vv>=v1 ? (rr->r_addend>>b) : ++*gs; ++- massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); +++ if (vv>=v1) +++ q=rr->r_addend>>b; +++ else { +++ q=++*gs; +++ massert(!make_got_room_for_stub(sec1,sece,sym1+ELF_R_SYM(r->r_info),st1,gs)); +++ } ++ massert(*gs==q || !r->r_addend); ++ massert(!(r->r_addend>>b)); ++ r->r_addend|=(q< ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-71) unstable; urgency=medium ++ . ++ * Version_2_6_13pre60 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-03-13 ++ ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -4118,6 +4118,7 @@ if test "${enable_gprof+set}" = set; the ++ $as_echo_n "checking working gprof... " >&6; } ++ case $use in ++ powerpc*) if test "$host_cpu" = "powerpc64le" ; then enableval="no"; fi;; +++ s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 ++ sh4*) enableval="no";; ++ ia64*) enableval="no";; ++ hppa*) enableval="no";; ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -331,6 +331,7 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof ++ AC_MSG_CHECKING([working gprof]) ++ case $use in ++ powerpc*) if test "$host_cpu" = "powerpc64le" ; then enableval="no"; fi;; +++ s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 ++ sh4*) enableval="no";; ++ ia64*) enableval="no";; ++ hppa*) enableval="no";; diff --cc debian/patches/Version_2_6_13pre62 index 00000000,00000000..c7d4c3c9 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre62 @@@ -1,0 -1,0 +1,113 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-72) unstable; urgency=medium ++ . ++ * Version_2_6_13pre61 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-03-14 ++ ++--- gcl-2.6.12.orig/h/elf64_alpha_reloc.h +++++ gcl-2.6.12/h/elf64_alpha_reloc.h ++@@ -22,12 +22,12 @@ ++ store_val(where,MASK(32),s+a); ++ break; ++ case R_ALPHA_LITERAL: ++- gote=got+(a>>32)-1; ++- a&=MASK(32); +++ massert(a || sym->st_size); +++ gote=got+(a ? (a>>32) : sym->st_size)-1; ++ if (s>=ggot1 && sst_size=0; ++ ++ for (*gs=0,sec=sec1;secsh_type==SHT_RELA) ++- for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++- if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { ++- ++- for (rr=vv=v-sec->sh_entsize; ++- vv>=v1 && ++- (ELF_R_TYPE(rr->r_info)!=ELF_R_TYPE(r->r_info) || ++- ELF_R_SYM(rr->r_info)!=ELF_R_SYM(r->r_info) || ++- rr->r_addend!=r->r_addend); ++- vv-=sec->sh_entsize,rr=vv); ++- ++- b=sizeof(r->r_addend)*4; ++- if (vv>=v1) ++- q=rr->r_addend>>b; ++- else { ++- q=++*gs; ++- massert(!make_got_room_for_stub(sec1,sece,sym1+ELF_R_SYM(r->r_info),st1,gs)); +++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) +++ +++ if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { +++ +++ if (sec->sh_type!=SHT_RELA || !r->r_addend) { +++ +++ sym=sym1+ELF_R_SYM(r->r_info); +++ +++ if (!sym->st_size) { +++ sym->st_size=++*gs; +++ massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); ++ } ++- massert(*gs==q || !r->r_addend); ++- massert(!(r->r_addend>>b)); ++- r->r_addend|=(q<sh_entsize; +++ vv>=v1 && (ELF_R_TYPE(rr->r_info)!=ELF_R_TYPE(r->r_info) || +++ ELF_R_SYM(rr->r_info)!=ELF_R_SYM(r->r_info) || +++ rr->r_addend!=r->r_addend); +++ vv-=sec->sh_entsize,rr=vv); +++ +++ q=vvr_addend>>32; +++ massert(!(r->r_addend>>32)); +++ r->r_addend|=(q<<32); ++ ++ } ++- +++ +++ } +++ ++ return 0; ++ ++ } diff --cc debian/patches/Version_2_6_13pre63 index 00000000,00000000..ee53ae96 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre63 @@@ -1,0 -1,0 +1,78 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-73) unstable; urgency=medium ++ . ++ * Version_2_6_13pre62 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-03-17 ++ ++--- gcl-2.6.12.orig/h/elf64_alpha_reloc_special.h +++++ gcl-2.6.12/h/elf64_alpha_reloc_special.h ++@@ -71,20 +71,21 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ sym->st_size=0; ++ ++ for (*gs=0,sec=sec1;secsh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) +++ if (sec->sh_type==SHT_RELA || sec->sh_type==SHT_REL) +++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++ ++- if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { +++ if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { ++ ++- if (sec->sh_type!=SHT_RELA || !r->r_addend) { +++ if (sec->sh_type!=SHT_RELA || !r->r_addend) { ++ ++- sym=sym1+ELF_R_SYM(r->r_info); +++ sym=sym1+ELF_R_SYM(r->r_info); ++ ++- if (!sym->st_size) { ++- sym->st_size=++*gs; ++- massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); ++- } +++ if (!sym->st_size) { +++ sym->st_size=++*gs; +++ massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); +++ } ++ ++- } else { +++ } else { ++ ++ for (rr=vv=v-sec->sh_entsize; ++ vv>=v1 && (ELF_R_TYPE(rr->r_info)!=ELF_R_TYPE(r->r_info) || ++@@ -96,9 +97,9 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ massert(!(r->r_addend>>32)); ++ r->r_addend|=(q<<32); ++ ++- } +++ } ++ ++- } +++ } ++ ++ return 0; ++ ++--- gcl-2.6.12.orig/o/gprof.c +++++ gcl-2.6.12/o/gprof.c ++@@ -1,3 +1,5 @@ +++#include +++ ++ #include "include.h" ++ #include "page.h" ++ #include "ptable.h" diff --cc debian/patches/Version_2_6_13pre64 index 00000000,00000000..e0a6ae0c new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre64 @@@ -1,0 -1,0 +1,169 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-74) unstable; urgency=medium ++ . ++ * Version_2_6_13pre63 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-03-21 ++ ++--- gcl-2.6.12.orig/h/elf64_alpha_reloc.h +++++ gcl-2.6.12/h/elf64_alpha_reloc.h ++@@ -1,16 +1,14 @@ ++ case R_ALPHA_GPDISP: ++- s=(ul)got; ++- s-=p; ++- s+=(s&0x8000)<<1; ++- store_val(where,MASK(16),s>>16); ++- where=(void *)where+a; ++- store_val(where,MASK(16),s); +++ gotoff=(ul)(got+(a>>32)); +++ s=gotoff-p; +++ store_val(where,MASK(16),(s-(short)s)>>16); +++ store_val((void *)where+(a&MASK(32)),MASK(16),s); ++ break; ++ case R_ALPHA_SREL32: ++ store_val(where,MASK(32),s+a-p); ++ break; ++ case R_ALPHA_GPREL32: ++- store_val(where,MASK(32),s+a-(ul)got); +++ store_val(where,MASK(32),s+a-gotoff); ++ break; ++ case R_ALPHA_LITUSE: ++ case R_ALPHA_HINT: ++@@ -22,23 +20,20 @@ ++ store_val(where,MASK(32),s+a); ++ break; ++ case R_ALPHA_LITERAL: ++- massert(a || sym->st_size); ++- gote=got+(a ? (a>>32) : sym->st_size)-1; +++ s+=a&MASK(32); +++ a=(a>>32)-1; ++ if (s>=ggot1 && s>16); +++ s+=a-gotoff; +++ store_val(where,MASK(16),(s-(short)s)>>16); ++ break; ++ case R_ALPHA_GPRELLOW: ++- store_val(where,MASK(16),s+a-(ul)got); +++ store_val(where,MASK(16),s+a-gotoff); ++ break; ++ case R_ALPHA_TLS_GD_HI: ++ store_vals(where,MASK(21),((long)(s+a-(p+4)))>>2); ++--- gcl-2.6.12.orig/h/elf64_alpha_reloc_special.h +++++ gcl-2.6.12/h/elf64_alpha_reloc_special.h ++@@ -1,4 +1,4 @@ ++-static ul ggot1,ggote; +++static ul ggot1,ggote,gotoff; ++ ++ static int ++ write_stub(ul s,ul *got,ul *gote) { ++@@ -61,44 +61,60 @@ find_special_params(void *v,Shdr *sec1,S ++ static int ++ label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,const char *sn,ul *gs) { ++ ++- Sym *sym; ++- Rela *r,*rr; +++ Sym *sym,*fsym=sym1; +++ Rela *r; ++ Shdr *sec; ++- void *v,*ve,*vv; ++- ul q; +++ void *v,*ve; +++ ul q,gotp; ++ ++ for (sym=sym1;symst_size=0; ++ ++- for (*gs=0,sec=sec1;secsh_type==SHT_RELA || sec->sh_type==SHT_REL) +++ for (*gs=gotp=0,sec=sec1;secsh_type==SHT_RELA) ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++ ++- if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { +++ switch(ELF_R_TYPE(r->r_info)) { +++ +++ case R_ALPHA_LITERAL: ++ ++- if (sec->sh_type!=SHT_RELA || !r->r_addend) { +++ if (!r->r_addend) { ++ ++ sym=sym1+ELF_R_SYM(r->r_info); +++ q=(gotp-sym->st_size)*sizeof(*gs); ++ ++- if (!sym->st_size) { +++ if (!sym->st_size || q!=(short)q) { ++ sym->st_size=++*gs; ++ massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); ++ } ++ ++- } else { +++ q=sym->st_size; +++ +++ } else +++ +++ q=++*gs; +++ +++ massert(!(r->r_addend>>32)); +++ r->r_addend|=(q<<32); ++ ++- for (rr=vv=v-sec->sh_entsize; ++- vv>=v1 && (ELF_R_TYPE(rr->r_info)!=ELF_R_TYPE(r->r_info) || ++- ELF_R_SYM(rr->r_info)!=ELF_R_SYM(r->r_info) || ++- rr->r_addend!=r->r_addend); ++- vv-=sec->sh_entsize,rr=vv); ++- ++- q=vvr_addend>>32; ++- massert(!(r->r_addend>>32)); ++- r->r_addend|=(q<<32); +++ q=(q-gotp)*sizeof(*gs); +++ massert(q==(short)q); ++ +++ break; +++ +++ case R_ALPHA_GPDISP: +++ +++ for (sym=fsym;symst_shndx!=1 || sym->st_value!=r->r_offset);sym++); +++ +++ if (symr_addend|=(gotp<<32); +++ +++ break; +++ ++ } ++ ++ return 0; diff --cc debian/patches/Version_2_6_13pre65 index 00000000,00000000..dbaef5d7 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre65 @@@ -1,0 -1,0 +1,212 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-75) unstable; urgency=medium ++ . ++ * Version_2_6_13pre64 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-03-22 ++ ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpif.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpif.lsp ++@@ -428,9 +428,8 @@ ++ (wt-label label)))) ++ ++ (if (eq default 't) ++- (progn (wt-nl "FEerror(\"The ECASE key value ~s is illegal.\",1,V" cvar ");") ++- (unwind-exit nil 'jump)) ++- (c2expr default)) +++ (wt-nl "FEerror(\"The ECASE key value ~s is illegal.\",1,V" cvar ");") +++ (c2expr default)) ++ ++ (wt "}") ++ (close-inline-blocks)) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpmulti.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpmulti.lsp ++@@ -221,56 +221,36 @@ ++ ++ ++ (defun c2multiple-value-bind (vars init-form body ++- &aux (block-p nil) (labels nil) ++- (*unwind-exit* *unwind-exit*) ++- (*vs* *vs*) (*clink* *clink*) (*ccb-vs* *ccb-vs*) ++- top-data) ++- (declare (object block-p)) ++- (multiple-value-check vars init-form) +++ &aux (block-p nil) +++ (*unwind-exit* *unwind-exit*) +++ (*vs* *vs*) (*clink* *clink*) (*ccb-vs* *ccb-vs*) +++ top-data) ++ ++- (dolist** (var vars) +++ (multiple-value-check vars init-form) +++ +++ (dolist (var vars) ++ (let ((kind (c2var-kind var))) ++- (declare (object kind)) ++ (if kind ++ (let ((cvar (next-cvar))) ++ (setf (var-kind var) kind) ++ (setf (var-loc var) cvar) ++ (wt-nl) ++ (unless block-p (wt "{") (setq block-p t)) ++- (wt-var-decl var) ++- ) ++- (setf (var-ref var) (vs-push))))) +++ (wt-var-decl var)) +++ (setf (var-ref var) (vs-push))))) ++ ++ (let ((*value-to-go* 'top) *top-data*) ++ (c2expr* init-form) (setq top-data *top-data*)) +++ ++ (and *record-call-info* (record-call-info nil (car top-data))) ++- (let ((*clink* *clink*) ++- (*unwind-exit* *unwind-exit*) ++- (*ccb-vs* *ccb-vs*)) ++- (do ((vs vars (cdr vs))) ++- ((endp vs)) ++- (declare (object vs)) ++- (push (next-label) labels) ++- (wt-nl "if(vs_base>=vs_top){") ++- (reset-top) ++- (wt-go (car labels)) (wt "}") +++ +++ (wt-nl "if(vs_base>vs_top) vs_top=vs_base;*vs_top=Cnil;") +++ (do ((vs vars (cdr vs))) +++ ((endp vs)) ++ (c2bind-loc (car vs) '(vs-base 0)) ++- (unless (endp (cdr vs)) (wt-nl "vs_base++;")))) +++ (unless (endp (cdr vs)) (wt-nl "if (vs_base>32)); +++ gotoff=(ul)(got+(a>>32)-1); ++ s=gotoff-p; ++ store_val(where,MASK(16),(s-(short)s)>>16); ++ store_val((void *)where+(a&MASK(32)),MASK(16),s); ++@@ -23,7 +23,7 @@ ++ s+=a&MASK(32); ++ a=(a>>32)-1; ++ if (s>=ggot1 && sr_addend>>32)); +++ if (r->r_addend>>32) +++ fprintf(stderr,"zeroing high addend %lx\n",r->r_addend>>32); +++ r->r_addend&=0xffffffff; +++ massert((q&0xffffffff)==q); ++ r->r_addend|=(q<<32); ++ ++ q=(q-gotp)*sizeof(*gs); ++@@ -111,6 +114,10 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ gotp=*gs+1; ++ } ++ +++ if (r->r_addend>>32) +++ fprintf(stderr,"zeroing high addend %lx\n",r->r_addend>>32); +++ r->r_addend&=0xffffffff; +++ massert((gotp&0xffffffff)==gotp); ++ r->r_addend|=(gotp<<32); ++ ++ break; diff --cc debian/patches/Version_2_6_13pre66 index 00000000,00000000..667cee3c new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre66 @@@ -1,0 -1,0 +1,132 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-75) unstable; urgency=medium ++ . ++ * Version_2_6_13pre65 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-03-23 ++ ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpmulti.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpmulti.lsp ++@@ -164,27 +164,21 @@ ++ (cmpwarn "~A was proclaimed to have only one return value. ~%;But you appear to want multiple values." fname)))))) ++ ++ (defun c2multiple-value-setq (vrefs form &aux top-data) ++- (multiple-value-check vrefs form) +++ (multiple-value-check vrefs form) ++ (let ((*value-to-go* 'top)*top-data*) ++ (c2expr* form) (setq top-data *top-data*)) ++ (and *record-call-info* (record-call-info nil (car top-data))) +++ (wt-nl "if(vs_base>vs_top) vs_top=vs_base;*vs_top=Cnil;") ++ (do ((vs vrefs (cdr vs))) ++ ((endp vs)) ++- (declare (object vs)) ++ (let ((vref (car vs))) ++- (declare (object vref)) ++- (wt-nl "if(vs_base&6; } ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5 ++ $as_echo "ok" >&6; } ++- assert_arg_to_cflags -pg +++ OLD_CFLAGS=$CFLAGS # Do not run configure tests with -pg +++ assert_arg_to_cflags -pg +++ CFLAGS=$OLD_CFLAGS ++ TFPFLAG="" ++ ++ $as_echo "#define GCL_GPROF 1" >>confdefs.h ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -334,6 +334,7 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof ++ s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 ++ sh4*) enableval="no";; ++ ia64*) enableval="no";; +++ alpha*) enableval="no";;#write_stub currently depends on t12 set in call ++ hppa*) enableval="no";; ++ arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++ aarch64*) enableval="no";;#unreproducible buildd bug 20170824 ++@@ -343,25 +344,11 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof ++ AC_MSG_RESULT([disabled]) ++ else ++ AC_MSG_RESULT([ok]) ++- assert_arg_to_cflags -pg +++ OLD_CFLAGS=$CFLAGS # Do not run configure tests with -pg +++ assert_arg_to_cflags -pg +++ CFLAGS=$OLD_CFLAGS ++ TFPFLAG="" ++ AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) ++-dnl AC_MSG_CHECKING([for text start]) ++-dnl echo 'int main () {return(0);}' >foo.c ++-dnl $CC foo.c -o foo ++-dnl GCL_GPROF_START=`nm foo | $AWK '/ *[[TD]] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc ++-dnl rm -f foo.c foo ++-dnl if test "$GCL_GPROF_START" != "" ; then ++-dnl AC_MSG_RESULT($GCL_GPROF_START) ++-dnl AC_DEFINE_UNQUOTED(GCL_GPROF_START,$GCL_GPROF_START,[starting address for gprof]) ++-dnl assert_arg_to_cflags -pg ++-dnl # case $use in ++-dnl # s390*) ;; # relocation truncation bug in gcc ++-dnl # *) TLIBS="$TLIBS -pg";; ++-dnl # esac ++-dnl TFPFLAG="" ++-dnl AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) ++-dnl fi ++ fi ++ fi]) ++ ++--- gcl-2.6.12.orig/o/usig.c +++++ gcl-2.6.12/o/usig.c ++@@ -150,7 +150,7 @@ DEFUN_NEW("FLD",object,fSfld,SI,1,1,NONE ++ ++ /* For now ignore last three args governing offsets and data modification, just to ++ support fpe sync with master*/ ++-DEFUN_NEW("*FIXNUM",object,fSAfixnum,SI,4,4,NONE,OI,OO,OO,OO,(fixnum addr,object x,object y,object z),"") { +++DEFUN_NEW("*FIXNUM",object,fSAfixnum,SI,4,4,NONE,II,OO,OO,OO,(fixnum addr,object x,object y,object z),"") { ++ RETURN1((object)*(fixnum *)addr); ++ } ++ DEFUN_NEW("*FLOAT",object,fSAfloat,SI,4,4,NONE,OI,OO,OO,OO,(fixnum addr,object x,object y,object z),"") { diff --cc debian/patches/Version_2_6_13pre67 index 00000000,00000000..274a39e0 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre67 @@@ -1,0 -1,0 +1,256 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-76) unstable; urgency=medium ++ . ++ * Version_2_6_13pre66 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-03-26 ++ ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -4121,7 +4121,6 @@ $as_echo_n "checking working gprof... " ++ s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 ++ sh4*) enableval="no";; ++ ia64*) enableval="no";; ++- alpha*) enableval="no";;#write_stub currently depends on t12 set in call ++ hppa*) enableval="no";; ++ arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++ aarch64*) enableval="no";;#unreproducible buildd bug 20170824 ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -334,7 +334,6 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof ++ s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 ++ sh4*) enableval="no";; ++ ia64*) enableval="no";; ++- alpha*) enableval="no";;#write_stub currently depends on t12 set in call ++ hppa*) enableval="no";; ++ arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++ aarch64*) enableval="no";;#unreproducible buildd bug 20170824 ++--- gcl-2.6.12.orig/h/elf64_alpha_reloc.h +++++ gcl-2.6.12/h/elf64_alpha_reloc.h ++@@ -1,14 +1,14 @@ ++ case R_ALPHA_GPDISP: ++- gotoff=(ul)(got+(a>>32)-1); +++ gotoff=(ul)(got+HIGH(a)-1); ++ s=gotoff-p; ++ store_val(where,MASK(16),(s-(short)s)>>16); ++- store_val((void *)where+(a&MASK(32)),MASK(16),s); +++ store_val((void *)where+LOW(a),MASK(16),s); ++ break; ++ case R_ALPHA_SREL32: ++ store_val(where,MASK(32),s+a-p); ++ break; ++ case R_ALPHA_GPREL32: ++- store_val(where,MASK(32),s+a-gotoff); +++ store_val(where,MASK(32),s+LOW(a)-(ul)(got+HIGH(a)-1)); ++ break; ++ case R_ALPHA_LITUSE: ++ case R_ALPHA_HINT: ++@@ -20,8 +20,8 @@ ++ store_val(where,MASK(32),s+a); ++ break; ++ case R_ALPHA_LITERAL: ++- s+=a&MASK(32); ++- a=(a>>32)-1; +++ s+=LOW(a); +++ a=HIGH(a)-1; ++ if (s>=ggot1 && s>16); /*ldah t12,(symhigh)(zero)*/ +++ *goti++=(0x8<<26)|(0x1b<<21)|(0x1b<<16)|(s&MASK(16)); /*lda t12,(symlow)(t12)*/ +++ *goti++=(0x29<<26)|(0x1b<<21)|(0x1b<<16)|0; /*ldq t12,0(t12)*/ +++ *goti++=(0x1a<<26)|(0x1f<<21)|(0x1b<<16)|0x4000; /*jsr zero,(t12),$pc+4*/ +++ *goti++=0; /*halt*/ +++ *goti++=0; /*halt*/ +++ +++ return 0; +++ +++} ++ ++ static int ++ write_stub(ul s,ul *gote) { ++ ++ unsigned int *goti; ++ +++ if (s==mcount) +++ return write_stub_mcount(mcount,gote); +++ ++ *gote=(ul)(goti=(void *)(gote+2)); ++ *++gote=s; ++ *goti++=(0x29<<26)|(0x1b<<21)|(0x1b<<16)|0xfff8; /*ldq t12,-8(t12)*/ ++@@ -35,15 +57,19 @@ static int ++ find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, ++ const char *st1,Sym *ds1,Sym *dse,Sym *sym1,Sym *syme) { ++ +++ Sym *sym; ++ Shdr *sec; ++ Rela *r; ++- void *ve; +++ void *ve,*dst1; ++ ++ massert((sec=get_section(".got",sec1,sece,sn))); ++ ++ ggot1=sec->sh_addr; ++ ggote=ggot1+sec->sh_size; ++ +++ massert(sec=get_section(".dynstr",sec1,sece,sn));/*FIXME pass as parameter*/ +++ dst1=v+sec->sh_offset; +++ ++ massert((sec=get_section(".rel.dyn",sec1,sece,sn))|| ++ (sec=get_section(".rela.dyn",sec1,sece,sn))); ++ ++@@ -51,13 +77,20 @@ find_special_params(void *v,Shdr *sec1,S ++ ve=v+sec->sh_size; ++ ++ for (r=v;vsh_entsize,r=v) ++- if (ELF_R_TYPE(r->r_info) && !ds1[ELF_R_SYM(r->r_info)].st_value) ++- ds1[ELF_R_SYM(r->r_info)].st_value=r->r_offset; +++ if (ELF_R_TYPE(r->r_info) && !(sym=ds1+ELF_R_SYM(r->r_info))->st_value) { +++ sym->st_value=r->r_offset; +++ if (!strncmp("_mcount",dst1+sym->st_name,7)) +++ mcount=sym->st_value; +++ } ++ ++ return 0; ++ ++ } ++ +++#define HIGH(a_) ((a_)>>32) +++#define LOW(a_) ((a_)&MASK(32)) +++#define SET_HIGH(a_,b_) ({ul _a=(a_);(a_)=((b_)<<32)|LOW(_a);}) +++ ++ static int ++ label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,const char *sn,ul *gs) { ++ ++@@ -67,12 +100,18 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ void *v,*ve; ++ ul q,gotp; ++ ++- for (sym=sym1;symst_size=0; +++ for (sym=sym1;symst_value)); +++ massert(!HIGH(sym->st_size)); +++ } ++ ++ for (*gs=gotp=0,sec=sec1;secsh_type==SHT_RELA) ++- for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) +++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) { +++ +++ if (HIGH(r->r_addend)) +++ fprintf(stderr,"zeroing high addend %lx\n",HIGH(r->r_addend));/*never reached fix(Cnil) code, to be eliminated*/ +++ SET_HIGH(r->r_addend,0UL); ++ ++ switch(ELF_R_TYPE(r->r_info)) { ++ ++@@ -81,49 +120,60 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ if (!r->r_addend) { ++ ++ sym=sym1+ELF_R_SYM(r->r_info); ++- q=(gotp-sym->st_size)*sizeof(*gs); +++ q=(HIGH(sym->st_size)-gotp)*sizeof(*gs); ++ ++- if (!sym->st_size || q!=(short)q) { ++- sym->st_size=++*gs; +++ if (!HIGH(sym->st_size) || q!=(short)q) {/*new cached got entry if first or out of range*/ +++ SET_HIGH(sym->st_size,++*gs); ++ massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); ++ } ++ ++- q=sym->st_size; +++ q=HIGH(sym->st_size); ++ ++ } else ++ ++ q=++*gs; ++ ++- if (r->r_addend>>32) ++- fprintf(stderr,"zeroing high addend %lx\n",r->r_addend>>32); ++- r->r_addend&=0xffffffff; ++- massert((q&0xffffffff)==q); ++- r->r_addend|=(q<<32); +++ SET_HIGH(r->r_addend,q); ++ ++- q=(q-gotp)*sizeof(*gs); +++ q=(q-gotp)*sizeof(*gs);/*check 16bit range gprel address in range*/ ++ massert(q==(short)q); ++ ++ break; ++ ++ case R_ALPHA_GPDISP: ++ ++- for (sym=fsym;symst_shndx!=1 || sym->st_value!=r->r_offset);sym++); +++ for (sym=fsym;symst_shndx!=1 || LOW(sym->st_value)!=r->r_offset);sym++);/*ordered search*/ ++ ++ if (symst_value,gotp=*gs+1); ++ } ++ ++- if (r->r_addend>>32) ++- fprintf(stderr,"zeroing high addend %lx\n",r->r_addend>>32); ++- r->r_addend&=0xffffffff; ++- massert((gotp&0xffffffff)==gotp); ++- r->r_addend|=(gotp<<32); +++ SET_HIGH(r->r_addend,gotp); +++ +++ break; +++ +++ case R_ALPHA_GPREL32: +++ +++ q=LOW(sym1[ELF_R_SYM(r->r_info)].st_value)+r->r_addend; +++ +++ /*unordered search*/ +++ for (sym=sym1;symst_shndx!=1 || LOW(sym->st_value)>q || LOW(sym->st_value)+LOW(sym->st_size)r_addend,HIGH(sym->st_value)); ++ ++ break; ++ ++ } ++ +++ } +++ +++ for (sym=sym1;symst_value,0UL); +++ SET_HIGH(sym->st_size,0UL); +++ } +++ ++ return 0; ++ ++ } diff --cc debian/patches/Version_2_6_13pre68 index 00000000,00000000..3c62bd07 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre68 @@@ -1,0 -1,0 +1,35 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-76) unstable; urgency=medium ++ . ++ * Version_2_6_13pre67 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-07-24 ++ ++--- gcl-2.6.12.orig/h/elf64_i386_reloc.h +++++ gcl-2.6.12/h/elf64_i386_reloc.h ++@@ -8,6 +8,7 @@ ++ add_val(where,~0L,s+a); ++ break; ++ case R_X86_64_PC32: +++ case R_X86_64_PLT32: ++ massert(ovchks(s+a-p,~MASK(32))); ++ add_val(where,MASK(32),s+a-p); ++ break; diff --cc debian/patches/Version_2_6_13pre69 index 00000000,00000000..37f5f682 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre69 @@@ -1,0 -1,0 +1,32 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-78) unstable; urgency=medium ++ . ++ * rebuild against latest compilers and tools ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-10-11 ++ ++--- gcl-2.6.12.orig/h/386-gnu.h +++++ gcl-2.6.12/h/386-gnu.h ++@@ -61,3 +61,4 @@ ++ #define NEED_STACK_CHK_GUARD ++ ++ #undef HAVE_D_TYPE /*FIXME defined, but not implemented in readdir*/ +++#define NO_FILE_LOCKING /*FIXME*/ diff --cc debian/patches/Version_2_6_13pre7 index 00000000,00000000..ccbd1e45 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre7 @@@ -1,0 -1,0 +1,163 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-7) unstable; urgency=medium ++ . ++ * Version_2_6_13pre6 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/h/att_ext.h +++++ gcl-2.6.12/h/att_ext.h ++@@ -29,7 +29,7 @@ void *malloc(size_t); ++ void *realloc(void *,size_t); ++ /* void * memalign(size_t,size_t); */ ++ void *alloc_contblock(size_t); ++-void *alloc_relblock(size_t); +++inline void *alloc_relblock(size_t); ++ /* object fSallocate_contiguous_pages(); */ ++ /* object fSallocate_relocatable_pages(); */ ++ ++--- gcl-2.6.12.orig/h/protoize.h +++++ gcl-2.6.12/h/protoize.h ++@@ -7,7 +7,7 @@ ++ /* alloc.c:364:OF */ extern object on_stack_cons (object x, object y); /* (x, y) object x; object y; */ ++ /* alloc.c:376:OF */ extern object fSallocated (object typ); /* (typ) object typ; */ ++ /* alloc.c:401:OF */ extern object fSreset_number_used (object typ); /* (typ) object typ; */ ++-/* alloc.c:480:OF */ extern void insert_contblock (void *p, ufixnum s); /* (p, s) char *p; int s; */ +++/* alloc.c:480:OF */ extern inline void insert_contblock (void *p, ufixnum s); /* (p, s) char *p; int s; */ ++ /* alloc.c:480:OF */ extern void insert_maybe_sgc_contblock (char *p, int s); /* (p, s) char *p; int s; */ ++ /* alloc.c:611:OF */ extern void set_maxpage (void); /* () */ ++ /* alloc.c:635:OF */ extern void gcl_init_alloc (void *); /* () */ ++--- gcl-2.6.12.orig/o/gbc.c +++++ gcl-2.6.12/o/gbc.c ++@@ -422,7 +422,11 @@ DEFVAR("*LEAF-COLLECTION-THRESHOLD*",sSA ++ ++ static inline bool ++ marking(void *p) { ++- return (sgc_enabled ? ON_WRITABLE_PAGE_CACHED(p) : !NULL_OR_ON_C_STACK(p)); +++ return ( +++#ifdef SGC +++ sgc_enabled ? ON_WRITABLE_PAGE_CACHED(p) : +++#endif +++ !NULL_OR_ON_C_STACK(p)); ++ } ++ ++ static inline bool ++@@ -483,7 +487,11 @@ mark_object_address(object *o,int f) { ++ ++ if (lp!=p || !f) { ++ lp=p; ++- lr=sgc_enabled ? WRITABLE_PAGE_P(lp) : 1; +++ lr= +++#ifdef SGC +++ sgc_enabled ? WRITABLE_PAGE_P(lp) : +++#endif +++ 1; ++ } ++ ++ if (lr) ++--- gcl-2.6.12.orig/o/main.c +++++ gcl-2.6.12/o/main.c ++@@ -147,8 +147,8 @@ mbrk(void *v) { ++ ++ #include ++ ++-ufixnum ++-get_phys_pages_no_malloc(void) { +++static ufixnum +++get_phys_pages_no_malloc(char n) { ++ MEMORYSTATUS m; ++ ++ m.dwLength=sizeof(m); ++@@ -161,8 +161,8 @@ get_phys_pages_no_malloc(void) { ++ ++ #include ++ ++-ufixnum ++-get_phys_pages_no_malloc(void) { +++static ufixnum +++get_phys_pages_no_malloc(char n) { ++ uint64_t s; ++ size_t z=sizeof(s); ++ int m[2]={CTL_HW,HW_MEMSIZE}; ++@@ -176,8 +176,8 @@ get_phys_pages_no_malloc(void) { ++ ++ #elif defined(__sun__) ++ ++-ufixnum ++-get_phys_pages_no_malloc(void) { +++static ufixnum +++get_phys_pages_no_malloc(char n) { ++ ++ return sysconf(_SC_PHYS_PAGES); ++ ++@@ -202,7 +202,7 @@ get_proc_meminfo_value_in_pages(const ch ++ return n>>(PAGEWIDTH-10); ++ } ++ ++-ufixnum +++static ufixnum ++ get_phys_pages_no_malloc(char freep) { ++ return freep ? ++ get_proc_meminfo_value_in_pages("MemFree:")+ ++--- gcl-2.6.12.orig/o/sfaslcoff.c +++++ gcl-2.6.12/o/sfaslcoff.c ++@@ -205,9 +205,7 @@ load_memory(struct scnhdr *sec1,struct s ++ memory->cfd.cfd_size=sz; ++ memory->cfd.cfd_self=0; ++ memory->cfd.cfd_start=0; ++- prefer_low_mem_contblock=TRUE; ++- memory->cfd.cfd_start=alloc_contblock(sz); ++- prefer_low_mem_contblock=FALSE; +++ memory->cfd.cfd_start=alloc_code_space(sz); ++ ++ for (sec=sec1;secs_paddr+=(ul)memory->cfd.cfd_start; ++--- gcl-2.6.12.orig/o/sfaslmacho.c +++++ gcl-2.6.12/o/sfaslmacho.c ++@@ -207,9 +207,7 @@ load_memory(struct section *sec1,struct ++ memory->cfd.cfd_size=sz; ++ memory->cfd.cfd_self=0; ++ memory->cfd.cfd_start=0; ++- prefer_low_mem_contblock=TRUE; ++- memory->cfd.cfd_start=alloc_contblock(sz); ++- prefer_low_mem_contblock=FALSE; +++ memory->cfd.cfd_start=alloc_code_space(sz); ++ ++ a=(ul)memory->cfd.cfd_start; ++ a=(a+ma)&~ma; ++--- gcl-2.6.12.orig/unixport/sys_init.lsp.in +++++ gcl-2.6.12/unixport/sys_init.lsp.in ++@@ -28,7 +28,7 @@ ++ (pcl (append x (list "pcl"))) ++ (clcs (append x (list "clcs"))) ++ (gtk (append x (list "gcl-tk")))) ++- (dolist (d (list lsp cmpnew #-pre-gcl xgcl-2 #+(or pcl ansi-cl) pcl #+ansi-cl clcs)) +++ (dolist (d (list lsp cmpnew #+(and xgcl (not pre-gcl)) xgcl-2 #+(or pcl ansi-cl) pcl #+ansi-cl clcs)) ++ (load (make-pathname :name "sys-proclaim" :type "lisp" :directory d))) ++ (load (make-pathname :name "tk-package" :type "lsp" :directory gtk)) ++ (load (make-pathname :name "gcl_lfun_list" :type "lsp" :directory cmpnew)) ++@@ -77,6 +77,5 @@ ++ ++ #-ansi-cl(use-package :cltl1-compat :lisp) ++ #-ansi-cl(do-symbols (s :cltl1-compat) (export s :lisp))) ++-(export '*load-pathname* :si);For maxima, at least as of 5.34.1 ++ ++ #+ansi-cl (use-package :pcl :user) diff --cc debian/patches/Version_2_6_13pre70 index 00000000,00000000..cbcbe0a8 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre70 @@@ -1,0 -1,0 +1,108 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-78) unstable; urgency=medium ++ . ++ * rebuild against latest compilers and tools ++ * Version_2_6_13pre69 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-10-29 ++ ++--- gcl-2.6.12.orig/h/linux.h +++++ gcl-2.6.12/h/linux.h ++@@ -132,17 +132,10 @@ do { int c = 0; \ ++ ++ #include ++ #include ++-#define GET_FULL_PATH_SELF(a_) do { \ ++- static char q[PATH_MAX]; \ ++- const char *s="/proc/self/exe"; \ ++- struct stat ss; \ ++- if (stat(s,&ss)) \ ++- (a_)=argv[0]; \ ++- else { \ ++- if (!realpath(s,q)) \ ++- error("realpath error"); \ ++- (a_)=q; \ ++- } \ +++#define GET_FULL_PATH_SELF(a_) do { \ +++ static char q[PATH_MAX]; \ +++ massert(which("/proc/self/exe",q) || which(argv[0],q)); \ +++ (a_)=q; \ ++ } while(0) ++ ++ ++--- gcl-2.6.12.orig/o/main.c +++++ gcl-2.6.12/o/main.c ++@@ -460,18 +460,49 @@ DEFUN_NEW("EQUAL-TAIL-RECURSION-CHECK",o ++ RETURN1((object)(w-u)); ++ } ++ +++static int +++mbin(const char *s,char *o) { +++ +++ struct stat ss; +++ +++ if (!stat(s,&ss) && (ss.st_mode&S_IFMT)==S_IFREG && !access(s,R_OK|X_OK)) { +++ massert(realpath(s,o)); +++ return 1; +++ } +++ +++ return 0; +++ +++} +++ +++static int +++which(const char *n,char *o) { +++ +++ char *s; +++ +++ if (strchr(n,'/')) +++ return mbin(n,o); +++ +++ massert(snprintf(FN1,sizeof(FN1),"%s",getenv("PATH"))>1); +++ for (s=NULL;(s=strtok(s ? NULL : FN1,":"));) { +++ +++ massert(snprintf(FN2,sizeof(FN2),"%s/%s",s,n)); +++ if (mbin(FN2,o)) +++ return 1; +++ +++ } +++ +++ return 0; +++ +++} +++ +++ ++ ++ int ++ main(int argc, char **argv, char **envp) { ++ ++-#ifdef GET_FULL_PATH_SELF ++ GET_FULL_PATH_SELF(kcl_self); ++-#else ++- kcl_self = argv[0]; ++-#endif ++- ++ *argv=kcl_self; ++- +++ ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include ++ #include diff --cc debian/patches/Version_2_6_13pre71 index 00000000,00000000..f0013e6f new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre71 @@@ -1,0 -1,0 +1,59 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-79) unstable; urgency=medium ++ . ++ * Version_2_6_13pre70 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-10-30 ++ ++--- gcl-2.6.12.orig/o/gbc.c +++++ gcl-2.6.12/o/gbc.c ++@@ -879,9 +879,9 @@ void hppa_save_regs(struct regs); ++ ++ asm(".code"); ++ asm(".export hppa_save_regs, entry"); +++ asm(".label hppa_save_regs"); ++ asm(".proc"); ++ asm(".callinfo"); ++- asm(".label hppa_save_regs"); ++ asm(".entry"); ++ ++ asm("stw %r3,0(%arg0)"); ++--- gcl-2.6.12.orig/o/main.c +++++ gcl-2.6.12/o/main.c ++@@ -242,7 +242,7 @@ get_gc_environ(void) { ++ } ++ ++ gc_page_min=0.5; ++- if ((e=getenv("GCL_GC_PAGE_MIN"))) { +++ if ((e=getenv("GCL_GC_PAGE_MIN"))||(e=getenv("GCL_GC_PAGE_THRESH"))) {/*legacy support*/ ++ massert(sscanf(e,"%lf",&gc_page_min)==1); ++ massert(gc_page_min>=0.0); ++ } ++@@ -253,7 +253,8 @@ get_gc_environ(void) { ++ massert(gc_page_max>=0.0); ++ } ++ ++- multiprocess_memory_pool=(e=getenv("GCL_MULTIPROCESS_MEMORY_POOL")) && *e; +++ multiprocess_memory_pool= +++ (e=getenv("GCL_MULTIPROCESS_MEMORY_POOL")) && (*e=='t' || *e=='T'); ++ ++ wait_on_abort=0; ++ if ((e=getenv("GCL_WAIT_ON_ABORT"))) diff --cc debian/patches/Version_2_6_13pre72 index 00000000,00000000..136954bb new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre72 @@@ -1,0 -1,0 +1,103 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-81) unstable; urgency=high ++ . ++ * Version_2_6_13pre72 ++ * Fix to ppc64el for acl2 FTBFS bug ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2019-01-21 ++ ++--- gcl-2.6.12.orig/h/elf64_ppcle_reloc_special.h +++++ gcl-2.6.12/h/elf64_ppcle_reloc_special.h ++@@ -1,12 +1,12 @@ ++ static Sym *toc; ++ ++-/* static int tramp[]={0,0, */ ++-/* (((0x3a<<10)|(0x9<<5)|0xc)<<16)|0xfff8,/\*ld r9,-8(r12)*\/ */ ++-/* ((0x3a<<10)|(0x9<<5)|0x9)<<16, /\*ld r9,0(r9)*\/ */ ++-/* 0x7d2c4b78, /\*mr r12,r9 *\/ */ ++-/* 0x7d8903a6, /\*mtctr r12*\/ */ ++-/* 0x4e800420 /\*bctrl*\/ */ ++-/* }; */ +++static int tramp[]={0,0, +++ (((0x3a<<10)|(0x9<<5)|0xc)<<16)|0xfff8,/*ld r9,-8(r12)*/ +++ ((0x3a<<10)|(0x9<<5)|0x9)<<16, /*ld r9,0(r9)*/ +++ 0x7d2c4b78, /*mr r12,r9 */ +++ 0x7d8903a6, /*mtctr r12*/ +++ 0x4e800420 /*bctrl*/ +++}; ++ ++ static int ++ find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, ++@@ -15,41 +15,29 @@ find_special_params(void *v,Shdr *sec1,S ++ Shdr *sec; ++ Rela *r; ++ void *ve; +++ ul *u,j; ++ ++ massert((sec=get_section(".rela.dyn",sec1,sece,sn))); ++ ++ v+=sec->sh_offset; ++ ve=v+sec->sh_size; ++ ++- for (r=v;vsh_entsize,r=v) +++ for (j=0,r=v;vsh_entsize,r=v) ++ if (ELF_R_TYPE(r->r_info) && !ds1[ELF_R_SYM(r->r_info)].st_value) ++- ds1[ELF_R_SYM(r->r_info)].st_value=*(ul *)r->r_offset; +++ j++; ++ ++- return 0; ++- ++- ++- /* massert((sec=get_section(".rel.dyn",sec1,sece,sn))|| */ ++- /* (sec=get_section(".rela.dyn",sec1,sece,sn))); */ +++ massert(u=malloc(j*sizeof(tramp))); ++ ++- /* v+=sec->sh_offset; */ ++- /* ve=v+sec->sh_size; */ +++ v=ve-sec->sh_size; +++ for (r=v;vsh_entsize,r=v) +++ if (ELF_R_TYPE(r->r_info) && !ds1[ELF_R_SYM(r->r_info)].st_value) { +++ memcpy(u,tramp,sizeof(tramp)); +++ *u++=r->r_offset; +++ ds1[ELF_R_SYM(r->r_info)].st_value=(ul)u; +++ u=((void *)(u-1)+sizeof(tramp)); +++ } ++ ++- /* for (j=0,r=v;vsh_entsize,r=v) */ ++- /* if (ELF_R_TYPE(r->r_info) && !ds1[ELF_R_SYM(r->r_info)].st_value) */ ++- /* j++; */ ++- ++- /* massert(u=malloc(j*sizeof(tramp))); */ ++- ++- /* v=ve-sec->sh_size; */ ++- /* for (r=v;vsh_entsize,r=v) */ ++- /* if (ELF_R_TYPE(r->r_info) && !ds1[ELF_R_SYM(r->r_info)].st_value) { */ ++- /* memcpy(u,tramp,sizeof(tramp)); */ ++- /* *u++=r->r_offset; */ ++- /* ds1[ELF_R_SYM(r->r_info)].st_value=(ul)u; */ ++- /* u=((void *)(u-1)+sizeof(tramp)); */ ++- /* } */ ++- ++- /* return 0; */ +++ return 0; ++ ++ } ++ diff --cc debian/patches/Version_2_6_13pre73 index 00000000,00000000..c64ecc45 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre73 @@@ -1,0 -1,0 +1,130 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-81) unstable; urgency=high ++ . ++ * Version_2_6_13pre72 ++ * Fix to ppc64el for acl2 FTBFS bug ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2019-02-02 ++ ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -4181,7 +4181,7 @@ case $use in ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 ++ ;; ++ arm*) ++- assert_arg_to_cflags -mlong-calls +++# assert_arg_to_cflags -mlong-calls ++ assert_arg_to_cflags -fdollars-in-identifiers ++ assert_arg_to_cflags -g #? ++ ;; ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -388,7 +388,7 @@ case $use in ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 ++ ;; ++ arm*) ++- assert_arg_to_cflags -mlong-calls +++# assert_arg_to_cflags -mlong-calls ++ assert_arg_to_cflags -fdollars-in-identifiers ++ assert_arg_to_cflags -g #? ++ ;; ++--- gcl-2.6.12.orig/h/arm-linux.h +++++ gcl-2.6.12/h/arm-linux.h ++@@ -12,5 +12,6 @@ ++ #define SGC ++ ++ #define RELOC_H "elf32_arm_reloc.h" +++#define SPECIAL_RELOC_H "elf32_arm_reloc_special.h" ++ ++ #define NEED_STACK_CHK_GUARD ++--- gcl-2.6.12.orig/h/elf32_arm_reloc.h +++++ gcl-2.6.12/h/elf32_arm_reloc.h ++@@ -53,11 +53,21 @@ ++ break; ++ case R_ARM_CALL: ++ case R_ARM_JUMP24: ++- add_vals(where,MASK(24),((long)(s+a-p))>>2); +++ massert(!a); +++ { +++ long x=((long)(s-p))/4; +++ if (abs(x)&(~MASK(23))) { +++ got+=(sym->st_size-1)*tz; +++ memcpy(got,tramp,sizeof(tramp)); +++ got[sizeof(tramp)/sizeof(*got)]=s; +++ x=((long)got-p)/4; +++ } +++ add_vals(where,MASK(24),x); +++ } ++ break; ++ case R_ARM_ABS32: ++- add_val(where,~0L,s+a); +++ add_vals(where,~0L,s+a); ++ break; ++ case R_ARM_V4BX: ++- add_val(where,~0L,s+a); +++ add_vals(where,~0L,s+a); ++ break; ++--- /dev/null +++++ gcl-2.6.12/h/elf32_arm_reloc_special.h ++@@ -0,0 +1,43 @@ +++/* #define R_AARCH64_TRAMP 1 */ +++static int tramp[]={0xe59fc000, /*ldr r12, [pc]*/ /*FIXME? Can this refer to an earlier address?*/ +++ 0xe12fff1c}; /*br r12*/ +++static ul tz=1+sizeof(tramp)/sizeof(ul); +++ +++ +++static int +++find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, +++ const char *st1,Sym *ds1,Sym *dse,Sym *sym,Sym *syme) { +++ +++ return 0; +++ +++} +++ +++static int +++label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,const char *sn,ul *gs) { +++ +++ Rel *r; +++ Sym *sym; +++ Shdr *sec; +++ void *v,*ve; +++ +++ for (sym=sym1;symst_size=0; +++ +++ for (*gs=0,sec=sec1;secsh_type==SHT_REL) +++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) +++ if (ELF_R_TYPE(r->r_info)==R_ARM_CALL || +++ ELF_R_TYPE(r->r_info)==R_ARM_JUMP24) { +++ +++ sym=sym1+ELF_R_SYM(r->r_info); +++ +++ if (!sym->st_size) +++ sym->st_size=++*gs; +++ +++ } +++ +++ (*gs)*=tz; +++ +++ return 0; +++ +++} diff --cc debian/patches/Version_2_6_13pre74 index 00000000,00000000..e8e364fb new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre74 @@@ -1,0 -1,0 +1,47 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-82) unstable; urgency=high ++ . ++ * Version_2_6_13pre73 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2019-02-02 ++ ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -4122,7 +4122,7 @@ $as_echo_n "checking working gprof... " ++ sh4*) enableval="no";; ++ ia64*) enableval="no";; ++ hppa*) enableval="no";; ++- arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible +++# arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++ aarch64*) enableval="no";;#unreproducible buildd bug 20170824 ++ *gnu) enableval="no";; ++ esac ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -335,7 +335,7 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof ++ sh4*) enableval="no";; ++ ia64*) enableval="no";; ++ hppa*) enableval="no";; ++- arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible +++# arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++ aarch64*) enableval="no";;#unreproducible buildd bug 20170824 ++ *gnu) enableval="no";; ++ esac diff --cc debian/patches/Version_2_6_13pre76 index 00000000,00000000..bac042b4 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre76 @@@ -1,0 -1,0 +1,446 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-83) unstable; urgency=high ++ . ++ * Version_2_6_13pre75 ++ * FIx acl2 arm builds (Closes: #919477). ++Author: Camm Maguire ++Bug-Debian: https://bugs.debian.org/919477 ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2019-02-05 ++ ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -2679,6 +2679,7 @@ case $canonical in ++ mipsel*linux*) use=mipsel-linux;; ++ sparc*linux*) use=sparc-linux;; ++ aarch64*linux*) use=aarch64-linux;; +++ arm*linux*hf) use=armhf-linux;; ++ arm*linux*) use=arm-linux;; ++ s390*linux*) use=s390-linux;; ++ ia64*linux*) use=ia64-linux;; ++@@ -4122,11 +4123,12 @@ $as_echo_n "checking working gprof... " ++ sh4*) enableval="no";; ++ ia64*) enableval="no";; ++ hppa*) enableval="no";; ++-# arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible +++# arm*) if echo $canonical |grep -q hf$; then enableval="no"; fi;;#FIXME CALL and JUMP24 veneers needed for thumb 20190201 #FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++ aarch64*) enableval="no";;#unreproducible buildd bug 20170824 ++ *gnu) enableval="no";; ++ esac ++- if test "$enableval" != "yes" ; then +++ GP_FLAG="" +++ if test "$enableval" != "yes" ; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: disabled" >&5 ++ $as_echo "disabled" >&6; } ++ else ++@@ -4134,7 +4136,8 @@ $as_echo "disabled" >&6; } ++ $as_echo "ok" >&6; } ++ OLD_CFLAGS=$CFLAGS # Do not run configure tests with -pg ++ assert_arg_to_cflags -pg ++- CFLAGS=$OLD_CFLAGS +++ GP_FLAG="-pg" +++ CFLAGS=$OLD_CFLAGS ++ TFPFLAG="" ++ ++ $as_echo "#define GCL_GPROF 1" >>confdefs.h ++@@ -4180,8 +4183,11 @@ case $use in ++ ia64*) ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 ++ ;; +++ armhf*) +++ assert_arg_to_cflags -fdollars-in-identifiers +++ assert_arg_to_cflags -g #? +++ ;; ++ arm*) ++-# assert_arg_to_cflags -mlong-calls ++ assert_arg_to_cflags -fdollars-in-identifiers ++ assert_arg_to_cflags -g #? ++ ;; ++@@ -9051,6 +9057,7 @@ LDFLAGS="`echo $LDFLAGS | sed 's,gcl.scr ++ ++ LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $LIBS $TLIBS" ++ +++CFLAGS="$CFLAGS $GP_FLAG" ++ FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS" ++ ++ # Work around bug with gcc on ppc -- CM ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -37,6 +37,7 @@ case $canonical in ++ mipsel*linux*) use=mipsel-linux;; ++ sparc*linux*) use=sparc-linux;; ++ aarch64*linux*) use=aarch64-linux;; +++ arm*linux*hf) use=armhf-linux;; ++ arm*linux*) use=arm-linux;; ++ s390*linux*) use=s390-linux;; ++ ia64*linux*) use=ia64-linux;; ++@@ -335,17 +336,19 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof ++ sh4*) enableval="no";; ++ ia64*) enableval="no";; ++ hppa*) enableval="no";; ++-# arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible +++# arm*) if echo $canonical |grep -q hf$; then enableval="no"; fi;;#FIXME CALL and JUMP24 veneers needed for thumb 20190201 #FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++ aarch64*) enableval="no";;#unreproducible buildd bug 20170824 ++ *gnu) enableval="no";; ++ esac ++- if test "$enableval" != "yes" ; then +++ GP_FLAG="" +++ if test "$enableval" != "yes" ; then ++ AC_MSG_RESULT([disabled]) ++ else ++ AC_MSG_RESULT([ok]) ++ OLD_CFLAGS=$CFLAGS # Do not run configure tests with -pg ++ assert_arg_to_cflags -pg ++- CFLAGS=$OLD_CFLAGS +++ GP_FLAG="-pg" +++ CFLAGS=$OLD_CFLAGS ++ TFPFLAG="" ++ AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) ++ fi ++@@ -387,8 +390,11 @@ case $use in ++ ia64*) ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 ++ ;; +++ armhf*) +++ assert_arg_to_cflags -fdollars-in-identifiers +++ assert_arg_to_cflags -g #? +++ ;; ++ arm*) ++-# assert_arg_to_cflags -mlong-calls ++ assert_arg_to_cflags -fdollars-in-identifiers ++ assert_arg_to_cflags -g #? ++ ;; ++@@ -2108,6 +2114,7 @@ LDFLAGS="`echo $LDFLAGS | sed 's,gcl.scr ++ AC_SUBST(LDFLAGS) ++ LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $LIBS $TLIBS" ++ AC_SUBST(LIBS) +++CFLAGS="$CFLAGS $GP_FLAG" ++ FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS" ++ AC_SUBST(FINAL_CFLAGS) ++ # Work around bug with gcc on ppc -- CM ++--- /dev/null +++++ gcl-2.6.12/h/armhf-linux.h ++@@ -0,0 +1,17 @@ +++#include "linux.h" +++ +++#ifdef IN_GBC +++#undef MPROTECT_ACTION_FLAGS +++#define MPROTECT_ACTION_FLAGS SA_RESTART|SA_SIGINFO +++#define GET_FAULT_ADDR(sig,code,sv,a) \ +++ ((siginfo_t *)code)->si_addr +++/* #define GET_FAULT_ADDR(sig,code,sv,a) \ */ +++/* ((void *)(*((char ***)(&code)))[44]) */ +++#endif +++ +++#define SGC +++ +++#define RELOC_H "elf32_armhf_reloc.h" +++#define SPECIAL_RELOC_H "elf32_armhf_reloc_special.h" +++ +++#define NEED_STACK_CHK_GUARD ++--- gcl-2.6.12.orig/h/elf32_arm_reloc.h +++++ gcl-2.6.12/h/elf32_arm_reloc.h ++@@ -1,44 +1,7 @@ ++-#define R_ARM_THM_CALL 10 ++-#define R_ARM_CALL 28 ++-#define R_ARM_V4BX 40 ++-#define R_ARM_THM_MOVW_ABS_NC 47 ++-#define R_ARM_THM_MOVW_ABS 48 ++ #define R_ARM_MOVW_ABS_NC 43 ++ #define R_ARM_MOVT_ABS 44 ++- case R_ARM_THM_JUMP24: ++- s+=a; ++- if (ELF_ST_TYPE(sym->st_info)==STT_FUNC) s|=1; ++- s-=p+4; /*FIXME maybe drop 4 and add_val below*/ ++- s=((long)s>>1); ++- massert(!(abs(s)&0xff000000)); ++- store_val(where,MASK(11)<<16,(s&0x7ff)<<16); ++- store_val(where,MASK(10),s>>11); ++- store_val(where,MASK(1)<<(16+11),(~((s>>21&0x1)^(s>>23&0x1)))<<(16+11)); ++- store_val(where,MASK(1)<<(16+13),(~((s>>22&0x1)^(s>>23&0x1)))<<(16+13)); ++- store_val(where,MASK(1)<<10,(s>>23&0x1)<<10); ++- break; ++- case R_ARM_THM_CALL: ++- s+=a; ++- if (ELF_ST_TYPE(sym->st_info)==STT_FUNC) s|=1; ++- s-=p+4; /*FIXME maybe drop 4 and add_val below*/ ++- s=((long)s>>1); ++- massert(!(abs(s)&0xffc00000)); ++- store_val(where,MASK(11),s>>11); ++- store_val(where,MASK(11)<<16,(s&0x7ff)<<16); ++- break; ++- case R_ARM_THM_MOVW_ABS_NC: ++- s+=a; ++- if (ELF_ST_TYPE(sym->st_info)==STT_FUNC) s|=1; ++- s&=0xffff; ++- s=((s>>12)&0xf)|(((s>>11)&0x1)<<10)|((s&0xff)<<16)|(((s>>8)&0x7)<<28); ++- add_vals(where,~0L,s); ++- break; ++- case R_ARM_THM_MOVW_ABS: ++- s+=a; ++- s>>=16; ++- s=((s>>12)&0xf)|(((s>>11)&0x1)<<10)|((s&0xff)<<16)|(((s>>8)&0x7)<<28); ++- add_vals(where,~0L,s); ++- break; +++#define R_ARM_CALL 28 +++#define R_ARM_V4BX 40 ++ case R_ARM_MOVW_ABS_NC: ++ s+=a; ++ s&=0xffff; ++@@ -53,21 +16,21 @@ ++ break; ++ case R_ARM_CALL: ++ case R_ARM_JUMP24: ++- massert(!a); ++ { ++- long x=((long)(s-p))/4; ++- if (abs(x)&(~MASK(23))) { +++ long x=((long)(s+a-p))/4; +++ if (abs(x)&(~MASK(23))) {/*24?*/ ++ got+=(sym->st_size-1)*tz; ++ memcpy(got,tramp,sizeof(tramp)); +++ /*relocate*/ ++ got[sizeof(tramp)/sizeof(*got)]=s; ++ x=((long)got-p)/4; ++ } ++ add_vals(where,MASK(24),x); ++ } ++ break; ++- case R_ARM_ABS32: +++ case R_ARM_V4BX: ++ add_vals(where,~0L,s+a); ++ break; ++- case R_ARM_V4BX: +++ case R_ARM_ABS32: ++ add_vals(where,~0L,s+a); ++ break; ++--- gcl-2.6.12.orig/h/elf32_arm_reloc_special.h +++++ gcl-2.6.12/h/elf32_arm_reloc_special.h ++@@ -1,9 +1,7 @@ ++-/* #define R_AARCH64_TRAMP 1 */ ++-static int tramp[]={0xe59fc000, /*ldr r12, [pc]*/ /*FIXME? Can this refer to an earlier address?*/ ++- 0xe12fff1c}; /*br r12*/ +++static int tramp[]={0xe59fc000, /*ldr r12, [pc]*/ /*FIXME? Can this refer to an earlier address?*/ +++ 0xe12fff1c}; /*br r12*/ ++ static ul tz=1+sizeof(tramp)/sizeof(ul); ++ ++- ++ static int ++ find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, ++ const char *st1,Sym *ds1,Sym *dse,Sym *sym,Sym *syme) { ++@@ -26,8 +24,10 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ for (*gs=0,sec=sec1;secsh_type==SHT_REL) ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++- if (ELF_R_TYPE(r->r_info)==R_ARM_CALL || ++- ELF_R_TYPE(r->r_info)==R_ARM_JUMP24) { +++ if ( +++ ELF_R_TYPE(r->r_info)==R_ARM_CALL || +++ ELF_R_TYPE(r->r_info)==R_ARM_JUMP24 +++ ) { ++ ++ sym=sym1+ELF_R_SYM(r->r_info); ++ ++--- /dev/null +++++ gcl-2.6.12/h/elf32_armhf_reloc.h ++@@ -0,0 +1,71 @@ +++#define R_ARM_THM_CALL 10 +++#define R_ARM_THM_MOVW_ABS_NC 47 +++#define R_ARM_THM_MOVW_ABS 48 +++ case R_ARM_THM_JUMP24: +++ { +++ long x=(long)(s+a-p); +++ if (1||abs(x)&(~MASK(25))) { +++ +++ got+=(sym->st_size-1)*tz; +++ memcpy(got,tramp,sizeof(tramp)); +++ +++ r->r_offset=(void *)got-(void *)start; +++ r->r_info=ELF_R_INFO(ELF_R_SYM(r->r_info),R_ARM_THM_MOVW_ABS_NC); +++ relocate(sym1,r,0,start,got,gote); +++ +++ r->r_offset=(void *)(got+1)-(void *)start; +++ r->r_info=ELF_R_INFO(ELF_R_SYM(r->r_info),R_ARM_THM_MOVW_ABS); +++ relocate(sym1,r,0,start,got,gote); +++ +++ x=((long)got-p); +++ } +++ if (ELF_ST_TYPE(sym->st_info)==STT_FUNC) x|=1; +++ x-=4; /*FIXME maybe drop 4 and add_val below*/ +++ x=((long)x>>1); +++ store_val(where,MASK(11)<<16,(x&0x7ff)<<16); +++ store_val(where,MASK(10),x>>11); +++ store_val(where,MASK(1)<<(16+11),(~((x>>21&0x1)^(x>>23&0x1)))<<(16+11)); +++ store_val(where,MASK(1)<<(16+13),(~((x>>22&0x1)^(x>>23&0x1)))<<(16+13)); +++ store_val(where,MASK(1)<<10,(x>>23&0x1)<<10); +++ } +++ break; +++ case R_ARM_THM_CALL: +++ { +++ long x=(long)(s+a-p); +++ if (1||abs(x)&(~MASK(23))) {/*24?*/ +++ got+=(sym->st_size-1)*tz; +++ memcpy(got,tramp,sizeof(tramp)); +++ +++ r->r_offset=(void *)got-(void *)start; +++ r->r_info=ELF_R_INFO(ELF_R_SYM(r->r_info),R_ARM_THM_MOVW_ABS_NC); +++ relocate(sym1,r,0,start,got,gote); +++ +++ r->r_offset=(void *)(got+1)-(void *)start; +++ r->r_info=ELF_R_INFO(ELF_R_SYM(r->r_info),R_ARM_THM_MOVW_ABS); +++ relocate(sym1,r,0,start,got,gote); +++ +++ x=((long)got-p); +++ } +++ if (ELF_ST_TYPE(sym->st_info)==STT_FUNC) x|=1; +++ x-=4; /*FIXME maybe drop 4 and add_val below*/ +++ x=((long)x>>1); +++ store_val(where,MASK(11),x>>11); +++ store_val(where,MASK(11)<<16,(x&0x7ff)<<16); +++ } +++ break; +++ case R_ARM_THM_MOVW_ABS_NC: +++ s+=a; +++ if (ELF_ST_TYPE(sym->st_info)==STT_FUNC) s|=1; +++ s&=0xffff; +++ s=((s>>12)&0xf)|(((s>>11)&0x1)<<10)|((s&0xff)<<16)|(((s>>8)&0x7)<<28); +++ add_vals(where,~0L,s); +++ break; +++ case R_ARM_THM_MOVW_ABS: +++ s+=a; +++ s>>=16; +++ s=((s>>12)&0xf)|(((s>>11)&0x1)<<10)|((s&0xff)<<16)|(((s>>8)&0x7)<<28); +++ add_vals(where,~0L,s); +++ break; +++ case R_ARM_ABS32: +++ add_vals(where,~0L,s+a); +++ break; ++--- /dev/null +++++ gcl-2.6.12/h/elf32_armhf_reloc_special.h ++@@ -0,0 +1,85 @@ +++static int tramp[]={0x0c00f240, /*movw r12, #0*/ +++ 0x0c00f2c0, /*movt r12, #0*/ +++ 0xbf004760}; /*bx r12 nop*/ +++static ul tz=sizeof(tramp)/sizeof(ul); +++ +++static ul * +++next_plt_entry(ul *p,ul *pe) { +++ +++ ul l0=0xe5bef000,/*ldr pc,[ip,#]*/ +++ l1=0xe5bcf000;/*ldr pc,[lr,#]*/ +++ +++ for (;psh_addr; +++ pe=(void *)p+psec->sh_size; +++ +++ massert((sec=get_section( ".rel.plt",sec1,sece,sn)) || +++ (sec=get_section(".rela.plt",sec1,sece,sn))); +++ +++ v+=sec->sh_offset; +++ ve=v+sec->sh_size; +++ +++ p=next_plt_entry(p,pe);/*plt0*/ +++ +++ for (r=v;vsh_entsize,r=v,p=next_plt_entry(p,pe)) { +++ if (!ds1[ELF_R_SYM(r->r_info)].st_value) +++ ds1[ELF_R_SYM(r->r_info)].st_value=(ul)p; +++ } +++ +++ massert(p==pe); +++ massert(v==ve); +++ +++ return 0; +++ +++} +++ +++static int +++label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,const char *sn,ul *gs) { +++ +++ Rel *r; +++ Sym *sym; +++ Shdr *sec; +++ void *v,*ve; +++ +++ for (sym=sym1;symst_size=0; +++ +++ for (*gs=0,sec=sec1;secsh_type==SHT_REL) +++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) +++ if ( +++#define R_ARM_THM_CALL 10 +++ ELF_R_TYPE(r->r_info)==R_ARM_THM_CALL || +++ ELF_R_TYPE(r->r_info)==R_ARM_THM_JUMP24 +++ ) { +++ +++ sym=sym1+ELF_R_SYM(r->r_info); +++ +++ if (!sym->st_size) +++ sym->st_size=++*gs; +++ +++ } +++ +++ (*gs)*=tz; +++ +++ return 0; +++ +++} ++--- gcl-2.6.12.orig/makedefc.in +++++ gcl-2.6.12/makedefc.in ++@@ -6,10 +6,6 @@ ++ # for main link of raw_gcl ++ LIBS=@LIBS@ ++ ++-#The multi precision library stuff ++-MPFILES=$(MPDIR)/@MPI_FILE@ $(MPDIR)/libmport.a ++- ++- ++ # root for the installation, eg /usr/local ++ # This would cause make install to create /usr/local/bin/gcl and ++ # /usr/local/lib/gcl-2-??/* with some basic files. ++--- gcl-2.6.12.orig/o/unexelf.c +++++ gcl-2.6.12/o/unexelf.c ++@@ -887,7 +887,7 @@ unexec (char *new_name, char *old_name, ++ ++ /* Walk through all section headers, insert the new data2 section right ++ before the new bss section. */ ++- for (n = 1, nn = 1; n < (int) old_file_h->e_shnum; n++, nn++) +++ for (n = 0, nn = 0; n < (int) old_file_h->e_shnum; n++, nn++) ++ { ++ caddr_t src; ++ /* If it is (s)bss section, insert the new data2 section before it. */ diff --cc debian/patches/Version_2_6_13pre77 index 00000000,00000000..42293a88 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre77 @@@ -1,0 -1,0 +1,71 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-83) unstable; urgency=high ++ . ++ * Version_2_6_13pre76 ++ * FIx acl2 arm builds (Closes: #919477). ++Author: Camm Maguire ++Bug-Debian: https://bugs.debian.org/919477 ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2019-02-05 ++ ++--- gcl-2.6.12.orig/h/elf32_arm_reloc.h +++++ gcl-2.6.12/h/elf32_arm_reloc.h ++@@ -18,10 +18,10 @@ ++ case R_ARM_JUMP24: ++ { ++ long x=((long)(s+a-p))/4; ++- if (abs(x)&(~MASK(23))) {/*24?*/ +++ if (abs(x)&(~MASK(24))) { ++ got+=(sym->st_size-1)*tz; ++ memcpy(got,tramp,sizeof(tramp)); ++- /*relocate*/ +++ /*recurse on relocate?*/ ++ got[sizeof(tramp)/sizeof(*got)]=s; ++ x=((long)got-p)/4; ++ } ++@@ -29,8 +29,6 @@ ++ } ++ break; ++ case R_ARM_V4BX: ++- add_vals(where,~0L,s+a); ++- break; ++ case R_ARM_ABS32: ++ add_vals(where,~0L,s+a); ++ break; ++--- gcl-2.6.12.orig/h/elf32_armhf_reloc.h +++++ gcl-2.6.12/h/elf32_armhf_reloc.h ++@@ -4,7 +4,7 @@ ++ case R_ARM_THM_JUMP24: ++ { ++ long x=(long)(s+a-p); ++- if (1||abs(x)&(~MASK(25))) { +++ if (abs(x)&(~MASK(24))) { ++ ++ got+=(sym->st_size-1)*tz; ++ memcpy(got,tramp,sizeof(tramp)); ++@@ -32,7 +32,7 @@ ++ case R_ARM_THM_CALL: ++ { ++ long x=(long)(s+a-p); ++- if (1||abs(x)&(~MASK(23))) {/*24?*/ +++ if (abs(x)&(~MASK(23))) { ++ got+=(sym->st_size-1)*tz; ++ memcpy(got,tramp,sizeof(tramp)); ++ diff --cc debian/patches/Version_2_6_13pre78 index 00000000,00000000..85136467 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre78 @@@ -1,0 -1,0 +1,38 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-83) unstable; urgency=high ++ . ++ * Version_2_6_13pre77 ++ * FIx acl2 arm builds (Closes: #919477). ++Author: Camm Maguire ++Bug-Debian: https://bugs.debian.org/919477 ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2019-02-05 ++ ++--- gcl-2.6.12.orig/h/elf32_arm_reloc.h +++++ gcl-2.6.12/h/elf32_arm_reloc.h ++@@ -18,7 +18,7 @@ ++ case R_ARM_JUMP24: ++ { ++ long x=((long)(s+a-p))/4; ++- if (abs(x)&(~MASK(24))) { +++ if (abs(x)&(~MASK(23))) { ++ got+=(sym->st_size-1)*tz; ++ memcpy(got,tramp,sizeof(tramp)); ++ /*recurse on relocate?*/ diff --cc debian/patches/Version_2_6_13pre79 index 00000000,00000000..6105d421 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre79 @@@ -1,0 -1,0 +1,47 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-83) unstable; urgency=high ++ . ++ * Version_2_6_13pre78 ++ * FIx acl2 arm builds (Closes: #919477). ++Author: Camm Maguire ++Bug-Debian: https://bugs.debian.org/919477 ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2019-02-06 ++ ++--- gcl-2.6.12.orig/h/elf32_armhf_reloc.h +++++ gcl-2.6.12/h/elf32_armhf_reloc.h ++@@ -4,7 +4,7 @@ ++ case R_ARM_THM_JUMP24: ++ { ++ long x=(long)(s+a-p); ++- if (abs(x)&(~MASK(24))) { +++ if (abs(x)&(~MASK(23))) { ++ ++ got+=(sym->st_size-1)*tz; ++ memcpy(got,tramp,sizeof(tramp)); ++@@ -32,7 +32,7 @@ ++ case R_ARM_THM_CALL: ++ { ++ long x=(long)(s+a-p); ++- if (abs(x)&(~MASK(23))) { +++ if (abs(x)&(~MASK(22))) { ++ got+=(sym->st_size-1)*tz; ++ memcpy(got,tramp,sizeof(tramp)); ++ diff --cc debian/patches/Version_2_6_13pre80 index 00000000,00000000..ad89d0de new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre80 @@@ -1,0 -1,0 +1,111 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-83) unstable; urgency=high ++ . ++ * Version_2_6_13pre79 ++ * Fix acl2 arm builds (Closes: #919477). ++Author: Camm Maguire ++Bug-Debian: https://bugs.debian.org/919477 ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2019-03-21 ++ ++--- gcl-2.6.12.orig/h/notcomp.h +++++ gcl-2.6.12/h/notcomp.h ++@@ -175,7 +175,7 @@ TS_MEMBER(t0,TS(t1)|TS(t2)|TS(t3)...) ++ #define TS(s) (1<tm_npage)); ++- CEerror("The storage for ~A is exhausted.~%\ ++-Currently, ~D pages are allocated.~% \ ++-Use ALLOCATE to expand the space.", ++- "Continues execution.", ++- 2, vs_top[-2], vs_top[-1], Cnil, Cnil); ++- ++- vs_popp; ++- vs_popp; +++ CEerror("Continues execution.", +++ "The storage for ~A is exhausted. ~D pages allocated. Use ALLOCATE to expand the space.", +++ 2, type_name(t), make_fixnum(tm->tm_npage)); ++ ++ call_after_gbc_hook(t); ++ ++--- gcl-2.6.12.orig/o/array.c +++++ gcl-2.6.12/o/array.c ++@@ -211,14 +211,18 @@ DEFUN_NEW("ASET1", object, fSaset1, SI, ++ break; ++ case aet_bit: ++ i += BV_OFFSET(x); ++- AGAIN_BIT: ++ ASSURE_TYPE(val,t_fixnum); ++- {int v = Mfix(val); ++- if (v == 0) CLEAR_BITREF(x,i); ++- else if (v == 1) SET_BITREF(x,i); ++- else {val= fSincorrect_type(val,sLbit); ++- goto AGAIN_BIT;} ++- break;} +++ switch (Mfix(val)) { +++ case 0: +++ CLEAR_BITREF(x,i); +++ break; +++ case 1: +++ SET_BITREF(x,i); +++ break; +++ default: +++ TYPE_ERROR(val,sLbit); +++ } +++ break; ++ case aet_fix: ++ ASSURE_TYPE(val,t_fixnum); ++ (x->fixa.fixa_self[i]) = Mfix(val); ++--- gcl-2.6.12.orig/o/utils.c +++++ gcl-2.6.12/o/utils.c ++@@ -169,20 +169,6 @@ Ifuncall_n(object fun,int n,...) { ++ /* return res; */ ++ /* } */ ++ ++-object ++-Icheck_one_type(object x, enum type t) ++-{ if (x->d.t != t) ++- { return CEerror("Expected a ~a ","Supply right type",1,type_name(t),Cnil,Cnil,Cnil); ++- } ++- return x; ++-} ++- ++- ++-object ++-fSincorrect_type(object val, object type) ++-{ return CEerror("Got ~a,Expected a ~a","Supply a new one",1,val,type,Cnil,Cnil); ++-} ++- ++ /* static void */ ++ /* Ineed_in_image(object (*foo) (/\* ??? *\/)) */ ++ /* {;} */ diff --cc debian/patches/Version_2_6_13pre81 index 00000000,00000000..63f2a285 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre81 @@@ -1,0 -1,0 +1,71 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-84) unstable; urgency=medium ++ . ++ * Version_2_6_13pre80 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2019-03-28 ++ ++--- gcl-2.6.12.orig/o/alloc.c +++++ gcl-2.6.12/o/alloc.c ++@@ -329,7 +329,7 @@ empty_relblock(void) { ++ void ++ setup_rb(bool preserve_rb_pointerp) { ++ ++- int lowp=new_rb_start!=rb_start || rb_high(); +++ int lowp=rb_high(); ++ ++ update_pool(2*(nrbpage-page(rb_size()))); ++ rb_start=new_rb_start; ++@@ -349,10 +349,13 @@ resize_hole(ufixnum hp,enum type tp,bool ++ char *start=rb_begin(),*new_start=heap_end+hp*PAGESIZE; ++ ufixnum size=rb_pointer-start; ++ ++- if (!in_placep && ++- ((new_start<=start && startrb_end : +++ new_start+(nrbpage<s.s_dbind != Cnil) ++- emsg("Toggling relblock when resizing hole to %lu\n",hp); +++ emsg("[GC Toggling relblock when resizing hole to %lu]\n",hp); ++ tm_table[t_relocatable].tm_adjgbccnt--; ++ GBC(t_relocatable); ++ return resize_hole(hp,tp,in_placep); ++@@ -389,7 +392,7 @@ alloc_page(long n) { ++ d=(available_pages/3)s.s_dbind != Cnil) ++- emsg("Hole overrun\n"); +++ emsg("[GC Hole overrun]\n"); ++ ++ resize_hole(d+nn,t_relocatable,0); ++ ++@@ -852,7 +855,7 @@ add_pages(struct typemanager *tm,fixnum ++ ++ if (rb_high() && m>((rb_start-heap_end)>>PAGEWIDTH)) { ++ if (sSAnotify_gbcA->s.s_dbind != Cnil) ++- emsg("Moving relblock low before expanding relblock pages\n"); +++ emsg("[GC Moving relblock low before expanding relblock pages]\n"); ++ tm_table[t_relocatable].tm_adjgbccnt--; ++ GBC(t_relocatable); ++ } diff --cc debian/patches/Version_2_6_13pre82 index 00000000,00000000..17a9f6f6 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre82 @@@ -1,0 -1,0 +1,40 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-85) unstable; urgency=medium ++ . ++ * Version_2_6_13pre81 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2019-03-28 ++ ++--- gcl-2.6.12.orig/o/alloc.c +++++ gcl-2.6.12/o/alloc.c ++@@ -349,9 +349,10 @@ resize_hole(ufixnum hp,enum type tp,bool ++ char *start=rb_begin(),*new_start=heap_end+hp*PAGESIZE; ++ ufixnum size=rb_pointer-start; ++ +++#define OVERLAP(c_,t_,s_) ((t_)<(c_)+(s_) && (c_)<(t_)+(s_)) ++ if (!in_placep && (rb_high() ? ++- new_start+size>rb_end : ++- new_start+(nrbpage<s.s_dbind != Cnil) diff --cc debian/patches/Version_2_6_13pre83 index 00000000,00000000..585f44fc new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre83 @@@ -1,0 -1,0 +1,446 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-85) unstable; urgency=medium ++ . ++ * Version_2_6_13pre82 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2019-04-02 ++ ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -6375,7 +6375,7 @@ main () ++ FILE *f; ++ if (!(f=fopen("conftest1","w"))) ++ return -1; ++- fprintf(f,"%u",sbrk(0)); +++ fprintf(f,"%p",sbrk(0)); ++ ++ ; ++ return 0; ++@@ -6591,7 +6591,7 @@ else ++ #endif ++ if (!(f=fopen("conftest1","w"))) ++ return -1; ++- fprintf(f,"%u",sbrk(0)); +++ fprintf(f,"%p",sbrk(0)); ++ return 0; ++ } ++ ++@@ -6625,7 +6625,7 @@ else ++ #include "h/unrandomize.h" ++ #endif ++ if (!(f=fopen("conftest1","w"))) return -1; ++- fprintf(f,"%u",sbrk(0)); +++ fprintf(f,"%p",sbrk(0)); ++ return 0; ++ } ++ ++@@ -6653,8 +6653,9 @@ $as_echo "no" >&6; } ++ as_fn_error $? "exiting" "$LINENO" 5 ++ fi ++ fi ++-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking CSTACK_ADDRESS" >&5 ++-$as_echo_n "checking CSTACK_ADDRESS... " >&6; } +++ +++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking CSTACK_DIRECTION" >&5 +++$as_echo_n "checking CSTACK_DIRECTION... " >&6; } ++ if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++ $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++@@ -6666,14 +6667,61 @@ else ++ ++ #include ++ #include ++- void * ++- foo() { +++ +++ unsigned long w; +++ +++ void +++ foo(void) { ++ int i; ++- return (void *)&i; +++ w=(unsigned long)&i; ++ } ++ ++ int ++ main(int argc,char **argv,char **envp) { +++ void *b; +++ FILE *fp = fopen("conftest1","w"); +++ #ifdef CAN_UNRANDOMIZE_SBRK +++ #include "h/unrandomize.h" +++ #endif +++ foo(); +++ fprintf(fp,"%d",((unsigned long) &b) > w ? -1 : 1); +++ fclose(fp); +++ return 0; +++ } +++_ACEOF +++if ac_fn_c_try_run "$LINENO"; then : +++ cstack_direction=`cat conftest1` +++else +++ cstack_direction=0 +++fi +++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ +++ conftest.$ac_objext conftest.beam conftest.$ac_ext +++fi +++ +++ +++cat >>confdefs.h <<_ACEOF +++#define CSTACK_DIRECTION $cstack_direction +++_ACEOF +++ +++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cstack_direction" >&5 +++$as_echo "$cstack_direction" >&6; } +++ +++ +++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking CSTACK_ADDRESS" >&5 +++$as_echo_n "checking CSTACK_ADDRESS... " >&6; } +++if test "$cross_compiling" = yes; then : +++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +++as_fn_error $? "cannot run test program while cross compiling +++See \`config.log' for more details" "$LINENO" 5; } +++else +++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext +++/* end confdefs.h. */ +++ +++ #include +++ #include +++ int +++ main(int argc,char **argv,char **envp) { ++ void *v ; ++ FILE *fp = fopen("conftest1","w"); ++ unsigned long i,j; ++@@ -6685,13 +6733,13 @@ else ++ j<<=$PAGEWIDTH; ++ j<<=16; ++ i=(unsigned long)&v; ++- if (foo()>i) i-=j; ++- j--; ++- i+=j; ++- i&=~j; ++- fprintf(fp,"0x%lx",i-1); ++- fclose(fp); ++- return 0; +++ if ($cstack_direction==1) i-=j; +++ j--; +++ i+=j; +++ i&=~j; +++ fprintf(fp,"0x%lx",i-1); +++ fclose(fp); +++ return 0; ++ } ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++@@ -6724,12 +6772,6 @@ else ++ ++ #include ++ #include ++- void * ++- foo() { ++- int i; ++- return (void *)&i; ++- } ++- ++ int ++ main(int argc,char **argv,char **envp) { ++ void *v ; ++@@ -6743,14 +6785,14 @@ else ++ j<<=$PAGEWIDTH; ++ j<<=16; ++ i=(unsigned long)&v; ++- if (foo()>i) i-=j; ++- j--; ++- i+=j; ++- i&=~j; ++- for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); ++- fprintf(fp,"%d",j); ++- fclose(fp); ++- return 0; +++ if ($cstack_direction==1) i-=j; +++ j--; +++ i+=j; +++ i&=~j; +++ for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); +++ fprintf(fp,"%ld",j); +++ fclose(fp); +++ return 0; ++ } ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++@@ -6854,54 +6896,6 @@ _ACEOF ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $cstack_alignment" >&5 ++ $as_echo "$cstack_alignment" >&6; } ++ ++-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking CSTACK_DIRECTION" >&5 ++-$as_echo_n "checking CSTACK_DIRECTION... " >&6; } ++-if test "$cross_compiling" = yes; then : ++- { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++-as_fn_error $? "cannot run test program while cross compiling ++-See \`config.log' for more details" "$LINENO" 5; } ++-else ++- cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++-/* end confdefs.h. */ ++- ++- #include ++- #include ++- void * ++- foo(void) { ++- int i; ++- return (void *)&i; ++- } ++- ++- int ++- main(int argc,char **argv,char **envp) { ++- char *b; ++- FILE *fp = fopen("conftest1","w"); ++- #ifdef CAN_UNRANDOMIZE_SBRK ++- #include "h/unrandomize.h" ++- #endif ++- fprintf(fp,"%d",((long) &b) > ((long) foo()) ? -1 : 1); ++- fclose(fp); ++- return 0; ++- } ++-_ACEOF ++-if ac_fn_c_try_run "$LINENO"; then : ++- cstack_direction=`cat conftest1` ++-else ++- cstack_direction=0 ++-fi ++-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++- conftest.$ac_objext conftest.beam conftest.$ac_ext ++-fi ++- ++- ++-cat >>confdefs.h <<_ACEOF ++-#define CSTACK_DIRECTION $cstack_direction ++-_ACEOF ++- ++-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cstack_direction" >&5 ++-$as_echo "$cstack_direction" >&6; } ++- ++ # Check whether --enable-immfix was given. ++ if test "${enable_immfix+set}" = set; then : ++ enableval=$enable_immfix; ++@@ -7050,8 +7044,7 @@ int ++ main () ++ { ++ ++- void *v; ++- unsigned long i,j,k,l,m; +++ unsigned long i,j,k,l; ++ FILE *fp = fopen("conftest1","w"); ++ ++ for (i=2,k=1;i;k=i,i<<=1); ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -1049,7 +1049,7 @@ AC_RUN_IFELSE( ++ FILE *f; ++ if (!(f=fopen("conftest1","w"))) ++ return -1; ++- fprintf(f,"%u",sbrk(0)); +++ fprintf(f,"%p",sbrk(0)); ++ ]])], ++ [HAVE_SBRK=1;AC_MSG_RESULT([yes])], ++ AC_MSG_RESULT([no: WARNING you must be able to emulate sbrk: as on mingw or macosx]), ++@@ -1145,7 +1145,7 @@ if test "$HAVE_SBRK" = "1" ; then ++ #endif ++ if (!(f=fopen("conftest1","w"))) ++ return -1; ++- fprintf(f,"%u",sbrk(0)); +++ fprintf(f,"%p",sbrk(0)); ++ return 0; ++ } ++ ]])],[SBRK=`cat conftest1`]) ++@@ -1165,7 +1165,7 @@ if test "$HAVE_SBRK" = "1" ; then ++ #include "h/unrandomize.h" ++ #endif ++ if (!(f=fopen("conftest1","w"))) return -1; ++- fprintf(f,"%u",sbrk(0)); +++ fprintf(f,"%p",sbrk(0)); ++ return 0; ++ } ++ ]])],[SBRK1=`cat conftest1`]) ++@@ -1183,20 +1183,47 @@ if test "$HAVE_SBRK" = "1" ; then ++ AC_MSG_ERROR([exiting]) ++ fi ++ fi ++-AC_MSG_CHECKING(CSTACK_ADDRESS) +++ +++AC_MSG_CHECKING(CSTACK_DIRECTION) ++ AC_RUN_IFELSE( ++ [AC_LANG_SOURCE( ++ [[ ++ #include ++ #include ++- void * ++- foo() { +++ +++ unsigned long w; +++ +++ void +++ foo(void) { ++ int i; ++- return (void *)&i; +++ w=(unsigned long)&i; ++ } ++ ++ int ++ main(int argc,char **argv,char **envp) { +++ void *b; +++ FILE *fp = fopen("conftest1","w"); +++ #ifdef CAN_UNRANDOMIZE_SBRK +++ #include "h/unrandomize.h" +++ #endif +++ foo(); +++ fprintf(fp,"%d",((unsigned long) &b) > w ? -1 : 1); +++ fclose(fp); +++ return 0; +++ }]])], +++ [cstack_direction=`cat conftest1`],[cstack_direction=0]) +++AC_DEFINE_UNQUOTED(CSTACK_DIRECTION,$cstack_direction,[whether C stack grows up or down]) +++AC_MSG_RESULT($cstack_direction) +++ +++ +++AC_MSG_CHECKING(CSTACK_ADDRESS) +++AC_RUN_IFELSE( +++ [AC_LANG_SOURCE( +++ [[ +++ #include +++ #include +++ int +++ main(int argc,char **argv,char **envp) { ++ void *v ; ++ FILE *fp = fopen("conftest1","w"); ++ unsigned long i,j; ++@@ -1208,13 +1235,13 @@ AC_RUN_IFELSE( ++ j<<=$PAGEWIDTH; ++ j<<=16; ++ i=(unsigned long)&v; ++- if (foo()>i) i-=j; ++- j--; ++- i+=j; ++- i&=~j; ++- fprintf(fp,"0x%lx",i-1); ++- fclose(fp); ++- return 0; +++ if ($cstack_direction==1) i-=j; +++ j--; +++ i+=j; +++ i&=~j; +++ fprintf(fp,"0x%lx",i-1); +++ fclose(fp); +++ return 0; ++ }]])], ++ [cstack_address=`cat conftest1`],[cstack_address=0]) ++ AC_DEFINE_UNQUOTED(CSTACK_ADDRESS,$cstack_address,[starting C stack address]) ++@@ -1226,12 +1253,6 @@ AC_RUN_IFELSE( ++ [[ ++ #include ++ #include ++- void * ++- foo() { ++- int i; ++- return (void *)&i; ++- } ++- ++ int ++ main(int argc,char **argv,char **envp) { ++ void *v ; ++@@ -1245,14 +1266,14 @@ AC_RUN_IFELSE( ++ j<<=$PAGEWIDTH; ++ j<<=16; ++ i=(unsigned long)&v; ++- if (foo()>i) i-=j; ++- j--; ++- i+=j; ++- i&=~j; ++- for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); ++- fprintf(fp,"%d",j); ++- fclose(fp); ++- return 0; +++ if ($cstack_direction==1) i-=j; +++ j--; +++ i+=j; +++ i&=~j; +++ for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); +++ fprintf(fp,"%ld",j); +++ fclose(fp); +++ return 0; ++ }]])], ++ [cstack_bits=`cat conftest1`],[cstack_bits=0]) ++ AC_DEFINE_UNQUOTED(CSTACK_BITS,$cstack_bits,[log starting C stack address]) ++@@ -1302,33 +1323,6 @@ AC_RUN_IFELSE( ++ AC_DEFINE_UNQUOTED(CSTACK_ALIGNMENT,$cstack_alignment,[C stack alignment]) ++ AC_MSG_RESULT($cstack_alignment) ++ ++-AC_MSG_CHECKING(CSTACK_DIRECTION) ++-AC_RUN_IFELSE( ++- [AC_LANG_SOURCE( ++- [[ ++- #include ++- #include ++- void * ++- foo(void) { ++- int i; ++- return (void *)&i; ++- } ++- ++- int ++- main(int argc,char **argv,char **envp) { ++- char *b; ++- FILE *fp = fopen("conftest1","w"); ++- #ifdef CAN_UNRANDOMIZE_SBRK ++- #include "h/unrandomize.h" ++- #endif ++- fprintf(fp,"%d",((long) &b) > ((long) foo()) ? -1 : 1); ++- fclose(fp); ++- return 0; ++- }]])], ++- [cstack_direction=`cat conftest1`],[cstack_direction=0]) ++-AC_DEFINE_UNQUOTED(CSTACK_DIRECTION,$cstack_direction,[whether C stack grows up or down]) ++-AC_MSG_RESULT($cstack_direction) ++- ++ AC_ARG_ENABLE([immfix],[ --enable-immfix will enable an immediate fixnum table above the C stack]) ++ ++ AC_ARG_ENABLE([fastimmfix],[ --enable-fastimmfix=XXXX will reject low immediate fixnums unless 2^XXX can be attained],,[enable_fastimmfix=64]) ++@@ -1429,8 +1423,7 @@ AC_RUN_IFELSE( ++ #include ++ ]], ++ [[ ++- void *v; ++- unsigned long i,j,k,l,m; +++ unsigned long i,j,k,l; ++ FILE *fp = fopen("conftest1","w"); ++ ++ for (i=2,k=1;i;k=i,i<<=1); ++--- gcl-2.6.12.orig/h/unrandomize.h +++++ gcl-2.6.12/h/unrandomize.h ++@@ -14,7 +14,7 @@ ++ long pers = personality(READ_IMPLIES_EXEC|personality(0xffffffffUL)); ++ long flag = ADDR_NO_RANDOMIZE; ++ ++- if (sizeof(long)==4) flag|=ADDR_LIMIT_3GB|ADDR_COMPAT_LAYOUT; +++ if (sizeof(long)==4) flag|=ADDR_LIMIT_3GB/* |ADDR_COMPAT_LAYOUT */; ++ ++ if (pers==-1) {printf("personality failure %d\n",errno);exit(-1);} ++ if ((pers & flag)!=flag && !getenv("GCL_UNRANDOMIZE")) { diff --cc debian/patches/Version_2_6_13pre84 index 00000000,00000000..ce8c974f new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre84 @@@ -1,0 -1,0 +1,45 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-86) unstable; urgency=medium ++ . ++ * Version_2_6_13pre83 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2019-04-06 ++ ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -4121,6 +4121,7 @@ $as_echo_n "checking working gprof... " ++ powerpc*) if test "$host_cpu" = "powerpc64le" ; then enableval="no"; fi;; ++ s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 ++ sh4*) enableval="no";; +++ m68k*) enableval="no";; ++ ia64*) enableval="no";; ++ hppa*) enableval="no";; ++ # arm*) if echo $canonical |grep -q hf$; then enableval="no"; fi;;#FIXME CALL and JUMP24 veneers needed for thumb 20190201 #FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -334,6 +334,7 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof ++ powerpc*) if test "$host_cpu" = "powerpc64le" ; then enableval="no"; fi;; ++ s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 ++ sh4*) enableval="no";; +++ m68k*) enableval="no";; ++ ia64*) enableval="no";; ++ hppa*) enableval="no";; ++ # arm*) if echo $canonical |grep -q hf$; then enableval="no"; fi;;#FIXME CALL and JUMP24 veneers needed for thumb 20190201 #FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible diff --cc debian/patches/Version_2_6_13pre85 index 00000000,00000000..8f38b607 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre85 @@@ -1,0 -1,0 +1,123 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-88) unstable; urgency=medium ++ . ++ * Source only upload ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2019-12-07 ++ ++--- gcl-2.6.12.orig/h/elf64_ppcle_reloc.h +++++ gcl-2.6.12/h/elf64_ppcle_reloc.h ++@@ -1,9 +1,25 @@ +++#define R_PPC64_PLTSEQ 119 /*FIXME not in elf.h*/ +++#define R_PPC64_PLTCALL 120 +++ ++ #define ha(x_) ((((x_) >> 16) + (((x_) & 0x8000) ? 1 : 0)) & 0xffff) ++ #define lo(x_) ((x_) & 0xffff) ++ ++ case R_PPC64_REL16_HA: ++ store_val(where,MASK(16),ha(s+a-p)); ++ break; +++ case R_PPC64_PLT16_HA: +++ gote=got+sym->st_size-1; +++ *gote=s+a; +++ store_val(where,MASK(16),ha((ul)gote-toc->st_value)); +++ break; +++ case R_PPC64_PLT16_LO_DS: +++ gote=got+sym->st_size-1; +++ *gote=s+a; +++ store_val(where,MASK(16),lo((ul)gote-toc->st_value));/*>>2*/ +++ break; +++ case R_PPC64_PLTSEQ: +++ case R_PPC64_PLTCALL: +++ break; ++ case R_PPC64_TOC16_HA: ++ store_val(where,MASK(16),ha(s+a-toc->st_value)); ++ break; ++--- gcl-2.6.12.orig/h/elf64_ppcle_reloc_special.h +++++ gcl-2.6.12/h/elf64_ppcle_reloc_special.h ++@@ -9,16 +9,12 @@ static int tramp[]={0,0, ++ }; ++ ++ static int ++-find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, ++- const char *st1,Sym *ds1,Sym *dse,Sym *sym,Sym *syme) { ++- ++- Shdr *sec; +++load_trampolines(void *v,Shdr *sec,Sym *ds1) { +++ ++ Rela *r; ++ void *ve; ++ ul *u,j; ++ ++- massert((sec=get_section(".rela.dyn",sec1,sece,sn))); ++- ++ v+=sec->sh_offset; ++ ve=v+sec->sh_size; ++ ++@@ -42,8 +38,25 @@ find_special_params(void *v,Shdr *sec1,S ++ } ++ ++ static int +++find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, +++ const char *st1,Sym *ds1,Sym *dse,Sym *sym,Sym *syme) { +++ +++ Shdr *sec; +++ +++ massert((sec=get_section(".rela.dyn",sec1,sece,sn))); +++ massert(!load_trampolines(v,sec,ds1)); +++ if ((sec=get_section(".rela.plt",sec1,sece,sn))) +++ massert(!load_trampolines(v,sec,ds1)); +++ +++ return 0; +++ +++} +++ +++static int ++ label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,const char *sn,ul *gs) { ++ +++ Rela *r; +++ void *v,*ve; ++ Shdr *sec; ++ Sym *sym; ++ ++@@ -58,6 +71,22 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ } ++ } ++ +++ for (sym=sym1;symst_size=0; +++ +++ for (*gs=0,sec=sec1;secsh_type==SHT_RELA) +++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) +++ if (ELF_R_TYPE(r->r_info)==R_PPC64_PLT16_HA|| +++ ELF_R_TYPE(r->r_info)==R_PPC64_PLT16_LO_DS) { +++ +++ sym=sym1+ELF_R_SYM(r->r_info); +++ +++ if (!sym->st_size) +++ sym->st_size=++*gs; +++ +++ } +++ ++ return 0; ++ ++ } diff --cc debian/patches/Version_2_6_13pre86 index 00000000,00000000..9bc68f2a new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre86 @@@ -1,0 -1,0 +1,45 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-88) unstable; urgency=medium ++ . ++ * Source only upload ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2019-12-07 ++ ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -4194,6 +4194,7 @@ case $use in ++ ;; ++ powerpc*) ++ assert_arg_to_cflags -mlongcall +++ if test "$host_cpu" != "powerpc64le" ; then assert_arg_to_cflags -mno-pltseq; fi ++ ;; ++ esac;; ++ esac ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -401,6 +401,7 @@ case $use in ++ ;; ++ powerpc*) ++ assert_arg_to_cflags -mlongcall +++ if test "$host_cpu" != "powerpc64le" ; then assert_arg_to_cflags -mno-pltseq; fi ++ ;; ++ esac;; ++ esac diff --cc debian/patches/Version_2_6_13pre87 index 00000000,00000000..b38d6b45 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre87 @@@ -1,0 -1,0 +1,89 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-89) unstable; urgency=medium ++ . ++ * Bug fix: "gcl - FTBFS on ppc64el - invalid relocation type 31", thanks ++ to thierry.fauck@fr.ibm.com; (Closes: #942312). ++ * Bug fix: "FTBFS on ppc64el", thanks to Ivo De Decker (Closes: ++ #944651). ++Author: Camm Maguire ++Bug-Debian: https://bugs.debian.org/942312 ++Bug-Debian: https://bugs.debian.org/944651 ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2019-12-08 ++ ++--- gcl-2.6.12.orig/h/elf64_ppcle_reloc.h +++++ gcl-2.6.12/h/elf64_ppcle_reloc.h ++@@ -10,32 +10,38 @@ ++ case R_PPC64_PLT16_HA: ++ gote=got+sym->st_size-1; ++ *gote=s+a; +++ massert(toc); ++ store_val(where,MASK(16),ha((ul)gote-toc->st_value)); ++ break; ++ case R_PPC64_PLT16_LO_DS: ++ gote=got+sym->st_size-1; ++ *gote=s+a; +++ massert(toc); ++ store_val(where,MASK(16),lo((ul)gote-toc->st_value));/*>>2*/ ++ break; ++ case R_PPC64_PLTSEQ: ++ case R_PPC64_PLTCALL: ++ break; ++ case R_PPC64_TOC16_HA: +++ massert(toc); ++ store_val(where,MASK(16),ha(s+a-toc->st_value)); ++ break; ++ case R_PPC64_TOC16_LO_DS: +++ massert(toc); ++ store_val(where,MASK(16),lo(s+a-toc->st_value));/*>>2*/ ++ break; ++ case R_PPC64_REL16_LO: ++ store_val(where,MASK(16),lo(s+a-p)); ++ break; ++ case R_PPC64_TOC16_LO: +++ massert(toc); ++ store_val(where,MASK(16),lo(s+a-toc->st_value)); ++ break; ++ case R_PPC64_ADDR64: ++ store_val(where,~0L,(s+a)); ++ break; ++ case R_PPC64_TOC: +++ massert(toc); ++ store_val(where,~0L,toc->st_value); ++ break; ++ case R_PPC64_REL32: ++--- gcl-2.6.12.orig/h/elf64_ppcle_reloc_special.h +++++ gcl-2.6.12/h/elf64_ppcle_reloc_special.h ++@@ -60,13 +60,12 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ Shdr *sec; ++ Sym *sym; ++ ++- massert(sec=get_section(".toc",sec1,sece,sn)); ++- ++- for (sym=sym1;symst_name; ++ if (!strcmp(s,".TOC.") || !strcmp(s,".toc.")) { ++ toc=sym; ++ toc->st_info=ELF_ST_INFO(STB_LOCAL,ELF_ST_TYPE(sym->st_info)); +++ massert((sec=get_section(".bss",sec1,sece,sn))); ++ toc->st_shndx=sec-sec1; ++ } ++ } diff --cc debian/patches/Version_2_6_13pre88 index 00000000,00000000..5701ceb6 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre88 @@@ -1,0 -1,0 +1,151 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-90) unstable; urgency=medium ++ . ++ * Version_2_6_13pre87 ++ * latest standards ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2019-12-18 ++ ++--- gcl-2.6.12.orig/h/pool.h +++++ gcl-2.6.12/h/pool.h ++@@ -20,9 +20,8 @@ static struct pool { ++ ufixnum s; ++ } *Pool; ++ ++-static struct flock pl,*plp=&pl; ++- ++-static const char *gcl_pool="/tmp/gcl_pool"; +++static struct flock f,pl,*plp=&pl; +++static char gcl_pool[PATH_MAX]; ++ ++ static int ++ set_lock(void) { ++@@ -66,8 +65,8 @@ open_pool(void) { ++ ++ if (pool==-1) { ++ ++- struct flock f; ++- +++ massert(!home_namestring1("~",1,FN1,sizeof(FN1))); +++ massert(snprintf(gcl_pool,sizeof(gcl_pool),"%sgcl_pool",FN1)>=0); ++ massert((pool=open(gcl_pool,O_CREAT|O_RDWR,0644))!=-1); ++ massert(!ftruncate(pool,sizeof(struct pool))); ++ massert((Pool=mmap(NULL,sizeof(struct pool),PROT_READ|PROT_WRITE,MAP_SHARED,pool,0))!=(void *)-1); ++@@ -111,6 +110,9 @@ close_pool(void) { ++ ++ #ifndef NO_FILE_LOCKING ++ if (pool!=-1) { +++ f.l_type=F_WRLCK; +++ if (!fcntl(pool,F_SETLK,&f)) +++ massert(!unlink(gcl_pool)); ++ register_pool(-1); ++ massert(!close(pool)); ++ massert(!munmap(Pool,sizeof(struct pool))); ++--- gcl-2.6.12.orig/h/protoize.h +++++ gcl-2.6.12/h/protoize.h ++@@ -1971,3 +1971,6 @@ travel_find_sharing(object,object); ++ ++ object ++ new_cfdata(void); +++ +++int +++home_namestring1(const char *,int,char *,int); ++--- gcl-2.6.12.orig/o/unixfsys.c +++++ gcl-2.6.12/o/unixfsys.c ++@@ -95,16 +95,20 @@ DEFUN_NEW("UID-TO-NAME",object,fSuid_to_ ++ #endif ++ } ++ ++-DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") { +++int +++home_namestring1(const char *n,int s,char *o,int so) { ++ ++-#ifndef __MINGW32__ +++ #ifndef __MINGW32__ ++ struct passwd *pwent,pw; ++ long r; ++ +++ massert(s>0); +++ massert(*n=='~'); +++ ++ massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); ++ massert(r<=sizeof(GETPW_BUF));/*FIXME maybe once at image startup*/ ++ ++- if (nm->st.st_fillp==1) +++ if (s==1) ++ ++ if ((pw.pw_dir=getenv("HOME"))) ++ pwent=&pw; ++@@ -113,26 +117,44 @@ DEFUN_NEW("HOME-NAMESTRING",object,fShom ++ ++ else { ++ ++- massert(nm->st.st_fillpst.st_self+1,nm->st.st_fillp-1); ++- FN2[nm->st.st_fillp-1]=0; +++ massert(spw_dir))+2pw_dir,r); ++- FN3[r]='/'; ++- FN3[r+1]=0; ++- RETURN1(make_simple_string(FN3)); +++ massert((r=strlen(pwent->pw_dir))+2pw_dir,r); +++ o[r]='/'; +++ o[r+1]=0; +++ return 0; ++ #else ++- massert(snprintf(FN1,sizeof(FN1)-1,"%s%s",getenv("SystemDrive"),getenv("HOMEPATH"))>=0); ++- RETURN1(make_simple_string(FN1)); +++ massert(snprintf(o,so-1,"%s%s",getenv("SystemDrive"),getenv("HOMEPATH"))>=0); +++ return 0; ++ #endif ++ ++ } ++ +++ +++DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") { +++ +++ check_type_string(&nm); +++ +++ massert(!home_namestring1(nm->st.st_self,nm->st.st_fillp,FN1,sizeof(FN1))); +++ RETURN1(make_simple_string(FN1)); +++ +++} +++#ifdef STATIC_FUNCTION_POINTERS +++object +++fShome_namestring(object x) { +++ return FFN(fShome_namestring)(x); +++} +++#endif +++ +++ +++ ++ #define FILE_EXISTS_P(a_,b_) !stat(a_,&b_) && S_ISREG(b_.st_mode) ++ #define DIR_EXISTS_P(a_,b_) !stat(a_,&b_) && S_ISDIR(b_.st_mode) ++ diff --cc debian/patches/Version_2_6_13pre89 index 00000000,00000000..dec85967 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre89 @@@ -1,0 -1,0 +1,277 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-91) unstable; urgency=medium ++ . ++ * Version_2_6_13pre88 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2019-12-30 ++ ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp ++@@ -57,28 +57,19 @@ ++ ++ ++ ;; Let the user write dump c-file etc to /dev/null. ++-(defun get-output-pathname (file ext name &optional (dir (pathname-directory *default-pathname-defaults*)) +++(defun get-output-pathname (file ext name &optional +++ (dir (pathname-directory *default-pathname-defaults*)) ++ (device (pathname-device *default-pathname-defaults*))) ++- (cond ++- ((equal file "/dev/null") (pathname file)) +++ (cond ((equal file "/dev/null") (pathname file)) ++ #+aix3 ++ ((and (equal name "float") ++ (equal ext "h")) ++ (get-output-pathname file ext "Float" )) ++- (t ++- (make-pathname :device (or (and (not (null file)) ++- (not (eq file t)) ++- (pathname-device file)) ++- device) ++- :directory (or (and (not (null file)) ++- (not (eq file t)) ++- (pathname-directory file)) ++- dir) ++- :name (or (and (not (null file)) ++- (not (eq file t)) ++- (pathname-name file)) ++- name) ++- :type ext)))) +++ ((let ((lf (and file (not (eq file t))))) +++ (let ((device (if lf (pathname-device file) device)) +++ (dir (if lf (pathname-directory file) dir)) +++ (name (if lf (pathname-name file) name))) +++ (make-pathname :device device :directory dir :name name :type ext)))))) ++ ++ (defun safe-system (string) ++ (multiple-value-bind ++@@ -109,15 +100,7 @@ ++ ;; will be performed for separate chunks of the lisp files. ++ (defvar *split-files* nil) ;; if ++ ++-(defun check-end (form eof) ++- (cond ((eq form eof) ++- (setf (third *split-files*) nil)) ++- ((> (file-position *compiler-input*) ++- (car *split-files*)) ++- (setf (third *split-files*)(file-position *compiler-input*))))) ++- ++- ++-(defun compile-file (&rest args +++(defun compile-file (filename &rest args ++ &aux (*print-pretty* nil) ++ (*package* *package*) (*split-files* *split-files*) ++ (*PRINT-CIRCLE* NIL) ++@@ -131,17 +114,17 @@ ++ (*PRINT-BASE* 10) ++ (*PRINT-ESCAPE* T) ++ (section-length *split-files*) ++- tem) +++ tem warnings failures +++ (filename (pathname filename)) +++ (*compile-file-pathname* (merge-pathnames filename #p".lsp")) +++ (*compile-file-truename* (truename *compile-file-pathname*))) ++ (loop ++ (compiler::init-env) ++- (setq tem (apply 'compiler::compile-file1 args)) ++- (cond ((atom *split-files*)(return tem)) ++- ((and (consp *split-files*) ++- (null (third *split-files*))) ++- (let ((gaz (let ((*DEFAULT-PATHNAME-DEFAULTS* (car args))) ++- (gazonk-name))) ++- (*readtable* (si::standard-readtable))) ++- (setq gaz (get-output-pathname gaz "lsp" (car args))) +++ (setq tem (apply 'compile-file1 filename args)) +++ (cond ((atom *split-files*) +++ (return (values (when tem (truename tem)) warnings failures))) +++ ((null (third *split-files*)) +++ (let ((gaz (gazonk-name))(*readtable* (si::standard-readtable))) ++ (with-open-file (st gaz :direction :output) ++ (print ++ `(eval-when (load eval) ++@@ -149,16 +132,15 @@ ++ (load (merge-pathnames v si::*load-pathname*)))) ++ st)) ++ (setq *split-files* nil) ++- (or (member :output-file args) ++- (setq args (append args (list :output-file (car args))))) ++ (return ++- (prog1 (apply 'compile-file gaz (cdr args)) ++- (unless *keep-gaz* (mdelete-file gaz)))) ++- )) ++- (t nil)) ++- (if (consp *split-files*) ++- (setf (car *split-files*) (+ (third *split-files*) section-length))) ++- )) +++ (let ((tem (apply 'compile-file gaz +++ (append args +++ (unless (member :output-file args) +++ (list :output-file +++ (get-output-pathname filename "o" nil nil nil))))))) +++ (unless *keep-gaz* (mdelete-file gaz)) +++ (values (when tem (truename tem)) warnings failures))))) +++ ((setf (car *split-files*) (+ (third *split-files*) section-length)))))) ++ ++ ++ (defun compile-file1 (input-pathname ++@@ -172,13 +154,14 @@ ++ (prof-p *default-prof-p*) ++ (print nil) ++ (load nil) ++- &aux (*standard-output* *standard-output*) ++- (*prof-p* prof-p) +++ &aux +++ (*standard-output* *standard-output*) +++ (*prof-p* prof-p) +++ (output-file (pathname output-file)) ++ (*error-output* *error-output*) ++ (*compiler-in-use* *compiler-in-use*) ++ (*c-debug* c-debug) ++ (*compile-print* (or print *compile-print*)) ++- (*package* *package*) ++ (*DEFAULT-PATHNAME-DEFAULTS* #p"") ++ (*data* (list nil)) ++ *init-name* ++@@ -211,41 +194,30 @@ Cannot compile ~a.~%" ++ (*compiler-input* (merge-pathnames input-pathname #p".lsp")) ++ ++ ++- (cond ((numberp *split-files*) ++- (if (< (file-length *compiler-input*) *split-files*) ++- (setq *split-files* nil) ++- (setq *split-files* (list *split-files* nil 0 nil))))) +++ (when (numberp *split-files*) +++ (setq *split-files* (unless (< (file-length *compiler-input*) *split-files*) (list *split-files* nil 0 nil)))) ++ ++- (cond ((consp *split-files*) ++- (file-position *compiler-input* (third *split-files*)) ++- (setq output-file ++- (make-pathname :directory (pathname-directory output-file) ++- :name (format nil "~a~a" (length (second *split-files*)) (pathname-name (pathname output-file))) ++- :type "o")) ++- ++- (push (pathname-name output-file) (second *split-files*)))) +++ (when (consp *split-files*) +++ (file-position *compiler-input* (third *split-files*)) +++ (setq output-file +++ (make-pathname :directory (pathname-directory output-file) +++ :name (format nil "~a~a" +++ (pathname-name output-file) +++ (length (second *split-files*))) +++ :type "o"))) ++ ++ ++- (let* ((eof (cons nil nil)) ++- (dir (or (and (not (null output-file)) ++- (pathname-directory output-file)) ++- (pathname-directory input-pathname))) ++- (name (or (and (not (null output-file)) ++- (pathname-name output-file)) ++- (pathname-name input-pathname))) ++- (device (or (and (not (null output-file)) ++- (pathname-device output-file)) ++- (pathname-device input-pathname))) ++- (typ (or (and (not (null output-file)) ++- (pathname-type output-file)) ++- "o")) ++- ++- (o-pathname (get-output-pathname o-file typ name dir device)) ++- (c-pathname (get-output-pathname c-file "c" name dir device)) ++- (h-pathname (get-output-pathname h-file "h" name dir device)) ++- (data-pathname (get-output-pathname data-file "data" name dir device))) +++ (let* ((eof (cons nil nil)) +++ (dir (pathname-directory (or output-file input-pathname))) +++ (name (pathname-name (or output-file input-pathname))) +++ (device (pathname-device (or output-file input-pathname))) +++ (typ (pathname-type (or output-file #p".o"))) +++ (o-pathname (get-output-pathname o-file typ name dir device)) +++ (c-pathname (get-output-pathname c-file "c" name dir device)) +++ (h-pathname (get-output-pathname h-file "h" name dir device)) +++ (data-pathname (get-output-pathname data-file "data" name dir device))) ++ ++- (declare (special dir name )) +++ (declare (special dir name)) ++ ++ (init-env) ++ ++@@ -278,21 +250,32 @@ Cannot compile ~a.~%" ++ (setq prev nil)) ++ ++ ;; t1expr the package ops again.. ++- (if (consp *split-files*) ++- (dolist (v (fourth *split-files*)) (t1expr v))) +++ (when (consp *split-files*) +++ (dolist (v (fourth *split-files*)) (t1expr v))) +++ ++ (unwind-protect ++ (do ((form (read *compiler-input* nil eof)(read *compiler-input* nil eof)) ++- (load-flag (if *eval-when-defaults* (member 'load *eval-when-defaults*) t))) +++ (load-flag (if *eval-when-defaults* +++ (or (member 'load *eval-when-defaults*) +++ (member :load-toplevel *eval-when-defaults*)) +++ t))) ++ (nil) ++- (cond ++- ((eq form eof)) ++- (load-flag (t1expr form)) ++- ((maybe-eval nil form))) ++- (cond ++- ((and *split-files* (check-end form eof)) ++- (setf (fourth *split-files*) nil);(reverse (third *data*)) ;FIXME check this ++- (return nil)) ++- ((eq form eof) (return nil)))) +++ +++ (unless (eq form eof) +++ (if load-flag +++ (t1expr form) +++ (maybe-eval nil form))) +++ +++ (when (or (eq form eof) +++ (when *split-files* +++ (> (file-position *compiler-input*) (car *split-files*)))) +++ +++ (when *split-files* +++ (push (pathname-name output-file) (second *split-files*)) +++ (setf (third *split-files*) (unless (eq form eof) (file-position *compiler-input*))) +++ (setf (fourth *split-files*) nil));(reverse (third *data*)) ;FIXME check this +++ +++ (return nil))) ++ ++ (when prev (set-dispatch-macro-character #\# #\, prev rtb))))) ++ ++@@ -331,7 +314,7 @@ Cannot compile ~a.~%" ++ (unless c-file (mdelete-file c-pathname)) ++ (unless h-file (mdelete-file h-pathname)) ++ (unless (or data-file #+ld-not-accept-data t system-p) (mdelete-file data-pathname)) ++- o-pathname) +++ (when o-file o-pathname)) ++ ++ (progn ++ (when (probe-file c-pathname) (mdelete-file c-pathname)) ++@@ -339,8 +322,7 @@ Cannot compile ~a.~%" ++ (when (probe-file data-pathname) (mdelete-file data-pathname)) ++ (format t "~&No FASL generated.~%") ++ (setq *error-p* t) ++- (values) ++- )))))) +++ (values)))))) ++ ++ (defun gazonk-name () ++ (dotimes (i 1000) diff --cc debian/patches/Version_2_6_13pre8a index 00000000,00000000..1031df65 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre8a @@@ -1,0 -1,0 +1,1359 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-8) unstable; urgency=medium ++ . ++ * Version_2_6_13pre7 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/gcl-tk/comm.c +++++ gcl-2.6.12/gcl-tk/comm.c ++@@ -66,7 +66,7 @@ fScheck_fd_for_input(fixnum fd,fixnum ti ++ ++ ++ struct connection_state * ++-setup_connection_state(fd) +++setup_connection_state(int fd) ++ { struct connection_state * res; ++ res = (void *)malloc(sizeof(struct connection_state)); ++ bzero(res,sizeof(struct connection_state)); ++--- gcl-2.6.12.orig/gcl-tk/guis.h +++++ gcl-2.6.12/gcl-tk/guis.h ++@@ -4,6 +4,10 @@ ++ #include ++ ++ #define NO_PRELINK_UNEXEC_DIVERSION +++#define IMMNUM_H +++#define GMP_WRAPPERS_H +++#define ERROR_H +++ ++ #include "include.h" ++ ++ #ifdef NeXT ++--- gcl-2.6.12.orig/gmp4/mpn/x86_64/k8/redc_1.asm +++++ gcl-2.6.12/gmp4/mpn/x86_64/k8/redc_1.asm ++@@ -114,7 +114,7 @@ ifdef(`PIC',` ++ ++ JUMPTABSECT ++ ALIGN(8) ++-L(tab): JMPENT( L(0m4), L(tab)) +++L(tab): JMPENT( L(0), L(tab)) ++ JMPENT( L(1), L(tab)) ++ JMPENT( L(2), L(tab)) ++ JMPENT( L(3), L(tab)) ++@@ -397,6 +397,7 @@ L(le1): add %r10, (up) ++ ++ ++ ALIGN(16) +++L(0): ++ L(0m4): ++ L(lo0): mov (mp,nneg,8), %rax ++ mov nneg, i ++--- gcl-2.6.12.orig/h/att_ext.h +++++ gcl-2.6.12/h/att_ext.h ++@@ -29,7 +29,7 @@ void *malloc(size_t); ++ void *realloc(void *,size_t); ++ /* void * memalign(size_t,size_t); */ ++ void *alloc_contblock(size_t); ++-inline void *alloc_relblock(size_t); +++void *alloc_relblock(size_t); ++ /* object fSallocate_contiguous_pages(); */ ++ /* object fSallocate_relocatable_pages(); */ ++ ++@@ -291,9 +291,7 @@ EXTER object sSAsystem_directoryA; ++ #ifdef UNIX ++ EXTER char *kcl_self; ++ #endif ++-#if !defined(IN_MAIN) || !defined(ATT) ++ EXTER bool raw_image; ++-#endif ++ char *merge_system_directory(); ++ ++ ++--- gcl-2.6.12.orig/h/cmpincl1.h +++++ gcl-2.6.12/h/cmpincl1.h ++@@ -1,2 +1 @@ ++-#define EXTER extern ++ #define CMPINCLUDE ++--- gcl-2.6.12.orig/h/compbas.h +++++ gcl-2.6.12/h/compbas.h ++@@ -1,2 +1,12 @@ ++ #include ++ #define _VA_LIST_DEFINED +++#ifndef EXTER +++#define EXTER extern +++#endif +++#ifndef INLINE +++#if defined(__GNUC__) && __GNUC__ <= 4 +++#define INLINE extern inline +++#else +++#define INLINE inline +++#endif +++#endif ++--- gcl-2.6.12.orig/h/error.h +++++ gcl-2.6.12/h/error.h ++@@ -1,4 +1,7 @@ ++-#define Icall_error_handler(a_,b_,c_,d_...) \ +++#ifndef ERROR_H +++#define ERROR_H +++ +++#define Icall_error_handler(a_,b_,c_,d_...) \ ++ Icall_gen_error_handler(Cnil,null_string,a_,b_,c_,##d_) ++ #define Icall_continue_error_handler(a_,b_,c_,d_,e_...) \ ++ Icall_gen_error_handler(Ct,a_,b_,c_,d_,##e_) ++@@ -8,12 +11,8 @@ extern enum type t_vtype; ++ extern int vtypep_fn(object); ++ extern void Check_type(object *,int (*)(object),object); ++ +++#define PFN(a_) INLINE int Join(a_,_fn)(object x) {return a_(x);} ++ ++-#ifdef IN_MAIN ++-#define PFN(a_) int Join(a_,_fn)(object x) {return a_(x);} ++-#else ++-#define PFN(a_) extern int Join(a_,_fn)(object x); ++-#endif ++ PFN(integerp) ++ PFN(non_negative_integerp) ++ PFN(rationalp) ++@@ -201,3 +200,4 @@ object ihs_top_function_name(ihs_ptr h); ++ abort();\ ++ }) ++ +++#endif /*ERROR_H*/ ++--- gcl-2.6.12.orig/h/gmp_wrappers.h +++++ gcl-2.6.12/h/gmp_wrappers.h ++@@ -1,12 +1,8 @@ ++-#ifndef GMP_EXTERN ++-#define GMP_EXTERN extern ++-#endif ++-#ifndef GMP_EXTERN_INLINE ++-#define GMP_EXTERN_INLINE GMP_EXTERN __inline__ ++-#endif +++#ifndef GMP_WRAPPERS_H +++#define GMP_WRAPPERS_H ++ ++-GMP_EXTERN jmp_buf gmp_jmp; ++-GMP_EXTERN int jmp_gmp,gmp_relocatable; +++EXTER jmp_buf gmp_jmp; +++EXTER int jmp_gmp,gmp_relocatable; ++ ++ #define join(a_,b_) a_ ## b_ ++ #define Join(a_,b_) join(a_,b_) ++@@ -95,7 +91,7 @@ GMP_EXTERN int jmp_gmp,gmp_relocatable; ++ set to -1 otherwise. 20040815 CM*/ ++ ++ #define MEM_GMP_CALL(n_,rt_,a_,s_,b_...) \ ++- GMP_EXTERN_INLINE Join(RF_,rt_) Join(m,a_)(Join(P,n_)(b_)) { \ +++ INLINE Join(RF_,rt_) Join(m,a_)(Join(P,n_)(b_)) { \ ++ int j;\ ++ Join(RD_,rt_);\ ++ if (gmp_relocatable) {\ ++@@ -195,3 +191,5 @@ MEM_GMP_CALL(2,size_t,mpz_sizeinbase,0,m ++ /*#define __gmpz_realloc m__gmpz_realloc*/ ++ #define __gmpz_size m__gmpz_size ++ #define __gmpz_sizeinbase m__gmpz_sizeinbase +++ +++#endif /*GMP_WRAPPERS_H*/ ++--- gcl-2.6.12.orig/h/immnum.h +++++ gcl-2.6.12/h/immnum.h ++@@ -17,10 +17,10 @@ ++ #define iif2(x,y) is_imm_fixnum2(x,y) ++ ++ ++-EXTER inline fixnum +++INLINE fixnum ++ lnabs(fixnum x) {return x<0 ? ~x : x;} ++ ++-EXTER inline char +++INLINE char ++ clz(ufixnum x) { ++ #ifdef HAVE_CLZL ++ return x ? __builtin_clzl(x) : sizeof(x)*8; ++@@ -29,7 +29,7 @@ clz(ufixnum x) { ++ #endif ++ } ++ ++-EXTER inline char +++INLINE char ++ ctz(ufixnum x) { ++ #ifdef HAVE_CTZL ++ return __builtin_ctzl(x);/*x ? __builtin_clzl(x) : sizeof(x)*8;*/ ++@@ -38,10 +38,10 @@ ctz(ufixnum x) { ++ #endif ++ } ++ ++-EXTER inline char +++INLINE char ++ fixnum_length(fixnum x) {return sizeof(x)*8-clz(lnabs(x));} ++ ++-EXTER inline object +++INLINE object ++ immnum_length(object x) {return iif(x) ? mif(fixnum_length(fif(x))) : integer_length(x);} ++ ++ ++@@ -57,7 +57,7 @@ immnum_length(object x) {return iif(x) ? ++ #define POPD 0x3F ++ #endif ++ ++-EXTER inline char +++INLINE char ++ fixnum_popcount(ufixnum x) { ++ x-=POPA&(x>>1); ++ x=(x&POPB)+((x>>2)&POPB); ++@@ -70,33 +70,33 @@ fixnum_popcount(ufixnum x) { ++ return x&POPD; ++ } ++ ++-EXTER inline char +++INLINE char ++ /* fixnum_count(fixnum x) {return __builtin_popcountl(lnabs(x));} */ ++ fixnum_count(fixnum x) {return fixnum_popcount(lnabs(x));} ++ ++-EXTER inline object +++INLINE object ++ immnum_count(object x) {return iif(x) ? mif(fixnum_count(fif(x))) : integer_count(x);} ++ ++ /*bs=sizeof(long)*8; ++ lb=bs-clz(labs(x));|x*y|=|x|*|y|<2^(lbx+lby)<2^(bs-1); ++ 0 bounded by 2^0, +-1 by 2^1,mpf by 2^(bs-1), which is sign bit ++ protect labs from most negative fix, here all immfix ok*/ ++-EXTER inline bool +++INLINE bool ++ fixnum_mul_safe_abs(fixnum x,fixnum y) {return clz(x)+clz(y)>sizeof(x)*8+1;} ++-EXTER inline object +++INLINE object ++ safe_mul_abs(fixnum x,fixnum y) {return fixnum_mul_safe_abs(x,y) ? make_fixnum(x*y) : fixnum_times(x,y);} ++-EXTER inline bool +++INLINE bool ++ fixnum_mul_safe(fixnum x,fixnum y) {return fixnum_mul_safe_abs(labs(x),labs(y));} ++-EXTER inline object +++INLINE object ++ safe_mul(fixnum x,fixnum y) {return fixnum_mul_safe(x,y) ? make_fixnum(x*y) : fixnum_times(x,y);} ++-EXTER inline object +++INLINE object ++ immnum_times(object x,object y) {return iif2(x,y) ? safe_mul(fif(x),fif(y)) : number_times(x,y);} ++ ++-EXTER inline object +++INLINE object ++ immnum_plus(object x,object y) {return iif2(x,y) ? make_fixnum(fif(x)+fif(y)) : number_plus(x,y);} ++-EXTER inline object +++INLINE object ++ immnum_minus(object x,object y) {return iif2(x,y) ? make_fixnum(fif(x)-fif(y)) : number_minus(x,y);} ++-EXTER inline object +++INLINE object ++ immnum_negate(object x) {return iif(x) ? make_fixnum(-fif(x)) : number_negate(x);} ++ ++ #define BOOLCLR 0 ++@@ -116,7 +116,7 @@ immnum_negate(object x) {return iif(x) ? ++ #define BOOLORC1 015 ++ #define BOOLORC2 013 ++ ++-EXTER inline fixnum +++INLINE fixnum ++ fixnum_boole(fixnum op,fixnum x,fixnum y) { ++ switch(op) { ++ case BOOLCLR: return 0; ++@@ -139,7 +139,7 @@ fixnum_boole(fixnum op,fixnum x,fixnum y ++ return 0;/*FIXME error*/ ++ } ++ ++-EXTER inline object +++INLINE object ++ immnum_boole(fixnum o,object x,object y) {return iif2(x,y) ? mif(fixnum_boole(o,fif(x),fif(y))) : log_op2(o,x,y);} ++ ++ #define immnum_bool(o,x,y) immnum_boole(fixint(o),x,y) ++@@ -156,93 +156,93 @@ immnum_boole(fixnum o,object x,object y) ++ #define immnum_orc1(x,y) immnum_boole(BOOLORC1,x,y) ++ #define immnum_orc2(x,y) immnum_boole(BOOLORC2,x,y) ++ ++-EXTER inline fixnum +++INLINE fixnum ++ fixnum_div(fixnum x,fixnum y,fixnum d) { ++ fixnum z=x/y; ++ if (d && x!=y*z && (x*d>0 ? y>0 : y<0)) ++ z+=d; ++ return z; ++ } ++-EXTER inline fixnum +++INLINE fixnum ++ fixnum_rem(fixnum x,fixnum y,fixnum d) { ++ fixnum z=x%y; ++ if (d && z && (x*d>0 ? y>0 : y<0)) ++ z+=y; ++ return z; ++ } ++-EXTER inline object +++INLINE object ++ immnum_truncate(object x,object y) {return iif2(x,y)&&y!=make_fixnum(0) ? mif(fixnum_div(fif(x),fif(y),0)) : (intdivrem(x,y,0,&x,NULL),x);} ++-EXTER inline object +++INLINE object ++ immnum_floor(object x,object y) {return iif2(x,y)&&y!=make_fixnum(0) ? mif(fixnum_div(fif(x),fif(y),-1)) : (intdivrem(x,y,-1,&x,NULL),x);} ++-EXTER inline object +++INLINE object ++ immnum_ceiling(object x,object y) {return iif2(x,y)&&y!=make_fixnum(0) ? mif(fixnum_div(fif(x),fif(y),1)) : (intdivrem(x,y,1,&x,NULL),x);} ++-EXTER inline object +++INLINE object ++ immnum_mod(object x,object y) {return iif2(x,y)&&y!=make_fixnum(0) ? mif(fixnum_rem(fif(x),fif(y),-1)) : (intdivrem(x,y,-1,NULL,&y),y);} ++-EXTER inline object +++INLINE object ++ immnum_rem(object x,object y) {return iif2(x,y)&&y!=make_fixnum(0) ? mif(fixnum_rem(fif(x),fif(y),0)) : (intdivrem(x,y,0,NULL,&y),y);} ++ ++-EXTER inline fixnum +++INLINE fixnum ++ fixnum_rshft(fixnum x,fixnum y) { ++ return y>=sizeof(x)*8 ? (x<0 ? -1 : 0) : x>>y; ++ } ++-EXTER inline object +++INLINE object ++ fixnum_lshft(fixnum x,fixnum y) { ++ return clz(labs(x))>y ? make_fixnum(x<);} ++-EXTER inline bool +++INLINE bool ++ immnum_ge(object x,object y) {return immnum_comp(x,y,>=);} ++ ++-EXTER inline bool +++INLINE bool ++ immnum_minusp(object x) {return iif(x) ? ((ufixnum)x)<((ufixnum)make_fixnum(0)) : number_minusp(x);} ++-EXTER inline bool +++INLINE bool ++ immnum_plusp(object x) {return iif(x) ? ((ufixnum)x)>((ufixnum)make_fixnum(0)) : number_plusp(x);} ++-EXTER inline bool +++INLINE bool ++ immnum_zerop(object x) {return iif(x) ? ((ufixnum)x)==((ufixnum)make_fixnum(0)) : number_zerop(x);} ++-EXTER inline bool +++INLINE bool ++ immnum_evenp(object x) {return iif(x) ? !(((ufixnum)x)&0x1) : number_evenp(x);} ++-EXTER inline bool +++INLINE bool ++ immnum_oddp(object x) {return iif(x) ? (((ufixnum)x)&0x1) : number_oddp(x);} ++ ++-EXTER inline object +++INLINE object ++ immnum_signum(object x) { ++ ufixnum ux=(ufixnum)x,uz=((ufixnum)make_fixnum(0)); ++ return iif(x) ? (ux=(ufixnum)y ? x : y) : (number_compare(x,y)>=0?x:y);} ++-EXTER inline object +++INLINE object ++ immnum_min(object x,object y) {return iif2(x,y) ? ((ufixnum)x<=(ufixnum)y ? x : y) : (number_compare(x,y)<=0?x:y);} ++ ++-EXTER inline bool +++INLINE bool ++ immnum_logt(object x,object y) {return iif2(x,y) ? fixnum_boole(BOOLAND,fif(x),fif(y))!=0 : !number_zerop(log_op2(BOOLAND,x,y));} ++ ++-EXTER inline fixnum +++INLINE fixnum ++ fixnum_gcd(fixnum x,fixnum y) { ++ ++ fixnum t; ++@@ -343,16 +343,16 @@ fixnum_gcd(fixnum x,fixnum y) { ++ ++ } ++ ++-EXTER inline object +++INLINE object ++ immnum_gcd(object x,object y) {return iif2(x,y) ? mif(fixnum_gcd(labs(fif(x)),labs(fif(y)))) : get_gcd(x,y);} ++ ++-EXTER inline object +++INLINE object ++ fixnum_lcm(fixnum x,fixnum y) { ++ fixnum g=fixnum_gcd(x,y); ++ return g ? safe_mul_abs(x,fixnum_div(y,g,0)) : make_fixnum(0); ++ } ++ ++-EXTER inline object +++INLINE object ++ immnum_lcm(object x,object y) {return iif2(x,y) ? fixnum_lcm(labs(fif(x)),labs(fif(y))) : get_lcm(x,y);} ++ ++ #endif ++--- gcl-2.6.12.orig/h/include.h +++++ gcl-2.6.12/h/include.h ++@@ -87,12 +87,6 @@ Foundation, 675 Mass Ave, Cambridge, MA ++ #define isalphanum(x) isalnum(x) ++ #endif ++ ++-#ifdef IN_MAIN ++-#define EXTER ++-#else ++-#define EXTER extern ++-#endif ++- ++ #if defined(GMP) || defined(NEED_MP_H) ++ #include "../h/mp.h" ++ #endif ++--- gcl-2.6.12.orig/h/notcomp.h +++++ gcl-2.6.12/h/notcomp.h ++@@ -28,10 +28,7 @@ EXTER long real_maxpage; ++ char *getenv(); ++ EXTER char *this_lisp; ++ ++-#ifndef IN_MAIN ++-EXTER ++-char stdin_buf[], stdout_buf[]; ++-#endif +++EXTER char stdin_buf[],stdout_buf[]; ++ ++ EXTER object user_package; ++ ++--- gcl-2.6.12.orig/h/page.h +++++ gcl-2.6.12/h/page.h ++@@ -106,7 +106,7 @@ extern fixnum writable_pages; ++ EXTER long first_data_page,real_maxpage,phys_pages,available_pages; ++ EXTER void *data_start,*initial_sbrk; ++ ++-#if !defined(IN_MAIN) && defined(SGC) +++#if defined(SGC) ++ #include "writable.h" ++ #endif ++ ++--- gcl-2.6.12.orig/h/protoize.h +++++ gcl-2.6.12/h/protoize.h ++@@ -1,13 +1,12 @@ ++ /* alloc.c:89:OF */ extern void *alloc_page (long n); /* (n) int n; */ ++-/* alloc.c:149:OF */ inline void add_page_to_freelist (char *p, struct typemanager *tm); /* (p, tm) char *p; struct typemanager *tm; */ ++ /* alloc.c:196:OF */ extern object type_name (int t); /* (t) int t; */ ++-/* alloc.c:213:OF */ inline object alloc_object (enum type t); /* (t) enum type t; */ ++-/* alloc.c:213:OF */ inline void add_pages(struct typemanager *,fixnum); ++-/* alloc.c:296:OF */ extern inline object make_cons (object a, object d); /* (a, d) object a; object d; */ +++/* alloc.c:213:OF */ object alloc_object (enum type t); /* (t) enum type t; */ +++/* alloc.c:213:OF */ void add_pages(struct typemanager *,fixnum); +++/* alloc.c:296:OF */ extern object make_cons (object a, object d); /* (a, d) object a; object d; */ ++ /* alloc.c:364:OF */ extern object on_stack_cons (object x, object y); /* (x, y) object x; object y; */ ++ /* alloc.c:376:OF */ extern object fSallocated (object typ); /* (typ) object typ; */ ++ /* alloc.c:401:OF */ extern object fSreset_number_used (object typ); /* (typ) object typ; */ ++-/* alloc.c:480:OF */ extern inline void insert_contblock (void *p, ufixnum s); /* (p, s) char *p; int s; */ +++/* alloc.c:480:OF */ extern void insert_contblock (void *p, ufixnum s); /* (p, s) char *p; int s; */ ++ /* alloc.c:480:OF */ extern void insert_maybe_sgc_contblock (char *p, int s); /* (p, s) char *p; int s; */ ++ /* alloc.c:611:OF */ extern void set_maxpage (void); /* () */ ++ /* alloc.c:635:OF */ extern void gcl_init_alloc (void *); /* () */ ++@@ -1841,43 +1840,40 @@ struct htent *gethash(object,object); ++ int ++ update_real_maxpage(void); ++ ++-inline fixnum +++fixnum ++ set_tm_maxpage(struct typemanager *,fixnum); ++ ++ void ++ init_gmp_rnd_state(__gmp_randstate_struct *); ++ ++-inline void ++-set_sgc_bit(struct pageinfo *,void *); ++- ++ void ++ reinit_gmp(void); ++ ++ object ++ mod(object,object); ++ ++-inline void +++void ++ intdivrem(object,object,fixnum,object *,object *); ++ ++-inline object +++object ++ integer_count(object); ++ ++-inline object +++object ++ integer_length(object); ++ ++-inline bool +++bool ++ integer_bitp(object,object); ++ ++-inline object +++object ++ fixnum_times(fixnum,fixnum); ++ ++-inline object +++object ++ log_op2(fixnum,object,object); ++ ++-inline object +++object ++ fixnum_big_shift(fixnum,fixnum); ++ ++-inline object +++object ++ integer_shift(object,object); ++ ++ object ++@@ -1921,22 +1917,19 @@ sigint(void); ++ void ++ allocate_code_block_reserve(void); ++ ++-inline void ++-resize_hole(ufixnum,enum type); ++- ++-inline void * +++void * ++ alloc_contblock_no_gc(size_t); ++ ++-inline void +++void ++ reset_contblock_freelist(void); ++ ++-inline void +++void ++ empty_relblock(void); ++ ++ fixnum ++ check_avail_pages(void); ++ ++-inline int +++int ++ mbrk(void *); ++ ++ void ++@@ -1948,5 +1941,8 @@ alloc_code_space(size_t); ++ object ++ fSmake_vector1_2(fixnum,fixnum,object,object); ++ ++-inline struct pageinfo * +++struct pageinfo * ++ get_pageinfo(void *); +++ +++void +++add_page_to_freelist(char *, struct typemanager *); ++--- gcl-2.6.12.orig/h/writable.h +++++ gcl-2.6.12/h/writable.h ++@@ -1,7 +1,7 @@ ++ EXTER fixnum last_page; ++ EXTER int last_result; ++ ++-EXTER inline int +++INLINE int ++ set_writable(fixnum i,bool m) { ++ ++ fixnum j; ++@@ -32,7 +32,7 @@ set_writable(fixnum i,bool m) { ++ ++ } ++ ++-EXTER inline int +++INLINE int ++ is_writable(fixnum i) { ++ ++ fixnum j; ++@@ -51,7 +51,7 @@ is_writable(fixnum i) { ++ ++ } ++ ++-EXTER inline int +++INLINE int ++ is_writable_cached(fixnum i) { ++ ++ if (last_page==i) ++--- gcl-2.6.12.orig/makefile +++++ gcl-2.6.12/makefile ++@@ -265,7 +265,7 @@ $(HDIR)new_decl.h: ++ ++ $(HDIR)mcompdefs.h: $(HDIR)compdefs.h $(HDIR)new_decl.h ++ $(AWK) 'BEGIN {print "#include \"include.h\"";print "#include \"cmponly.h\"";print "---"} {a=$$1;gsub("\\.\\.\\.","",a);print "\"#define " $$1 "\" " a}' $< |\ ++- $(CC) -E -I./$(HDIR) - |\ +++ $(CC) -E -P -I./$(HDIR) - |\ ++ $(AWK) '/^\-\-\-$$/ {i=1;next} {if (!i) next} {gsub("\"","");print}' >$@ ++ ++ $(HDIR)cmpinclude.h: $(HDIR)mcompdefs.h $(CMPINCLUDE_FILES) $(HDIR)config.h ++--- gcl-2.6.12.orig/o/alloc.c +++++ gcl-2.6.12/o/alloc.c ++@@ -134,7 +134,7 @@ acomp(const void *v1,const void *v2) { ++ ++ } ++ ++-inline struct pageinfo * +++struct pageinfo * ++ get_pageinfo(void *x) { ++ ++ struct pageinfo **pp=bsearchleq(&x,contblock_array->v.v_self,contblock_array->v.v_fillp,sizeof(*contblock_array->v.v_self),acomp); ++@@ -144,7 +144,7 @@ get_pageinfo(void *x) { ++ ++ } ++ ++-inline void +++static inline void ++ add_page_to_contblock_list(void *p,fixnum m) { ++ ++ struct pageinfo *pp=pageinfo(p); ++@@ -176,7 +176,70 @@ icomp(const void *v1,const void *v2) { ++ return *f1<*f2 ? -1 : *f1==*f2 ? 0 : +1; ++ } ++ ++-inline void +++ +++void +++add_page_to_freelist(char *p, struct typemanager *tm) { +++ +++ short t,size; +++ long i=tm->tm_nppage,fw; +++ object x,f; +++ struct pageinfo *pp; +++ +++ t=tm->tm_type; +++ +++ size=tm->tm_size; +++ f=tm->tm_free; +++ pp=pageinfo(p); +++ bzero(pp,sizeof(*pp)); +++ pp->type=t; +++ pp->magic=PAGE_MAGIC; +++ +++ if (cell_list_head==NULL) +++ cell_list_tail=cell_list_head=pp; +++ else if (pp > cell_list_tail) { +++ cell_list_tail->next=pp; +++ cell_list_tail=pp; +++ } +++ +++ x= (object)pagetochar(page(p)); +++ /* set_type_of(x,t); */ +++ make_free(x); +++ +++#ifdef SGC +++ +++ if (sgc_enabled && tm->tm_sgc) +++ pp->sgc_flags=SGC_PAGE_FLAG; +++ +++#ifndef SGC_WHOLE_PAGE +++ if (TYPEWORD_TYPE_P(pp->type)) +++ x->d.s=(sgc_enabled && tm->tm_sgc) ? SGC_RECENT : SGC_NORMAL; +++#endif +++ +++ /* array headers must be always writable, since a write to the +++ body does not touch the header. It may be desirable if there +++ are many arrays in a system to make the headers not writable, +++ but just SGC_TOUCH the header each time you write to it. this +++ is what is done with t_structure */ +++ if (t==(tm_of(t_array)->tm_type)) +++ pp->sgc_flags|=SGC_PERM_WRITABLE; +++ +++#endif +++ +++ fw= *(fixnum *)x; +++ while (--i >= 0) { +++ *(fixnum *)x=fw; +++ SET_LINK(x,f); +++ f=x; +++ x= (object) ((char *)x + size); +++ } +++ +++ tm->tm_free=f; +++ tm->tm_nfree += tm->tm_nppage; +++ tm->tm_npage++; +++ +++} +++ +++static inline void ++ maybe_reallocate_page(struct typemanager *ntm,ufixnum count) { ++ ++ void **y,**n; ++@@ -248,7 +311,7 @@ int reserve_pages_for_signal_handler=30; ++ reserve_pages_for_signal_handler pages on hand in the hole ++ */ ++ ++-inline void +++void ++ empty_relblock(void) { ++ ++ object o=sSAleaf_collection_thresholdA->s.s_dbind; ++@@ -262,7 +325,7 @@ empty_relblock(void) { ++ ++ } ++ ++-inline void +++static inline void ++ resize_hole(ufixnum hp,enum type tp) { ++ ++ char *new_start=heap_end+hp*PAGESIZE; ++@@ -283,7 +346,7 @@ resize_hole(ufixnum hp,enum type tp) { ++ ++ } ++ ++-inline void * +++void * ++ alloc_page(long n) { ++ ++ bool s=n<0; ++@@ -332,7 +395,7 @@ alloc_page(long n) { ++ ++ struct pageinfo *cell_list_head=NULL,*cell_list_tail=NULL;; ++ ++-inline ufixnum +++static inline ufixnum ++ sum_maxpages(void) { ++ ++ ufixnum i,j; ++@@ -352,7 +415,7 @@ check_avail_pages(void) { ++ } ++ ++ ++-inline fixnum +++fixnum ++ set_tm_maxpage(struct typemanager *tm,fixnum n) { ++ ++ fixnum r=tm->tm_type==t_relocatable,j=tm->tm_maxpage,z=(n-j)*(r ? 2 : 1); ++@@ -365,69 +428,6 @@ set_tm_maxpage(struct typemanager *tm,fi ++ return 1; ++ } ++ ++- ++-inline void ++-add_page_to_freelist(char *p, struct typemanager *tm) { ++- ++- short t,size; ++- long i=tm->tm_nppage,fw; ++- object x,f; ++- struct pageinfo *pp; ++- ++- t=tm->tm_type; ++- ++- size=tm->tm_size; ++- f=tm->tm_free; ++- pp=pageinfo(p); ++- bzero(pp,sizeof(*pp)); ++- pp->type=t; ++- pp->magic=PAGE_MAGIC; ++- ++- if (cell_list_head==NULL) ++- cell_list_tail=cell_list_head=pp; ++- else if (pp > cell_list_tail) { ++- cell_list_tail->next=pp; ++- cell_list_tail=pp; ++- } ++- ++- x= (object)pagetochar(page(p)); ++- /* set_type_of(x,t); */ ++- make_free(x); ++- ++-#ifdef SGC ++- ++- if (sgc_enabled && tm->tm_sgc) ++- pp->sgc_flags=SGC_PAGE_FLAG; ++- ++-#ifndef SGC_WHOLE_PAGE ++- if (TYPEWORD_TYPE_P(pp->type)) ++- x->d.s=(sgc_enabled && tm->tm_sgc) ? SGC_RECENT : SGC_NORMAL; ++-#endif ++- ++- /* array headers must be always writable, since a write to the ++- body does not touch the header. It may be desirable if there ++- are many arrays in a system to make the headers not writable, ++- but just SGC_TOUCH the header each time you write to it. this ++- is what is done with t_structure */ ++- if (t==(tm_of(t_array)->tm_type)) ++- pp->sgc_flags|=SGC_PERM_WRITABLE; ++- ++-#endif ++- ++- fw= *(fixnum *)x; ++- while (--i >= 0) { ++- *(fixnum *)x=fw; ++- SET_LINK(x,f); ++- f=x; ++- x= (object) ((char *)x + size); ++- } ++- ++- tm->tm_free=f; ++- tm->tm_nfree += tm->tm_nppage; ++- tm->tm_npage++; ++- ++-} ++- ++ object ++ type_name(int t) { ++ return make_simple_string(tm_table[(int)t].tm_name+1); ++@@ -435,7 +435,7 @@ type_name(int t) { ++ ++ ++ static void ++-call_after_gbc_hook(t) { +++call_after_gbc_hook(int t) { ++ if (sSAafter_gbc_hookA && sSAafter_gbc_hookA->s.s_dbind!= Cnil) { ++ set_up_string_register(tm_table[(int)t].tm_name+1); ++ ifuncall1(sSAafter_gbc_hookA->s.s_dbind,intern(string_register,system_package)); ++@@ -536,7 +536,7 @@ rebalance_maxpages(struct typemanager *m ++ ++ } ++ ++-inline long +++long ++ opt_maxpage(struct typemanager *my_tm) { ++ ++ double x=0.0,y=0.0,z,r; ++@@ -707,7 +707,7 @@ find_contblock(ufixnum n,void **p) { ++ return find_cbpp(*p,n); ++ } ++ ++-inline void +++void ++ print_cb(int print) { ++ ++ struct contblock *cbp,***cbppp,**cbpp=&cb_pointer; ++@@ -729,7 +729,7 @@ print_cb(int print) { ++ ++ } ++ ++-inline void +++void ++ insert_contblock(void *p,ufixnum s) { ++ ++ struct contblock *cbp=p,**cbpp,***cbppp; ++@@ -761,7 +761,7 @@ delete_contblock(void *p,struct contbloc ++ ++ } ++ ++-inline void +++void ++ reset_contblock_freelist(void) { ++ ++ cb_pointer=NULL; ++@@ -769,7 +769,7 @@ reset_contblock_freelist(void) { ++ ++ } ++ ++-inline void * +++static inline void * ++ alloc_from_freelist(struct typemanager *tm,fixnum n) { ++ ++ void *p; ++@@ -851,7 +851,7 @@ too_full_p(struct typemanager *tm) { ++ ++ } ++ ++-inline void * +++static inline void * ++ alloc_after_gc(struct typemanager *tm,fixnum n) { ++ ++ if (tm->tm_npage+tpage(tm,n)>tm->tm_maxpage && GBC_enable) { ++@@ -883,7 +883,7 @@ alloc_after_gc(struct typemanager *tm,fi ++ ++ } ++ ++-inline void +++void ++ add_pages(struct typemanager *tm,fixnum m) { ++ ++ switch (tm->tm_type) { ++@@ -923,7 +923,7 @@ add_pages(struct typemanager *tm,fixnum ++ ++ } ++ ++-inline void * +++static inline void * ++ alloc_after_adding_pages(struct typemanager *tm,fixnum n) { ++ ++ fixnum m=tpage(tm,n); ++@@ -945,7 +945,7 @@ alloc_after_adding_pages(struct typemana ++ ++ } ++ ++-inline void * +++static inline void * ++ alloc_after_reclaiming_pages(struct typemanager *tm,fixnum n) { ++ ++ fixnum m=tpage(tm,n),reloc_min; ++@@ -972,10 +972,10 @@ alloc_after_reclaiming_pages(struct type ++ ++ } ++ ++-inline void *alloc_mem(struct typemanager *,fixnum); +++static inline void *alloc_mem(struct typemanager *,fixnum); ++ ++ #ifdef SGC ++-inline void * +++static inline void * ++ alloc_after_turning_off_sgc(struct typemanager *tm,fixnum n) { ++ ++ if (!sgc_enabled) return NULL; ++@@ -985,7 +985,7 @@ alloc_after_turning_off_sgc(struct typem ++ } ++ #endif ++ ++-inline void * +++static inline void * ++ alloc_mem(struct typemanager *tm,fixnum n) { ++ ++ void *p; ++@@ -1007,7 +1007,7 @@ alloc_mem(struct typemanager *tm,fixnum ++ return exhausted_report(tm->tm_type,tm); ++ } ++ ++-inline object +++object ++ alloc_object(enum type t) { ++ ++ object obj; ++@@ -1022,12 +1022,12 @@ alloc_object(enum type t) { ++ ++ } ++ ++-inline void * +++void * ++ alloc_contblock(size_t n) { ++ return alloc_mem(tm_of(t_contiguous),CEI(n,CPTR_SIZE)); ++ } ++ ++-inline void * +++void * ++ alloc_contblock_no_gc(size_t n) { ++ ++ struct typemanager *tm=tm_of(t_contiguous); ++@@ -1073,7 +1073,7 @@ alloc_code_space(size_t sz) { ++ ++ } ++ ++-inline void * +++void * ++ alloc_relblock(size_t n) { ++ ++ return alloc_mem(tm_of(t_relocatable),CEI(n,PTR_ALIGN)); ++@@ -1089,7 +1089,7 @@ load_cons(object p,object a,object d) { ++ p->c.c_car=a; ++ } ++ ++-inline object +++object ++ make_cons(object a,object d) { ++ ++ static struct typemanager *tm=tm_table+t_cons;/*FIXME*/ ++@@ -1105,7 +1105,7 @@ make_cons(object a,object d) { ++ ++ ++ ++-inline object on_stack_cons(object x, object y) { +++object on_stack_cons(object x, object y) { ++ object p = (object) alloca_val; ++ load_cons(p,x,y); ++ return p; ++--- gcl-2.6.12.orig/o/gbc.c +++++ gcl-2.6.12/o/gbc.c ++@@ -158,7 +158,7 @@ in_contblock_stack_list(void *p,void *** ++ return a && a[0]==p; ++ } ++ ++-inline char +++static inline char ++ get_bit(char *v,struct pageinfo *pi,void *x) { ++ void *ve=CB_DATA_START(pi); ++ fixnum off=(x-ve)>>LOG_BYTES_CONTBLOCK,i=off>>LOG_BITS_CHAR,s=off&~(~0UL<>s)&0x1; ++ } ++ ++-inline void +++static inline void ++ set_bit(char *v,struct pageinfo *pi,void *x) { ++ void *ve=CB_DATA_START(pi); ++ fixnum off=(x-ve)>>LOG_BYTES_CONTBLOCK,i=off>>LOG_BITS_CHAR,s=off&~(~0UL<>LOG_BYTES_CONTBLOCK;i=_o>>LOG_BITS_CHAR;s=_o&~(~0UL< ++ void change_contexts(); ++@@ -47,6 +45,11 @@ int ovm_process_created; ++ void initialize_process(); ++ #endif ++ +++ +++#define EXTER +++#define INLINE +++ +++ ++ #include "include.h" ++ #include ++ #include "page.h" ++@@ -118,7 +121,7 @@ cstack_dir(fixnum j) { ++ ++ fixnum log_maxpage_bound=sizeof(fixnum)*8-1; ++ ++-inline int +++int ++ mbrk(void *v) { ++ ++ ufixnum uv=(ufixnum)v,uc=(ufixnum)sbrk(0),ux,um; ++@@ -1120,10 +1123,6 @@ init_main(void) { ++ ++ } ++ ++-#ifdef SGC ++-#include "writable.h" ++-#endif ++- ++ #ifdef HAVE_PRINT_INSN_I386 ++ ++ #include "dis-asm.h" ++--- gcl-2.6.12.orig/o/makefile +++++ gcl-2.6.12/o/makefile ++@@ -20,7 +20,7 @@ OBJS:=$(addsuffix .o,typespec main alloc ++ num_pred num_comp num_arith num_sfun num_co num_log num_rand earith character sequence list hash\ ++ array string regexpr structure toplevel file read backq print format pathname unixfsys unixfasl\ ++ error unixtime unixsys unixsave funlink fat_string run_process nfunlink usig usig2 utils makefun\ ++- sockets gmp_wrappers clxsocket init_pari nsocket sfasl prelink) +++ sockets clxsocket init_pari nsocket sfasl prelink) ++ OBJS:=$(OBJS) $(RL_OBJS) $(EXTRAS) ++ ++ INI_FILES=$(patsubst %.o,%.ini,${OBJS}) ++--- gcl-2.6.12.orig/o/num_arith.c +++++ gcl-2.6.12/o/num_arith.c ++@@ -62,7 +62,7 @@ object fixnum_sub(fixnum i, fixnum j) ++ } ++ } ++ ++-inline object +++object ++ fixnum_times(fixnum i, fixnum j) { ++ ++ #ifdef HAVE_CLZL ++--- gcl-2.6.12.orig/o/num_co.c +++++ gcl-2.6.12/o/num_co.c ++@@ -277,7 +277,7 @@ LFD(Ldenominator)(void) ++ vs_base[0] = small_fixnum(1); ++ } ++ ++-inline void +++void ++ intdivrem(object x,object y,fixnum d,object *q,object *r) { ++ ++ enum type tx=type_of(x),ty=type_of(y); ++--- gcl-2.6.12.orig/o/num_log.c +++++ gcl-2.6.12/o/num_log.c ++@@ -37,12 +37,12 @@ Foundation, 675 Mass Ave, Cambridge, MA ++ ++ ++ ++-inline object +++object ++ fixnum_big_shift(fixnum x,fixnum w) { ++ MPOP(return,shifti,SI_TO_MP(x,big_fixnum1),w); ++ } ++ ++-inline object +++object ++ integer_fix_shift(object x, fixnum w) { ++ if (type_of(x)==t_fixnum) { ++ fixnum fx=fix(x); ++@@ -51,7 +51,7 @@ integer_fix_shift(object x, fixnum w) { ++ MPOP(return,shifti,MP(x),w); ++ } ++ ++-inline object +++object ++ integer_shift(object x,object y) { ++ enum type tx=type_of(x),ty=type_of(y); ++ if (ty==t_fixnum) ++@@ -66,12 +66,12 @@ integer_shift(object x,object y) { ++ } ++ } ++ ++-inline object +++object ++ integer_length(object x) { ++ return make_fixnum(type_of(x)==t_fixnum ? fixnum_length(fix(x)) : MP_SIZE_IN_BASE2(MP(x))); ++ } ++ ++-inline object +++object ++ integer_count(object x) { ++ return make_fixnum(type_of(x)==t_fixnum ? fixnum_count(fix(x)) : MP_BITCOUNT(MP(x))); ++ } ++@@ -120,7 +120,7 @@ LFD(Lboole)(void) ++ ++ } ++ ++-inline bool +++bool ++ integer_bitp(object p,object x) { ++ enum type tp=type_of(p),tx=type_of(x); ++ ++--- gcl-2.6.12.orig/o/num_sfun.c +++++ gcl-2.6.12/o/num_sfun.c ++@@ -94,7 +94,7 @@ number_exp(object x) ++ } ++ } ++ ++-inline object +++static inline object ++ number_fix_iexpt(object x,fixnum y,fixnum ly,fixnum j) { ++ object z; ++ ++@@ -103,7 +103,7 @@ number_fix_iexpt(object x,fixnum y,fixnu ++ return fixnum_bitp(j,y) ? number_times(x,z) : z; ++ } ++ ++-inline object +++static inline object ++ number_big_iexpt(object x,object y,fixnum ly,fixnum j) { ++ object z; ++ ++@@ -113,7 +113,7 @@ number_big_iexpt(object x,object y,fixnu ++ ++ } ++ ++-inline object +++static inline object ++ number_zero_expt(object x,bool promote_short_p) { ++ ++ switch (type_of(x)) { ++@@ -135,7 +135,7 @@ number_zero_expt(object x,bool promote_s ++ } ++ ++ ++-inline object +++static inline object ++ number_ui_expt(object x,fixnum fy) { ++ ++ switch (type_of(x)) { ++@@ -173,17 +173,17 @@ number_ui_expt(object x,fixnum fy) { ++ ++ } ++ ++-inline object +++static inline object ++ number_ump_expt(object x,object y) { ++ return number_big_iexpt(x,y,fix(integer_length(y)),0); ++ } ++ ++-inline object +++static inline object ++ number_log_expt(object x,object y) { ++ return number_zerop(y) ? number_zero_expt(y,type_of(x)==t_longfloat) : number_exp(number_times(number_nlog(x),y)); ++ } ++ ++-inline object +++static inline object ++ number_invert(object x,object y,object z) { ++ ++ switch (type_of(z)) { ++@@ -198,7 +198,7 @@ number_invert(object x,object y,object z ++ } ++ ++ ++-inline object +++static inline object ++ number_si_expt(object x,object y) { ++ switch (type_of(y)) { ++ case t_fixnum: ++--- gcl-2.6.12.orig/o/package.d +++++ gcl-2.6.12/o/package.d ++@@ -114,7 +114,7 @@ static int package_sizes[]={ ++ 32749, 65521, 131071, 262139, 524287, 1048573}; ++ ++ static int ++-suitable_package_size(n) +++suitable_package_size(int n) ++ {int *i=package_sizes; ++ if (n>= 1000000) return 1048573; ++ while(*i < n) { i++;} diff --cc debian/patches/Version_2_6_13pre8b index 00000000,00000000..fef1bb0f new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre8b @@@ -1,0 -1,0 +1,43 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-9) unstable; urgency=medium ++ . ++ * Version_2_6_13pre8a ++ * Bug fix: "ftbfs with GCC-5", thanks to Matthias Klose (Closes: ++ #777866). ++Author: Camm Maguire ++Bug-Debian: https://bugs.debian.org/777866 ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/o/prelink.c +++++ gcl-2.6.12/o/prelink.c ++@@ -2,6 +2,12 @@ ++ ++ #include "include.h" ++ +++extern FILE *stdin __attribute__((weak)); +++extern FILE *stderr __attribute__((weak)); +++extern FILE *stdout __attribute__((weak)); +++extern rl_compentry_func_t *rl_completion_entry_function __attribute__((weak)); +++extern const char *rl_readline_name __attribute__((weak)); +++ ++ void ++ prelink_init(void) { ++ diff --cc debian/patches/Version_2_6_13pre90 index 00000000,00000000..fe7aa971 new file mode 100644 --- /dev/null +++ b/debian/patches/Version_2_6_13pre90 @@@ -1,0 -1,0 +1,90 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-93) unstable; urgency=medium ++ . ++ * Version_2_6_13pre90 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2020-02-21 ++ ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -3974,7 +3974,7 @@ $as_echo "removing $1 from LDFLAGS" >&6; ++ ++ } ++ ++-add_args_to_cflags -fsigned-char -pipe \ +++add_args_to_cflags -fsigned-char -pipe -fcommon \ ++ -fno-builtin-malloc -fno-builtin-free \ ++ -fno-PIE -fno-pie -fno-PIC -fno-pic \ ++ -Wall \ ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -258,7 +258,7 @@ remove_arg_from_ldflags() { ++ ++ } ++ ++-add_args_to_cflags -fsigned-char -pipe \ +++add_args_to_cflags -fsigned-char -pipe -fcommon \ ++ -fno-builtin-malloc -fno-builtin-free \ ++ -fno-PIE -fno-pie -fno-PIC -fno-pic \ ++ -Wall \ ++--- gcl-2.6.12.orig/o/main.c +++++ gcl-2.6.12/o/main.c ++@@ -445,20 +445,21 @@ gcl_cleanup(int gc) { ++ } ++ ++ /*gcc boolean expression tail position bug*/ +++static char *stack_to_be_allocated; ++ ++-void * ++-cclear_stack(unsigned long size) { ++- void *v=alloca(size); ++- memset(v,0,size); ++- return v; +++void +++get_stack_to_be_allocated(unsigned long size) { +++ stack_to_be_allocated=alloca(size); ++ } ++ ++ DEFUN_NEW("EQUAL-TAIL-RECURSION-CHECK",object,fSequal_tail_recursion_check,SI,1,1,NONE,II,OO,OO,OO,(fixnum s),"") { ++ object x0=make_list(s/sizeof(object)),x1=make_list(s/sizeof(object)); ++- char *u=cclear_stack(s),*w; +++ char *w; +++ get_stack_to_be_allocated(s); +++ memset(stack_to_be_allocated,0,s); ++ fLequal(x0,x1); ++- for (w=u;w ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-95) unstable; urgency=high ++ . ++ * Version_2_6_13pre90 ++ * build under GCL_MEM_MULTIPLE=0.1 ++ * Bug fix: "FTBFS: Unrecoverable error: Segmentation violation..", ++ thanks to Lucas Nussbaum (Closes: #952334). ++Author: Camm Maguire ++Bug-Debian: https://bugs.debian.org/952334 ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2020-08-23 ++ ++--- gcl-2.6.12.orig/h/elf32_armhf_reloc_special.h +++++ gcl-2.6.12/h/elf32_armhf_reloc_special.h ++@@ -6,13 +6,15 @@ static ul tz=sizeof(tramp)/sizeof(ul); ++ static ul * ++ next_plt_entry(ul *p,ul *pe) { ++ ++- ul l0=0xe5bef000,/*ldr pc,[ip,#]*/ ++- l1=0xe5bcf000;/*ldr pc,[lr,#]*/ +++ /* 4778 bx pc */ /*optional*/ +++ /* e7fd b.n 20dd0 <__fprintf_chk@plt> */ /*optional*/ +++ /* above when stripped becomes undefined instruction*/ +++ /* e28fc601 add ip, pc, #1048576 ; 0x100000 */ +++ /* e28ccab0 add ip, ip, #176, 20 ; 0xb0000 */ +++ /* e5bcf914 ldr pc, [ip, #2324]! ; 0x914 */ ++ ++- for (;p>20)!=0xe28;p++); +++ return p; ++ ++ } ++ diff --cc debian/patches/ansi-test-clean-target index 00000000,00000000..15f42d93 new file mode 100644 --- /dev/null +++ b/debian/patches/ansi-test-clean-target @@@ -1,0 -1,0 +1,33 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-39) unstable; urgency=medium ++ . ++ * pathnames1.1 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2016-10-12 ++ ++--- gcl-2.6.12.orig/ansi-tests/makefile +++++ gcl-2.6.12/ansi-tests/makefile ++@@ -8,3 +8,5 @@ test: ++ ++ clean: ++ rm -f test.out *.fasl *.o *.so *~ *.fn *.x86f *.fasl *.ufsl +++ rm -f foo.txt temp.dat file-that-was-renamed.txt tmp.dat tmp.dat.BAK tmp2.dat +++ rm -rf scratch tmp.txt foo.lsp 'CLTEST:foo.txt' diff --cc debian/patches/data_bss_offset-in-unexec-sparc64-fix index 00000000,00000000..08d1543d new file mode 100644 --- /dev/null +++ b/debian/patches/data_bss_offset-in-unexec-sparc64-fix @@@ -1,0 -1,0 +1,83 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-31) unstable; urgency=medium ++ . ++ * Version_2_6_13pre39 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: ++ ++--- gcl-2.6.12.orig/o/unexelf.c +++++ gcl-2.6.12/o/unexelf.c ++@@ -428,6 +428,8 @@ extern void fatal (char *, ...); ++ #include /* for HDRR declaration */ ++ #endif /* __sgi */ ++ +++#include "page.h" +++ ++ #ifndef MAP_ANON ++ #ifdef MAP_ANONYMOUS ++ #define MAP_ANON MAP_ANONYMOUS ++@@ -655,7 +657,7 @@ unexec (char *new_name, char *old_name, ++ char *old_section_names; ++ ++ ElfW(Addr) old_bss_addr, new_bss_addr,new_data2_addr; ++- ElfW(Off) old_bss_size, new_data2_size,old_bss_offset,new_data2_offset,old_file_size,new_file_size; +++ ElfW(Off) old_bss_size, new_data2_size,old_bss_offset,new_data2_offset,old_file_size,new_file_size,data_bss_offset; ++ ++ int n, nn; ++ int old_bss_index, old_sbss_index; ++@@ -772,7 +774,9 @@ unexec (char *new_name, char *old_name, ++ if (new_file < 0) ++ fatal ("Can't creat (%s): errno %d\n", new_name, errno); ++ ++- new_file_size = stat_buf.st_size + old_file_h->e_shentsize + new_data2_size + (new_data2_offset-old_bss_offset); +++ data_bss_offset=CEI(new_data2_offset-old_bss_offset,sizeof(long));/*????, e.g. sparc64*/ +++ +++ new_file_size = stat_buf.st_size + old_file_h->e_shentsize + new_data2_size + data_bss_offset; ++ ++ if (ftruncate (new_file, new_file_size)) ++ fatal ("Can't ftruncate (%s): errno %d\n", new_name, errno); ++@@ -784,7 +788,7 @@ unexec (char *new_name, char *old_name, ++ new_file_h = (ElfW(Ehdr) *) new_base; ++ new_program_h = (ElfW(Phdr) *) ((byte *) new_base + old_file_h->e_phoff); ++ new_section_h = (ElfW(Shdr) *) ++- ((byte *) new_base + old_file_h->e_shoff + new_data2_size + (new_data2_offset-old_bss_offset)); +++ ((byte *) new_base + old_file_h->e_shoff + new_data2_size + data_bss_offset); ++ ++ ++ /* Make our new file, program and section headers as copies of the ++@@ -802,7 +806,7 @@ unexec (char *new_name, char *old_name, ++ * further away now. ++ */ ++ ++- new_file_h->e_shoff += new_data2_size + (new_data2_offset-old_bss_offset); +++ new_file_h->e_shoff += new_data2_size + data_bss_offset; ++ new_file_h->e_shnum += 1; ++ ++ #ifdef DEBUG ++@@ -958,7 +962,7 @@ unexec (char *new_name, char *old_name, ++ if (NEW_SECTION_H (nn).sh_offset >= old_bss_offset || ++ /* solaris has symtab straddling bss offset */ ++ NEW_SECTION_H (nn).sh_offset+NEW_SECTION_H (nn).sh_size > old_bss_offset) ++- NEW_SECTION_H (nn).sh_offset += new_data2_size+(new_data2_offset-old_bss_offset); +++ NEW_SECTION_H (nn).sh_offset += new_data2_size+data_bss_offset; ++ #endif ++ /* Any section that was originally placed after the section ++ header table should now be off by the size of one section diff --cc debian/patches/defined_real_maxpage index 00000000,00000000..4fe1d27f new file mode 100644 --- /dev/null +++ b/debian/patches/defined_real_maxpage @@@ -1,0 -1,0 +1,71 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-50) unstable; urgency=medium ++ . ++ * list_order.6 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2017-06-14 ++ ++--- gcl-2.6.12.orig/h/386-gnu.h +++++ gcl-2.6.12/h/386-gnu.h ++@@ -59,3 +59,5 @@ ++ #define RELOC_H "elf32_i386_reloc.h" ++ ++ #define NEED_STACK_CHK_GUARD +++ +++#define DEFINED_REAL_MAXPAGE (1UL<<18) /*FIXME brk probe broken*/ ++--- gcl-2.6.12.orig/h/m68k-linux.h +++++ gcl-2.6.12/h/m68k-linux.h ++@@ -78,3 +78,5 @@ int cacheflush(void *,int,int,int); ++ #define RELOC_H "elf32_m68k_reloc.h" ++ ++ #define NEED_STACK_CHK_GUARD +++ +++#define DEFINED_REAL_MAXPAGE (1UL<<18) /*FIXME brk probe broken*/ ++--- gcl-2.6.12.orig/h/sh4-linux.h +++++ gcl-2.6.12/h/sh4-linux.h ++@@ -56,3 +56,5 @@ ++ #define RELOC_H "elf32_sh4_reloc.h" ++ ++ #define NEED_STACK_CHK_GUARD +++ +++#define DEFINED_REAL_MAXPAGE (1UL<<18) /*FIXME brk probe broken*/ ++--- gcl-2.6.12.orig/o/main.c +++++ gcl-2.6.12/o/main.c ++@@ -302,6 +302,9 @@ update_real_maxpage(void) { ++ } ++ #endif ++ +++#ifdef DEFINED_REAL_MAXPAGE +++ real_maxpage=DEFINED_REAL_MAXPAGE; +++#else ++ massert(cur=sbrk(0)); ++ beg=data_start ? data_start : cur; ++ for (i=0,j=(1L<PAGESIZE;j>>=1) ++@@ -311,7 +314,8 @@ update_real_maxpage(void) { ++ i+=j; ++ } ++ massert(!mbrk(cur)); ++- +++#endif +++ ++ phys_pages=ufmin(get_phys_pages1(0)+page(beg),real_maxpage)-page(beg); ++ ++ get_gc_environ(); diff --cc debian/patches/disable_gprof_aarch64 index 00000000,00000000..239d89c2 new file mode 100644 --- /dev/null +++ b/debian/patches/disable_gprof_aarch64 @@@ -1,0 -1,0 +1,56 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-54) unstable; urgency=medium ++ . ++ * list_order.11 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2017-08-24 ++ ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -4122,6 +4122,7 @@ $as_echo_n "checking working gprof... " ++ ia64*) enableval="no";; ++ hppa*) enableval="no";; ++ arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible +++ aarch64*) enableval="no";;#unreproducible buildd bug 20170824 ++ *gnu) enableval="no";; ++ esac ++ if test "$enableval" != "yes" ; then ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -335,6 +335,7 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof ++ ia64*) enableval="no";; ++ hppa*) enableval="no";; ++ arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible +++ aarch64*) enableval="no";;#unreproducible buildd bug 20170824 ++ *gnu) enableval="no";; ++ esac ++ if test "$enableval" != "yes" ; then ++--- gcl-2.6.12.orig/o/regexp.c +++++ gcl-2.6.12/o/regexp.c ++@@ -231,7 +231,7 @@ int case_fold_search = 0; ++ * of the structure of the compiled regexp. ++ */ ++ static regexp * ++-regcomp(char *exp,int *sz) +++regcomp(char *exp,ufixnum *sz) ++ { ++ register regexp *r; ++ register char *scan; diff --cc debian/patches/list_order.1 index 00000000,00000000..f04c29e2 new file mode 100644 --- /dev/null +++ b/debian/patches/list_order.1 @@@ -1,0 -1,0 +1,8651 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-47) unstable; urgency=high ++ . ++ * pathnames1.13 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2017-05-28 ++ ++--- gcl-2.6.12.orig/clcs/sys-proclaim.lisp +++++ gcl-2.6.12/clcs/sys-proclaim.lisp ++@@ -4,7 +4,9 @@ ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- CONDITIONS::COERCE-TO-FN CONDITIONS::SLOT-SYM)) +++ COMMON-LISP::DEFINE-CONDITION COMMON-LISP::HANDLER-CASE +++ COMMON-LISP::IGNORE-ERRORS COMMON-LISP::HANDLER-BIND +++ CONDITIONS::SLOT-SYM CONDITIONS::COERCE-TO-FN)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++@@ -20,27 +22,27 @@ ++ CONDITIONS::|(PCL::FAST-METHOD MAKE-LOAD-FORM (CONDITION))|)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++- CONDITIONS::IS-CONDITION CONDITIONS::DEFAULT-REPORT ++- CONDITIONS::IS-WARNING CONDITIONS::CONDITIONP)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::*) ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PACKAGE-ERROR T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CASE-FAILURE T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ABORT-FAILURE T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (STREAM-ERROR T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNDEFINED-FUNCTION T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (FILE-ERROR T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-VARIABLE T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ARITHMETIC-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (END-OF-FILE T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (STREAM-ERROR T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PRINT-NOT-READABLE T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CASE-FAILURE T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PACKAGE-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CELL-ERROR T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (SIMPLE-CONDITION T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-SLOT T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNDEFINED-FUNCTION T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-CONDITION T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PRINT-NOT-READABLE T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (TYPE-ERROR T))|)) ++\ No newline at end of file +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ABORT-FAILURE T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ARITHMETIC-ERROR T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-SLOT T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (TYPE-ERROR T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (SIMPLE-CONDITION T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-VARIABLE T))|)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +++ CONDITIONS::CONDITIONP CONDITIONS::DEFAULT-REPORT +++ CONDITIONS::IS-CONDITION CONDITIONS::IS-WARNING)) ++\ No newline at end of file ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpcall.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpcall.lsp ++@@ -27,8 +27,7 @@ ++ (eval-when (compile eval) ++ (defmacro link-arg-p (x) ++ `(let ((.u ,x)) ++- (not (member .u '(character boolean long-float short-float))))) ++-) +++ (not (member .u '(character boolean long-float short-float) :test 'eq))))) ++ ++ (defun fast-link-proclaimed-type-p (fname &optional args) ++ (and ++@@ -134,6 +133,7 @@ ++ (let ((*vs* *vs*) (form (caddr funob))) ++ (declare (object form)) ++ (cond ((and (listp args) +++ (< (length args) 12) ;FIXME fcalln1 limitation ++ *use-sfuncall* ++ ;;Determine if only one value at most is required: ++ (or ++@@ -167,8 +167,9 @@ ++ (defun fcalln-inline (&rest args) ++ (wt-nl "({object _f=" (car args) ";enum type _t=type_of(_f);") ++ (wt-nl "_f = _t==t_symbol && _f->s.s_gfdef!=OBJNULL ? (_t=type_of(_f->s.s_gfdef),_f->s.s_gfdef) : _f;") ++- (wt-nl "_t==t_sfun ? _f->sfn.sfn_self : ") ++- (wt-nl "(fcall.argd= " (length (cdr args)) ",_t==t_vfun ? _f->vfn.vfn_self : ") +++ (wt-nl "_t==t_sfun&&(_f->sfn.sfn_argd&0xff)== " (length (cdr args)) " ? _f->sfn.sfn_self : ") +++ (wt-nl "(fcall.argd= " (length (cdr args)) +++ ",_t==t_vfun&&_f->vfn.vfn_minargs<= " (length (cdr args)) "&&" (length (cdr args)) "<=_f->vfn.vfn_maxargs ? _f->vfn.vfn_self : ") ++ (wt-nl "(fcall.fun=_f,fcalln));})") ++ (wt-nl "(") ++ (when (cdr args) (wt (cadr args)) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpenv.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpenv.lsp ++@@ -376,9 +376,7 @@ ++ doc form) ++ (loop ++ (when (endp body) (return)) ++- (setq form (cmp-macroexpand (car body))) ++- (when (and (consp form) (eq (car form) 'load-time-value)) ++- (setq form (cmp-eval form))) +++ (setq form (car body)) ++ (cond ++ ((stringp form) ++ (when (or (null doc-p) (endp (cdr body)) doc) (return)) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpfun.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpfun.lsp ++@@ -603,7 +603,9 @@ ++ (t ++ `(si::structure-subtype-p ++ ,x ',type)))) ++-; ((and (print (list 'slow 'typep type)) nil)) +++ ((and (symbolp type) (setq tem (get type 'si::deftype-definition))) +++ `(typep ,x ',(funcall tem))) +++ ;; ((and (print (list 'slow 'typep type)) nil)) ++ (t nil))) ++ (and new (c1expr `(the boolean , new))))) ++ ++@@ -877,36 +879,6 @@ ++ (c1expr (cmp-eval (cons f args)))))) ++ ++ ++-(si::putprop 'do 'co1special-fix-decl 'co1special) ++-(si::putprop 'do* 'co1special-fix-decl 'co1special) ++-(si::putprop 'prog 'co1special-fix-decl 'co1special) ++-(si::putprop 'prog* 'co1special-fix-decl 'co1special) ++- ++-(defun co1special-fix-decl (f args) ++- (flet ((fixup (forms &aux decls ) ++- (block nil ++- (tagbody ++- top ++- (or (consp forms) (go end)) ++- (let ((tem (car forms))) ++- (if (and (consp tem) ++- (setq tem (cmp-macroexpand tem)) ++- (eq (car tem) 'declare)) ++- (progn (push tem decls) (pop forms)) ++- (go end))) ++- (go top) ++- ; all decls made explicit. ++- end ++- (return (nconc (nreverse decls) forms)))))) ++- (c1expr ++- (cmp-macroexpand ++- (case f ++- ((do do*) `(,f ,(car args) ++- ,(second args) ++- ,@ (fixup (cddr args)))) ++- ((prog prog*) ++- `(,f ,(car args) ++- ,@ (fixup (cdr args))))))))) ++ (si::putprop 'sublis 'co1sublis 'co1) ++ (defun co1sublis (f args &aux test) f ++ (and (case (length args) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpinline.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpinline.lsp ++@@ -465,7 +465,7 @@ ++ (t . INLINE))) ++ ++ (defun inline-type (type) ++- (or (cdr (assoc type *inline-types*)) 'inline)) +++ (or (cdr (assoc type *inline-types* :test 'eq)) 'inline)) ++ ++ (defun get-inline-info (fname args return-type &aux x ii) ++ (and (fast-link-proclaimed-type-p fname args) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmplam.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmplam.lsp ++@@ -475,9 +475,9 @@ ++ (*unwind-exit* *unwind-exit*) ++ (*ccb-vs* *ccb-vs*)) ++ (when rest ++- (wt-nl "vs_top[0]=Cnil;") ++- (wt-nl "{object *p=vs_top, *q=vs_base+" (length optionals) ";") ++- (wt-nl " for(;p>q;p--)p[-1]=MMcons(p[-1],p[0]);}")) +++ (wt-nl "{object *q=vs_base+" (length optionals) ",*l;") +++ (wt-nl " for (l=q;qc.c_cdr) *l=MMcons(*q,Cnil);") +++ (wt-nl " *l=Cnil;}")) ++ (do ((opts optionals (cdr opts))) ++ ((endp opts)) ++ (declare (object opts)) ++@@ -510,11 +510,11 @@ ++ ++ (wt-label label))) ++ (rest ++- (wt-nl "vs_top[0]=Cnil;") ++- (wt-nl "{object *p=vs_top;") ++- (wt-nl " for(;p>vs_base;p--)p[-1]=" +++ (wt-nl "{object *q=vs_base,*l;") +++ (wt-nl " for (l=q;qc.c_cdr) *l=" ++ (if *rest-on-stack* "ON_STACK_CONS" "MMcons") ++- "(p[-1],p[0]);}") +++ "(*q,Cnil);") +++ (wt-nl " *l=Cnil;}") ++ (c2bind rest) ++ (wt-nl) ++ (reset-top)) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpmulti.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpmulti.lsp ++@@ -108,22 +108,11 @@ ++ (unwind-exit 'fun-val nil (if top-data (car top-data))) ++ ) ++ ++-(defun c1values (args &aux (info (make-info))) ++- (cond ((and args (not (cdr args)) ++- (or (not (consp (car args))) ++- (and (symbolp (caar args)) ++- (let ((tem (get-return-type (caar args)))) ++- (and tem ++- (or (atom tem) ++- (and (consp tem) ++- (null (cdr tem)) ++- (not (eq '* (car tem)))))))))) ++- ;;the compiler put in unnecessary code ++- ;;if we just had say (values nil) ++- ;; so if we know there's one value only: ++- (c1expr (car args))) ++- (t (setq args (c1args args info)) ++- (list 'values info args)))) +++(defun c1values (args &aux (info (make-info))(s (si::sgen "VALUES"))) +++ (cond ((and args (not (cdr args))) +++ (c1expr `(let ((,s ,(car args))) ,s))) +++ (t (setq args (c1args args info)) +++ (list 'values info args)))) ++ ++ (defun c2values (forms &aux (base *vs*) (*vs* *vs*)) ++ (cond ((and (eq *value-to-go* 'return-object) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpopt.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpopt.lsp ++@@ -66,6 +66,10 @@ ++ (push '((t) boolean #.(flags)"type_of(#0)==t_longfloat") ++ (get 'long-float-p 'inline-always)) ++ +++;;COMPLEX-P +++ (push '((t) boolean #.(flags)"type_of(#0)==t_complex") +++ (get 'si::complexp 'inline-always)) +++ ++ ;;SFEOF ++ (push '((object) boolean #.(flags set)"(gcl_feof((#0)->sm.sm_fp))") ++ (get 'sfeof 'inline-unsafe)) ++@@ -479,21 +483,56 @@ ++ (get 'array-total-size 'inline-unsafe)) ++ ++ ;;ARRAYP ++- (push '((t) boolean #.(flags) ++- "@0;type_of(#0)==t_array|| ++-type_of(#0)==t_vector|| ++-type_of(#0)==t_string|| ++-type_of(#0)==t_bitvector") ++- (get 'arrayp 'inline-always)) +++;; (push '((t) boolean #.(flags) +++;; "@0;type_of(#0)==t_array|| +++;; type_of(#0)==t_vector|| +++;; type_of(#0)==t_string|| +++;; type_of(#0)==t_bitvector") +++;; (get 'arrayp 'inline-always)) ++ ++ ;;ATOM ++- (push '((t) boolean #.(flags)"type_of(#0)!=t_cons") +++ (push '((t) boolean #.(flags)"atom(#0)") ++ (get 'atom 'inline-always)) ++ ++ ;;BIT-VECTOR-P ++ (push '((t) boolean #.(flags)"(type_of(#0)==t_bitvector)") ++ (get 'bit-vector-p 'inline-always)) ++ +++;;BIT-VECTOR-P +++ (push '((t) boolean #.(flags)"(type_of(#0)==t_bitvector)") +++ (get 'bit-vector-p 'inline-always)) +++ +++;;HASH-TABLE-P +++ (push '((t) boolean #.(flags)"(type_of(#0)==t_hashtable)") +++ (get 'hash-table-p 'inline-always)) +++ +++;;RANDOM-STATE-P +++ (push '((t) boolean #.(flags)"(type_of(#0)==t_random)") +++ (get 'random-state-p 'inline-always)) +++ +++;;RANDOM-STATE-P +++ (push '((t) boolean #.(flags)"(type_of(#0)==t_random)") +++ (get 'random-state-p 'inline-always)) +++ +++;;PACKAGEP +++ (push '((t) boolean #.(flags)"(type_of(#0)==t_package)") +++ (get 'packagep 'inline-always)) +++ +++;;STREAMP +++ (push '((t) boolean #.(flags)"(type_of(#0)==t_stream)") +++ (get 'streamp 'inline-always)) +++ +++;;READTABLEP +++ (push '((t) boolean #.(flags)"(type_of(#0)==t_readtable)") +++ (get 'readtablep 'inline-always)) +++ +++;;COMPOUND PREDICATES +++(dolist (l '(integerp rationalp floatp realp numberp vectorp arrayp compiled-function-p)) +++ (push +++ `((t) boolean #.(flags) ,(substitute #\_ #\- (concatenate 'string (string-downcase l) "(#0)"))) +++ (get l 'inline-always))) +++ +++ ++ ;;BOUNDP ++ (push '((t) boolean #.(flags)"(#0)->s.s_dbind!=OBJNULL") ++ (get 'boundp 'inline-unsafe)) ++@@ -739,7 +778,7 @@ type_of(#0)==t_bitvector") ++ (get 'cons 'inline-always)) ++ ++ ;;CONSP ++- (push '((t) boolean #.(flags)"type_of(#0)==t_cons") +++ (push '((t) boolean #.(flags)"consp(#0)") ++ (get 'consp 'inline-always)) ++ ++ ;;COS ++@@ -832,9 +871,9 @@ type_of(#0)==t_bitvector") ++ (get 'float 'inline-always)) ++ ++ ;;FLOATP ++- (push '((t) boolean #.(flags) ++- "@0;type_of(#0)==t_shortfloat||type_of(#0)==t_longfloat") ++- (get 'floatp 'inline-always)) +++ ;; (push '((t) boolean #.(flags) +++ ;; "@0;type_of(#0)==t_shortfloat||type_of(#0)==t_longfloat") +++ ;; (get 'floatp 'inline-always)) ++ ++ ;;CEILING ++ (push '((t t) t #.(compiler::flags) "immnum_ceiling(#0,#1)") (get 'ceiling 'compiler::inline-always)) ++@@ -861,9 +900,9 @@ type_of(#0)==t_bitvector") ++ (get 'get 'inline-always)) ++ ++ ;;INTEGERP ++- (push '((t) boolean #.(flags) ++- "@0;type_of(#0)==t_fixnum||type_of(#0)==t_bignum") ++- (get 'integerp 'inline-always)) +++ ;; (push '((t) boolean #.(flags) +++ ;; "@0;type_of(#0)==t_fixnum||type_of(#0)==t_bignum") +++ ;; (get 'integerp 'inline-always)) ++ (push '((fixnum) boolean #.(flags) ++ "1") ++ (get 'integerp 'inline-always)) ++@@ -940,7 +979,7 @@ type_of(#0)==t_bitvector") ++ (get 'list* 'inline-always)) ++ ++ ;;LISTP ++- (push '((t) boolean #.(flags)"@0;type_of(#0)==t_cons||(#0)==Cnil") +++ (push '((t) boolean #.(flags)"listp(#0)") ++ (get 'listp 'inline-always)) ++ ++ ;;si::spice-p ++@@ -1082,14 +1121,14 @@ type_of(#0)==t_bitvector") ++ (get 'null 'inline-always)) ++ ++ ;;NUMBERP ++- (push '((t) boolean #.(flags) ++- "@0;type_of(#0)==t_fixnum|| ++-type_of(#0)==t_bignum|| ++-type_of(#0)==t_ratio|| ++-type_of(#0)==t_shortfloat|| ++-type_of(#0)==t_longfloat|| ++-type_of(#0)==t_complex") ++- (get 'numberp 'inline-always)) +++;; (push '((t) boolean #.(flags) +++;; "@0;type_of(#0)==t_fixnum|| +++;; type_of(#0)==t_bignum|| +++;; type_of(#0)==t_ratio|| +++;; type_of(#0)==t_shortfloat|| +++;; type_of(#0)==t_longfloat|| +++;; type_of(#0)==t_complex") +++;; (get 'numberp 'inline-always)) ++ ++ ;;PLUSP ++ (push '((t) boolean #.(flags) "immnum_plusp(#0)");"number_compare(small_fixnum(0),#0)<0" ++@@ -1175,7 +1214,7 @@ type_of(#0)==t_complex") ++ (get 'si::pathname-designatorp 'inline-always)) ++ ++ ;;PATHNAMEP ++-(push '((t) boolean #.(flags)"pathnamep(#0)") +++(push '((t) boolean #.(flags)"type_of(#0)==t_pathname") ++ (get 'pathnamep 'inline-always)) ++ ++ ;;STRINGP ++@@ -1235,11 +1274,11 @@ type_of(#0)==t_complex") ++ ++ ++ ;;VECTORP ++- (push '((t) boolean #.(flags) ++- "@0;type_of(#0)==t_vector|| ++-type_of(#0)==t_string|| ++-type_of(#0)==t_bitvector") ++- (get 'vectorp 'inline-always)) +++;; (push '((t) boolean #.(flags) +++;; "@0;type_of(#0)==t_vector|| +++;; type_of(#0)==t_string|| +++;; type_of(#0)==t_bitvector") +++;; (get 'vectorp 'inline-always)) ++ ++ ;;WRITE-CHAR ++ (push '((t) t #.(flags set) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmptop.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmptop.lsp ++@@ -135,7 +135,6 @@ ++ ;;; Pass 2 initializers. ++ ++ (si:putprop 'defun 't2defun 't2) ++-(si:putprop 'defmacro 't2defmacro 't2) ++ (si:putprop 'declare 't2declare 't2) ++ (si:putprop 'defentry 't2defentry 't2) ++ (si:putprop 'si:putprop 't2putprop 't2) ++@@ -143,7 +142,6 @@ ++ ;;; Pass 2 C function generators. ++ ++ (si:putprop 'defun 't3defun 't3) ++-(si:putprop 'defmacro 't3defmacro 't3) ++ (si:putprop 'ordinary 't3ordinary 't3) ++ (si:putprop 'sharp-comma 't3sharp-comma 't3) ++ (si:putprop 'clines 't3clines 't3) ++@@ -205,26 +203,20 @@ ++ (let ((new (copy-seq str))) ++ (dash-to-underscore-int new 0 (length new)))) ++ ++-(defun init-name (p &optional sp (gp t) (dc t) (nt t)) ++ ++- (cond ((not sp) "code") ++- ((not (pathnamep p)) (init-name (pathname p) sp gp dc nt)) ++- (gp (init-name (truename (merge-pathnames p #p".lsp")) sp nil dc nt)) ++- ((pathname-type p) ++- (init-name (make-pathname ++- :host (pathname-host p) ++- :device (pathname-device p) ++- :directory (pathname-directory p) ++- :name (pathname-name p) ++- :version (pathname-version p)) sp gp dc nt)) ++-; #-aosvs(dc (string-downcase (init-name p sp gp nil nt))) ++- ((and nt ++- (let* ((pn (pathname-name p)) ++- (pp (make-pathname :name pn))) ++- (and (not (equal pp p)) ++- (eql 4 (string<= "gcl_" pn)) ++- (init-name pp sp gp dc nil))))) ++- ((dash-to-underscore (namestring p))))) +++(defun init-name (p &optional sp) +++ +++ (if sp +++ (let* ((p (truename (merge-pathnames p #p".lsp"))) +++ (pn (pathname-name p)) +++ (g (zerop (si::string-match #v"^gcl_" pn)))) +++ (dash-to-underscore +++ (namestring +++ (make-pathname :host (unless g (pathname-host p)) +++ :device (unless g (pathname-device p)) +++ :directory (unless g (pathname-directory p)) +++ :name pn)))) +++ "code")) ++ ++ ;; FIXME consider making this a macro ++ (defun c-function-name (prefix num fname) ++@@ -469,7 +461,7 @@ ++ (too-few-args 'defun 2 (length args))) ++ (cmpck (not (symbolp (car args))) ++ "The function name ~s is not a symbol." (car args)) ++- (maybe-eval nil (cons 'defun args)) +++ (unless (macro-function (car args)) (maybe-eval nil (cons 'defun args))) ++ (tagbody ++ top ++ (setq *non-package-operation* t) ++@@ -615,8 +607,9 @@ ++ (setq type (f-type (pop args)))))) ++ ++ ++-(defun wt-if-proclaimed (fname cfun lambda-expr) ++- (cond ((fast-link-proclaimed-type-p fname) +++(defun wt-if-proclaimed (fname cfun lambda-expr macro-p) +++ (cond (macro-p (add-init `(si::MM ',fname ,(add-address (c-function-name "LI" cfun fname))))) +++ ((fast-link-proclaimed-type-p fname) ++ (cond ((unless (member '* (get fname 'proclaimed-arg-types)) (assoc fname *inline-functions*)) ++ (add-init `(si::mfsfun ',fname ,(add-address (c-function-name "LI" cfun fname)) ++ ,(proclaimed-argd (get fname 'proclaimed-arg-types) ++@@ -698,11 +691,11 @@ ++ (defun si::add-debug (fname x) ++ (si::putprop fname x 'si::debugger)) ++ ++-(defun t3init-fun (fname cfun lambda-expr doc) +++(defun t3init-fun (fname cfun lambda-expr doc macro-p) ++ ++ (when doc (add-init `(si::putprop ',fname ,doc 'si::function-documentation))) ++ ++- (cond ((wt-if-proclaimed fname cfun lambda-expr)) +++ (cond ((wt-if-proclaimed fname cfun lambda-expr macro-p)) ++ ((vararg-p fname) ++ (let ((keyp (ll-keywords-p (lambda-list lambda-expr)))) ++ ; (wt-h "static object LI" cfun "();") ++@@ -724,6 +717,7 @@ ++ (add-init `(si::mf ',fname ,(add-address (c-function-name "" cfun fname))))))) ++ ++ (defun t3defun (fname cfun lambda-expr doc sp &aux inline-info +++ (macro-p (equal `(mflag ,fname) (cadr (member *current-form* *top-level-forms*)))) ++ (*current-form* (list 'defun fname)) ++ (*volatile* (volatile (second lambda-expr))) ++ *downward-closures*) ++@@ -736,9 +730,9 @@ ++ (return (setq inline-info v)))) ++ ++ ;;; Add global entry information. ++- (when (not (fast-link-proclaimed-type-p fname)) ++- (push (list fname cfun (cadr inline-info) (caddr inline-info)) ++- *global-entries*)) +++ (unless (or macro-p (fast-link-proclaimed-type-p fname)) +++ (push (list fname cfun (cadr inline-info) (caddr inline-info)) +++ *global-entries*)) ++ ++ ;;; Local entry ++ (analyze-regs (cadr lambda-expr) 0) ++@@ -761,7 +755,7 @@ ++ ++ (wt-downward-closure-macro cfun) ++ ++- (t3init-fun fname cfun lambda-expr doc) +++ (t3init-fun fname cfun lambda-expr doc macro-p) ++ ++ (add-debug-info fname lambda-expr)) ++ ++@@ -1333,63 +1327,13 @@ ++ (long-float "double ") ++ (otherwise "object "))) ++ ++- ++-(defun t1defmacro (args) ++- (when (or (endp args) (endp (cdr args))) ++- (too-few-args 'defmacro 2 (length args))) ++- (cmpck (not (symbolp (car args))) ++- "The macro name ~s is not a symbol." (car args)) ++- (maybe-eval t (cons 'defmacro args)) ++- (setq *non-package-operation* t) ++- (let ((*vars* nil) (*funs* nil) (*blocks* nil) (*tags* nil) ++- (*sharp-commas* nil) (*special-binding* nil) ++- macro-lambda (cfun (next-cfun))) ++- (setq macro-lambda (c1dm (car args) (cadr args) (cddr args))) ++- (add-load-time-sharp-comma) ++- (push (list 'defmacro (car args) cfun (cddr macro-lambda) ++- (car macro-lambda) ;doc ++- (cadr macro-lambda) ; ppn ++- *special-binding*) ++- *top-level-forms*)) ++- ) ++- ++- ++-(defun t2defmacro (fname cfun macro-lambda doc ppn sp) ++- ++- (declare (ignore macro-lambda doc ppn sp)) ++- (wt-h "static void " (c-function-name "L" cfun fname) "();") ++- ) ++- ++-(defun t3defmacro (fname cfun macro-lambda doc ppn sp ++- &aux (*volatile* (if (get fname 'contains-setjmp) ++- " VOL " ""))) ++- (let-pass3 ++- ((*exit* 'return)) ++- (wt-comment "macro definition for " fname) ++- (wt-nl1 "static void " (c-function-name "L" cfun fname) "()") ++- (wt-nl1 "{register object *" *volatile* "base=vs_base;") ++- (assign-down-vars (nth 4 macro-lambda) cfun ;*dm-info* ++- 't3defun) ++- (wt-nl "register object *"*volatile* "sup=base+VM" *reservation-cmacro* ";") ++- (wt " VC" *reservation-cmacro*) ++- (if *safe-compile* ++- (wt-nl "vs_reserve(VM" *reservation-cmacro* ");") ++- (wt-nl "vs_check;")) ++- (when sp (wt-nl "bds_check;")) ++- (when *compiler-push-events* (wt-nl "ihs_check;")) ++- (c2dm (car macro-lambda) (cadr macro-lambda) (caddr macro-lambda) ++- (cadddr macro-lambda)) ++- (wt-nl1 "}") ++- (push (cons *reservation-cmacro* *max-vs*) *reservations*) ++- (wt-h "#define VC" *reservation-cmacro*) ++- (wt-cvars) ++- ++- (when doc (add-init `(si::putprop ',fname ,doc 'si::function-documentation) )) ++- (when ppn ++- (add-init `(si::putprop ',fname ',ppn 'si::pretty-print-format) )) ++- (add-init `(si::MM ',fname ,(add-address (c-function-name "L" cfun fname))) ) ++- ++- )) +++(defun t1defmacro (args &aux (w args)(n (pop args))(l (symbol-plist n)) +++ (macp (when (listp n) (eq 'macro (car n))))(n (if macp (cdr n) n))) +++ (proclaim `(ftype (function (t t) t) ,n)) +++ (maybe-eval (not (macro-function n)) (cons 'defmacro w));FIXME? +++ (t1expr `(defun ,n ,@(if macp args (cddr (caddr (si::defmacro* n (pop args) args)))))) +++ (setf (symbol-plist n) l) +++ (push `(mflag ,n) *top-level-forms*)) ++ ++ (defun t1ordinary (form &aux tem ) ++ (setq *non-package-operation* t) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmputil.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmputil.lsp ++@@ -180,33 +180,27 @@ ++ (or (member-if (lambda (x) (when (consp x) (eq (car x) fname))) *funs*) ++ (macro-function fname)))) ++ ++-(defun do-macro-expansion (how form &aux env) ++- (dolist (v *funs*) +++(defun macro-env (&aux env) +++ (dolist (v *funs* (when env (list nil (nreverse env) nil))) ++ (when (consp v) ++- (push (list (car v) 'macro (cadr v)) env))) ++- (when env (setq env (list nil (nreverse env) nil))) ++- (let ((x (multiple-value-list (cmp-toplevel-eval `(,@how ',form ',env))))) ++- (if (car x) ++- (let ((*print-case* :upcase)) ++- (incf *error-count*) ++- (print-current-form) ++- (format t ";;; The macro form ~s was not expanded successfully.~%" form) ++- `(error "Macro-expansion of ~s failed at compile time." ',form)) ++- (cadr x)))) +++ (push (list (car v) 'macro (cadr v)) env)))) ++ ++ (defun cmp-macroexpand (form) ++ (if (macro-def-p form) ++- (do-macro-expansion '(macroexpand) form) +++ (macroexpand form (macro-env)) ++ form)) ++ ++ (defun cmp-macroexpand-1 (form) ++ (if (macro-def-p form) ++- (do-macro-expansion '(macroexpand-1) form) +++ (macroexpand-1 form (macro-env)) ++ form)) ++ ++ (defun cmp-expand-macro (fd fname args &aux (form (cons fname args))) ++ (if (macro-def-p form) ++- (do-macro-expansion `(funcall *macroexpand-hook* ',fd) form) +++ (let ((env (macro-env))) +++ (if (eq *macroexpand-hook* 'funcall) +++ (funcall fd form env) +++ (funcall *macroexpand-hook* fd form env))) ++ form)) ++ ++ (defvar *compiler-break-enable* nil) ++--- gcl-2.6.12.orig/cmpnew/sys-proclaim.lisp +++++ gcl-2.6.12/cmpnew/sys-proclaim.lisp ++@@ -2,24 +2,116 @@ ++ (COMMON-LISP::IN-PACKAGE "COMPILER") ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- ((COMMON-LISP::INTEGER -9223372036854775808 ++- 9223372036854775807) ++- (COMMON-LISP::INTEGER -9223372036854775808 ++- 9223372036854775807)) ++- COMMON-LISP::T) ++- COMPILER::MLIN)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +++ COMPILER::TAG-REF-CLB COMPILER::SET-TOP +++ COMPILER::C1MULTIPLE-VALUE-BIND COMPILER::C1LIST-NTH +++ COMPILER::C1RPLACA-NTHCDR COMPILER::C1DEFINE-STRUCTURE +++ COMPILER::BLK-REF-CLB COMPILER::WT-VV COMPILER::C1LENGTH +++ COMPILER::C1MAPC COMPILER::C1LOCAL-CLOSURE +++ COMPILER::CHECK-VREF COMPILER::WT-VAR-DECL COMPILER::C1TAGBODY +++ COMPILER::BLK-REF-CCB COMPILER::C1LOAD-TIME-VALUE +++ COMPILER::C1ASH COMPILER::FUN-LEVEL COMPILER::COPY-INFO +++ COMPILER::INLINE-POSSIBLE COMPILER::WT-VS-BASE +++ COMPILER::T1DEFENTRY COMPILER::CHARACTER-LOC-P +++ COMPILER::C2RPLACA COMPILER::RESET-INFO-TYPE +++ COMPILER::TYPE-FILTER COMPILER::TAG-SWITCH +++ COMPILER::DECL-BODY-SAFETY COMPILER::C1AND +++ COMPILER::C1FMLA-CONSTANT COMPILER::C2GO-CLB +++ COMPILER::C1FUNCTION COMPILER::C1MAPLIST COMPILER::VAR-TYPE +++ COMPILER::CLINK COMPILER::UNWIND-NO-EXIT COMPILER::VAR-LOC +++ COMPILER::C2RPLACD COMPILER::VERIFY-DATA-VECTOR +++ COMPILER::TAG-REF-CCB COMPILER::C1RETURN-FROM +++ COMPILER::T1DEFINE-STRUCTURE COMPILER::MDELETE-FILE +++ COMPILER::OBJECT-TYPE COMPILER::WT-CAR COMPILER::TAG-P +++ COMPILER::ADD-LOOP-REGISTERS COMPILER::C1MEMQ +++ COMPILER::C2FUNCTION COMPILER::CMP-MACRO-FUNCTION +++ COMPILER::C1BOOLE-CONDITION COMPILER::REP-TYPE COMPILER::C2GET +++ COMPILER::C2VAR COMPILER::C2EXPR* COMPILER::C1ADD-GLOBALS +++ COMPILER::WT1 COMPILER::C1BLOCK COMPILER::C1MAPL +++ COMPILER::C1MAPCAR COMPILER::FSET-FN-NAME COMPILER::C2GO-CCB +++ COMPILER::T1DEFLA COMPILER::C1NTH-CONDITION +++ COMPILER::ADD-OBJECT2 COMPILER::VAR-NAME COMPILER::C1EXPR +++ COMPILER::FUN-REF COMPILER::SCH-LOCAL-FUN +++ COMPILER::FIXNUM-LOC-P COMPILER::BLK-VAR +++ COMPILER::C1UNWIND-PROTECT COMPILER::C2BIND +++ COMPILER::PARSE-CVSPECS COMPILER::C1NTH +++ COMPILER::WT-SWITCH-CASE SYSTEM::UNDEF-COMPILER-MACRO +++ COMPILER::SET-UP-VAR-CVS COMPILER::C1ECASE +++ COMPILER::C1STRUCTURE-REF COMPILER::FUN-INFO +++ COMPILER::C1MEMBER COMPILER::C1GET COMPILER::WT-FUNCTION-LINK +++ COMPILER::C1ASH-CONDITION COMPILER::WT-CCB-VS COMPILER::INFO-P +++ COMPILER::REGISTER COMPILER::TAG-VAR COMPILER::C1VAR +++ COMPILER::C1TERPRI COMPILER::LTVP +++ COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::C1MAPCON +++ COMPILER::PUSH-ARGS-LISPCALL COMPILER::C1SETQ +++ COMPILER::C2DOWNWARD-FUNCTION COMPILER::T3ORDINARY +++ COMPILER::C1VREF COMPILER::WT-VS COMPILER::CONSTANT-FOLD-P +++ COMPILER::C1MULTIPLE-VALUE-PROG1 COMPILER::BLK-EXIT +++ COMPILER::T1DEFUN COMPILER::C1LABELS COMPILER::C1FSET +++ COMPILER::T1MACROLET COMPILER::FUN-NAME COMPILER::C1APPLY +++ COMPILER::FUN-P COMPILER::WT-DATA-PACKAGE-OPERATION +++ COMPILER::C1FUNOB COMPILER::WT-SYMBOL-FUNCTION +++ COMPILER::GET-RETURN-TYPE COMPILER::ADD-CONSTANT +++ COMPILER::SAFE-SYSTEM COMPILER::BLK-VALUE-TO-GO +++ COMPILER::NEED-TO-SET-VS-POINTERS COMPILER::C2TAGBODY-LOCAL +++ COMPILER::C1DECLARE COMPILER::C1OR COMPILER::C1ASSOC +++ COMPILER::ADD-ADDRESS COMPILER::VAR-KIND +++ COMPILER::PROCLAMATION COMPILER::FIX-OPT COMPILER::WT-DATA1 +++ COMPILER::INFO-SP-CHANGE COMPILER::ARGS-CAUSE-SIDE-EFFECT +++ COMPILER::WRITE-BLOCK-OPEN COMPILER::C2TAGBODY-BODY +++ COMPILER::CONS-TO-LISTA COMPILER::SAVE-FUNOB COMPILER::VAR-REF +++ COMPILER::C1LOCAL-FUN COMPILER::VAR-REP-LOC +++ COMPILER::SET-PUSH-CATCH-FRAME COMPILER::CTOP-WRITE +++ COMPILER::C2TAGBODY-CLB COMPILER::T1CLINES +++ COMPILER::ADD-OBJECT COMPILER::GET-LOCAL-RETURN-TYPE +++ COMPILER::DEFAULT-INIT COMPILER::FUNCTION-ARG-TYPES +++ COMPILER::C1STRUCTURE-SET COMPILER::CMP-MACROEXPAND-1 +++ COMPILER::INLINE-TYPE COMPILER::VAR-REGISTER +++ COMPILER::DECLARATION-TYPE COMPILER::C1CATCH COMPILER::C1LET +++ COMPILER::T3CLINES COMPILER::UNDEFINED-VARIABLE COMPILER::C1GO +++ COMPILER::TAG-NAME COMPILER::SCH-GLOBAL COMPILER::C1IF +++ COMPILER::C1FLET COMPILER::INLINE-BOOLE3-STRING +++ COMPILER::INFO-CHANGED-ARRAY COMPILER::C2FUNCALL-AUX +++ COMPILER::FUN-REF-CCB COMPILER::WT-CADR COMPILER::FUN-CFUN +++ COMPILER::WT-VS* COMPILER::WT-DOWN COMPILER::C2GETHASH +++ COMPILER::ADD-REG1 COMPILER::REPLACE-CONSTANT +++ COMPILER::C2DM-RESERVE-V COMPILER::RESULT-TYPE +++ COMPILER::C1FUNCALL COMPILER::C1THE COMPILER::VARARG-P +++ COMPILER::INFO-REFERRED-ARRAY COMPILER::C1PROGV +++ COMPILER::T2DECLARE COMPILER::T1DEFCFUN COMPILER::C2VALUES +++ COMPILER::C1SWITCH COMPILER::C1MAPCAN +++ COMPILER::CMP-MACROEXPAND COMPILER::TAG-LABEL +++ COMPILER::TAG-UNWIND-EXIT COMPILER::C1PRINC COMPILER::C1THROW +++ COMPILER::SAVE-AVMA COMPILER::VOLATILE COMPILER::FLAGS-POS +++ COMPILER::INFO-TYPE COMPILER::C1NTHCDR-CONDITION +++ COMPILER::C1MULTIPLE-VALUE-SETQ COMPILER::WT-FUNCALL-C +++ COMPILER::PUSH-ARGS COMPILER::C1DM-BAD-KEY +++ COMPILER::T1ORDINARY COMPILER::C1PSETQ COMPILER::BLK-REF +++ COMPILER::C2DM-RESERVE-VL COMPILER::C1MACROLET +++ COMPILER::C1SHARP-COMMA COMPILER::C1RPLACA +++ COMMON-LISP::PROCLAIM COMPILER::PUSH-DATA-INCF +++ COMPILER::MACRO-DEF-P COMPILER::BLK-NAME COMPILER::C1VALUES +++ COMPILER::C1DOWNWARD-FUNCTION COMPILER::T1DEFMACRO +++ COMPILER::GET-ARG-TYPES COMPILER::ADD-SYMBOL +++ COMPILER::NAME-SD1 COMPILER::C2GO-LOCAL +++ COMPILER::C2TAGBODY-CCB COMPILER::WT-LIST +++ COMPILER::GET-LOCAL-ARG-TYPES COMPILER::C1BOOLE3 +++ COMPILER::C1STACK-LET COMPILER::WT-CDR COMPILER::C1QUOTE +++ COMPILER::C1EVAL-WHEN COMPILER::VAR-P COMPILER::CHECK-DOWNWARD +++ COMPILER::T1PROGN COMPILER::BLK-P COMPILER::C2LOCATION +++ COMPILER::THE-PARAMETER COMPILER::C2VAR-KIND +++ COMPILER::C1GETHASH COMPILER::LTVP-EVAL COMPILER::C1RPLACD +++ COMPILER::INFO-VOLATILE COMPILER::LONG-FLOAT-LOC-P +++ COMPILER::FUNCTION-RETURN-TYPE COMPILER::SHORT-FLOAT-LOC-P +++ COMPILER::WT-H1 COMPILER::C1MULTIPLE-VALUE-CALL +++ COMPILER::NAME-TO-SD COMPILER::C1PROGN COMPILER::SET-RETURN +++ COMPILER::C1LET* COMPILER::AET-C-TYPE COMPILER::C1COMPILER-LET +++ COMPILER::MAXARGS COMPILER::VAR-REF-CCB COMPILER::VV-STR +++ COMPILER::C1NTHCDR COMPILER::TAG-REF COMPILER::GET-INCLUDED)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++- COMMON-LISP::*) ++- (COMMON-LISP::INTEGER -9223372036854775808 ++- 9223372036854775807) ++- (COMMON-LISP::INTEGER -9223372036854775808 ++- 9223372036854775807)) ++- COMMON-LISP::T) ++- COMPILER::DASH-TO-UNDERSCORE-INT)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) +++ COMPILER::INLINE-BOOLE3)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++@@ -29,332 +121,93 @@ ++ COMPILER::TS COMPILER::DASH-TO-UNDERSCORE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++- COMPILER::C1NIL COMPILER::WT-DATA-FILE ++- COMPILER::CLOSE-INLINE-BLOCKS COMPILER::WT-NEXT-VAR-ARG ++- COMPILER::RESET-TOP COMPILER::VS-PUSH COMPILER::BABOON ++- COMPILER::GAZONK-NAME COMPILER::PRINT-COMPILER-INFO ++- COMPILER::ADD-LOAD-TIME-SHARP-COMMA COMPILER::INIT-ENV ++- COMPILER::PRINT-CURRENT-FORM COMPILER::WT-C-PUSH COMPILER::C1T ++- COMPILER::WT-FIRST-VAR-ARG COMPILER::CCB-VS-PUSH ++- COMPILER::INC-INLINE-BLOCKS COMPILER::WT-CVARS ++- COMPILER::WT-FASD-DATA-FILE COMPILER::WFS-ERROR ++- COMPILER::WT-DATA-END COMPILER::TAIL-RECURSION-POSSIBLE ++- COMPILER::CVS-PUSH COMPILER::WT-DATA-BEGIN)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::FIXNUM) ++- COMPILER::ANALYZE-REGS1 COMPILER::ANALYZE-REGS ++- COMPILER::PROCLAIMED-ARGD)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) ++ COMMON-LISP::T) ++- COMPILER::CHECK-FNAME-ARGS COMPILER::COERCE-LOC ++- COMPILER::TYPE>= COMPILER::C2BIND-LOC ++- COMPILER::RESULT-TYPE-FROM-ARGS COMPILER::ADD-DEBUG-INFO ++- COMPILER::MAKE-USER-INIT COMPILER::CO1EQL COMPILER::C2ASSOC!2 ++- COMPILER::WT-VAR COMPILER::CFAST-WRITE COMPILER::C2STACK-LET ++- COMPILER::C2DM-BIND-INIT COMPILER::IS-REP-REFERRED ++- COMPILER::CO1CONS COMPILER::SHIFT<< ++- COMPILER::C2MULTIPLE-VALUE-SETQ COMPILER::C2CALL-LOCAL ++- COMPILER::CO1SCHAR COMPILER::C1CONSTANT-VALUE ++- COMPILER::WT-CHARACTER-VALUE COMPILER::CONVERT-CASE-TO-SWITCH ++- COMPILER::C2MULTIPLE-VALUE-CALL COMPILER::C2EXPR-TOP ++- COMPILER::CO1READ-BYTE COMPILER::PRIN1-CMP ++- COMPILER::STRUCT-TYPE-OPT COMPILER::C1DECL-BODY ++- COMPILER::COERCE-LOC-STRUCTURE-REF ++- COMPILER::CO1STRUCTURE-PREDICATE COMPILER::WT-MAKE-DCLOSURE ++- COMPILER::ARGS-INFO-CHANGED-VARS ++- COMPILER::C2LIST-NTH-IMMEDIATE COMPILER::CO1LDB ++- COMPILER::CO1WRITE-BYTE COMPILER::C1PROGN* ++- COMPILER::CO1CONSTANT-FOLD COMPILER::SET-JUMP-TRUE ++- COMPILER::C1SETQ1 COMPILER::CO1READ-CHAR COMPILER::C2BIND-INIT ++- COMPILER::CO1TYPEP COMPILER::WT-FIXNUM-VALUE ++- COMPILER::MULTIPLE-VALUE-CHECK COMPILER::SHIFT>> ++- COMPILER::CO1SUBLIS COMPILER::DO-MACRO-EXPANSION ++- COMPILER::C2UNWIND-PROTECT COMPILER::C2CALL-LAMBDA ++- COMPILER::C2MEMBER!2 COMPILER::GET-INLINE-LOC ++- COMPILER::C1LAMBDA-FUN COMPILER::JUMPS-TO-P COMPILER::C1EXPR* ++- COMPILER::C2SETQ COMPILER::C2APPLY COMPILER::UNWIND-BDS ++- COMPILER::SET-BDS-BIND COMPILER::NEED-TO-PROTECT ++- COMPILER::C1FMLA COMPILER::TYPE-AND COMPILER::CMPFIX-ARGS ++- COMPILER::MAYBE-EVAL COMPILER::C2BLOCK-CLB COMPILER::SET-DBIND ++- COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY ++- COMPILER::WT-LONG-FLOAT-VALUE COMPILER::C2DM-BIND-VL ++- COMPILER::WT-SHORT-FLOAT-VALUE COMPILER::T3SHARP-COMMA ++- COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES COMPILER::C2CATCH ++- COMPILER::C2EXPR-TOP* COMPILER::SET-JUMP-FALSE ++- COMPILER::CO1VECTOR-PUSH COMPILER::WT-V*-MACROS ++- COMPILER::ARGS-INFO-REFERRED-VARS COMPILER::SET-VS ++- COMPILER::WT-REQUIREDS COMPILER::C2RETURN-CCB ++- COMPILER::C2THROW COMPILER::CHECK-END ++- COMPILER::PUSH-CHANGED-VARS COMPILER::C2BLOCK-CCB ++- SYSTEM::ADD-DEBUG COMPILER::C2PSETQ COMPILER::C1ARGS ++- COMPILER::COMPILER-CC COMPILER::INLINE-PROC ++- COMPILER::CO1WRITE-CHAR COMPILER::COMPILER-DEF-HOOK ++- COMPILER::CAN-BE-REPLACED COMPILER::C2MULTIPLE-VALUE-PROG1 ++- COMPILER::C2DM-BIND-LOC COMPILER::ADD-INFO ++- COMPILER::CO1SPECIAL-FIX-DECL COMPILER::C2LAMBDA-EXPR-WITH-KEY ++- COMPILER::FAST-READ COMPILER::C2RETURN-CLB ++- COMPILER::PROCLAIM-VAR)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::*) ++- COMPILER::COMPILE-FILE1)) +++ COMPILER::C2CALL-UNKNOWN-GLOBAL COMPILER::WT-IF-PROCLAIMED +++ COMPILER::MY-CALL COMPILER::WT-GLOBAL-ENTRY +++ COMPILER::T3DEFUN-NORMAL COMPILER::C2STRUCTURE-REF +++ COMPILER::C2SWITCH COMPILER::C2CALL-GLOBAL +++ COMPILER::T3DEFUN-VARARG COMPILER::C1MAKE-VAR)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++- COMPILER::MAKE-INLINE-STRING COMPILER::GET-INLINE-INFO ++- COMPILER::C1STRUCTURE-REF1 COMPILER::CJF COMPILER::SET-VAR ++- COMPILER::CHECK-FORM-TYPE COMPILER::AND-FORM-TYPE ++- COMPILER::SUBLIS1-INLINE COMPILER::T3DEFCFUN ++- COMPILER::WT-INLINE-INTEGER COMPILER::C-FUNCTION-NAME ++- COMPILER::FIX-DOWN-ARGS COMPILER::ASSIGN-DOWN-VARS ++- COMPILER::WT-INLINE-FIXNUM COMPILER::C2GO COMPILER::CJT ++- COMPILER::TOO-FEW-ARGS COMPILER::C2PRINC COMPILER::C2CASE ++- COMPILER::C2LET* COMPILER::BOOLE3 COMPILER::COMPILER-PASS2 ++- COMPILER::C1DM COMPILER::CHECK-VDECL COMPILER::C2LET ++- COMPILER::MYSUB COMPILER::CAN-BE-REPLACED* ++- COMPILER::ADD-FUNCTION-PROCLAMATION COMPILER::WT-IF-PROCLAIMED ++- COMPILER::C1MAP-FUNCTIONS COMPILER::ADD-FAST-LINK ++- COMPILER::WT-INLINE-LONG-FLOAT COMPILER::TOO-MANY-ARGS ++- COMPILER::C2MULTIPLE-VALUE-BIND COMPILER::C2PROGV ++- COMPILER::WT-INLINE-CHARACTER ++- COMPILER::ADD-FUNCTION-DECLARATION COMPILER::CMP-EXPAND-MACRO ++- COMPILER::C2MAPCAR COMPILER::INLINE-TYPE-MATCHES ++- COMPILER::C2FUNCALL-SFUN COMPILER::WT-MAKE-CCLOSURE ++- COMPILER::C2MAPCAN COMPILER::C2TAGBODY ++- COMPILER::WT-INLINE-COND COMPILER::C2MAPC ++- COMPILER::WT-INLINE-SHORT-FLOAT)) +++ COMPILER::LINK COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL +++ COMPILER::INLINE-ARGS)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- COMPILER::T3LOCAL-FUN COMPILER::T3LOCAL-DCFUN)) +++ COMPILER::WT-INLINE-INTEGER COMPILER::ADD-FUNCTION-DECLARATION +++ COMPILER::C1STRUCTURE-REF1 COMPILER::ADD-FAST-LINK +++ COMPILER::AND-FORM-TYPE COMPILER::C2PRINC COMPILER::C2MAPCAN +++ COMPILER::CJT COMPILER::C2CASE COMPILER::WT-INLINE-LONG-FLOAT +++ COMPILER::SUBLIS1-INLINE COMPILER::MYSUB +++ COMPILER::ADD-FUNCTION-PROCLAMATION COMPILER::FIX-DOWN-ARGS +++ COMPILER::TOO-MANY-ARGS COMPILER::CMP-EXPAND-MACRO +++ COMPILER::C2MULTIPLE-VALUE-BIND COMPILER::C2GO +++ COMPILER::WT-INLINE-FIXNUM COMPILER::WT-INLINE-COND +++ COMPILER::C1MAP-FUNCTIONS COMPILER::C1DM +++ COMPILER::WT-MAKE-CCLOSURE COMPILER::CAN-BE-REPLACED* +++ COMPILER::C-FUNCTION-NAME COMPILER::C2LET* COMPILER::CJF +++ COMPILER::TOO-FEW-ARGS COMPILER::BOOLE3 COMPILER::T3DEFCFUN +++ COMPILER::C2FUNCALL-SFUN COMPILER::C2MAPC +++ COMPILER::CHECK-FORM-TYPE COMPILER::SET-VAR +++ COMPILER::C2TAGBODY COMPILER::CHECK-VDECL +++ COMPILER::GET-INLINE-INFO COMPILER::ASSIGN-DOWN-VARS +++ COMPILER::C2LET COMPILER::INLINE-TYPE-MATCHES +++ COMPILER::COMPILER-PASS2 COMPILER::C2PROGV COMPILER::C2MAPCAR +++ COMPILER::MAKE-INLINE-STRING COMPILER::WT-INLINE-CHARACTER +++ COMPILER::WT-INLINE-SHORT-FLOAT)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- COMPILER::T3DEFMACRO COMPILER::T3DEFENTRY COMPILER::T2DEFENTRY ++- COMPILER::DEFSYSFUN COMPILER::T2DEFMACRO)) +++ COMPILER::T2DEFENTRY COMPILER::DEFSYSFUN COMPILER::T3DEFENTRY)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- COMPILER::T3DEFUN COMPILER::T3DEFUN-LOCAL-ENTRY ++- COMPILER::C2STRUCTURE-SET COMPILER::T2DEFUN +++ COMPILER::T3DEFUN-LOCAL-ENTRY COMPILER::T3INIT-FUN +++ COMPILER::T2DEFUN COMPILER::T3DEFUN COMPILER::C2STRUCTURE-SET ++ COMPILER::C1APPLY-OPTIMIZE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::T) ++- COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL ++- COMPILER::INLINE-ARGS COMPILER::LINK)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T) ++- COMMON-LISP::T) ++- COMPILER::T3INIT-FUN COMPILER::C2STRUCTURE-REF ++- COMPILER::WT-GLOBAL-ENTRY COMPILER::T3DEFUN-NORMAL ++- COMPILER::T3DEFUN-VARARG COMPILER::C1MAKE-VAR ++- COMPILER::C2SWITCH COMPILER::MY-CALL COMPILER::C2CALL-GLOBAL ++- COMPILER::C2CALL-UNKNOWN-GLOBAL)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::T) ++ COMPILER::GET-OUTPUT-PATHNAME COMPILER::WT-SIMPLE-CALL)) ++-(COMMON-LISP::MAPC ++- (COMMON-LISP::LAMBDA (COMPILER::X) ++- (COMMON-LISP::SETF ++- (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) ++- COMMON-LISP::T)) ++- '(COMPILER::CMP-ANON COMMON-LISP::COMPILE COMPILER::CMP-TMP-MACRO ++- COMMON-LISP::DISASSEMBLE)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++- COMPILER::MAKE-VAR COMPILER::COMPILER-COMMAND ++- COMPILER::LIST*-INLINE COMMON-LISP::COMPILE-FILE ++- COMPILER::CS-PUSH COMPILER::MAKE-INFO COMPILER::FCALLN-INLINE ++- COMPILER::C2FSET COMPILER::MAKE-TAG COMPILER::WT-CLINK ++- COMPILER::LIST-INLINE COMPILER::MAKE-FUN COMPILER::MAKE-BLK)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++- COMPILER::T1EVAL-WHEN COMPILER::T1EXPR ++- COMPILER::WT-CHARACTER-LOC COMPILER::SET-LOC ++- COMPILER::CMP-TOPLEVEL-EVAL COMPILER::C2PROGN ++- COMPILER::WT-TO-STRING COMPILER::MEXPAND-DEFTYPE ++- COMPILER::WT-SHORT-FLOAT-LOC COMPILER::CMP-EVAL ++- COMPILER::WT-LOC COMPILER::C2AND COMPILER::C2EXPR ++- COMPILER::WT-LONG-FLOAT-LOC COMPILER::C2OR ++- COMPILER::WT-FIXNUM-LOC)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++- COMPILER::LTVP-EVAL COMPILER::FSET-FN-NAME COMPILER::C1MAPCON ++- COMPILER::FUNCTION-ARG-TYPES COMPILER::C1SHARP-COMMA ++- COMPILER::SAVE-AVMA COMPILER::C2TAGBODY-CCB COMPILER::VAR-LOC ++- COMPILER::WT-DOWN COMPILER::C1SETQ COMPILER::TAG-REF-CCB ++- COMPILER::T1DEFINE-STRUCTURE COMPILER::SAVE-FUNOB ++- COMPILER::C1VAR COMPILER::VV-STR COMPILER::C1RPLACA ++- COMPILER::INFO-SP-CHANGE COMPILER::BLK-REF-CCB ++- COMPILER::T1ORDINARY COMPILER::FIXNUM-LOC-P ++- COMPILER::FUN-REF-CCB COMPILER::C2GET COMPILER::FUN-NAME ++- COMPILER::FUN-P COMPILER::SCH-GLOBAL COMPILER::C1LET ++- COMPILER::C2TAGBODY-CLB COMPILER::C1UNWIND-PROTECT ++- COMPILER::SET-RETURN COMPILER::WT-VAR-DECL ++- COMPILER::VAR-REGISTER COMPILER::C1DEFINE-STRUCTURE ++- COMPILER::LTVP COMPILER::INLINE-POSSIBLE COMPILER::CHECK-VREF ++- COMPILER::TAG-NAME COMPILER::C2DM-RESERVE-VL ++- COMPILER::VAR-TYPE COMPILER::WT-LIST COMPILER::C1LET* ++- COMPILER::VARARG-P COMPILER::C1LOAD-TIME-VALUE ++- COMPILER::C2FUNCALL-AUX COMPILER::INFO-TYPE COMPILER::C1GET ++- COMPILER::C1NTHCDR-CONDITION COMPILER::C1AND ++- COMPILER::C1MULTIPLE-VALUE-CALL COMPILER::C1RPLACA-NTHCDR ++- COMPILER::INFO-VOLATILE COMPILER::INLINE-TYPE ++- COMPILER::LONG-FLOAT-LOC-P COMPILER::INFO-CHANGED-ARRAY ++- SYSTEM::UNDEF-COMPILER-MACRO COMPILER::DECL-BODY-SAFETY ++- COMPILER::TAG-VAR COMPILER::CHARACTER-LOC-P COMPILER::C2BIND ++- COMPILER::C1DECLARE COMPILER::CONS-TO-LISTA ++- COMPILER::C1MULTIPLE-VALUE-SETQ COMPILER::NAME-SD1 ++- COMPILER::BLK-NAME COMPILER::PARSE-CVSPECS COMPILER::C1MAPL ++- COMPILER::AET-C-TYPE COMPILER::C2VAR COMPILER::COPY-INFO ++- COMPILER::C1PSETQ COMPILER::C1VREF COMPILER::FUN-REF ++- COMPILER::WT-H1 COMPILER::T1DEFCFUN COMPILER::T1PROGN ++- COMPILER::C1EVAL-WHEN COMPILER::FLAGS-POS COMPILER::WT-VS ++- COMPILER::C2VAR-KIND COMPILER::C1LENGTH ++- COMPILER::C1MULTIPLE-VALUE-BIND COMPILER::C2LOCATION ++- COMPILER::C2DM-RESERVE-V COMPILER::C2FUNCTION ++- COMPILER::WT-SWITCH-CASE COMPILER::C2TAGBODY-LOCAL ++- COMPILER::CONSTANT-FOLD-P COMPILER::NEED-TO-SET-VS-POINTERS ++- COMPILER::C1MAPCAN COMPILER::WT-FUNCALL-C COMPILER::WT-CCB-VS ++- COMPILER::C1RETURN-FROM COMPILER::GET-INCLUDED ++- COMPILER::C1BLOCK COMPILER::ADD-CONSTANT COMPILER::WT-VS-BASE ++- COMPILER::C1NTH-CONDITION COMPILER::FUN-LEVEL ++- COMPILER::UNWIND-NO-EXIT COMMON-LISP::PROCLAIM ++- COMPILER::C1PRINC COMPILER::C2EXPR* COMPILER::RESULT-TYPE ++- COMPILER::TAG-REF COMPILER::C1FUNCALL COMPILER::C1PROGN ++- COMPILER::MAXARGS COMPILER::UNDEFINED-VARIABLE COMPILER::C1THE ++- COMPILER::CMP-MACROEXPAND COMPILER::C1MAPCAR ++- COMPILER::DEFAULT-INIT COMPILER::C1STRUCTURE-SET ++- COMPILER::WT-SYMBOL-FUNCTION COMPILER::T1DEFUN ++- COMPILER::WT-DATA1 COMPILER::PUSH-DATA-INCF COMPILER::C1IF ++- COMPILER::C1NTHCDR COMPILER::ADD-SYMBOL ++- COMPILER::C1MULTIPLE-VALUE-PROG1 COMPILER::BLK-REF ++- COMPILER::WT-FUNCTION-LINK COMPILER::INFO-P COMPILER::C1FSET ++- COMPILER::C1PROGV COMPILER::C1ASSOC COMPILER::VAR-REF ++- COMPILER::ARGS-CAUSE-SIDE-EFFECT COMPILER::MDELETE-FILE ++- COMPILER::CMP-MACRO-FUNCTION COMPILER::C2DOWNWARD-FUNCTION ++- COMPILER::C2GO-LOCAL COMPILER::T1DEFLA COMPILER::VAR-REF-CCB ++- COMPILER::C1FLET COMPILER::C1LIST-NTH ++- COMPILER::ADD-LOOP-REGISTERS COMPILER::INFO-REFERRED-ARRAY ++- COMPILER::BLK-VALUE-TO-GO COMPILER::WT-VS* ++- COMPILER::NAME-TO-SD COMPILER::C1RPLACD ++- COMPILER::WT-DATA-PACKAGE-OPERATION COMPILER::C1SWITCH ++- COMPILER::C1CATCH COMPILER::WT-CAR COMPILER::C1MACROLET ++- COMPILER::OBJECT-TYPE COMPILER::C1MAPC COMPILER::T1CLINES ++- COMPILER::C1COMPILER-LET COMPILER::CMP-MACROEXPAND-1 ++- COMPILER::C1TAGBODY COMPILER::C1MAPLIST COMPILER::PUSH-ARGS ++- COMPILER::T3ORDINARY COMPILER::C1MEMBER COMPILER::T1MACROLET ++- COMPILER::WT-CDR COMPILER::C1BOOLE3 COMPILER::PROCLAMATION ++- COMPILER::GET-LOCAL-RETURN-TYPE COMPILER::C1LOCAL-FUN ++- COMPILER::VAR-KIND COMPILER::WT1 COMPILER::TAG-SWITCH ++- COMPILER::C1OR COMPILER::C1STRUCTURE-REF ++- COMPILER::THE-PARAMETER COMPILER::VAR-REP-LOC ++- COMPILER::DECLARATION-TYPE COMPILER::TAG-P COMPILER::C2GETHASH ++- COMPILER::C1EXPR COMPILER::REPLACE-CONSTANT COMPILER::C1ECASE ++- COMPILER::FUN-CFUN COMPILER::SET-TOP COMPILER::TAG-LABEL ++- COMPILER::C1DM-BAD-KEY COMPILER::C1THROW COMPILER::C2GO-CCB ++- COMPILER::REP-TYPE COMPILER::C2VALUES ++- COMPILER::SHORT-FLOAT-LOC-P COMPILER::FUNCTION-RETURN-TYPE ++- COMPILER::ADD-OBJECT COMPILER::CTOP-WRITE COMPILER::C1MEMQ ++- COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::C1TERPRI ++- COMPILER::T1DEFMACRO COMPILER::T3CLINES COMPILER::ADD-REG1 ++- COMPILER::C1NTH COMPILER::C1ASH COMPILER::C1FMLA-CONSTANT ++- COMPILER::C2GO-CLB COMPILER::WT-CADR ++- COMPILER::C1BOOLE-CONDITION COMPILER::CLINK COMPILER::VAR-NAME ++- COMPILER::PUSH-ARGS-LISPCALL COMPILER::GET-ARG-TYPES ++- COMPILER::BLK-VAR COMPILER::C1APPLY COMPILER::CHECK-DOWNWARD ++- COMPILER::C1QUOTE COMPILER::TAG-REF-CLB ++- COMPILER::GET-LOCAL-ARG-TYPES COMPILER::REGISTER ++- COMPILER::BLK-P COMPILER::FUN-INFO COMPILER::C2RPLACD ++- COMPILER::ADD-OBJECT2 COMPILER::C2TAGBODY-BODY ++- COMPILER::T1DEFENTRY COMPILER::C1FUNCTION ++- COMPILER::C1DOWNWARD-FUNCTION COMPILER::SAFE-SYSTEM ++- COMPILER::C1GO COMPILER::BLK-EXIT COMPILER::VERIFY-DATA-VECTOR ++- COMPILER::C2RPLACA COMPILER::T2DECLARE COMPILER::MACRO-DEF-P ++- COMPILER::C1LABELS COMPILER::C1GETHASH COMPILER::FIX-OPT ++- COMPILER::SCH-LOCAL-FUN COMPILER::C1FUNOB ++- COMPILER::SET-PUSH-CATCH-FRAME COMPILER::GET-RETURN-TYPE ++- COMPILER::SET-UP-VAR-CVS COMPILER::TAG-UNWIND-EXIT ++- COMPILER::VAR-P COMPILER::C1ADD-GLOBALS COMPILER::TYPE-FILTER ++- COMPILER::WT-VV COMPILER::C1ASH-CONDITION COMPILER::VOLATILE ++- COMPILER::INLINE-BOOLE3-STRING COMPILER::C1LOCAL-CLOSURE ++- COMPILER::WRITE-BLOCK-OPEN COMPILER::ADD-ADDRESS ++- COMPILER::RESET-INFO-TYPE COMPILER::C1VALUES ++- COMPILER::BLK-REF-CLB COMPILER::C1STACK-LET)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++- COMPILER::INLINE-BOOLE3)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T ++- (COMMON-LISP::INTEGER -9223372036854775808 ++- 9223372036854775807)) ++- COMMON-LISP::T) ++- COMPILER::MEMOIZED-HASH-EQUAL)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::*) ++- COMPILER::WT-INLINE-LOC COMPILER::NCONC-FILES ++- COMPILER::COMPILER-BUILD COMPILER::C2BLOCK-LOCAL ++- COMPILER::C2DECL-BODY COMPILER::C1SYMBOL-FUN COMPILER::C2BLOCK ++- COMPILER::C1BODY COMPILER::C2RETURN-LOCAL)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++- COMPILER::C1LAMBDA-EXPR COMPILER::CMPWARN COMPILER::ADD-INIT ++- COMPILER::UNWIND-EXIT COMPILER::CMPNOTE COMPILER::CMPERR ++- COMPILER::C1CASE COMPILER::WT-COMMENT COMPILER::INIT-NAME ++- COMPILER::FAST-LINK-PROCLAIMED-TYPE-P COMPILER::WT-INTEGER-LOC ++- COMPILER::WT-CVAR)) +++ COMPILER::T3LOCAL-DCFUN COMPILER::T3LOCAL-FUN)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++- COMPILER::C2IF COMPILER::WT-INLINE COMPILER::C2COMPILER-LET ++- COMPILER::C2FLET COMPILER::C2LABELS)) +++ COMPILER::C2LABELS COMPILER::C2FLET COMPILER::C2IF +++ COMPILER::WT-INLINE COMPILER::C2COMPILER-LET)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::*) ++- COMPILER::C2RETURN-FROM COMPILER::C2APPLY-OPTIMIZE ++- COMPILER::C2DM COMPILER::C1DM-V COMPILER::C1DM-VL)) +++ COMPILER::C2RETURN-FROM COMPILER::C2DM COMPILER::C1DM-VL +++ COMPILER::C2APPLY-OPTIMIZE COMPILER::C1DM-V)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++@@ -363,6 +216,36 @@ ++ COMPILER::T3DEFUN-AUX)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) +++ COMPILER::C2PROGN COMPILER::WT-LONG-FLOAT-LOC +++ COMPILER::WT-CHARACTER-LOC COMPILER::WT-TO-STRING +++ COMPILER::WT-LOC COMPILER::MEXPAND-DEFTYPE +++ COMPILER::CMP-TOPLEVEL-EVAL COMPILER::T1EVAL-WHEN +++ COMPILER::T1EXPR COMPILER::C2OR COMPILER::WT-FIXNUM-LOC +++ COMPILER::C2EXPR COMPILER::C2AND COMPILER::CMP-EVAL +++ COMPILER::SET-LOC COMPILER::WT-SHORT-FLOAT-LOC)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +++ COMPILER::MAKE-INFO COMPILER::FCALLN-INLINE +++ COMPILER::LIST-INLINE COMPILER::LIST*-INLINE +++ COMPILER::COMPILER-COMMAND COMPILER::MAKE-BLK +++ COMPILER::MAKE-FUN COMPILER::WT-CLINK COMPILER::C2FSET +++ COMPILER::MAKE-TAG COMPILER::CS-PUSH COMPILER::MAKE-VAR +++ COMMON-LISP::COMPILE-FILE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) +++ COMPILER::F-TYPE)) +++(COMMON-LISP::MAPC +++ (COMMON-LISP::LAMBDA (COMPILER::X) +++ (COMMON-LISP::SETF +++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) +++ COMMON-LISP::T)) +++ '(COMMON-LISP::DISASSEMBLE COMPILER::CMP-TMP-MACRO +++ COMPILER::CMP-ANON COMMON-LISP::COMPILE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*))) ++ COMMON-LISP::T) ++@@ -374,11 +257,9 @@ ++ (COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*)) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++- (COMMON-LISP::INTEGER -9223372036854775808 ++- 9223372036854775807) ++ COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++- COMPILER::BSEARCHLEQ)) +++ COMPILER::PUSH-ARRAY)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++@@ -386,10 +267,148 @@ ++ (COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*)) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807) ++ COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++- COMPILER::PUSH-ARRAY)) +++ COMPILER::BSEARCHLEQ)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++- COMPILER::F-TYPE)) ++\ No newline at end of file +++ (COMMON-LISP::FUNCTION +++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER +++ COMMON-LISP::*) +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807) +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807)) +++ COMMON-LISP::T) +++ COMPILER::DASH-TO-UNDERSCORE-INT)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ ((COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807) +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807)) +++ COMMON-LISP::T) +++ COMPILER::MLIN)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807)) +++ COMMON-LISP::T) +++ COMPILER::MEMOIZED-HASH-EQUAL)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +++ COMPILER::MACRO-ENV COMPILER::C1T COMPILER::PRINT-CURRENT-FORM +++ COMPILER::CCB-VS-PUSH COMPILER::C1NIL +++ COMPILER::WT-FASD-DATA-FILE COMPILER::INIT-ENV +++ COMPILER::WT-CVARS COMPILER::CVS-PUSH +++ COMPILER::WT-FIRST-VAR-ARG COMPILER::WT-NEXT-VAR-ARG +++ COMPILER::WT-DATA-FILE COMPILER::WT-C-PUSH +++ COMPILER::GAZONK-NAME COMPILER::WT-DATA-END +++ COMPILER::INC-INLINE-BLOCKS COMPILER::TAIL-RECURSION-POSSIBLE +++ COMPILER::RESET-TOP COMPILER::CLOSE-INLINE-BLOCKS +++ COMPILER::PRINT-COMPILER-INFO COMPILER::WFS-ERROR +++ COMPILER::VS-PUSH COMPILER::BABOON COMPILER::WT-DATA-BEGIN +++ COMPILER::ADD-LOAD-TIME-SHARP-COMMA)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::FIXNUM) +++ COMPILER::PROCLAIMED-ARGD COMPILER::ANALYZE-REGS1 +++ COMPILER::ANALYZE-REGS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ COMPILER::UNWIND-EXIT COMPILER::WT-COMMENT COMPILER::CMPERR +++ COMPILER::WT-CVAR COMPILER::FAST-LINK-PROCLAIMED-TYPE-P +++ COMPILER::C1CASE COMPILER::CMPWARN COMPILER::ADD-INIT +++ COMPILER::INIT-NAME COMPILER::WT-INTEGER-LOC COMPILER::CMPNOTE +++ COMPILER::C1LAMBDA-EXPR)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ COMPILER::C2BLOCK COMPILER::C1SYMBOL-FUN +++ COMPILER::C2BLOCK-LOCAL COMPILER::C2DECL-BODY +++ COMPILER::COMPILER-BUILD COMPILER::NCONC-FILES +++ COMPILER::WT-INLINE-LOC COMPILER::C2RETURN-LOCAL +++ COMPILER::C1BODY)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ COMPILER::WT-FIXNUM-VALUE COMPILER::DOLIST** COMPILER::CO1LDB +++ COMPILER::PUSH-REFERRED-WITH-START COMPILER::C2ASSOC!2 +++ COMPILER::ADD-DEBUG-INFO COMPILER::WT-CHARACTER-VALUE +++ COMPILER::MAYBE-WT-C2DM-BIND-VL COMPILER::C2BIND-LOC +++ COMPILER::C2CATCH COMPILER::DO-REFERRED COMPILER::C2BLOCK-CLB +++ COMPILER::CO1CONSTANT-FOLD COMPILER::C2CALL-LOCAL +++ COMPILER::SHIFT<< COMPILER::C2UNWIND-PROTECT +++ COMPILER::C2MULTIPLE-VALUE-SETQ COMPILER::C2DM-BIND-VL +++ COMPILER::DOTIMES* COMPILER::REFERRED-LENGTH COMPILER::C1ARGS +++ COMPILER::CK-SPEC COMPILER::C2MULTIPLE-VALUE-CALL +++ COMPILER::C2CALL-LAMBDA COMPILER::CO1READ-BYTE +++ COMPILER::CO1VECTOR-PUSH COMPILER::STACK-LET COMPILER::CMPCK +++ COMPILER::MAYBE-EVAL COMPILER::COERCE-LOC COMPILER::C2PSETQ +++ SYSTEM::DEFINE-INLINE-FUNCTION COMPILER::WT-MAKE-DCLOSURE +++ COMPILER::COMPILER-CC COMPILER::WT-GO COMPILER::C1LAMBDA-FUN +++ COMPILER::C2RETURN-CLB COMPILER::C1DECL-BODY +++ COMPILER::PUSH-CHANGED-VARS COMPILER::GET-INLINE-LOC +++ COMPILER::CO1SUBLIS COMPILER::CHANGED-LENGTH COMPILER::CO1CONS +++ COMPILER::ARGS-INFO-REFERRED-VARS COMPILER::SET-JUMP-FALSE +++ COMPILER::MAKE-USER-INIT COMPILER::NEXT-CVAR +++ COMPILER::CAN-BE-REPLACED COMPILER::WT-V*-MACROS +++ COMPILER::NEXT-CMACRO COMPILER::C2RETURN-CCB +++ COMPILER::CO1SCHAR COMPILER::IS-CHANGED +++ COMMON-LISP::DEFINE-COMPILER-MACRO COMPILER::SET-DBIND +++ COMPILER::WT-H COMPILER::COERCE-LOC-STRUCTURE-REF +++ COMPILER::C1EXPR* COMPILER::IS-REFERRED COMPILER::SHIFT>> +++ COMPILER::WT COMPILER::TYPE-AND COMPILER::PRIN1-CMP +++ COMPILER::C2BIND-INIT COMPILER::RESULT-TYPE-FROM-ARGS +++ COMPILER::EQL-NOT-NIL COMPILER::C2APPLY COMPILER::C2BLOCK-CCB +++ COMPILER::WT-NL1 COMPILER::CO1WRITE-CHAR COMPILER::CFAST-WRITE +++ COMPILER::NEED-TO-PROTECT COMPILER::T3SHARP-COMMA +++ SYSTEM::ADD-DEBUG COMPILER::BIGNUM-EXPANSION-STORAGE +++ COMPILER::C2SETQ COMPILER::FLAG-P +++ COMPILER::PUSH-CHANGED-WITH-START COMPILER::CMPFIX-ARGS +++ COMPILER::CO1STRUCTURE-PREDICATE COMPILER::FAST-READ +++ COMPILER::C1CONSTANT-VALUE COMPILER::BASE-USED +++ COMPILER::PROCLAIM-VAR COMPILER::CO1TYPEP +++ COMPILER::SET-JUMP-TRUE COMPILER::TYPE>= COMPILER::DOTIMES** +++ COMPILER::CONVERT-CASE-TO-SWITCH COMPILER::C2MEMBER!2 +++ COMPILER::DO-CHANGED COMPILER::ADD-INFO COMPILER::SET-VS +++ COMPILER::CHECK-FNAME-ARGS +++ COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES +++ COMPILER::C2MULTIPLE-VALUE-PROG1 COMPILER::NEXT-LABEL* +++ COMPILER::WT-VAR COMPILER::C2THROW COMPILER::INLINE-PROC +++ COMPILER::PUSH-REFERRED COMPILER::C2LIST-NTH-IMMEDIATE +++ COMPILER::C1FMLA COMPILER::PUSH-CHANGED +++ COMPILER::MULTIPLE-VALUE-CHECK COMPILER::MIA +++ COMPILER::WT-LABEL COMPILER::WT-NL +++ COMPILER::WT-SHORT-FLOAT-VALUE COMPILER::SET-BDS-BIND +++ COMPILER::DO-ARRAY COMPILER::WT-REQUIREDS +++ COMPILER::C2EXPR-TOP* COMPILER::C2DM-BIND-LOC +++ COMPILER::DOLIST* SYSTEM::SWITCH-FINISH +++ COMPILER::IS-REP-REFERRED COMPILER::WT-LONG-FLOAT-VALUE +++ COMPILER::C1SETQ1 COMPILER::FLAGS COMPILER::CO1EQL +++ COMPILER::CHECK-END COMPILER::NEXT-LABEL COMPILER::CK-VL +++ COMPILER::ARGS-INFO-CHANGED-VARS COMPILER::C1PROGN* +++ COMPILER::C2DM-BIND-INIT COMPILER::STRUCT-TYPE-OPT +++ COMPILER::UNWIND-BDS COMPILER::SAFE-COMPILE +++ COMPILER::CO1READ-CHAR COMPILER::JUMPS-TO-P SYSTEM::SWITCH +++ COMPILER::NEXT-CFUN COMPILER::CO1WRITE-BYTE +++ COMPILER::DOWNWARD-FUNCTION COMPILER::COMPILER-DEF-HOOK +++ COMPILER::C2STACK-LET COMPILER::C2EXPR-TOP +++ COMPILER::C2LAMBDA-EXPR-WITH-KEY COMPILER::IN-ARRAY +++ COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ COMPILER::COMPILE-FILE1)) ++\ No newline at end of file ++--- gcl-2.6.12.orig/config.sub +++++ gcl-2.6.12/config.sub ++@@ -1,8 +1,8 @@ ++ #! /bin/sh ++ # Configuration validation subroutine script. ++-# Copyright 1992-2014 Free Software Foundation, Inc. +++# Copyright 1992-2015 Free Software Foundation, Inc. ++ ++-timestamp='2014-05-01' +++timestamp='2015-08-20' ++ ++ # This file is free software; you can redistribute it and/or modify it ++ # under the terms of the GNU General Public License as published by ++@@ -25,7 +25,7 @@ timestamp='2014-05-01' ++ # of the GNU General Public License, version 3 ("GPLv3"). ++ ++ ++-# Please send patches with a ChangeLog entry to config-patches@gnu.org. +++# Please send patches to . ++ # ++ # Configuration subroutine to validate and canonicalize a configuration type. ++ # Supply the specified configuration type as an argument. ++@@ -68,7 +68,7 @@ Report bugs and patches to >32)-1; ++ a&=MASK(32); ++- store_val(where,MASK(16),((void *)gote-(void *)got)); ++ if (s>=ggot && sr_addend=((void *)gote-(void *)got)-s; +++ switch(tp) { +++ case R_MIPS_GOT_HI16: +++ case R_MIPS_CALL_HI16: +++ r->r_info=((ul)R_MIPS_HI16<<56)|(r->r_info&MASK(32)); +++ relocate(sym1,r,((Rela *)r)->r_addend,start,got,gote); +++ break; +++ case R_MIPS_GOT_LO16: +++ case R_MIPS_CALL_LO16: +++ r->r_info=((ul)R_MIPS_LO16<<56)|(r->r_info&MASK(32)); +++ relocate(sym1,r,((Rela *)r)->r_addend,start,got,gote); +++ break; +++ default: +++ store_val(where,MASK(16),((void *)gote-(void *)got)); +++ break; +++ } ++ break; ++ case R_MIPS_GOT_OFST: ++ recurse(s+a); ++--- gcl-2.6.12.orig/h/elf64_mips_reloc_special.h +++++ gcl-2.6.12/h/elf64_mips_reloc_special.h ++@@ -108,6 +108,10 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++ if (ELF_R_TYPE(r->r_info)==R_MIPS_CALL16|| ++ ELF_R_TYPE(r->r_info)==R_MIPS_GOT_DISP|| +++ ELF_R_TYPE(r->r_info)==R_MIPS_GOT_HI16|| +++ ELF_R_TYPE(r->r_info)==R_MIPS_GOT_LO16|| +++ ELF_R_TYPE(r->r_info)==R_MIPS_CALL_HI16|| +++ ELF_R_TYPE(r->r_info)==R_MIPS_CALL_LO16|| ++ ELF_R_TYPE(r->r_info)==R_MIPS_GOT_PAGE) { ++ ++ sym=sym1+ELF_R_SYM(r->r_info); ++--- gcl-2.6.12.orig/h/lu.h +++++ gcl-2.6.12/h/lu.h ++@@ -143,7 +143,7 @@ struct hashtable { ++ int ht_size; ++ short ht_test; ++ short ht_static; ++- SPAD; +++ struct htent *ht_cache; ++ ++ }; ++ ++@@ -290,6 +290,8 @@ struct random { ++ struct readtable { ++ FIRSTWORD; ++ struct rtent *rt_self; +++ object rt_case; +++ SPAD; ++ }; ++ ++ struct pathname { ++--- gcl-2.6.12.orig/h/notcomp.h +++++ gcl-2.6.12/h/notcomp.h ++@@ -373,3 +373,4 @@ typedef struct {void *a,*b,*c,*d;} gmp_r ++ EXTER gmp_randfnptr_t Mersenne_Twister_Generator_Noseed; ++ #endif ++ +++#define collect(p_,f_) (p_)=&(*(p_)=(f_))->c.c_cdr ++--- gcl-2.6.12.orig/h/object.h +++++ gcl-2.6.12/h/object.h ++@@ -249,6 +249,9 @@ struct freelist { ++ #define FL_LINK F_LINK ++ #define SET_LINK(x,val) F_LINK(x) = (address_int) (val) ++ #define OBJ_LINK(x) ((object) INT_TO_ADDRESS(F_LINK(x))) +++#define PHANTOM_FREELIST(x) ({struct freelist f;(object)((void *)&x+((void *)&f-(void *)&f.f_link));}) +++#define FREELIST_TAIL(tm_) ({struct typemanager *_tm=tm_;\ +++ _tm->tm_free==OBJNULL ? PHANTOM_FREELIST(_tm->tm_free) : _tm->tm_tail;}) ++ ++ #define FREE (-1) /* free object */ ++ ++@@ -261,6 +264,8 @@ struct typemanager { ++ long tm_nppage; /* number per page */ ++ object tm_free; /* free list */ ++ /* Note that it is of type object. */ +++ object tm_tail; /* free list tail */ +++ /* Note that it is of type object. */ ++ long tm_nfree; /* number of free elements */ ++ long tm_npage; /* number of pages */ ++ long tm_maxpage; /* maximum number of pages */ ++@@ -562,6 +567,9 @@ EXTER unsigned plong signals_allowed, si ++ /* #define equal(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (!IMMNIL(_a)&&!IMMNIL(_b)&&equal1(_a,_b));}) */ ++ /* #define equalp(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (_a!=Cnil&&_b!=Cnil&&equalp1(_a,_b));}) */ ++ ++-#define eql(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b ? TRUE : (IMMNIL(_a)||IMMNIL(_b) ? FALSE : eql1(_a,_b));}) +++#define eql_is_eq(a_) (is_imm_fixnum(a_)||valid_cdr(a_)||(a_->d.t>t_complex)) +++ +++#define eql(a_,b_) ({register object _a=(a_);register object _b=(b_);\ +++ _a==_b ? TRUE : (eql_is_eq(_a)||eql_is_eq(_b)||_a->d.t!=_b->d.t ? FALSE : eql1(_a,_b));}) ++ #define equal(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b ? TRUE : (IMMNIL(_a)||IMMNIL(_b) ? FALSE : equal1(_a,_b));}) ++ #define equalp(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b ? TRUE : (_a==Cnil||_b==Cnil ? FALSE : equalp1(_a,_b));}) ++--- gcl-2.6.12.orig/h/protoize.h +++++ gcl-2.6.12/h/protoize.h ++@@ -1961,3 +1961,6 @@ do_gcl_abort(void); ++ ++ int ++ vsystem(const char *); +++ +++object +++n_cons_from_x(fixnum,object); ++--- gcl-2.6.12.orig/h/type.h +++++ gcl-2.6.12/h/type.h ++@@ -134,7 +134,7 @@ enum smmode { /* stream mode */ ++ #define fixnump(a_) SPP(a_,fixnum) ++ #define readtablep(a_) SPP(a_,readtable) ++ #define functionp(a_) ({enum type _t=type_of(a_);_t>=t_cfun && _t<=t_closure;}) ++-#define compiled_functionp(a_) functionp(a_) +++#define compiled_function_p(a_) functionp(a_) ++ ++ #define integerp(a_) ({enum type _tp=type_of(a_); _tp >= t_fixnum && _tp <= t_bignum;}) ++ #define non_negative_integerp(a_) ({enum type _tp=type_of(a_); (_tp == t_fixnum && fix(a_)>=0) || (_tp==t_bignum && big_sign(a_)>=0);}) ++--- gcl-2.6.12.orig/lsp/gcl_arraylib.lsp +++++ gcl-2.6.12/lsp/gcl_arraylib.lsp ++@@ -27,14 +27,14 @@ ++ (proclaim '(optimize (safety 2) (space 3))) ++ ++ (defvar *baet-hash* (make-hash-table :test 'equal)) ++-(defun best-array-element-type (type) ++- (or (gethash type *baet-hash*) ++- (setf (gethash type *baet-hash*) ++- (if type ++- (car (member type '(character bit signed-char unsigned-char signed-short unsigned-short ++- fixnum short-float long-float t) ++- :test 'subtypep)) t))))) ++- +++(defun best-array-element-type (type &aux +++ (tps '(character bit signed-char unsigned-char signed-short unsigned-short +++ fixnum short-float long-float t))) +++ (if type +++ (or (car (member type tps)) +++ (gethash type *baet-hash*) +++ (setf (gethash type *baet-hash*) (car (member type tps :test 'subtypep)))) t)) +++ ++ (defun upgraded-array-element-type (type &optional environment) ++ (declare (ignore environment)) ++ (best-array-element-type type)) ++--- gcl-2.6.12.orig/lsp/gcl_autoload.lsp +++++ gcl-2.6.12/lsp/gcl_autoload.lsp ++@@ -267,7 +267,7 @@ ++ (push (list (nth nfree *type-list*) typename) ++ link-alist)))))) ++ (terpri) ++- (dolist (info (reverse info-list)) +++ (dolist (info (nreverse info-list)) ++ (apply #'format t "~8D/~D~19T~6,1F%~@[~8D~]~35T~{~A~^ ~}" ++ (append (cdr info) ++ (if (assoc (car info) link-alist) ++--- gcl-2.6.12.orig/lsp/gcl_debug.lsp +++++ gcl-2.6.12/lsp/gcl_debug.lsp ++@@ -167,7 +167,7 @@ ++ ,@ (do ((v (cdr lis) (cdr v)) ++ (i 0 (1+ i)) ++ (res)) ++- ((null v)(reverse res)) +++ ((null v)(nreverse res)) ++ (push `(setf ,(car v) (mv-ref ,i)) res)))) ++ ++ (defmacro mv-values (&rest lis) ++@@ -175,7 +175,7 @@ ++ ,@ (do ((v (cdr lis) (cdr v)) ++ (i 0 (1+ i)) ++ (res)) ++- ((null v)(reverse res)) +++ ((null v)(nreverse res)) ++ (push `(set-mv ,i ,(car v)) res)))) ++ ++ ;;start a lisp debugger loop. Exit it by using :step ++--- gcl-2.6.12.orig/lsp/gcl_defmacro.lsp +++++ gcl-2.6.12/lsp/gcl_defmacro.lsp ++@@ -103,7 +103,7 @@ ++ (push `(unless (endp ,(dm-nth-cdr (cdr ac) (car ac))) ++ (dm-too-many-arguments)) body)) ++ (unless envp (push `(declare (ignore ,env)) body)) ++- (list doc ppn `(lambda-block ,name ,(reverse *dl*) ,@(append decls body))) +++ (list doc ppn `(lambda-block ,name ,(nreverse *dl*) ,@(append decls body))) ++ ) ++ ++ (defun dm-vl (vl whole top) ++--- gcl-2.6.12.orig/lsp/gcl_directory.lsp +++++ gcl-2.6.12/lsp/gcl_directory.lsp ++@@ -41,7 +41,7 @@ ++ (l (length yy)) ++ (y (link-expand (vector-push-string yy s) l)) ++ (y (if (eq y yy) y (make-frame y)))) ++- (when (or (eq (stat z) :directory) (zerop (length z))) +++ (when (or (eq (stat1 z) :directory) (zerop (length z))) ++ (cond ((eq (car x) :wild-inferiors) (recurse-dir z y f)) ++ (x (walk-dir z y (lambda (q e l) ++ (declare (ignore l)) ++--- gcl-2.6.12.orig/lsp/gcl_evalmacros.lsp +++++ gcl-2.6.12/lsp/gcl_evalmacros.lsp ++@@ -23,178 +23,146 @@ ++ (in-package :si) ++ ++ ++-(eval-when (compile) (proclaim '(optimize (safety 2) (space 3)))) +++;(eval-when (compile) (proclaim '(optimize (safety 2) (space 3)))) ++ ;(eval-when (eval compile) (defun si:clear-compiler-properties (symbol))) ++-(eval-when (eval compile) (setq si:*inhibit-macro-special* nil)) ++- ++-(defmacro sgen (&optional (pref "G")) ++- `(load-time-value (gensym ,pref))) +++(eval-when (eval compile) +++ (setq si:*inhibit-macro-special* nil) +++ (defmacro ?cons (f x &aux (s (sgen "?CONS"))) `(let ((,s ,x)) (if (cdr ,s) (cons ,f ,s) (car ,s)))) +++ (defmacro ?list (x &aux (s (sgen "?LIST"))) `(let ((,s ,x)) (when ,s (list ,s)))) +++ (defmacro collect (v r rp np &aux (s (sgen "COLLECT"))) +++ `(let ((,s ,v)) (setf rp (if rp (rplacd rp (list ,s)) (setq r ,s)) rp np))) +++ (defmacro ?let (k kf r) `(let ((r ,r)) (if (eq ,k ,kf) r `(let ((,,k ,,kf)) (declare (ignorable ,,k)) ,r)))) +++ (defmacro ?key (x &aux (s (sgen "?KEY"))) `(if (or (constantp ,x) (symbolp ,x)) ,x ',s))) ++ +++(defmacro sgen (&optional (pref "G")) `(load-time-value (gensym ,pref))) ++ ++ (defmacro defvar (var &optional (form nil form-sp) doc-string) ++- `(progn (si:*make-special ',var) ++- ,(if doc-string ++- `(si:putprop ',var ,doc-string 'variable-documentation)) ++- ,(if form-sp ++- `(or (boundp ',var) ++- (setq ,var ,form))) ++- ',var) ++- ) +++ (declare (optimize (safety 1))) +++ `(progn (*make-special ',var) +++ ,@(when doc-string `((putprop ',var ,doc-string 'variable-documentation))) +++ ,@(when form-sp `((unless (boundp ',var) (setq ,var ,form)))) +++ ',var)) ++ ++ (defmacro defparameter (var form &optional doc-string) ++- (if doc-string ++- `(progn (si:*make-special ',var) ++- (si:putprop ',var ,doc-string 'variable-documentation) ++- (setq ,var ,form) ++- ',var) ++- `(progn (si:*make-special ',var) ++- (setq ,var ,form) ++- ',var))) +++ (declare (optimize (safety 1))) +++ `(progn (*make-special ',var) +++ ,@(when doc-string `((putprop ',var ,doc-string 'variable-documentation))) +++ (setq ,var ,form) +++ ',var)) ++ ++ (defmacro defconstant (var form &optional doc-string) ++- (if doc-string ++- `(progn (si:*make-constant ',var ,form) ++- (si:putprop ',var ,doc-string 'variable-documentation) ++- ',var) ++- `(progn (si:*make-constant ',var ,form) ++- ',var))) +++ (declare (optimize (safety 1))) +++ `(progn (*make-constant ',var ,form) +++ ,@(when doc-string `((putprop ',var ,doc-string 'variable-documentation))) +++ ',var)) ++ ++ ++ ;;; Each of the following macros is also defined as a special form. ++ ;;; Thus their names need not be exported. ++ ++-(defmacro and (&rest forms) ++- (if (endp forms) ++- t ++- (let ((x (reverse forms))) ++- (do ((forms (cdr x) (cdr forms)) ++- (form (car x) `(if ,(car forms) ,form))) ++- ((endp forms) form)))) ++- ) ++- ++-(defmacro or (&rest forms) ++- (if (endp forms) ++- nil ++- (let ((x (reverse forms))) ++- (do ((forms (cdr x) (cdr forms)) ++- (form (car x) ++- (let ((temp (gensym))) ++- `(let ((,temp ,(car forms))) ++- (if ,temp ,temp ,form))))) ++- ((endp forms) form)))) ++- ) ++- ++-(defun parse-body-header (x &optional doc decl ctps &aux (a (car x))) ++- (cond ++- ((unless (or doc ctps) (and (stringp a) (cdr x))) (parse-body-header (cdr x) a decl ctps)) ++- ((unless ctps (when (consp a) (eq (car a) 'declare))) (parse-body-header (cdr x) doc (cons a decl) ctps)) ++- ((when (consp a) (eq (car a) 'check-type)) (parse-body-header (cdr x) doc decl (cons a ctps))) ++- (t (values doc (nreverse decl) (nreverse ctps) x)))) +++(defmacro and (&rest forms &aux r rp np) +++ (declare (optimize (safety 1))) +++ (do ((y forms))((endp y) (if forms r t)) +++ (let ((x (pop y))) +++ (if (constantp x) (unless (if (eval x) y) (collect x r rp np) (setq y nil)) +++ (if y (collect `(if ,@(setq np (list x))) r rp np) +++ (collect x r rp np)))))) +++ +++(defmacro or (&rest forms &aux r rp np (s (sgen "OR"))) +++ (declare (optimize (safety 1))) +++ (do ((y forms))((endp y) r) +++ (let ((x (pop y))) +++ (if (constantp x) (when (eval x) (collect x r rp np) (setq y nil)) +++ (if (symbolp x) (collect `(if ,x ,@(setq np (list x))) r rp np) +++ (if y (collect `(let ((,s ,x)) (if ,s ,@(setq np (list s)))) r rp np) +++ (collect x r rp np))))))) +++ +++(defun parse-body-header (x) +++ (let* ((doc x)(x (or (when (stringp (car x)) (cdr x)) x)) +++ (dec x)(x (member-if-not (lambda (x) (when (consp x) (eq (car x) 'declare))) x)) +++ (ctp x)(x (member-if-not (lambda (x) (when (consp x) (eq (car x) 'check-type))) x))) +++ (values (car (ldiff doc dec)) (ldiff dec ctp) (ldiff ctp x) x))) ++ ++ (defmacro locally (&rest body) ++ (multiple-value-bind ++- (doc decls ctps body) +++ (doc dec) ++ (parse-body-header body) +++ (declare (ignore doc)) ++ `(let (,@(mapcan (lambda (x &aux (z (pop x))(z (if (eq z 'type) (pop x) z))) ++ (case z ++ ((ftype inline notinline optimize) nil) ++ (otherwise (mapcar (lambda (x) (list x x)) x)))) ++- (apply 'append (mapcar 'cdr decls)))) ++- ,@(when doc (list doc)) ++- ,@decls ++- ,@ctps +++ (apply 'append (mapcar 'cdr dec)))) ++ ,@body))) ++ ++-(defmacro loop (&rest body &aux (tag (gensym))) ++- `(block nil (tagbody ,tag (progn ,@body) (go ,tag)))) +++(defmacro loop (&rest body &aux (tag (sgen "LOOP"))) +++ `(block nil (tagbody ,tag ,(?cons 'progn body) (go ,tag)))) ++ ++-(import 'while 'user) ++ (defmacro while (test &rest forms) ++- `(loop (unless ,test (return)) ,@forms) ) +++ `(loop (unless ,test (return)) ,@forms)) ++ ++ (defmacro defmacro (name vl &rest body) ++ `(si:define-macro ',name (si:defmacro* ',name ',vl ',body))) ++ ++ (defmacro defun (name lambda-list &rest body) ++- (multiple-value-bind (doc decl body) ++- (find-doc body nil) ++- (if doc ++- `(progn (setf (get ',name 'si:function-documentation) ,doc) ++- (setf (symbol-function ',name) ++- #'(lambda ,lambda-list ++- ,@decl (block ,name ,@body))) ++- ',name) ++- `(progn (setf (symbol-function ',name) ++- #'(lambda ,lambda-list ++- ,@decl (block ,name ,@body))) ++- ',name)))) +++ (multiple-value-bind +++ (doc dec ctp body) +++ (parse-body-header body) +++ `(progn ,@(when doc `((setf (get ',name 'function-documentation) ,doc))) +++ (setf (symbol-function ',name) (lambda ,lambda-list ,@dec ,@ctp (block ,name ,@body))) +++ ',name))) ++ ++ ; assignment ++ ++ (defmacro psetq (&rest args) ++- (do ((l args (cddr l)) ++- (forms nil) ++- (bindings nil)) ++- ((endp l) (list* 'let* (nreverse bindings) (nreverse (cons nil forms)))) ++- (declare (object l)) ++- (let ((sym (gensym))) ++- (push (list sym (cadr l)) bindings) ++- (push (list 'setq (car l) sym) forms))) ++- ) +++ (declare (optimize (safety 1))) +++ (assert (evenp (length args))) +++ (let ((x (let ((i 0)) (mapcon (lambda (x) (when (oddp (incf i)) `((,(cadr x) ,(car x) ,(gensym))))) args)))) +++ (when x +++ `(let* ,(mapcar (lambda (x) `(,(caddr x) ,(car x))) x) +++ (setq ,@(mapcan 'cdr x)) +++ nil)))) ++ ++ ; conditionals +++(defmacro cond (&rest clauses &aux r rp np (s (sgen "COND"))) +++ (declare (optimize (safety 1))) +++ (do ((y clauses))((endp y) r) +++ (let* ((x (pop y))(z (pop x))) +++ (if (constantp z) (when (eval z) (collect (if x (?cons 'progn x) z) r rp np) (setq y nil)) +++ (if x (collect `(if ,z ,@(setq np (list (?cons 'progn x)))) r rp np) +++ (if (symbolp z) (collect `(if ,z ,@(setq np (list z))) r rp np) +++ (if y (collect `(let ((,s ,z)) (if ,s ,@(setq np (list s)))) r rp np) +++ (collect `(values ,z) r rp np)))))))) +++ +++(defmacro when (pred &rest body &aux (x (?cons 'progn body))) +++ (declare (optimize (safety 1))) +++ (if (constantp pred) (if (eval pred) x) `(if ,pred ,x))) +++ +++(defmacro unless (pred &rest body &aux (x (?cons 'progn body))) +++ (declare (optimize (safety 1))) +++ (if (constantp pred) (if (not (eval pred)) x) `(if (not ,pred) ,x))) ++ ++-(defmacro cond (&rest clauses &aux (form nil)) ++- (let ((x (reverse clauses))) ++- (dolist (l x form) ++- (cond ((endp (cdr l)) ++- (if (or (constantp (car l)) (eq l (car x))) ++- (setq form (car l)) ++- (let ((sym (gensym))) ++- (setq form `(let ((,sym ,(car l))) (if ,sym ,sym ,form)))))) ++- ((and (constantp (car l)) (car l)) ++- (setq form (if (endp (cddr l)) (cadr l) `(progn ,@(cdr l))))) ++- ((setq form (if (endp (cddr l)) ++- `(if ,(car l) ,(cadr l) ,form) ++- `(if ,(car l) (progn ,@(cdr l)) ,form)))))))) ++- ++- ++-(defmacro when (pred &rest body) ++- `(if ,pred (progn ,@body))) +++; program feature ++ ++-(defmacro unless (pred &rest body) ++- `(if (not ,pred) (progn ,@body))) +++(defun prog?* (let?* vl body) +++ (multiple-value-bind +++ (doc dec ctp body) +++ (parse-body-header body) +++ (declare (ignore doc)) +++ `(block nil (,let?* ,vl ,@dec (tagbody ,@(append ctp body)))))) ++ ++-; program feature +++(defmacro prog (vl &rest body) +++ (prog?* 'let vl body)) ++ ++-(defmacro prog (vl &rest body &aux (decl nil)) ++- (do () ++- ((or (endp body) ++- (not (consp (car body))) ++- (not (eq (caar body) 'declare))) ++- `(block nil (let ,vl ,@decl (tagbody ,@body))) ++- ) ++- (push (car body) decl) ++- (pop body)) ++- ) ++- ++-(defmacro prog* (vl &rest body &aux (decl nil)) ++- (do () ++- ((or (endp body) ++- (not (consp (car body))) ++- (not (eq (caar body) 'declare))) ++- `(block nil (let* ,vl ,@decl (tagbody ,@body))) ++- ) ++- (push (car body) decl) ++- (pop body)) ++- ) +++(defmacro prog* (vl &rest body) +++ (prog?* 'let* vl body)) ++ ++ ; sequencing ++ ++-(defmacro prog1 (first &rest body &aux (sym (gensym))) +++(defmacro prog1 (first &rest body &aux (sym (sgen "PROG1"))) ++ `(let ((,sym ,first)) ,@body ,sym)) ++ ++-(defmacro prog2 (first second &rest body &aux (sym (gensym))) +++(defmacro prog2 (first second &rest body &aux (sym (sgen "PROG2"))) ++ `(progn ,first (let ((,sym ,second)) ,@body ,sym))) ++ ++ ; multiple values ++@@ -203,115 +171,79 @@ ++ `(multiple-value-call 'list ,form)) ++ ++ (defmacro multiple-value-setq (vars form) ++- (do ((vl vars (cdr vl)) ++- (sym (gensym)) ++- (forms nil) ++- (n 0 (1+ n))) ++- ((endp vl) `(let ((,sym (multiple-value-list ,form))) ,@forms)) ++- (declare (fixnum n) (object vl)) ++- (push `(setq ,(car vl) (nth ,n ,sym)) forms)) ++- ) ++- ++-(defmacro multiple-value-bind (vars form &rest body) ++- (do ((vl vars (cdr vl)) ++- (sym (gensym)) ++- (bind nil) ++- (n 0 (1+ n))) ++- ((endp vl) `(let* ((,sym (multiple-value-list ,form)) ,@(nreverse bind)) ++- ,@body)) ++- (declare (fixnum n) (object vl)) ++- (push `(,(car vl) (nth ,n ,sym)) bind)) ++- ) ++- ++-(defmacro do (control (test . result) &rest body ++- &aux (decl nil) (label (gensym)) (vl nil) (step nil)) ++- (do () ++- ((or (endp body) ++- (not (consp (car body))) ++- (not (eq (caar body) 'declare)))) ++- (push (car body) decl) ++- (pop body)) ++- (dolist (c control) ++- (declare (object c)) ++- (if(symbolp c) (setq c (list c))) ++- (push (list (car c) (cadr c)) vl) ++- (unless (endp (cddr c)) ++- (push (car c) step) ++- (push (caddr c) step))) ++- `(block nil ++- (let ,(nreverse vl) ++- ,@decl ++- (tagbody ++- ,label (if ,test (return (progn ,@result))) ++- (tagbody ,@body) ++- (psetq ,@(nreverse step)) ++- (go ,label))))) ++- ++-(defmacro do* (control (test . result) &rest body ++- &aux (decl nil) (label (gensym)) (vl nil) (step nil)) ++- (do () ++- ((or (endp body) ++- (not (consp (car body))) ++- (not (eq (caar body) 'declare)))) ++- (push (car body) decl) ++- (pop body)) ++- (dolist (c control) ++- (declare (object c)) ++- (if(symbolp c) (setq c (list c))) ++- (push (list (car c) (cadr c)) vl) ++- (unless (endp (cddr c)) ++- (push (car c) step) ++- (push (caddr c) step))) ++- `(block nil ++- (let* ,(nreverse vl) ++- ,@decl ++- (tagbody ++- ,label (if ,test (return (progn ,@result))) ++- (tagbody ,@body) ++- (setq ,@(nreverse step)) ++- (go ,label)))) ++- ) ++- ++-(defmacro case (keyform &rest clauses &aux (key (load-time-value (gensym "CASE"))) (c (reverse clauses))) ++- (declare (optimize (safety 2))) ++- (labels ((sw (x) `(eql ,key ',x))(dfp (x) (or (eq x t) (eq x 'otherwise))) ++- (v (x) (if (when (listp x) (not (cdr x))) (car x) x)) ++- (m (x c &aux (v (v x))) (if (eq v x) (cons c v) v))) ++- `(let ((,key ,keyform)) ++- (declare (ignorable ,key)) ++- ,(let ((df (when (dfp (caar c)) (m (cdr (pop c)) 'progn)))) ++- (reduce (lambda (y c &aux (a (pop c))(v (v a))) ++- (when (dfp a) (error "default case must be last")) ++- `(if ,(if (when (eq a v) (listp v)) (m (mapcar #'sw v) 'or) (sw v)) ,(m c 'progn) ,y)) ++- c :initial-value df))))) ++- ++-(defmacro ecase (keyform &rest clauses &aux (key (sgen "ECASE"))) ++- (declare (optimize (safety 2))) ++- `(let ((,key ,keyform)) ++- (declare (ignorable ,key)) ++- (case ,key +++ (declare (optimize (safety 1))) +++ (let ((syms (mapcar (lambda (x) (declare (ignore x)) (gensym)) (or vars (list nil))))) +++ `(multiple-value-bind ,syms ,form ,@(?list (?cons 'setq (mapcan 'list vars syms))) ,(car syms)))) +++ +++(defmacro multiple-value-bind (vars form &rest body &aux (sym (sgen "MULTIPLE-VALUE-BIND"))) +++ (declare (optimize (safety 1))) +++ `(let* ((,sym (multiple-value-list ,form)) +++ ,@(mapcon (lambda (x) `((,(car x) (car ,sym)) ,@(when (cdr x) `((,sym (cdr ,sym)))))) vars)) +++ (declare (ignorable ,sym)) +++ ,@body)) +++ +++(defun do?* (?* control test result body &aux (label (sgen "DO"))) +++ (multiple-value-bind +++ (doc dec ctp body) +++ (parse-body-header body) +++ (declare (ignore doc)) +++ (labels ((?let (vl dec body) (if (or vl dec) `(,(if ?* 'let* 'let) ,vl ,@dec ,body) body)) +++ (?tagbody (l x y &aux (x (macroexpand x))) (if x `(tagbody ,l ,x ,@(?list (when (eq (car x) 'if) y))) y))) +++ `(block nil +++ ,(?let +++ (mapcar (lambda (x) (if (listp x) (ldiff x (cddr x)) x)) control) +++ dec +++ (?tagbody +++ label +++ `(unless ,test +++ ,@(?list (?cons 'tagbody (append ctp body))) +++ ,@(?list (?cons (if ?* 'setq 'psetq) (mapcan (lambda (x) (when (and (listp x) (cddr x)) (list (car x) (caddr x)))) control))) +++ (go ,label)) +++ `(return ,(?cons 'progn result)))))))) +++ +++(defmacro do (control (test . result) &rest body) +++ (do?* nil control test result body)) +++ +++(defmacro do* (control (test . result) &rest body) +++ (do?* t control test result body)) +++ +++(defmacro case (keyform &rest clauses &aux r rp np (key (?key keyform))) +++ (declare (optimize (safety 1))) +++ (labels ((sw (x) `(eql ,key ,(if (constantp x) x `',x)))) +++ (do ((y clauses))((endp y) (?let key keyform r)) +++ (let* ((x (pop y))(z (pop x))) +++ (if (member z '(t otherwise)) +++ (if y (error "default case must be last") (collect (?cons 'progn x) r rp np)) +++ (when z +++ (if (constantp key) +++ (let ((key (eval key))) (when (if (listp z) (member key z) (eql key z)) (collect (?cons 'progn x) r rp np) (setq y nil))) +++ (collect `(if ,(if (listp z) (?cons 'or (mapcar #'sw z)) (sw z)) +++ ,@(setq np (list (?cons 'progn x)))) r rp np)))))))) +++ +++(defmacro ecase (keyform &rest clauses &aux (key (?key keyform))) +++ (declare (optimize (safety 1))) +++ (?let key keyform +++ `(case ,key ++ ,@(mapcar (lambda (x) (if (member (car x) '(t otherwise)) (cons (list (car x)) (cdr x)) x)) clauses) ++ (otherwise ++ (error 'type-error :datum ,key ++ :expected-type '(member ,@(apply 'append (mapcar (lambda (x &aux (x (car x))) (if (listp x) x (list x))) clauses)))))))) ++ +++(defmacro ccase (keyform &rest clauses &aux (key (?key keyform))) +++ (declare (optimize (safety 1))) +++ (?let key keyform +++ `(do nil (nil) +++ (case ,key +++ ,@(mapcar (lambda (x &aux (k (pop x))) +++ `(,(if (member k '(t otherwise)) (list k) k) (return ,(?cons 'progn x)))) clauses) +++ (otherwise +++ (check-type ,key (member ,@(apply 'append (mapcar (lambda (x &aux (x (car x))) (if (listp x) x (list x))) clauses))))))))) ++ ++-(defmacro ccase (keyform &rest clauses &aux (key (sgen "CCASE"))) ++- (declare (optimize (safety 2))) ++- `(let ((,key ,keyform)) ++- (declare (ignorable ,key)) ++- (do nil (nil) ++- (case ,key ++- ,@(mapcar (lambda (x &aux (k (pop x))) ++- `(,(if (member k '(t otherwise)) (list k) k) (return ,(if (cdr x) (cons 'progn x) (car x))))) clauses) ++- (otherwise ++- (check-type ,key (member ,@(apply 'append (mapcar (lambda (x &aux (x (car x))) (if (listp x) x (list x))) clauses))))))))) ++- ++-(defmacro return (&optional (val nil)) `(return-from nil ,val)) ++- ++-(defmacro dolist ((var form &optional (val nil)) &rest body ++- &aux (temp (gensym))) ++- `(do* ((,temp ,form (cdr ,temp)) (,var (car ,temp) (car ,temp))) +++ +++(defmacro return (&optional val) `(return-from nil ,val)) +++ +++(defmacro dolist ((var form &optional (val nil)) &rest body &aux (temp (sgen "DOLIST"))) +++ `(do* ((,temp ,form (cdr ,temp))(,var (car ,temp) (car ,temp))) ++ ((endp ,temp) ,val) ++ ,@body)) ++ ++@@ -327,59 +259,19 @@ ++ ;; appears to treat this as positive or negative depending on the sign ++ ;; of the other argument in the comparison, apparently to symmetrize ++ ;; the long integer range. 20040403 CM. ++-(defmacro dotimes ((var form &optional (val nil)) &rest body) ++- (cond ++- ((symbolp form) ++- (let ((temp (gensym))) ++- `(cond ((< ,form 0) ++- (let ((,var 0)) ++- (declare (fixnum ,var) (ignorable ,var)) ++- ,val)) ++- ((<= ,form most-positive-fixnum) ++- (let ((,temp ,form)) ++- (declare (fixnum ,temp)) ++- (do* ((,var 0 (1+ ,var))) ((>= ,var ,temp) ,val) ++- (declare (fixnum ,var)) ++- ,@body))) ++- (t ++- (let ((,temp ,form)) ++- (do* ((,var 0 (1+ ,var))) ((>= ,var ,temp) ,val) ++- ,@body)))))) ++- ((constantp form) ++- (cond ((< form 0) ++- `(let ((,var 0)) ++- (declare (fixnum ,var) (ignorable ,var)) ++- ,val)) ++- ((<= form most-positive-fixnum) ++- `(do* ((,var 0 (1+ ,var))) ((>= ,var ,form) ,val) ++- (declare (fixnum ,var)) ++- ,@body)) ++- (t ++- `(do* ((,var 0 (1+ ,var))) ((>= ,var ,form) ,val) ++- ,@body)))) ++- (t ++- (let ((temp (gensym))) ++- `(let ((,temp ,form)) ++- (cond ((< ,temp 0) ++- (let ((,var 0)) ++- (declare (fixnum ,var) (ignorable ,var)) ++- ,val)) ++- ((<= ,temp most-positive-fixnum) ++- (let ((,temp ,temp)) ++- (declare (fixnum ,temp)) ++- (do* ((,var 0 (1+ ,var))) ((>= ,var ,temp) ,val) ++- (declare (fixnum ,var)) ++- ,@body))) ++- (t ++- (do* ((,var 0 (1+ ,var))) ((>= ,var ,temp) ,val) ++- ,@body)))))))) ++- +++(defmacro dotimes ((var form &optional val) &rest body &aux (s (sgen "DOTIMES"))(m (sgen "DOTIMES"))) +++ `(let* ((,s (block nil ,form))(,m (min ,s most-positive-fixnum))) +++ (declare (fixnum ,m)) +++ (do ((,var 0 (1+ ,var))) +++ ((>= ,var ,m) (if (eql ,s ,m) ,val (do ((,var ,m (1+ ,var)))((>= ,var ,s) ,val) ,@body))) +++ (declare (fixnum ,var)) +++ ,@body))) ++ ++ (defmacro declaim (&rest l) ++- `(eval-when (compile eval load) ++- ,@(mapcar #'(lambda (x) `(proclaim ',x)) l))) +++ `(eval-when (compile eval load) +++ ,@(mapcar (lambda (x) `(proclaim ',x)) l))) ++ ++-(defmacro lambda ( &rest l) `(function (lambda ,@l))) +++(defmacro lambda (&rest l) `(function (lambda ,@l))) ++ ++ (defun compiler-macro-function (name) ++ (get name 'compiler-macro-prop)) ++--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp +++++ gcl-2.6.12/lsp/gcl_iolib.lsp ++@@ -380,7 +380,7 @@ ++ ++ (defun get-byte-stream-nchars (s) ++ (let* ((tp (stream-element-type s))) ++- (ceiling (if (consp tp) (cadr tp) char-length) char-length))) +++ (values (ceiling (if (consp tp) (cadr tp) char-length) char-length)))) ++ ++ ;; (defun parse-integer (s &key start end (radix 10) junk-allowed) ++ ;; (declare (optimize (safety 1))) ++@@ -488,21 +488,19 @@ ++ (stream (load-stream p print))) ++ (when verbose (format t ";; Finished loading ~s~%" p)))) ++ ++-(defun ensure-directories-exist (ps &key verbose &aux created) +++(defun ensure-directories-exist (ps &key verbose) ++ (declare (optimize (safety 1))) ++ (check-type ps pathname-designator) ++ (when (wild-pathname-p ps) ++ (error 'file-error :pathname ps :format-control "Pathname is wild")) ++- (labels ((d (x y &aux (z (ldiff x y)) (n (namestring (make-pathname :directory z)))) ++- (when (when z (stringp (car (last z)))) ++- (unless (eq :directory (stat n)) ++- (mkdir n) ++- (setq created t) ++- (when verbose (format *standard-output* "Creating directory ~s~%" n)))) ++- (when y (d x (cdr y))))) ++- (let ((pd (pathname-directory ps))) ++- (d pd (cdr pd))) ++- (values ps created))) +++ (let ((pd (pathname-directory ps)) ls) +++ (dotimes (i (length pd)) +++ (let ((s (namestring (make-pathname :directory (if (zerop i) pd (ldiff pd (last pd i))))))) +++ (if (eq (stat1 s) :directory) (return) (push s ls)))) +++ (dolist (s ls) +++ (mkdir s) +++ (when verbose (format *standard-output* "Creating directory ~s~%" s))) +++ (values ps (if ls t)))) ++ ++ (defun file-length (x) ++ (declare (optimize (safety 1))) ++@@ -511,7 +509,7 @@ ++ (let ((s (broadcast-stream-streams x))) (if s (file-length (car (last s))) 0)) ++ (multiple-value-bind (tp sz) (stat x) ++ (declare (ignore tp)) ++- (/ sz (get-byte-stream-nchars x))))) +++ (values (truncate sz (get-byte-stream-nchars x)))))) ++ ++ (defun file-position (x &optional (pos :start pos-p)) ++ (declare (optimize (safety 1))) ++--- gcl-2.6.12.orig/lsp/gcl_loop.lsp +++++ gcl-2.6.12/lsp/gcl_loop.lsp ++@@ -793,6 +793,8 @@ a LET-like macro, and a SETQ-like macro, ++ (unless (= (length before-loop) (length after-loop)) ++ (error "LOOP-BODY called with non-synched before- and after-loop lists.")) ++ ;;All our work is done from these copies, working backwards from the end: +++ (when (equal before-loop after-loop) +++ (setq main-body (append before-loop main-body) before-loop nil after-loop nil));accelerator ++ (setq rbefore (reverse before-loop) rafter (reverse after-loop)) ++ (labels ((psimp (l) ++ (let ((ans nil)) ++--- gcl-2.6.12.orig/lsp/gcl_parse_namestring.lsp +++++ gcl-2.6.12/lsp/gcl_parse_namestring.lsp ++@@ -2,15 +2,6 @@ ++ ++ (deftype seqind nil `fixnum) ++ ++-(defun match-beginning (i &aux (v *match-data*)) ++- (declare ((vector fixnum) v)(seqind i)) ++- (the (or (integer -1 -1 ) seqind) (aref v i))) ++-(defun match-end (i &aux (v *match-data*)) ++- (declare ((vector fixnum) v)(seqind i)) ++- (the (or (integer -1 -1 ) seqind) (aref v (+ i (ash (length v) -1))))) ++- ++-(declaim (inline match-beginning match-end)) ++- ++ (defun dir-conj (x) (if (eq x :relative) :absolute :relative)) ++ ++ (defvar *up-key* :up) ++--- gcl-2.6.12.orig/lsp/gcl_predlib.lsp +++++ gcl-2.6.12/lsp/gcl_predlib.lsp ++@@ -348,8 +348,7 @@ ++ ;; FIXME this needs to be more robust ++ (defun known-type-p (type) ++ (when (consp type) (setq type (car type))) ++- (if (or (equal (string type) "ERROR") ++- (member type +++ (if (or (member type ++ '(t nil boolean null symbol keyword atom cons list sequence ++ signed-char unsigned-char signed-short unsigned-short ++ number integer bignum rational ratio float method-combination ++@@ -370,8 +369,9 @@ ++ storage-condition stream-error string-stream structure-class ++ style-warning synonym-stream two-way-stream structure-object ++ type-error unbound-slot unbound-variable undefined-function ++- warning )) ++- (get type 's-data)) +++ warning) :test 'eq) +++ (get type 's-data) +++ (equal (string type) "ERROR")) ++ t ++ nil)) ++ ++--- gcl-2.6.12.orig/lsp/gcl_rename_file.lsp +++++ gcl-2.6.12/lsp/gcl_rename_file.lsp ++@@ -26,7 +26,7 @@ ++ (defun delete-file (f &aux (pf (truename f))(nf (namestring pf))) ++ (declare (optimize (safety 1))) ++ (check-type f pathname-designator) ++- (unless (if (eq :directory (stat nf)) (rmdir nf) (unlink nf)) +++ (unless (if (eq :directory (stat1 nf)) (rmdir nf) (unlink nf)) ++ (error 'file-error :pathname (pathname nf) :format-control "Cannot delete pathname.")) ++ t) ++ ++--- gcl-2.6.12.orig/lsp/gcl_seqlib.lsp +++++ gcl-2.6.12/lsp/gcl_seqlib.lsp ++@@ -25,7 +25,7 @@ ++ (in-package :si) ++ ++ ++-(proclaim '(optimize (safety 2) (space 3))) +++;(proclaim '(optimize (safety 2) (space 3))) ++ ++ ++ (proclaim '(function seqtype (t) t)) ++@@ -274,40 +274,87 @@ ++ (list 'quote f))) ++ ++ (defmacro eval-body () *body*) +++(defmacro mcf (x) `(when ,x (coerce ,x 'function))) +++(deftype function-designator nil `(or (and symbol (not boolean)) function)) +++(defmacro rcollect (r rp form) +++ `(let ((tmp ,form)) +++ (setq ,rp (last (if ,rp (rplacd ,rp tmp) (setq ,r tmp)))))) +++ +++ (defmacro dcollect (r rp form) +++ `(let ((tmp ,form)) +++ (declare (dynamic-extent tmp)) +++ (setq ,rp (cond (,rp (rplacd ,rp tmp) tmp) ((setq ,r tmp)))))) +++ ++ ) ++ +++(defun remove (item sequence &key key test test-not from-end count (start 0) end +++ &aux (kf (mcf key))(tf (mcf test))(tnf (mcf test-not)) r rp q qp xz (from-end (when count from-end)) +++ (l (listp sequence))(ln (if l array-dimension-limit (length sequence))) +++ (e (if end (min ln (max 0 end)) ln)) +++ (c (if count (min ln (max 0 count)) ln))) +++ +++ (declare (optimize (safety 1))(dynamic-extent q)(fixnum c e)) +++ +++ (check-type sequence sequence) +++ (check-type start seqind) +++ (check-type end (or null seqind)) +++ (check-type count (or null integer)) +++ (check-type key (or null function-designator)) +++ (check-type test (or null function-designator)) +++ (check-type test-not (or null function-designator)) +++ +++ (cond ((unless from-end l) +++ (do ((i start (1+ i))(j 0)(s (if (zerop start) sequence (nthcdr start sequence)) (cdr s))) +++ ((or (endp s) (>= i e) (>= j c)) (rcollect r rp sequence) r) +++ (declare (fixnum i j)) +++ (let* ((x (car s))(kx (if kf (funcall kf x) x))) +++ (when (cond (tf (funcall tf item kx))(tnf (not (funcall tnf item kx)))((eql item kx))) +++ (do nil ((eq sequence s) (setq sequence (cdr sequence))) (rcollect r rp (cons (pop sequence) nil))) +++ (incf j))))) +++ (t +++ (do* ((j 0 (1+ j))) +++ ((not (when (< j c) +++ (setq xz (position item sequence +++ :start (if (unless from-end xz) (1+ xz) start) +++ :end (if (when from-end xz) xz end) +++ :key kf :test tf :test-not tnf :from-end from-end))))) +++ (declare (fixnum j)) +++ (if from-end (push xz q) (dcollect q qp (cons xz nil)))) +++; (print q) +++ (cond ((not q) sequence) +++ (l (do* ((lq -1 (car q))(q q (cdr q))(v sequence (cdr v)))((not q) (rcollect r rp v) r) +++ (declare (fixnum lq)) +++ (dotimes (i (the fixnum (- (car q) lq 1))) (declare (fixnum i))(rcollect r rp (cons (pop v) nil))))) +++ ((let ((r (make-array (- (length sequence) (length q)) :element-type (array-element-type sequence)))) +++ (do* ((j 0 (+ j (- (car q) lq 1)))(lq -1 (car q))(q q (cdr q))) +++ ((when (replace r sequence :start1 j :start2 (1+ lq) :end2 (car q)) (not q)) r))))))) +++) ++ ++-(defseq remove () t nil ++- (if (not from-end) ++- `(if (listp sequence) ++- (let ((l sequence) (l1 nil)) ++- (do ((i 0 (f+ 1 i))) ++- ((>= i start)) ++- (declare (fixnum i)) ++- (push (car l) l1) ++- (pop l)) ++- (do ((i start (f+ 1 i)) (j 0)) ++- ((or (>= i end) (>= j count) (endp l)) ++- (nreconc l1 l)) ++- (declare (fixnum i j)) ++- (cond ((call-test test test-not item (funcall key (car l))) ++- (setf j (f+ 1 j)) ++- (pop l)) ++- (t ++- (push (car l) l1) ++- (pop l))))) ++- (delete item sequence ++- :from-end from-end ++- :test test :test-not test-not ++- :start start :end end ++- :count count ++- :key key)) ++- `(delete item sequence ++- :from-end from-end ++- :test test :test-not test-not ++- :start start :end end ++- :count count ++- :key key))) +++(defun remove-if (p s &key key from-end count (start 0) end &aux (kf (mcf key))) +++ +++ (declare (optimize (safety 1))) +++ +++ (check-type p function-designator) +++ (check-type s sequence) +++ (check-type start seqind) +++ (check-type end (or null seqind)) +++ (check-type count (or null integer)) +++ (check-type key (or null function-designator)) +++ +++ (remove p s :key kf :test #'funcall :start start :end end :count count :from-end from-end)) +++ +++(defun remove-if-not (p s &key key from-end count (start 0) end &aux (kf (mcf key))) +++ +++ (declare (optimize (safety 1))) +++ +++ (check-type p function-designator) +++ (check-type s sequence) +++ (check-type start seqind) +++ (check-type end (or null seqind)) +++ (check-type count (or null integer)) +++ (check-type key (or null function-designator)) +++ +++ (remove p s :key kf :test-not #'funcall :start start :end end :count count :from-end from-end)) ++ ++ ++ (defseq delete () t t ++--- gcl-2.6.12.orig/lsp/gcl_setf.lsp +++++ gcl-2.6.12/lsp/gcl_setf.lsp ++@@ -197,6 +197,7 @@ ++ (defsetf symbol-plist si:set-symbol-plist) ++ (defsetf gethash (k h &optional d) (v) `(si:hash-set ,k ,h ,v)) ++ (defsetf row-major-aref si:aset1) +++(defsetf readtable-case si::set-readtable-case) ++ (defsetf documentation (s d) (v) ++ `(case ,d ++ (variable (si:putprop ,s ,v 'variable-documentation)) ++--- gcl-2.6.12.orig/lsp/gcl_top.lsp +++++ gcl-2.6.12/lsp/gcl_top.lsp ++@@ -582,7 +582,7 @@ First directory is checked for first nam ++ (defvar *tmp-dir*) ++ ++ (defun ensure-dir-string (str) ++- (if (eq (stat str) :directory) +++ (if (eq (stat1 str) :directory) ++ (coerce-slash-terminated str) ++ str)) ++ ++@@ -590,7 +590,7 @@ First directory is checked for first nam ++ (dolist (x `(,@(mapcar 'si::getenv '("TMPDIR" "TMP" "TEMP")) "/tmp" "")) ++ (when x ++ (let ((x (coerce-slash-terminated x))) ++- (when (eq (stat x) :directory) +++ (when (eq (stat1 x) :directory) ++ (return-from get-temp-dir x)))))) ++ ++ ++--- gcl-2.6.12.orig/lsp/gcl_translate_pathname.lsp +++++ gcl-2.6.12/lsp/gcl_translate_pathname.lsp ++@@ -51,7 +51,7 @@ ++ ++ (defun list-toggle-case (x f) ++ (typecase x ++- (string (funcall f x)) +++ (string (values (funcall f x))) ++ (cons (mapcar (lambda (x) (list-toggle-case x f)) x)) ++ (otherwise x))) ++ ++--- gcl-2.6.12.orig/lsp/gcl_truename.lsp +++++ gcl-2.6.12/lsp/gcl_truename.lsp ++@@ -6,7 +6,7 @@ ++ (set-fr (fr e &aux (fr (or fr (frame 0 b)))) (setf (fill-pointer fr) e) fr)) ++ (let* ((i (string-match +dirsep+ str b)) ++ (fr (set-fr fr (if (eql i -1) n i))) ++- (l (when (eq (stat fr) :link) (readlinkat 0 fr)))) +++ (l (when (eq (stat1 fr) :link) (readlinkat 0 fr)))) ++ (cond (l (let ((b (if (eql #\/ (aref l 0)) 0 b))) ++ (link-expand (string-concatenate (set-fr fr b) l (frame (if (eql i -1) n i) n)) b))) ++ ((eql i -1) str) ++@@ -25,7 +25,7 @@ ++ (error 'file-error :pathname pd :format-control "Pathname is wild")) ++ (let* ((ns (ensure-dir-string (link-expand ns))) ++ (ppd (if (eq (namestring pd) ns) pd (pathname ns)))) ++- (unless (or (zerop (length ns)) (stat ns)) +++ (unless (or (zerop (length ns)) (stat1 ns)) ++ (error 'file-error :pathname ns :format-control "Pathname does not exist")) ++ (let* ((d (pathname-directory ppd)) ++ (d1 (subst :back :up d)) ++@@ -38,5 +38,5 @@ ++ (check-type pd pathname-designator) ++ (when (wild-pathname-p pn) ++ (error 'file-error :pathname pn :format-control "Pathname is wild")) ++- (when (eq (stat (link-expand (namestring pn))) :file) +++ (when (eq (stat1 (link-expand (namestring pn))) :file) ++ (truename pn))) ++--- gcl-2.6.12.orig/lsp/sys-proclaim.lisp +++++ gcl-2.6.12/lsp/sys-proclaim.lisp ++@@ -3,239 +3,282 @@ ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++- COMMON-LISP::*)) ++- COMMON-LISP::T) ++- SYSTEM::RESET-SYS-PATHS)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++- (COMMON-LISP::VECTOR COMMON-LISP::T)) ++- SYSTEM::CONTEXT-VEC)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::INTEGER -9223372036854775808 ++- 9223372036854775807)) +++ 9223372036854775807) +++ COMMON-LISP::T) ++ COMMON-LISP::T) ++- SYSTEM::PUSH-CONTEXT SYSTEM::GET-CONTEXT)) +++ SYSTEM::SMALLNTHCDR)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++- SLOOP::PARSE-LOOP-DO ANSI-LOOP::LOOP-WHEN-IT-VARIABLE ++- SYSTEM::GET-INDEX-NODE SLOOP::LOOP-PEEK ++- ANSI-LOOP::LOOP-POP-SOURCE SYSTEM::STEP-READ-LINE ++- SYSTEM::SET-UP-TOP-LEVEL SLOOP::LOOP-POP SYSTEM::SET-ENV ++- SYSTEM::DBL COMMON-LISP::TYPE-ERROR SYSTEM::INSPECT-INDENT ++- SLOOP::PARSE-LOOP-COLLECT SYSTEM::CLEANUP ++- SYSTEM::DEFAULT-SYSTEM-BANNER ++- SYSTEM::CURRENT-DIRECTORY-PATHNAME ANSI-LOOP::LOOP-DO-WITH ++- SYSTEM::INIT-BREAK-POINTS SYSTEM::TEST-ERROR ++- SYSTEM::GET-SIG-FN-NAME SLOOP::PARSE-ONE-WHEN-CLAUSE ++- ANSI-LOOP::LOOP-DO-DO SYSTEM::READ-EVALUATED-FORM ++- SYSTEM::INSPECT-INDENT-1 ANSI-LOOP::LOOP-DO-NAMED ++- SLOOP::PARSE-LOOP-FOR SYSTEM::ALL-TRACE-DECLARATIONS ++- ANSI-LOOP::LOOP-GET-FORM ANSI-LOOP::LOOP-BIND-BLOCK ++- SLOOP::PARSE-LOOP-WHEN SYSTEM::TOP-LEVEL ++- SYSTEM::DM-TOO-FEW-ARGUMENTS SYSTEM::KCL-TOP-RESTARTS ++- SYSTEM::DEFAULT-INFO-HOTLIST SYSTEM::SHOW-RESTARTS ++- SYSTEM::DM-TOO-MANY-ARGUMENTS SYSTEM::SETUP-LINEINFO ++- SYSTEM::GET-TEMP-DIR ANSI-LOOP::LOOP-ITERATION-DRIVER ++- SLOOP::PARSE-LOOP1 SLOOP::LOOP-UN-POP ++- ANSI-LOOP::LOOP-DO-FINALLY SYSTEM::INSPECT-READ-LINE ++- ANSI-LOOP::LOOP-CONTEXT SYSTEM::SET-CURRENT ++- ANSI-LOOP::LOOP-DO-REPEAT SYSTEM::ILLEGAL-BOA ++- COMMON-LISP::LISP-IMPLEMENTATION-VERSION ++- ANSI-LOOP::LOOP-DO-RETURN ANSI-LOOP::LOOP-DO-INITIALLY ++- ANSI-LOOP::LOOP-GET-PROGN)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +++ SYSTEM::NORMALIZE-TYPE SYSTEM::PNL1 +++ ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS SYSTEM::DM-BAD-KEY +++ SYSTEM::S-DATA-INCLUDES +++ ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS +++ COMMON-LISP::HOST-NAMESTRING +++ COMMON-LISP::TWO-WAY-STREAM-INPUT-STREAM COMMON-LISP::LOGNOT +++ SYSTEM::BREAK-FORWARD-SEARCH-STACK +++ SLOOP::SUBSTITUTE-SLOOP-BODY +++ COMMON-LISP::CONCATENATED-STREAM-STREAMS +++ ANSI-LOOP::LOOP-MINIMAX-OPERATIONS SYSTEM::ADD-TO-HOTLIST +++ SYSTEM::RESTART-REPORT-FUNCTION COMMON-LISP::THIRD +++ SYSTEM::DWIM SYSTEM::GET-INSTREAM SYSTEM::TOGGLE-CASE +++ SYSTEM::INSTREAM-P COMMON-LISP::DELETE-FILE +++ SYSTEM::BEST-ARRAY-ELEMENT-TYPE COMMON-LISP::ISQRT +++ SYSTEM::INSERT-BREAK-POINT SYSTEM::WILD-DIR-ELEMENT-P +++ COMMON-LISP::ABS SYSTEM::WHICH COMMON-LISP::ACOS +++ SYSTEM::COERCE-SLASH-TERMINATED +++ COMMON-LISP::LOAD-LOGICAL-PATHNAME-TRANSLATIONS +++ ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD +++ COMMON-LISP::ECHO-STREAM-OUTPUT-STREAM SYSTEM::DIR-P +++ SYSTEM::SETUP-INFO SYSTEM::S-DATA-TYPE +++ ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS +++ SYSTEM::PRINT-SYMBOL-APROPOS SYSTEM::S-DATA-FROZEN +++ SYSTEM::REAL-ASINH ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS +++ SLOOP::PARSE-NO-BODY SYSTEM::INSPECT-STRING SYSTEM::PRINT-FRS +++ SYSTEM::LEAP-YEAR-P SYSTEM::RESTRICT-STREAM-ELEMENT-TYPE +++ SYSTEM::RESTART-INTERACTIVE-FUNCTION +++ SYSTEM::S-DATA-SLOT-DESCRIPTIONS SYSTEM::S-DATA-STATICP +++ SYSTEM::INSPECT-STRUCTURE COMMON-LISP::ASINH +++ ANSI-LOOP::LOOP-PATH-USER-DATA SYSTEM::RE-QUOTE-STRING +++ SYSTEM::MLP SYSTEM::GET-STRING-INPUT-STREAM-INDEX +++ SYSTEM::INFO-GET-FILE COMMON-LISP::EIGHTH +++ SYSTEM::SHOW-BREAK-POINT SYSTEM::SIMPLE-ARRAY-P +++ COMMON-LISP::RESTART-NAME SLOOP::POINTER-FOR-COLLECT +++ COMMON-LISP::PHASE SYSTEM::LNP +++ SYSTEM::REWRITE-RESTART-CASE-CLAUSE +++ SLOOP::LOOP-COLLECT-KEYWORD-P SYSTEM::S-DATA-HAS-HOLES +++ SYSTEM::EVAL-FEATURE ANSI-LOOP::DESTRUCTURING-SIZE +++ COMMON-LISP::BROADCAST-STREAM-STREAMS +++ ANSI-LOOP::LOOP-PATH-FUNCTION COMMON-LISP::BYTE-POSITION +++ ANSI-LOOP::LOOP-MINIMAX-TYPE COMMON-LISP::TANH +++ SYSTEM::BKPT-FILE SYSTEM::FRS-KIND +++ SYSTEM::S-DATA-PRINT-FUNCTION SYSTEM::UNIQUE-ID +++ SYSTEM::IHS-NOT-INTERPRETED-ENV SYSTEM::INSPECT-PACKAGE +++ ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA SYSTEM::BKPT-FILE-LINE +++ ANSI-LOOP::LOOP-EMIT-BODY SYSTEM::PATCH-SHARP +++ ANSI-LOOP::LOOP-COLLECTOR-P SYSTEM::DIR-CONJ +++ SYSTEM::CHECK-TRACE-SPEC ANSI-LOOP::LOOP-COLLECTOR-HISTORY +++ ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS SYSTEM::FIX-LOAD-PATH +++ ANSI-LOOP::LOOP-COLLECTOR-NAME SYSTEM::PATH-STREAM-NAME +++ SLOOP::LOOP-LET-BINDINGS ANSI-LOOP::LOOP-TYPED-INIT +++ FPE::ST-LOOKUP SYSTEM::IHS-VISIBLE SYSTEM::INFO-GET-TAGS +++ SYSTEM::EXPAND-HOME-DIR SYSTEM::DM-KEY-NOT-ALLOWED +++ ANSI-LOOP::LOOP-UNIVERSE-P +++ SYSTEM::CANONICALIZE-PATHNAME-DIRECTORY +++ COMMON-LISP::CONSTANTLY SYSTEM::WILD-NAMESTRING-P +++ SYSTEM::INSPECT-NUMBER SYSTEM::LOGICAL-PATHNAME-DESIGNATOR-P +++ COMMON-LISP::FOURTH SYSTEM::NODES-FROM-INDEX +++ SYSTEM::LOGICAL-PATHNAME-HOST-P SYSTEM::S-DATA-NAMED +++ COMMON-LISP::INVOKE-DEBUGGER SYSTEM::INSPECT-VECTOR +++ SYSTEM::VERSION-PARSE SYSTEM::WILD-PATH-ELEMENT-P +++ SLOOP::RETURN-SLOOP-MACRO SYSTEM::REGEXP-CONV +++ SYSTEM::NUMBER-OF-DAYS-FROM-1900 +++ COMMON-LISP::ECHO-STREAM-INPUT-STREAM SYSTEM::CHDIR +++ SYSTEM::DBL-RPL-LOOP COMMON-LISP::ASIN COMMON-LISP::RATIONAL +++ ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED +++ COMMON-LISP::NAMESTRING SYSTEM::TRACE-ONE-PREPROCESS +++ SYSTEM::TERMINAL-INTERRUPT SYSTEM::SEQTYPE SYSTEM::S-DATA-RAW +++ SYSTEM::GET-NEXT-VISIBLE-FUN FPE::XMM-LOOKUP +++ SYSTEM::MAKE-KCL-TOP-RESTART ANSI-LOOP::LOOP-MINIMAX-P +++ ANSI-LOOP::LOOP-MAXMIN-COLLECTION +++ COMMON-LISP::COMPILER-MACRO-FUNCTION SYSTEM::BKPT-FUNCTION +++ SYSTEM::DIRECTORY-LIST-CHECK SYSTEM::S-DATA-SLOT-POSITION +++ SYSTEM::SHORT-NAME SYSTEM::DBL-EVAL +++ ANSI-LOOP::LOOP-COLLECTOR-DATA SYSTEM::S-DATA-DOCUMENTATION +++ ANSI-LOOP::LOOP-EMIT-FINAL-VALUE COMMON-LISP::NINTH +++ SYSTEM::CHECK-DECLARATIONS ANSI-LOOP::LOOP-PATH-NAMES +++ COMMON-LISP::LOGICAL-PATHNAME COMMON-LISP::SIGNUM +++ COMMON-LISP::FIND-ALL-SYMBOLS COMMON-LISP::FIFTH +++ SYSTEM::S-DATA-P ANSI-LOOP::LOOP-CONSTANTP SYSTEM::IDESCRIBE +++ SYSTEM::BKPT-FORM ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE +++ SLOOP::SLOOP-SLOOP-MACRO SYSTEM::NEXT-STACK-FRAME +++ SYSTEM::INSPECT-CONS SYSTEM::KNOWN-TYPE-P +++ SYSTEM::RESET-TRACE-DECLARATIONS COMMON-LISP::SINH +++ ANSI-LOOP::LOOP-PATH-P COMMON-LISP::PROVIDE +++ SYSTEM::INSPECT-SYMBOL SYSTEM::FIND-DOCUMENTATION +++ ANSI-LOOP::LOOP-MAKE-DESETQ COMMON-LISP::TENTH +++ SYSTEM::MAKE-DEFPACKAGE-FORM COMMON-LISP::FILE-WRITE-DATE +++ COMMON-LISP::TWO-WAY-STREAM-OUTPUT-STREAM +++ COMMON-LISP::TRUENAME COMMON-LISP::COMPLEMENT +++ COMMON-LISP::FIRST ANSI-LOOP::LOOP-COLLECTOR-CLASS +++ ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS COMMON-LISP::ATANH +++ SYSTEM::LOGICAL-PATHNAMEP COMMON-LISP::DIRECTORY-NAMESTRING +++ SYSTEM::RESTART-P ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE +++ SYSTEM::FIND-KCL-TOP-RESTART COMMON-LISP::FILE-NAMESTRING +++ COMMON-LISP::STREAM-EXTERNAL-FORMAT COMMON-LISP::SECOND +++ COMMON-LISP::FILE-LENGTH SYSTEM::INSTREAM-STREAM +++ ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE COMMON-LISP::PATHNAME +++ SYSTEM::DO-F COMMON-LISP::FILE-AUTHOR +++ SYSTEM::LOAD-PATHNAME-EXISTS SLOOP::AVERAGING-SLOOP-MACRO +++ ANSI-LOOP::LOOP-CONSTRUCT-RETURN ANSI-LOOP::LOOP-UNIVERSE-ANSI +++ ANSI-LOOP::LOOP-PSEUDO-BODY SLOOP::PARSE-LOOP +++ ANSI-LOOP::LOOP-HACK-ITERATION SYSTEM::S-DATA-CONC-NAME +++ SYSTEM::SEARCH-STACK ANSI-LOOP::LOOP-DO-THEREIS +++ COMMON-LISP::BYTE-SIZE ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE +++ COMMON-LISP::ACOSH SYSTEM::GET-PATH +++ COMMON-LISP::LOGICAL-PATHNAME-TRANSLATIONS +++ SYSTEM::S-DATA-CONSTRUCTORS SYSTEM::ENSURE-DIR-STRING +++ SYSTEM::FREEZE-DEFSTRUCT SYSTEM::PRINT-IHS +++ SYSTEM::INSPECT-CHARACTER COMMON-LISP::ARRAY-DIMENSIONS +++ SLOOP::PARSE-LOOP-INITIALLY SYSTEM::COMPUTING-ARGS-P +++ SYSTEM::INSTREAM-STREAM-NAME SYSTEM::PROCESS-ARGS FPE::GREF +++ SYSTEM::S-DATA-NAME ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS +++ SYSTEM::GET-BYTE-STREAM-NCHARS SYSTEM::S-DATA-INCLUDED +++ SYSTEM::WALK-THROUGH SYSTEM::RESTART-FUNCTION +++ SLOOP::TRANSLATE-NAME +++ ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED +++ COMMON-LISP::SEVENTH COMMON-LISP::CIS FPE::LOOKUP +++ COMMON-LISP::COSH COMMON-LISP::VECTOR-POP SYSTEM::IHS-FNAME +++ SYSTEM::BREAK-BACKWARD-SEARCH-STACK SLOOP::REPEAT-SLOOP-MACRO +++ COMMON-LISP::PROBE-FILE ANSI-LOOP::LOOP-LIST-COLLECTION +++ SYSTEM::CONTEXT-P COMMON-LISP::SIXTH SYSTEM::NC +++ SYSTEM::MAKE-FRAME COMMON-LISP::COMPILE-FILE-PATHNAME +++ SYSTEM::INFO-NODE-FROM-POSITION SYSTEM::NODE-OFFSET +++ SYSTEM::RESTART-TEST-FUNCTION SYSTEM::ALOAD +++ ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS +++ ANSI-LOOP::LOOP-COLLECTOR-DTYPE SYSTEM::S-DATA-OFFSET +++ SYSTEM::SHOW-ENVIRONMENT COMMON-LISP::SYNONYM-STREAM-SYMBOL +++ SYSTEM::INSPECT-ARRAY ANSI-LOOP::LOOP-MAKE-PSETQ)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++- COMMON-LISP::HASH-TABLE) ++- SYSTEM::CONTEXT-SPICE)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) +++ SYSTEM::BREAK-QUIT SYSTEM::DBL-BACKTRACE +++ SYSTEM::BREAK-PREVIOUS SYSTEM::INFO-ERROR SYSTEM::BREAK-VS +++ SYSTEM::BREAK-LOCAL SYSTEM::IHS-BACKTRACE +++ ANSI-LOOP::LOOP-OPTIONAL-TYPE SYSTEM::BREAK-NEXT +++ COMMON-LISP::MUFFLE-WARNING SYSTEM::BREAK-BDS +++ COMMON-LISP::CONTINUE SYSTEM::SHOW-BREAK-VARIABLES)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++- (COMMON-LISP::OR COMMON-LISP::NULL ++- COMMON-LISP::HASH-TABLE)) ++- SYSTEM::CONTEXT-HASH)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::FIXNUM) ++- ANSI-LOOP::DUPLICATABLE-CODE-P SYSTEM::RELATIVE-LINE ++- SYSTEM::LENEL SYSTEM::GET-NODE-INDEX SYSTEM::FASLINK ++- SYSTEM::THE-END)) +++ (COMMON-LISP::VECTOR COMMON-LISP::T)) +++ SYSTEM::CONTEXT-VEC)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ (COMMON-LISP::FUNCTION +++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER +++ COMMON-LISP::*)) ++ COMMON-LISP::T) ++- SLOOP::IN-PACKAGE-SLOOP-MAP SLOOP::DESETQ1 ++- COMMON-LISP::LOGANDC2 ANSI-LOOP::MAKE-LOOP-MINIMAX ++- COMMON-LISP::WRITE-BYTE SYSTEM::MATCH-DIMENSIONS ++- SLOOP::IN-CAREFULLY-SLOOP-FOR SLOOP::SUM-SLOOP-COLLECT ++- SYSTEM::DOT-DIR-P SLOOP::IN-FRINGE-SLOOP-MAP ++- SLOOP::COLLATE-SLOOP-COLLECT ANSI-LOOP::LOOP-TMEMBER ++- FPE::READ-OPERANDS SYSTEM::IN-INTERVAL-P SYSTEM::SUBSTRINGP ++- FPE::PAREN-READER ANSI-LOOP::HIDE-VARIABLE-REFERENCES ++- SYSTEM::QUOTATION-READER SYSTEM::ALL-MATCHES SYSTEM::GET-MATCH ++- SYSTEM::ADD-FILE ANSI-LOOP::LOOP-DO-ALWAYS SLOOP::THE-TYPE ++- SYSTEM::?PUSH SYSTEM::INCREMENT-CURSOR ++- SYSTEM::CHECK-SEQ-START-END SLOOP::MAKE-VALUE ++- SLOOP::THEREIS-SLOOP-COLLECT ANSI-LOOP::LOOP-DO-WHILE ++- COMMON-LISP::COERCE ANSI-LOOP::LOOP-TEQUAL ++- ANSI-LOOP::LOOP-DECLARE-VARIABLE COMMON-LISP::LOGNAND ++- COMMON-LISP::LOGORC1 SYSTEM::BREAK-STEP-NEXT ++- SLOOP::LOGXOR-SLOOP-COLLECT COMMON-LISP::LOGNOR ++- COMPILER::COMPILER-DEF-HOOK ANSI-LOOP::LOOP-TASSOC ++- SYSTEM::GET-LINE-OF-FORM SLOOP::MAXIMIZE-SLOOP-COLLECT ++- ANSI-LOOP::LOOP-DO-IF SYSTEM::SETF-EXPAND SYSTEM::DM-V ++- SYSTEM::ITERATE-OVER-BKPTS COMMON-LISP::NTHCDR ++- SYSTEM::CONDITION-PASS SYSTEM::DISPLAY-COMPILED-ENV ++- COMMON-LISP::LDB-TEST ANSI-LOOP::LOOP-MAYBE-BIND-FORM ++- SYSTEM::SUPER-GO SYSTEM::SETF-LOGICAL-PATHNAME-TRANSLATIONS ++- FPE::RF SYSTEM::SUB-INTERVAL-P SYSTEM::LEFT-PARENTHESIS-READER ++- COMMON-LISP::FILE-STRING-LENGTH SYSTEM::OBJLT SYSTEM::MSUB ++- SYSTEM::COERCE-TO-STRING SYSTEM::SAFE-EVAL ++- SYSTEM::SET-PATH-STREAM-NAME SYSTEM::SET-BACK ++- ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION COMMON-LISP::LOGTEST ++- SYSTEM::*BREAK-POINTS* SLOOP::=-SLOOP-FOR ++- SLOOP::MINIMIZE-SLOOP-COLLECT SYSTEM::KEYWORD-SUPPLIED-P ++- SLOOP::COUNT-SLOOP-COLLECT FPE::%-READER COMMON-LISP::LOGORC2 ++- SYSTEM::SEQUENCE-CURSOR SYSTEM::LOOKUP-KEYWORD ++- COMMON-LISP::BYTE SYSTEM::PARSE-SLOT-DESCRIPTION ++- COMMON-LISP::LOGANDC1 SYSTEM::DM-NTH-CDR FPE::0-READER ++- SLOOP::L-EQUAL SYSTEM::LIST-DELQ SYSTEM::DM-NTH ++- COMMON-LISP::LDB SYSTEM::SETF-HELPER ++- SLOOP::NEVER-SLOOP-COLLECT SLOOP::PARSE-LOOP-MAP ++- COMMON-LISP::NTH SYSTEM::BREAK-STEP-INTO ++- SYSTEM::GET-INFO-CHOICES SLOOP::IN-TABLE-SLOOP-MAP ++- SYSTEM::GET-NODES COMMON-LISP::VECTOR-PUSH ++- COMMON-LISP::PATHNAME-MATCH-P SYSTEM::DBL-UP ++- ANSI-LOOP::LOOP-LOOKUP-KEYWORD FPE::READ-INSTRUCTION ++- SLOOP::ALWAYS-SLOOP-COLLECT SYSTEM::SET-DIR SYSTEM::INFO-AUX ++- SYSTEM::DISPLAY-ENV COMMON-LISP::DOCUMENTATION ++- SYSTEM::OVERWRITE-SLOT-DESCRIPTIONS)) +++ SYSTEM::RESET-SYS-PATHS)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::*) ++- COMMON-LISP::APROPOS ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE ++- COMMON-LISP::FFLOOR SYSTEM::PRINT-DOC SYSTEM::INFO ++- SYSTEM::PARSE-BODY-HEADER COMMON-LISP::INVOKE-RESTART ++- SYSTEM::BREAK-FUNCTION SYSTEM::SHOW-INFO COMMON-LISP::FROUND ++- COMMON-LISP::GET-SETF-EXPANSION COMMON-LISP::PARSE-NAMESTRING ++- SYSTEM::APROPOS-DOC COMMON-LISP::ENSURE-DIRECTORIES-EXIST ++- COMMON-LISP::USE-VALUE COMMON-LISP::READ-FROM-STRING ++- COMMON-LISP::FTRUNCATE COMMON-LISP::STORE-VALUE ++- SYSTEM::STEPPER SYSTEM::GET-SETF-METHOD-MULTIPLE-VALUE ++- COMMON-LISP::APROPOS-LIST COMMON-LISP::FCEILING ++- COMMON-LISP::WRITE-TO-STRING ++- COMMON-LISP::DECODE-UNIVERSAL-TIME)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) +++ COMMON-LISP::T) +++ SYSTEM::MAYBE-BREAK SYSTEM::MME3 SYSTEM::FIND-LINE-IN-FUN +++ SYSTEM::SETF-STRUCTURE-ACCESS SYSTEM::EXPAND-RANGE +++ SYSTEM::MINMAX SYSTEM::COERCE-TO-CONDITION +++ SLOOP::FIRST-SLOOP-FOR SLOOP::FIRST-USE-SLOOP-FOR +++ SYSTEM::DO-BREAK-LEVEL SYSTEM::ELSUB +++ ANSI-LOOP::LOOP-FOR-ARITHMETIC SYSTEM::CALL-TEST +++ SYSTEM::ELEMENT SYSTEM::LOAD-PATHNAME)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- SYSTEM::SETF-EXPAND-1 SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS ++- SYSTEM::WARN-VERSION ANSI-LOOP::LOOP-TRANSLATE ++- ANSI-LOOP::LOOP-FOR-IN ANSI-LOOP::PRINT-LOOP-UNIVERSE ++- ANSI-LOOP::LOOP-STANDARD-EXPANSION ++- ANSI-LOOP::LOOP-ANSI-FOR-EQUALS SYSTEM::DM-VL ++- SYSTEM::SHARP-A-READER COMMON-LISP::DEPOSIT-FIELD ++- SYSTEM::RESTART-CASE-EXPRESSION-CONDITION ++- SYSTEM::APPLY-DISPLAY-FUN ANSI-LOOP::HIDE-VARIABLE-REFERENCE ++- SYSTEM::FLOATING-POINT-ERROR SYSTEM::GET-SLOT-POS +++ SYSTEM::SHARP-P-READER ANSI-LOOP::HIDE-VARIABLE-REFERENCE +++ SYSTEM::CHECK-TRACE-ARGS SYSTEM::SHARP-U-READER +++ SYSTEM::FLOATING-POINT-ERROR ANSI-LOOP::LOOP-FOR-IN +++ COMMON-LISP::DEPOSIT-FIELD SYSTEM::GET-SLOT-POS +++ SYSTEM::SHARP-A-READER SYSTEM::SHARP-V-READER +++ SYSTEM::PATHNAME-PARSE +++ SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS SYSTEM::SETF-EXPAND-1 +++ COMMON-LISP::DPB SYSTEM::RESTART-CASE-EXPRESSION-CONDITION +++ SYSTEM::CHECK-S-DATA ANSI-LOOP::LOOP-FOR-BEING +++ SYSTEM::TO-REGEXP-OR-NAMESTRING SYSTEM::APPLY-DISPLAY-FUN +++ ANSI-LOOP::LOOP-ANSI-FOR-EQUALS ANSI-LOOP::LOOP-SUM-COLLECTION +++ ANSI-LOOP::LOOP-FOR-ON SYSTEM::MFR +++ ANSI-LOOP::LOOP-STANDARD-EXPANSION SYSTEM::PROG?* ++ ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE ++- SYSTEM::MAKE-BREAK-POINT SYSTEM::SHARP-V-READER ++- SYSTEM::TO-REGEXP-OR-NAMESTRING ANSI-LOOP::LOOP-FOR-ON ++- SYSTEM::SHARP-U-READER ANSI-LOOP::LOOP-SUM-COLLECTION ++- SYSTEM::SHARP-P-READER SYSTEM::MAKE-T-TYPE ++- ANSI-LOOP::LOOP-FOR-ACROSS SYSTEM::MFR SYSTEM::RECURSE-DIR ++- SYSTEM::PATHNAME-PARSE ANSI-LOOP::LOOP-FOR-BEING ++- COMMON-LISP::DPB SYSTEM::SHARP-DQ-READER ++- SYSTEM::CHECK-TRACE-ARGS SYSTEM::DEFMACRO* ++- SYSTEM::CHECK-S-DATA FPE::REF)) +++ SYSTEM::SHARP-DQ-READER SYSTEM::RECURSE-DIR SYSTEM::DM-VL +++ ANSI-LOOP::LOOP-FOR-ACROSS ANSI-LOOP::PRINT-LOOP-UNIVERSE +++ SYSTEM::WARN-VERSION ANSI-LOOP::LOOP-TRANSLATE +++ SYSTEM::DEFMACRO* SYSTEM::MAKE-BREAK-POINT SYSTEM::MAKE-T-TYPE +++ FPE::REF)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::T) +++ SYSTEM::MME2 COMMON-LISP::SUBSTITUTE-IF-NOT +++ ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH +++ COMMON-LISP::SUBSTITUTE SYSTEM::WALK-DIR +++ SYSTEM::CHECK-TYPE-SYMBOL COMMON-LISP::TRANSLATE-PATHNAME +++ ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH +++ COMMON-LISP::MAP ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH +++ ANSI-LOOP::ADD-LOOP-PATH SLOOP::LOOP-DECLARE-BINDING +++ SYSTEM::COMPLETE-PROP SYSTEM::MATCH-COMPONENT +++ COMMON-LISP::NSUBSTITUTE COMMON-LISP::NSUBSTITUTE-IF +++ COMMON-LISP::SUBSTITUTE-IF COMMON-LISP::NSUBSTITUTE-IF-NOT +++ SYSTEM::PUSH-LET-BINDING ANSI-LOOP::LOOP-MAKE-VARIABLE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++- SYSTEM::FIND-IHS COMMON-LISP::NSET-DIFFERENCE ++- COMMON-LISP::BIT-NAND SYSTEM::BREAK-CALL ++- COMMON-LISP::COUNT-IF-NOT COMMON-LISP::DELETE ++- SYSTEM::INTERNAL-COUNT COMMON-LISP::BIT-ORC1 ++- COMMON-LISP::DELETE-IF COMMON-LISP::BIT-ANDC1 ++- SYSTEM::VECTOR-PUSH-STRING COMMON-LISP::MISMATCH ++- COMMON-LISP::NOTEVERY SYSTEM::PROCESS-ERROR COMMON-LISP::TYPEP ++- COMMON-LISP::BIT-IOR COMMON-LISP::BIT-EQV ++- COMMON-LISP::COUNT-IF COMMON-LISP::REMOVE-IF ++- COMMON-LISP::EVERY COMMON-LISP::POSITION-IF-NOT ++- COMMON-LISP::ADJUST-ARRAY COMMON-LISP::VECTOR-PUSH-EXTEND ++- SYSTEM::INTERNAL-COUNT-IF-NOT COMMON-LISP::COUNT ++- COMMON-LISP::DELETE-IF-NOT COMMON-LISP::NINTERSECTION ++- COMMON-LISP::FIND-IF-NOT COMMON-LISP::BIT-ORC2 ++- COMMON-LISP::SUBSETP COMMON-LISP::SOME SYSTEM::WREADDIR ++- COMMON-LISP::SET-DIFFERENCE COMMON-LISP::UNION ++- COMMON-LISP::BIT-XOR SLOOP::PARSE-LOOP-MACRO ++- COMMON-LISP::REPLACE COMMON-LISP::REMOVE ++- SLOOP::LOOP-ADD-BINDING COMMON-LISP::BIT-ANDC2 ++- COMMON-LISP::READ-SEQUENCE COMMON-LISP::CERROR ++- COMMON-LISP::INTERSECTION COMMON-LISP::POSITION-IF ++- ANSI-LOOP::LOOP-CHECK-DATA-TYPE SYSTEM::INTERNAL-COUNT-IF ++- COMMON-LISP::NUNION COMMON-LISP::WRITE-SEQUENCE ++- COMMON-LISP::MAP-INTO COMMON-LISP::MAKE-SEQUENCE ++- COMMON-LISP::SET-EXCLUSIVE-OR SLOOP::IN-ARRAY-SLOOP-FOR ++- COMMON-LISP::FIND-IF COMMON-LISP::SEARCH COMMON-LISP::FILL ++- COMMON-LISP::FIND COMMON-LISP::NOTANY ++- COMMON-LISP::NSET-EXCLUSIVE-OR COMMON-LISP::BIT-NOR ++- COMMON-LISP::REMOVE-IF-NOT COMMON-LISP::POSITION ++- COMMON-LISP::BIT-AND)) +++ COMMON-LISP::DELETE-IF-NOT COMMON-LISP::FILL +++ COMMON-LISP::SET-EXCLUSIVE-OR ANSI-LOOP::LOOP-CHECK-DATA-TYPE +++ SYSTEM::INTERNAL-COUNT-IF-NOT COMMON-LISP::SOME +++ COMMON-LISP::COUNT COMMON-LISP::NOTANY SYSTEM::INTERNAL-COUNT +++ COMMON-LISP::POSITION-IF-NOT COMMON-LISP::SET-DIFFERENCE +++ SLOOP::IN-ARRAY-SLOOP-FOR COMMON-LISP::NUNION +++ COMMON-LISP::BIT-NAND SYSTEM::PROCESS-ERROR +++ COMMON-LISP::BIT-ANDC2 COMMON-LISP::POSITION-IF +++ COMMON-LISP::NSET-DIFFERENCE COMMON-LISP::WRITE-SEQUENCE +++ COMMON-LISP::BIT-XOR COMMON-LISP::READ-SEQUENCE +++ COMMON-LISP::DELETE-IF COMMON-LISP::MAP-INTO +++ COMMON-LISP::SUBSETP COMMON-LISP::REMOVE-IF-NOT +++ COMMON-LISP::FIND-IF COMMON-LISP::INTERSECTION +++ COMMON-LISP::REPLACE COMMON-LISP::VECTOR-PUSH-EXTEND +++ COMMON-LISP::BIT-ORC2 COMMON-LISP::POSITION +++ COMMON-LISP::CERROR COMMON-LISP::FIND COMMON-LISP::BIT-ORC1 +++ SYSTEM::BREAK-CALL SLOOP::PARSE-LOOP-MACRO COMMON-LISP::EVERY +++ COMMON-LISP::COUNT-IF-NOT COMMON-LISP::ADJUST-ARRAY +++ COMMON-LISP::SEARCH COMMON-LISP::REMOVE-IF +++ COMMON-LISP::NOTEVERY COMMON-LISP::TYPEP COMMON-LISP::COUNT-IF +++ SYSTEM::WREADDIR SYSTEM::INTERNAL-COUNT-IF COMMON-LISP::DELETE +++ COMMON-LISP::NSET-EXCLUSIVE-OR COMMON-LISP::UNION +++ COMMON-LISP::BIT-EQV COMMON-LISP::NINTERSECTION +++ COMMON-LISP::MISMATCH SYSTEM::FIND-IHS COMMON-LISP::REMOVE +++ SYSTEM::VECTOR-PUSH-STRING COMMON-LISP::BIT-IOR +++ COMMON-LISP::FIND-IF-NOT COMMON-LISP::MAKE-SEQUENCE +++ COMMON-LISP::BIT-ANDC1 SLOOP::LOOP-ADD-BINDING +++ COMMON-LISP::BIT-NOR COMMON-LISP::BIT-AND)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T) +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- SYSTEM::FIND-LINE-IN-FUN ANSI-LOOP::LOOP-FOR-ARITHMETIC ++- SYSTEM::EXPAND-RANGE SYSTEM::MAYBE-BREAK SYSTEM::MINMAX ++- SLOOP::FIRST-USE-SLOOP-FOR SLOOP::FIRST-SLOOP-FOR ++- SYSTEM::SETF-STRUCTURE-ACCESS SYSTEM::DO-BREAK-LEVEL ++- SYSTEM::CALL-TEST SYSTEM::ELEMENT SYSTEM::LOAD-PATHNAME ++- SYSTEM::COERCE-TO-CONDITION SYSTEM::ELSUB)) +++ SYSTEM::DO-ARG-COUNT-ERROR SYSTEM::PUSH-SUB-LIST-BINDING)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- SLOOP::DEF-LOOP-INTERNAL COMMON-LISP::MERGE ++- SYSTEM::PRINT-STACK-FRAME)) +++ SYSTEM::MAKE-PREDICATE SYSTEM::DO?* SYSTEM::MAKE-CONSTRUCTOR)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::*) +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) ++ COMMON-LISP::T) ++- COMMON-LISP::ENCODE-UNIVERSAL-TIME)) +++ ANSI-LOOP::LOOP-SEQUENCER)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::*) +++ COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++- ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH ++- SYSTEM::COMPLETE-PROP SYSTEM::CHECK-TYPE-SYMBOL ++- COMMON-LISP::NSUBSTITUTE ++- ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH COMMON-LISP::SUBSTITUTE ++- COMMON-LISP::TRANSLATE-PATHNAME COMMON-LISP::NSUBSTITUTE-IF ++- COMMON-LISP::MAP SLOOP::LOOP-DECLARE-BINDING SYSTEM::WALK-DIR ++- SYSTEM::MATCH-COMPONENT ANSI-LOOP::LOOP-MAKE-VARIABLE ++- ANSI-LOOP::ADD-LOOP-PATH COMMON-LISP::SUBSTITUTE-IF ++- COMMON-LISP::NSUBSTITUTE-IF-NOT SYSTEM::MME2 ++- ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH ++- COMMON-LISP::SUBSTITUTE-IF-NOT SYSTEM::PUSH-LET-BINDING)) +++ SYSTEM::EXPAND-WILD-DIRECTORY SLOOP::DEF-LOOP-INTERNAL +++ COMMON-LISP::MERGE SYSTEM::PRINT-STACK-FRAME)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++@@ -243,88 +286,120 @@ ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::T) ++- SYSTEM::SHARP-SHARP-READER SYSTEM::SHARP-EQ-READER)) +++ SYSTEM::SHARP-EQ-READER SYSTEM::SHARP-SHARP-READER)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) ++ COMMON-LISP::T) ++- SYSTEM::DO-ARG-COUNT-ERROR SYSTEM::PUSH-SUB-LIST-BINDING)) +++ COMMON-LISP::ENCODE-UNIVERSAL-TIME)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++- SYSTEM::MAKE-CONSTRUCTOR SYSTEM::MAKE-PREDICATE)) +++ SYSTEM::UNIVERSAL-ERROR-HANDLER)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ SYSTEM::PARSE-DEFMACRO SYSTEM::PARSE-DEFMACRO-LAMBDA-LIST)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::*) +++ COMMON-LISP::SUBST COMMON-LISP::SUBST-IF-NOT +++ COMMON-LISP::SUBST-IF SYSTEM::MASET)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ SYSTEM::READ-INSPECT-COMMAND SYSTEM::RESTART-PRINT +++ ANSI-LOOP::LOOP-GET-COLLECTION-INFO SYSTEM::SHARP-+-READER +++ SYSTEM::VERIFY-KEYWORDS SYSTEM::SHARP-S-READER +++ SYSTEM::LIST-MERGE-SORT SYSTEM::SHARP---READER)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ SYSTEM::PARSE-BODY COMMON-LISP::SORT +++ SLOOP::FIND-IN-ORDERED-LIST COMMON-LISP::REDUCE +++ COMMON-LISP::STABLE-SORT COMMON-LISP::SUBTYPEP)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++- COMMON-LISP::T) ++- ANSI-LOOP::LOOP-SEQUENCER)) +++ COMMON-LISP::*) +++ SYSTEM::TRACE-CALL)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::T) ++- SYSTEM::UNIVERSAL-ERROR-HANDLER)) ++-(COMMON-LISP::MAPC ++- (COMMON-LISP::LAMBDA (COMPILER::X) ++- (COMMON-LISP::SETF ++- (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) ++- COMMON-LISP::T)) ++- '(SYSTEM::SI-FIND-CLASS SYSTEM::WARNINGP SYSTEM::SI-CLASS-OF ++- SYSTEM::CONDITION-CLASS-P SYSTEM::UNTRACE-ONE ++- SYSTEM::MAKE-ACCESS-FUNCTION SYSTEM::SIMPLE-CONDITION-CLASS-P ++- SYSTEM::CONDITIONP SYSTEM::AUTOLOAD ++- SYSTEM::SI-CLASS-PRECEDENCE-LIST SYSTEM::SI-CLASSP ++- FPE::BREAK-ON-FLOATING-POINT-EXCEPTIONS SYSTEM::TRACE-ONE ++- SYSTEM::AUTOLOAD-MACRO SYSTEM::DEFINE-STRUCTURE ++- SYSTEM::SI-CLASS-NAME)) +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ SYSTEM::PUSH-OPTIONAL-BINDING)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++- SYSTEM::INSTREAM-NAME ANSI-LOOP::LOOP-LIST-STEP ++- COMMON-LISP::PRIN1-TO-STRING ANSI-LOOP::NAMED-VARIABLE ++- SYSTEM::WAITING SYSTEM::FIND-DECLARATIONS COMMON-LISP::INSPECT ++- SYSTEM::END-WAITING SYSTEM::BREAK-GO SYSTEM::INFO-SUBFILE ++- COMMON-LISP::INVOKE-RESTART-INTERACTIVELY ++- ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES SYSTEM::INSPECT-OBJECT ++- SYSTEM::BREAK-LEVEL-INVOKE-RESTART SYSTEM::EXPAND-RANGES ++- SYSTEM::GET-&ENVIRONMENT COMMON-LISP::DESCRIBE ++- COMMON-LISP::PRINC-TO-STRING)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +++ SYSTEM::MAKE-CONTEXT ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE +++ ANSI-LOOP::MAKE-LOOP-UNIVERSE SYSTEM::MAKE-S-DATA +++ SYSTEM::NEXT-MATCH COMMON-LISP::USER-HOMEDIR-PATHNAME +++ SYSTEM::STEP-NEXT ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL +++ COMMON-LISP::VECTOR SLOOP::PARSE-LOOP-WITH +++ COMMON-LISP::COMPUTE-RESTARTS COMMON-LISP::BREAK +++ ANSI-LOOP::MAKE-LOOP-PATH ANSI-LOOP::LOOP-GENTEMP +++ COMMON-LISP::ABORT COMMON-LISP::YES-OR-NO-P +++ SYSTEM::MAKE-INSTREAM SYSTEM::DBL-READ +++ SYSTEM::MAYBE-CLEAR-INPUT SYSTEM::MAKE-RESTART +++ ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL COMMON-LISP::Y-OR-N-P +++ SLOOP::PARSE-LOOP-DECLARE ANSI-LOOP::MAKE-LOOP-COLLECTOR +++ SYSTEM::DESCRIBE-ENVIRONMENT SYSTEM::STEP-INTO +++ SYSTEM::CURRENT-STEP-FUN COMMON-LISP::DRIBBLE +++ COMMON-LISP::MAKE-PATHNAME SYSTEM::BREAK-LOCALS SYSTEM::LOC +++ SYSTEM::TRANSFORM-KEYWORDS)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++- COMMON-LISP::ABORT ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE ++- SYSTEM::MAKE-S-DATA ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL ++- ANSI-LOOP::MAKE-LOOP-PATH SYSTEM::CURRENT-STEP-FUN SYSTEM::LOC ++- SYSTEM::DBL-READ SYSTEM::MAKE-RESTART ++- SYSTEM::TRANSFORM-KEYWORDS COMMON-LISP::Y-OR-N-P ++- SYSTEM::NEXT-MATCH COMMON-LISP::COMPUTE-RESTARTS ++- SLOOP::PARSE-LOOP-WITH COMMON-LISP::VECTOR SYSTEM::STEP-NEXT ++- ANSI-LOOP::MAKE-LOOP-COLLECTOR ++- COMMON-LISP::USER-HOMEDIR-PATHNAME SLOOP::PARSE-LOOP-DECLARE ++- COMMON-LISP::YES-OR-NO-P SYSTEM::STEP-INTO ++- SYSTEM::MAKE-CONTEXT SYSTEM::BREAK-LOCALS ++- SYSTEM::DESCRIBE-ENVIRONMENT COMMON-LISP::DRIBBLE ++- ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL SYSTEM::MAYBE-CLEAR-INPUT ++- COMMON-LISP::BREAK ANSI-LOOP::LOOP-GENTEMP ++- ANSI-LOOP::MAKE-LOOP-UNIVERSE SYSTEM::MAKE-INSTREAM ++- COMMON-LISP::MAKE-PATHNAME)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) +++ ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES +++ COMMON-LISP::PRIN1-TO-STRING SYSTEM::GET-&ENVIRONMENT +++ COMMON-LISP::INSPECT SYSTEM::BREAK-GO +++ SYSTEM::PARSE-BODY-HEADER COMMON-LISP::PRINC-TO-STRING +++ SYSTEM::EXPAND-RANGES ANSI-LOOP::NAMED-VARIABLE +++ ANSI-LOOP::LOOP-LIST-STEP SYSTEM::INSTREAM-NAME +++ SYSTEM::WAITING SYSTEM::END-WAITING COMMON-LISP::DESCRIBE +++ SYSTEM::INFO-SUBFILE SYSTEM::FIND-DECLARATIONS +++ SYSTEM::INSPECT-OBJECT SYSTEM::BREAK-LEVEL-INVOKE-RESTART +++ COMMON-LISP::INVOKE-RESTART-INTERACTIVELY)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- ((COMMON-LISP::INTEGER -9223372036854775808 ++- 9223372036854775807)) ++- COMMON-LISP::FIXNUM) ++- FPE::FE-ENABLE SYSTEM::DBL-WHAT-FRAME)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) +++ SYSTEM::S-DATA-SIZE FPE::REG-LOOKUP SYSTEM::INSTREAM-LINE +++ SYSTEM::S-DATA-LENGTH SYSTEM::THE-START)) +++(COMMON-LISP::MAPC +++ (COMMON-LISP::LAMBDA (COMPILER::X) +++ (COMMON-LISP::SETF +++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) +++ COMMON-LISP::T)) +++ '(SYSTEM::SI-CLASS-PRECEDENCE-LIST SYSTEM::AUTOLOAD +++ SYSTEM::UNTRACE-ONE SYSTEM::TRACE-ONE SYSTEM::CONDITIONP +++ SYSTEM::MAKE-ACCESS-FUNCTION SYSTEM::SI-CLASS-NAME +++ SYSTEM::SI-CLASSP SYSTEM::SI-CLASS-OF SYSTEM::SI-FIND-CLASS +++ SYSTEM::CONDITION-CLASS-P SYSTEM::AUTOLOAD-MACRO +++ SYSTEM::WARNINGP SYSTEM::DEFINE-STRUCTURE +++ FPE::BREAK-ON-FLOATING-POINT-EXCEPTIONS +++ SYSTEM::SIMPLE-CONDITION-CLASS-P)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++@@ -336,155 +411,9 @@ ++ SYSTEM::ROUND-UP)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++- COMMON-LISP::*) ++- (COMMON-LISP::INTEGER -9223372036854775808 ++- 9223372036854775807)) ++- COMMON-LISP::FIXNUM) ++- SYSTEM::ATOI)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++- SYSTEM::REGEXP-CONV SYSTEM::DIR-CONJ SYSTEM::DIR-P ++- ANSI-LOOP::LOOP-LIST-COLLECTION COMMON-LISP::COSH ++- SYSTEM::GET-BYTE-STREAM-NCHARS SYSTEM::INSPECT-CONS ++- SYSTEM::KNOWN-TYPE-P SYSTEM::LNP COMMON-LISP::SEVENTH ++- SYSTEM::BKPT-FUNCTION SYSTEM::WILD-DIR-ELEMENT-P ++- COMMON-LISP::COMPILER-MACRO-FUNCTION ++- ANSI-LOOP::LOOP-HACK-ITERATION ++- COMMON-LISP::ECHO-STREAM-OUTPUT-STREAM ++- SYSTEM::DIRECTORY-LIST-CHECK COMMON-LISP::FILE-WRITE-DATE ++- SYSTEM::NORMALIZE-TYPE COMMON-LISP::EIGHTH SYSTEM::TOGGLE-CASE ++- SYSTEM::SHOW-ENVIRONMENT ++- COMMON-LISP::TWO-WAY-STREAM-INPUT-STREAM SYSTEM::GET-PATH ++- COMMON-LISP::ASINH SYSTEM::FIND-KCL-TOP-RESTART ++- SYSTEM::RESTART-P SYSTEM::EVAL-FEATURE SYSTEM::ALOAD ++- COMMON-LISP::PHASE SLOOP::SUBSTITUTE-SLOOP-BODY ++- COMMON-LISP::ASIN SYSTEM::NODES-FROM-INDEX ++- SYSTEM::MAKE-DEFPACKAGE-FORM ANSI-LOOP::LOOP-COLLECTOR-DTYPE ++- SYSTEM::LOGICAL-PATHNAMEP SYSTEM::INSPECT-VECTOR ++- ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS ++- SYSTEM::RESTART-REPORT-FUNCTION SYSTEM::IHS-VISIBLE ++- SLOOP::LOOP-COLLECT-KEYWORD-P ANSI-LOOP::LOOP-TYPED-INIT ++- COMMON-LISP::VECTOR-POP SYSTEM::UNIQUE-ID ++- ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS ++- SYSTEM::SIMPLE-ARRAY-P COMMON-LISP::ACOS SYSTEM::DBL-EVAL ++- SYSTEM::INSPECT-STRING SYSTEM::MLP ++- SYSTEM::INSTREAM-STREAM-NAME SYSTEM::WILD-NAMESTRING-P ++- ANSI-LOOP::LOOP-PATH-FUNCTION ++- SYSTEM::GET-STRING-INPUT-STREAM-INDEX ++- ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE SYSTEM::SEQTYPE ++- ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS ++- SYSTEM::BEST-ARRAY-ELEMENT-TYPE ++- ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA SYSTEM::S-DATA-FROZEN ++- SYSTEM::S-DATA-DOCUMENTATION SYSTEM::DWIM COMMON-LISP::SIGNUM ++- SYSTEM::FIND-DOCUMENTATION ANSI-LOOP::LOOP-COLLECTOR-HISTORY ++- ANSI-LOOP::LOOP-MAKE-PSETQ FPE::GREF SYSTEM::S-DATA-OFFSET ++- SYSTEM::WILD-PATH-ELEMENT-P SYSTEM::INSTREAM-P ++- COMMON-LISP::DIRECTORY-NAMESTRING SYSTEM::INSPECT-ARRAY ++- COMMON-LISP::ARRAY-DIMENSIONS ++- ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS ANSI-LOOP::LOOP-MINIMAX-P ++- SLOOP::RETURN-SLOOP-MACRO SYSTEM::WALK-THROUGH ++- SYSTEM::NEXT-STACK-FRAME SYSTEM::S-DATA-NAME COMMON-LISP::TANH ++- SYSTEM::BREAK-BACKWARD-SEARCH-STACK COMMON-LISP::TENTH ++- SYSTEM::INFO-NODE-FROM-POSITION FPE::ST-LOOKUP ++- COMMON-LISP::RESTART-NAME SYSTEM::S-DATA-TYPE ++- SYSTEM::BKPT-FILE-LINE COMMON-LISP::FIND-ALL-SYMBOLS ++- COMMON-LISP::FIFTH SLOOP::LOOP-LET-BINDINGS ++- COMMON-LISP::ECHO-STREAM-INPUT-STREAM ++- ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED ++- COMMON-LISP::PROBE-FILE SYSTEM::MAKE-FRAME ++- SYSTEM::IHS-NOT-INTERPRETED-ENV SYSTEM::SEARCH-STACK ++- COMMON-LISP::COMPILE-FILE-PATHNAME ++- SYSTEM::PRINT-SYMBOL-APROPOS COMMON-LISP::LOGNOT ++- SYSTEM::INFO-GET-TAGS SYSTEM::SHORT-NAME ++- ANSI-LOOP::LOOP-MINIMAX-TYPE COMMON-LISP::SIXTH ++- COMMON-LISP::SECOND ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS ++- COMMON-LISP::TWO-WAY-STREAM-OUTPUT-STREAM ++- SYSTEM::S-DATA-INCLUDES SYSTEM::RESTART-INTERACTIVE-FUNCTION ++- SLOOP::TRANSLATE-NAME SYSTEM::PATCH-SHARP COMMON-LISP::ABS ++- ANSI-LOOP::LOOP-CONSTANTP SYSTEM::LEAP-YEAR-P ++- ANSI-LOOP::LOOP-UNIVERSE-ANSI ANSI-LOOP::LOOP-EMIT-BODY ++- COMMON-LISP::HOST-NAMESTRING COMMON-LISP::FIRST ++- SYSTEM::INSERT-BREAK-POINT ++- COMMON-LISP::LOAD-LOGICAL-PATHNAME-TRANSLATIONS ++- COMMON-LISP::DELETE-FILE ANSI-LOOP::LOOP-PSEUDO-BODY ++- SYSTEM::GET-NEXT-VISIBLE-FUN SYSTEM::S-DATA-HAS-HOLES ++- ANSI-LOOP::LOOP-COLLECTOR-NAME COMMON-LISP::FOURTH ++- SYSTEM::BKPT-FILE SYSTEM::CANONICALIZE-PATHNAME-DIRECTORY ++- SYSTEM::INSTREAM-STREAM SYSTEM::PNL1 SYSTEM::IHS-FNAME ++- SYSTEM::S-DATA-SLOT-POSITION SLOOP::PARSE-LOOP ++- SYSTEM::CHECK-TRACE-SPEC SYSTEM::S-DATA-CONSTRUCTORS ++- SYSTEM::S-DATA-STATICP SYSTEM::CONTEXT-P ++- COMMON-LISP::LOGICAL-PATHNAME-TRANSLATIONS ++- SYSTEM::INFO-GET-FILE COMMON-LISP::COMPLEMENT ++- SYSTEM::INSPECT-NUMBER SYSTEM::RESET-TRACE-DECLARATIONS ++- ANSI-LOOP::LOOP-PATH-P SLOOP::REPEAT-SLOOP-MACRO SYSTEM::DO-F ++- SYSTEM::INSPECT-PACKAGE SYSTEM::PATH-STREAM-NAME ++- SYSTEM::GET-INSTREAM COMMON-LISP::BYTE-SIZE ++- SYSTEM::RESTART-FUNCTION FPE::LOOKUP SYSTEM::S-DATA-CONC-NAME ++- COMMON-LISP::PROVIDE SYSTEM::S-DATA-NAMED SYSTEM::PRINT-FRS ++- ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE SYSTEM::NODE-OFFSET ++- ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE SYSTEM::PRINT-IHS ++- ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS COMMON-LISP::TRUENAME ++- SYSTEM::BREAK-FORWARD-SEARCH-STACK ++- COMMON-LISP::CONCATENATED-STREAM-STREAMS SYSTEM::VERSION-PARSE ++- SYSTEM::INSPECT-CHARACTER SYSTEM::LOGICAL-PATHNAME-HOST-P ++- SYSTEM::DM-BAD-KEY SYSTEM::EXPAND-HOME-DIR ++- ANSI-LOOP::LOOP-PATH-USER-DATA ++- ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS SYSTEM::INSPECT-SYMBOL ++- COMMON-LISP::INVOKE-DEBUGGER ++- SYSTEM::LOGICAL-PATHNAME-DESIGNATOR-P ++- COMMON-LISP::BYTE-POSITION COMMON-LISP::ISQRT COMMON-LISP::CIS ++- ANSI-LOOP::LOOP-COLLECTOR-CLASS ++- COMMON-LISP::SYNONYM-STREAM-SYMBOL ANSI-LOOP::LOOP-PATH-NAMES ++- SYSTEM::RE-QUOTE-STRING SYSTEM::INSPECT-STRUCTURE ++- COMMON-LISP::RATIONAL FPE::XMM-LOOKUP ++- SYSTEM::REWRITE-RESTART-CASE-CLAUSE ++- SYSTEM::S-DATA-PRINT-FUNCTION ++- SYSTEM::RESTRICT-STREAM-ELEMENT-TYPE SLOOP::SLOOP-SLOOP-MACRO ++- COMMON-LISP::NAMESTRING SYSTEM::ENSURE-DIR-STRING ++- COMMON-LISP::CONSTANTLY SLOOP::PARSE-LOOP-INITIALLY ++- SYSTEM::S-DATA-RAW SYSTEM::ADD-TO-HOTLIST SYSTEM::FRS-KIND ++- ANSI-LOOP::LOOP-MAXMIN-COLLECTION ++- ANSI-LOOP::LOOP-COLLECTOR-DATA SYSTEM::PROCESS-ARGS ++- SYSTEM::COERCE-SLASH-TERMINATED SYSTEM::MAKE-KCL-TOP-RESTART ++- COMMON-LISP::ATANH ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD ++- COMMON-LISP::SINH ANSI-LOOP::LOOP-UNIVERSE-P ++- ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED ++- SYSTEM::S-DATA-INCLUDED COMMON-LISP::STREAM-EXTERNAL-FORMAT ++- SYSTEM::COMPUTING-ARGS-P SYSTEM::REAL-ASINH ++- ANSI-LOOP::LOOP-CONSTRUCT-RETURN ++- SYSTEM::S-DATA-SLOT-DESCRIPTIONS SYSTEM::FIX-LOAD-PATH ++- SYSTEM::CHECK-DECLARATIONS ++- ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS ++- SLOOP::POINTER-FOR-COLLECT COMMON-LISP::LOGICAL-PATHNAME ++- SYSTEM::CHDIR SYSTEM::IDESCRIBE ++- ANSI-LOOP::LOOP-MINIMAX-OPERATIONS COMMON-LISP::ACOSH ++- COMMON-LISP::NINTH ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE ++- ANSI-LOOP::LOOP-COLLECTOR-P SYSTEM::S-DATA-P SYSTEM::BKPT-FORM ++- COMMON-LISP::FILE-NAMESTRING SYSTEM::TERMINAL-INTERRUPT ++- SYSTEM::SETUP-INFO SLOOP::PARSE-NO-BODY ++- SYSTEM::DM-KEY-NOT-ALLOWED ANSI-LOOP::LOOP-EMIT-FINAL-VALUE ++- SYSTEM::FREEZE-DEFSTRUCT SYSTEM::DBL-RPL-LOOP ++- SYSTEM::TRACE-ONE-PREPROCESS ++- COMMON-LISP::BROADCAST-STREAM-STREAMS COMMON-LISP::THIRD ++- SLOOP::AVERAGING-SLOOP-MACRO SYSTEM::SHOW-BREAK-POINT ++- COMMON-LISP::PATHNAME ANSI-LOOP::LOOP-DO-THEREIS ++- COMMON-LISP::FILE-AUTHOR ANSI-LOOP::LOOP-MAKE-DESETQ ++- SYSTEM::NC SYSTEM::NUMBER-OF-DAYS-FROM-1900 ++- SYSTEM::RESTART-TEST-FUNCTION SYSTEM::WHICH ++- ANSI-LOOP::DESTRUCTURING-SIZE COMMON-LISP::FILE-LENGTH)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++- SYSTEM::BREAK-VS ANSI-LOOP::LOOP-OPTIONAL-TYPE ++- SYSTEM::BREAK-BDS SYSTEM::IHS-BACKTRACE SYSTEM::INFO-ERROR ++- SYSTEM::BREAK-LOCAL SYSTEM::SHOW-BREAK-VARIABLES ++- COMMON-LISP::MUFFLE-WARNING SYSTEM::BREAK-PREVIOUS ++- SYSTEM::BREAK-QUIT SYSTEM::DBL-BACKTRACE COMMON-LISP::CONTINUE ++- SYSTEM::BREAK-NEXT)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ COMMON-LISP::HASH-TABLE) +++ SYSTEM::CONTEXT-SPICE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++@@ -512,124 +441,227 @@ ++ SYSTEM::BIGNTHCDR)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::T) ++- COMMON-LISP::FIND-RESTART COMMON-LISP::PATHNAME-HOST ++- SYSTEM::LINK-EXPAND COMMON-LISP::CONCATENATE COMMON-LISP::WARN ++- COMMON-LISP::FILE-POSITION ANSI-LOOP::LOOP-WARN ++- COMMON-LISP::PATHNAME-DIRECTORY COMMON-LISP::SBIT ++- COMMON-LISP::BIT ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES ++- COMMON-LISP::PATHNAME-TYPE COMMON-LISP::MAKE-ARRAY ++- ANSI-LOOP::LOOP-ERROR COMMON-LISP::DIRECTORY SYSTEM::DIR-PARSE ++- COMMON-LISP::TRANSLATE-LOGICAL-PATHNAME ++- SYSTEM::NTH-STACK-FRAME COMMON-LISP::REQUIRE COMMON-LISP::LOAD ++- SYSTEM::MGLIST COMMON-LISP::DELETE-DUPLICATES ++- COMMON-LISP::PATHNAME-VERSION COMMON-LISP::ENOUGH-NAMESTRING ++- SYSTEM::BAD-SEQ-LIMIT COMMON-LISP::REMOVE-DUPLICATES ++- COMMON-LISP::PATHNAME-NAME ++- COMMON-LISP::MAKE-STRING-INPUT-STREAM SLOOP::LOOP-ADD-TEMPS ++- SYSTEM::NLOAD SYSTEM::LIST-MATCHES ++- COMMON-LISP::ARRAY-ROW-MAJOR-INDEX ++- COMMON-LISP::ARRAY-IN-BOUNDS-P SYSTEM::BREAK-LEVEL ++- SYSTEM::PROCESS-SOME-ARGS SYSTEM::TO-REGEXP ++- COMMON-LISP::UPGRADED-ARRAY-ELEMENT-TYPE COMMON-LISP::OPEN ++- SYSTEM::FILE-SEARCH COMMON-LISP::READ-BYTE ++- SYSTEM::FILE-TO-STRING SLOOP::ADD-FROM-DATA COMMON-LISP::ERROR ++- COMMON-LISP::SIGNAL SYSTEM::MGSUB COMMON-LISP::WILD-PATHNAME-P ++- COMMON-LISP::PATHNAME-DEVICE SYSTEM::LOGICAL-PATHNAME-PARSE ++- COMMON-LISP::MERGE-PATHNAMES SYSTEM::INFO-SEARCH ++- COMMON-LISP::BIT-NOT)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::*) ++- ANSI-LOOP::ESTIMATE-CODE-SIZE-1 SYSTEM::DO-REPL ++- SYSTEM::SOURCE-PORTION SYSTEM::RESTART-REPORT ++- SYSTEM::NEW-SEMI-COLON-READER SYSTEM::FIND-DOC ++- ANSI-LOOP::ESTIMATE-CODE-SIZE SYSTEM::NEWLINE ++- COMMON-LISP::RENAME-FILE SYSTEM::LIST-TOGGLE-CASE)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::*) ++- COMMON-LISP::REDUCE COMMON-LISP::STABLE-SORT ++- SYSTEM::PARSE-BODY SLOOP::FIND-IN-ORDERED-LIST ++- COMMON-LISP::SUBTYPEP COMMON-LISP::SORT)) +++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER +++ COMMON-LISP::*) +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807)) +++ COMMON-LISP::FIXNUM) +++ SYSTEM::ATOI)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::*) ++- SYSTEM::LIST-MERGE-SORT ANSI-LOOP::LOOP-GET-COLLECTION-INFO ++- SYSTEM::SHARP---READER SYSTEM::SHARP-S-READER ++- SYSTEM::VERIFY-KEYWORDS SYSTEM::RESTART-PRINT ++- SYSTEM::SHARP-+-READER SYSTEM::READ-INSPECT-COMMAND)) +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +++ ANSI-LOOP::LOOP-DO-INITIALLY SYSTEM::GET-INDEX-NODE +++ SLOOP::PARSE-ONE-WHEN-CLAUSE SYSTEM::STEP-READ-LINE +++ SYSTEM::DM-TOO-MANY-ARGUMENTS SYSTEM::READ-EVALUATED-FORM +++ SYSTEM::DM-TOO-FEW-ARGUMENTS SYSTEM::KCL-TOP-RESTARTS +++ ANSI-LOOP::LOOP-ITERATION-DRIVER +++ SYSTEM::CURRENT-DIRECTORY-PATHNAME SYSTEM::INSPECT-INDENT +++ SYSTEM::CLEANUP ANSI-LOOP::LOOP-WHEN-IT-VARIABLE +++ SLOOP::PARSE-LOOP-WHEN ANSI-LOOP::LOOP-DO-NAMED +++ ANSI-LOOP::LOOP-GET-FORM SYSTEM::GET-TEMP-DIR +++ SYSTEM::ILLEGAL-BOA SYSTEM::SET-UP-TOP-LEVEL +++ SYSTEM::SETUP-LINEINFO ANSI-LOOP::LOOP-CONTEXT +++ SYSTEM::TOP-LEVEL SYSTEM::DBL SLOOP::LOOP-UN-POP +++ SYSTEM::SET-CURRENT ANSI-LOOP::LOOP-GET-PROGN +++ ANSI-LOOP::LOOP-DO-REPEAT SYSTEM::INIT-BREAK-POINTS +++ SLOOP::PARSE-LOOP-FOR SLOOP::LOOP-POP +++ ANSI-LOOP::LOOP-POP-SOURCE ANSI-LOOP::LOOP-DO-WITH +++ ANSI-LOOP::LOOP-DO-DO COMMON-LISP::LISP-IMPLEMENTATION-VERSION +++ ANSI-LOOP::LOOP-DO-RETURN SLOOP::PARSE-LOOP-DO +++ SLOOP::LOOP-PEEK ANSI-LOOP::LOOP-BIND-BLOCK +++ SYSTEM::DEFAULT-SYSTEM-BANNER SLOOP::PARSE-LOOP1 +++ SYSTEM::INSPECT-READ-LINE ANSI-LOOP::LOOP-DO-FINALLY +++ SYSTEM::TEST-ERROR COMMON-LISP::TYPE-ERROR +++ SYSTEM::DEFAULT-INFO-HOTLIST SYSTEM::SHOW-RESTARTS +++ SYSTEM::SET-ENV SLOOP::PARSE-LOOP-COLLECT +++ SYSTEM::ALL-TRACE-DECLARATIONS SYSTEM::GET-SIG-FN-NAME +++ SYSTEM::INSPECT-INDENT-1)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::*) ++- SYSTEM::PUSH-OPTIONAL-BINDING)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ (COMMON-LISP::OR COMMON-LISP::NULL +++ COMMON-LISP::HASH-TABLE)) +++ SYSTEM::CONTEXT-HASH)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T) ++- COMMON-LISP::*) ++- SYSTEM::TRACE-CALL)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::FIXNUM) +++ SYSTEM::LENEL SYSTEM::GET-NODE-INDEX SYSTEM::FASLINK +++ SYSTEM::THE-END ANSI-LOOP::DUPLICATABLE-CODE-P +++ SYSTEM::RELATIVE-LINE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::*) ++- COMMON-LISP::*) ++- SYSTEM::MASET)) +++ ((COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807)) +++ COMMON-LISP::FIXNUM) +++ SYSTEM::DBL-WHAT-FRAME FPE::FE-ENABLE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::*) ++- SYSTEM::EXPAND-WILD-DIRECTORY)) +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) +++ SYSTEM::GCL-TOP-LEVEL SYSTEM::BREAK-CURRENT +++ SYSTEM::BREAK-RESUME SYSTEM::BREAK-HELP SYSTEM::BREAK-MESSAGE +++ ANSI-LOOP::LOOP-DO-FOR SYSTEM::SIMPLE-BACKTRACE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::*) ++- SYSTEM::PARSE-DEFMACRO SYSTEM::PARSE-DEFMACRO-LAMBDA-LIST)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ SYSTEM::PROCESS-SOME-ARGS COMMON-LISP::CONCATENATE +++ SYSTEM::TO-REGEXP COMMON-LISP::PATHNAME-DEVICE +++ SYSTEM::LIST-MATCHES ANSI-LOOP::LOOP-WARN +++ COMMON-LISP::REMOVE-DUPLICATES COMMON-LISP::PATHNAME-HOST +++ COMMON-LISP::BIT COMMON-LISP::SBIT +++ COMMON-LISP::ENOUGH-NAMESTRING SYSTEM::DIR-PARSE +++ SYSTEM::FILE-SEARCH SYSTEM::BREAK-LEVEL ANSI-LOOP::LOOP-ERROR +++ SYSTEM::MGLIST COMMON-LISP::PATHNAME-NAME +++ COMMON-LISP::MAKE-STRING-INPUT-STREAM SLOOP::ADD-FROM-DATA +++ COMMON-LISP::TRANSLATE-LOGICAL-PATHNAME COMMON-LISP::DIRECTORY +++ SYSTEM::FILE-TO-STRING COMMON-LISP::ARRAY-ROW-MAJOR-INDEX +++ SYSTEM::NTH-STACK-FRAME SLOOP::LOOP-ADD-TEMPS +++ COMMON-LISP::WARN +++ ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES +++ SYSTEM::LINK-EXPAND COMMON-LISP::PATHNAME-TYPE +++ COMMON-LISP::OPEN COMMON-LISP::BIT-NOT +++ COMMON-LISP::DELETE-DUPLICATES COMMON-LISP::ERROR +++ COMMON-LISP::FILE-POSITION COMMON-LISP::PATHNAME-VERSION +++ COMMON-LISP::ARRAY-IN-BOUNDS-P COMMON-LISP::REQUIRE +++ SYSTEM::MGSUB COMMON-LISP::MERGE-PATHNAMES COMMON-LISP::LOAD +++ COMMON-LISP::PATHNAME-DIRECTORY COMMON-LISP::SIGNAL +++ COMMON-LISP::WILD-PATHNAME-P COMMON-LISP::FIND-RESTART +++ SYSTEM::INFO-SEARCH SYSTEM::LOGICAL-PATHNAME-PARSE +++ SYSTEM::BAD-SEQ-LIMIT COMMON-LISP::READ-BYTE +++ COMMON-LISP::UPGRADED-ARRAY-ELEMENT-TYPE SYSTEM::NLOAD +++ COMMON-LISP::MAKE-ARRAY)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++- SYSTEM::MME3)) +++ COMMON-LISP::RENAME-FILE ANSI-LOOP::ESTIMATE-CODE-SIZE-1 +++ SYSTEM::FIND-DOC SYSTEM::SOURCE-PORTION SYSTEM::NEWLINE +++ SYSTEM::DO-REPL SYSTEM::RESTART-REPORT +++ ANSI-LOOP::ESTIMATE-CODE-SIZE SYSTEM::NEW-SEMI-COLON-READER)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::INTEGER -9223372036854775808 ++- 9223372036854775807) ++- COMMON-LISP::T) +++ 9223372036854775807)) ++ COMMON-LISP::T) ++- SYSTEM::SMALLNTHCDR)) +++ SYSTEM::GET-CONTEXT SYSTEM::PUSH-CONTEXT)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) ++- SYSTEM::GCL-TOP-LEVEL SYSTEM::BREAK-MESSAGE ++- SYSTEM::BREAK-RESUME SYSTEM::SIMPLE-BACKTRACE ++- SYSTEM::BREAK-HELP ANSI-LOOP::LOOP-DO-FOR ++- SYSTEM::BREAK-CURRENT)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++- SYSTEM::S-DATA-LENGTH SYSTEM::THE-START SYSTEM::INSTREAM-LINE ++- SYSTEM::S-DATA-SIZE FPE::REG-LOOKUP)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ COMMON-LISP::PSETF COMMON-LISP::PROG* SYSTEM::BREAK-STEP-INTO +++ SLOOP::IN-PACKAGE-SLOOP-MAP SLOOP::SLOOP-FINISH +++ SYSTEM::CHECK-SEQ-START-END SLOOP::SLOOP +++ COMMON-LISP::MULTIPLE-VALUE-SETQ COMMON-LISP::ASSERT +++ SLOOP::MINIMIZE-SLOOP-COLLECT COMMON-LISP::ROTATEF +++ SYSTEM::LIST-TOGGLE-CASE SYSTEM::INCREMENT-CURSOR +++ ANSI-LOOP::LOOP-COLLECT-ANSWER COMMON-LISP::PROG2 +++ SLOOP::SLOOP-SWAP COMMON-LISP::DEFTYPE +++ SYSTEM::SETF-LOGICAL-PATHNAME-TRANSLATIONS SYSTEM::?PUSH +++ COMMON-LISP::DO-EXTERNAL-SYMBOLS +++ ANSI-LOOP::LOOP-COLLECT-RPLACD COMMON-LISP::TRACE +++ ANSI-LOOP::LOOP-DO-IF ANSI-LOOP::MAKE-LOOP-MINIMAX +++ SYSTEM::SUBSTRINGP COMMON-LISP::LOGORC2 +++ ANSI-LOOP::LOOP-DO-WHILE ANSI-LOOP::LOOP-LOOKUP-KEYWORD +++ SLOOP::DEF-LOOP-COLLECT SYSTEM::SETF-HELPER +++ COMMON-LISP::WITH-CONDITION-RESTARTS SYSTEM::INSPECT-PRINT +++ SLOOP::PARSE-LOOP-MAP SYSTEM::KEYWORD-SUPPLIED-P +++ COMMON-LISP::LOOP-FINISH ANSI-LOOP::LOOP-TASSOC +++ SYSTEM::GET-LINE-OF-FORM ANSI-LOOP::LOOP-STORE-TABLE-DATA +++ SLOOP::L-EQUAL COMMON-LISP::ETYPECASE +++ SLOOP::THEREIS-SLOOP-COLLECT COMMON-LISP::RETURN +++ SYSTEM::SUB-INTERVAL-P COMMON-LISP::ECASE +++ COMMON-LISP::WRITE-BYTE SYSTEM::LOOKUP-KEYWORD +++ COMMON-LISP::DEFSETF ANSI-LOOP::LOOP-DO-ALWAYS +++ SYSTEM::PARSE-SLOT-DESCRIPTION COMMON-LISP::VECTOR-PUSH +++ SYSTEM::GET-INFO-CHOICES SYSTEM::SETF-EXPAND +++ SYSTEM::LEFT-PARENTHESIS-READER SLOOP::DEF-LOOP-FOR +++ COMMON-LISP::PROG SYSTEM::OVERWRITE-SLOT-DESCRIPTIONS +++ SYSTEM::SUPER-GO COMMON-LISP::LDB SYSTEM::NODE +++ SYSTEM::COERCE-TO-PACKAGE COMMON-LISP::DO SYSTEM::TP-ERROR +++ SYSTEM::GET-NODES SLOOP::THE-TYPE ANSI-LOOP::LOOP-TMEMBER +++ ANSI-LOOP::LOOP-TEQUAL COMMON-LISP::DEFPARAMETER +++ COMMON-LISP::WITH-OPEN-STREAM SYSTEM::DEFINE-SETF-METHOD +++ SYSTEM::IF-ERROR ANSI-LOOP::HIDE-VARIABLE-REFERENCES +++ SLOOP::DESETQ1 COMMON-LISP::LOOP COMMON-LISP::CTYPECASE +++ COMMON-LISP::DEFSTRUCT COMMON-LISP::CASE SYSTEM::DOT-DIR-P +++ SYSTEM::INSPECT-RECURSIVELY COMMON-LISP::DOTIMES +++ SYSTEM::BREAK-STEP-NEXT SYSTEM::ALL-MATCHES +++ COMMON-LISP::LOCALLY SLOOP::IN-TABLE-SLOOP-MAP +++ SYSTEM::DISPLAY-ENV COMMON-LISP::MULTIPLE-VALUE-LIST +++ COMMON-LISP::LDB-TEST COMMON-LISP::DECLAIM +++ COMMON-LISP::WITH-STANDARD-IO-SYNTAX SYSTEM::SGEN +++ SLOOP::ALWAYS-SLOOP-COLLECT COMMON-LISP::PUSHNEW +++ COMMON-LISP::MULTIPLE-VALUE-BIND FPE::%-READER +++ COMMON-LISP::CCASE SLOOP::DEF-LOOP-MACRO +++ ANSI-LOOP::LOOP-REALLY-DESETQ SYSTEM::IN-INTERVAL-P +++ SYSTEM::DBL-UP SLOOP::DEF-LOOP-MAP ANSI-LOOP::LOOP-BODY +++ SYSTEM::SEQUENCE-CURSOR COMMON-LISP::COERCE +++ COMMON-LISP::PATHNAME-MATCH-P SYSTEM::OBJLT +++ COMMON-LISP::RESTART-CASE +++ COMMON-LISP::WITH-HASH-TABLE-ITERATOR COMMON-LISP::STEP +++ SYSTEM::QUOTATION-READER SYSTEM::PUT-AUX COMMON-LISP::TYPECASE +++ SYSTEM::*BREAK-POINTS* COMMON-LISP::LOGTEST +++ SYSTEM::CONDITION-PASS COMMON-LISP::DEFVAR +++ COMMON-LISP::WITH-OUTPUT-TO-STRING SYSTEM::SET-BACK +++ COMMON-LISP::NTHCDR COMMON-LISP::DO-ALL-SYMBOLS +++ SYSTEM::INFO-AUX COMMON-LISP::LOGANDC1 COMMON-LISP::PROG1 +++ FPE::READ-OPERANDS SYSTEM::DISPLAY-COMPILED-ENV +++ COMMON-LISP::DEFCONSTANT SYSTEM::DM-V SLOOP::LOOP-RETURN +++ SYSTEM::ADD-FILE SYSTEM::WHILE SYSTEM::WITHOUT-INTERRUPTS +++ COMMON-LISP::NTH-VALUE COMMON-LISP::OR +++ ANSI-LOOP::LOOP-COPYLIST* SLOOP::IN-CAREFULLY-SLOOP-FOR +++ ANSI-LOOP::LOOP-DECLARE-VARIABLE SYSTEM::GET-MATCH +++ ANSI-LOOP::WITH-LOOP-LIST-COLLECTION-HEAD +++ ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION SYSTEM::MV-SETQ +++ SLOOP::COLLATE-SLOOP-COLLECT COMMON-LISP::LOGORC1 +++ SYSTEM::DM-NTH-CDR COMPILER::COMPILER-DEF-HOOK +++ SYSTEM::CHECK-TYPE-EVAL COMMON-LISP::DECF +++ COMMON-LISP::WITH-PACKAGE-ITERATOR SYSTEM::COERCE-TO-STRING +++ COMMON-LISP::DEFINE-MODIFY-MACRO FPE::0-READER +++ COMMON-LISP::WITH-COMPILATION-UNIT COMMON-LISP::LOGNAND +++ COMMON-LISP::CHECK-TYPE COMMON-LISP::INCF +++ SLOOP::MAXIMIZE-SLOOP-COLLECT SYSTEM::ITERATE-OVER-BKPTS +++ SLOOP::LOGXOR-SLOOP-COLLECT SLOOP::NEVER-SLOOP-COLLECT +++ SYSTEM::MV-VALUES SYSTEM::MSUB COMMON-LISP::DO* +++ SLOOP::=-SLOOP-FOR COMMON-LISP::UNLESS +++ SYSTEM::MATCH-DIMENSIONS COMMON-LISP::DOLIST +++ ANSI-LOOP::LOOP-MAYBE-BIND-FORM SLOOP::LOCAL-FINISH +++ COMMON-LISP::PSETQ COMMON-LISP::COND +++ COMMON-LISP::WITH-SIMPLE-RESTART COMMON-LISP::DO-SYMBOLS +++ COMMON-LISP::FILE-STRING-LENGTH COMMON-LISP::LAMBDA +++ ANSI-LOOP::LOOP-ACCUMULATE-MINIMAX-VALUE +++ SLOOP::IN-FRINGE-SLOOP-MAP SYSTEM::SET-DIR +++ COMMON-LISP::WITH-INPUT-FROM-STRING SYSTEM::LIST-DELQ +++ COMMON-LISP::BYTE COMMON-LISP::DOCUMENTATION SYSTEM::SAFE-EVAL +++ COMMON-LISP::DEFMACRO SLOOP::DESETQ COMMON-LISP::POP +++ SLOOP::COUNT-SLOOP-COLLECT SLOOP::LCASE +++ COMMON-LISP::DEFPACKAGE COMMON-LISP::DEFUN COMMON-LISP::TIME +++ COMMON-LISP::LOGNOR COMMON-LISP::RESTART-BIND +++ COMMON-LISP::PUSH COMMON-LISP::SHIFTF COMMON-LISP::AND +++ COMMON-LISP::WHEN SYSTEM::DM-NTH COMMON-LISP::WITH-OPEN-FILE +++ SLOOP::MAKE-VALUE COMMON-LISP::UNTRACE FPE::PAREN-READER +++ ANSI-LOOP::WITH-MINIMAX-VALUE COMMON-LISP::NTH +++ FPE::READ-INSTRUCTION SLOOP::SUM-SLOOP-COLLECT +++ COMMON-LISP::REMF COMMON-LISP::DESTRUCTURING-BIND +++ SYSTEM::SET-PATH-STREAM-NAME FPE::RF COMMON-LISP::LOGANDC2)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) ++- SYSTEM::MATCH-BEGINNING SYSTEM::MATCH-END)) ++\ No newline at end of file +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ COMMON-LISP::FCEILING COMMON-LISP::APROPOS-LIST +++ COMMON-LISP::READ-FROM-STRING +++ COMMON-LISP::ENSURE-DIRECTORIES-EXIST SYSTEM::APROPOS-DOC +++ COMMON-LISP::FTRUNCATE SYSTEM::BREAK-FUNCTION +++ SYSTEM::GET-SETF-METHOD-MULTIPLE-VALUE SYSTEM::STEPPER +++ COMMON-LISP::DECODE-UNIVERSAL-TIME +++ ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE +++ COMMON-LISP::STORE-VALUE COMMON-LISP::GET-SETF-EXPANSION +++ SYSTEM::PRINT-DOC SYSTEM::INFO COMMON-LISP::APROPOS +++ COMMON-LISP::WRITE-TO-STRING COMMON-LISP::USE-VALUE +++ COMMON-LISP::FROUND COMMON-LISP::PARSE-NAMESTRING +++ COMMON-LISP::INVOKE-RESTART COMMON-LISP::FFLOOR +++ SYSTEM::SHOW-INFO)) ++\ No newline at end of file ++--- gcl-2.6.12.orig/o/alloc.c +++++ gcl-2.6.12/o/alloc.c ++@@ -182,61 +182,61 @@ void ++ add_page_to_freelist(char *p, struct typemanager *tm) { ++ ++ short t,size; ++- long i=tm->tm_nppage,fw; ++- object x,f; +++ long fw; +++ object x,xe,f; ++ struct pageinfo *pp; ++ ++- t=tm->tm_type; +++ t=tm->tm_type; ++ ++- size=tm->tm_size; ++- f=tm->tm_free; ++- pp=pageinfo(p); ++- bzero(pp,sizeof(*pp)); ++- pp->type=t; ++- pp->magic=PAGE_MAGIC; ++- ++- if (cell_list_head==NULL) ++- cell_list_tail=cell_list_head=pp; ++- else if (pp > cell_list_tail) { ++- cell_list_tail->next=pp; ++- cell_list_tail=pp; ++- } ++- ++- x= (object)pagetochar(page(p)); ++- /* set_type_of(x,t); */ ++- make_free(x); +++ size=tm->tm_size; +++ pp=pageinfo(p); +++ bzero(pp,sizeof(*pp)); +++ pp->type=t; +++ pp->magic=PAGE_MAGIC; +++ +++ if (cell_list_head==NULL) +++ cell_list_tail=cell_list_head=pp; +++ else if (pp > cell_list_tail) { +++ cell_list_tail->next=pp; +++ cell_list_tail=pp; +++ } +++ +++ x= (object)pagetochar(page(p)); +++ /* set_type_of(x,t); */ +++ make_free(x); ++ ++ #ifdef SGC ++ ++- if (sgc_enabled && tm->tm_sgc) ++- pp->sgc_flags=SGC_PAGE_FLAG; +++ if (sgc_enabled && tm->tm_sgc) +++ pp->sgc_flags=SGC_PAGE_FLAG; ++ ++ #ifndef SGC_WHOLE_PAGE ++- if (TYPEWORD_TYPE_P(pp->type)) ++- x->d.s=(sgc_enabled && tm->tm_sgc) ? SGC_RECENT : SGC_NORMAL; +++ if (TYPEWORD_TYPE_P(pp->type)) +++ x->d.s=(sgc_enabled && tm->tm_sgc) ? SGC_RECENT : SGC_NORMAL; ++ #endif ++ ++- /* array headers must be always writable, since a write to the ++- body does not touch the header. It may be desirable if there ++- are many arrays in a system to make the headers not writable, ++- but just SGC_TOUCH the header each time you write to it. this ++- is what is done with t_structure */ +++ /* array headers must be always writable, since a write to the +++ body does not touch the header. It may be desirable if there +++ are many arrays in a system to make the headers not writable, +++ but just SGC_TOUCH the header each time you write to it. this +++ is what is done with t_structure */ ++ if (t==(tm_of(t_array)->tm_type)) ++ pp->sgc_flags|=SGC_PERM_WRITABLE; ++- +++ ++ #endif ++ ++- fw= *(fixnum *)x; ++- while (--i >= 0) { ++- *(fixnum *)x=fw; ++- SET_LINK(x,f); ++- f=x; ++- x= (object) ((char *)x + size); ++- } ++- ++- tm->tm_free=f; ++- tm->tm_nfree += tm->tm_nppage; ++- tm->tm_npage++; +++ f=FREELIST_TAIL(tm); +++ fw=x->fw; +++ xe=(object)((void *)x+tm->tm_nppage*size); +++ for (;xfw=fw; +++ SET_LINK(f,x); +++ } +++ +++ SET_LINK(f,OBJNULL); +++ tm->tm_tail=f; +++ tm->tm_nfree+=tm->tm_nppage; +++ tm->tm_npage++; ++ ++ } ++ ++@@ -1065,15 +1065,13 @@ make_cons(object a,object d) { ++ ++ } ++ ++- ++- ++-object on_stack_cons(object x, object y) { +++object +++on_stack_cons(object x, object y) { ++ object p = (object) alloca_val; ++ load_cons(p,x,y); ++ return p; ++ } ++ ++- ++ DEFUNM_NEW("ALLOCATED",object,fSallocated,SI,1,1,NONE,OO,OO,OO,OO,(object typ),"") ++ { struct typemanager *tm=(&tm_table[t_from_type(typ)]); ++ tm = & tm_table[tm->tm_type]; ++--- gcl-2.6.12.orig/o/assignment.c +++++ gcl-2.6.12/o/assignment.c ++@@ -388,14 +388,7 @@ EVAL: ++ ++ OTHERWISE: ++ vs_base = vs_top; ++- vs_push(sLsetf); ++- vs_push(place); ++- vs_push(form); ++- result=vs_top[-1]; ++- vs_push(Cnil); ++- stack_cons(); ++- stack_cons(); ++- stack_cons(); +++ vs_push(list(3,sLsetf,place,result=form)); ++ /***/ ++ #define VS_PUSH_ENV \ ++ if(lex_env[1]){ \ ++@@ -428,9 +421,7 @@ FFN(Fpush)(object form) ++ return; ++ } ++ vs_base = vs_top; ++- vs_push(sLpush); ++- vs_push(form); ++- stack_cons(); +++ vs_push(make_cons(sLpush,form)); ++ /***/ ++ VS_PUSH_ENV ; ++ /***/ ++@@ -457,9 +448,7 @@ FFN(Fpop)(object form) ++ return; ++ } ++ vs_base = vs_top; ++- vs_push(sLpop); ++- vs_push(form); ++- stack_cons(); +++ vs_push(make_cons(sLpop,form)); ++ /***/ ++ VS_PUSH_ENV ; ++ /***/ ++@@ -495,9 +484,7 @@ FFN(Fincf)(object form) ++ return; ++ } ++ vs_base = vs_top; ++- vs_push(sLincf); ++- vs_push(form); ++- stack_cons(); +++ vs_push(make_cons(sLincf,form)); ++ /***/ ++ VS_PUSH_ENV ; ++ /***/ ++@@ -533,9 +520,7 @@ FFN(Fdecf)(object form) ++ return; ++ } ++ vs_base = vs_top; ++- vs_push(sLdecf); ++- vs_push(form); ++- stack_cons(); +++ vs_push(make_cons(sLdecf,form)); ++ /***/ ++ VS_PUSH_ENV ; ++ /***/ ++--- gcl-2.6.12.orig/o/backq.c +++++ gcl-2.6.12/o/backq.c ++@@ -22,7 +22,7 @@ Foundation, 675 Mass Ave, Cambridge, MA ++ #include "include.h" ++ ++ #define attach(x) (vs_head = make_cons(x, vs_head)) ++-#define make_list (vs_push(Cnil), stack_cons(), stack_cons()) +++#define make_list (vs_popp,vs_head=list(2,vs_head,*vs_top)) ++ ++ ++ #define QUOTE 1 ++--- gcl-2.6.12.orig/o/bind.c +++++ gcl-2.6.12/o/bind.c ++@@ -433,10 +433,11 @@ SEARCH_DECLARE: ++ optional[i].opt_svar_spp); ++ } ++ if (rest_flag) { ++- vs_push(Cnil); ++- for (i = narg, j = nreq+nopt; --i >= j; ) ++- vs_head = make_cons(base[i], vs_head); ++- bind_var(rest->rest_var, vs_head, rest->rest_spp); +++ object *l=vs_top++; +++ for (i=nreq+nopt;irest_var, vs_head, rest->rest_spp); ++ } ++ if (key_flag) { ++ int allow_other_keys_found=0; ++@@ -824,12 +825,11 @@ parse_key(object *base, bool rest, bool ++ } ++ } ++ if (rest) { ++- top = vs_top; ++- vs_push(Cnil); ++- base++; ++- while (base < vs_top) ++- stack_cons(); ++- vs_top = top; +++ object *a,*l; +++ for (l=a=base;as.s_sfdef != NOT_SPECIAL && sym->s.s_mflag) ++ sym->s.s_sfdef = NOT_SPECIAL; ++- cf = alloc_object(t_cfun); ++- cf->cf.cf_self = self; ++- cf->cf.cf_name = sym; ++- cf->cf.cf_data = data; +++ sfn = alloc_object(t_sfun); +++ sfn->sfn.sfn_self = (void *)self;/*FIXME*/ +++ sfn->sfn.sfn_name = sym; +++ sfn->sfn.sfn_data = data; +++ sfn->sfn.sfn_argd=2; ++ data->cfd.cfd_start=start; ++ data->cfd.cfd_size=size; ++- sym = clear_compiler_properties(sym,cf); ++- sym->s.s_gfdef = cf; +++ sym = clear_compiler_properties(sym,sfn); +++ sym->s.s_gfdef = sfn; ++ sym->s.s_mflag = TRUE; ++ return sym; ++ } ++--- gcl-2.6.12.orig/o/eval.c +++++ gcl-2.6.12/o/eval.c ++@@ -60,38 +60,41 @@ object sSAbreak_stepA; ++ /* for t_sfun,t_gfun with args on vs stack */ ++ ++ static void ++-quick_call_sfun(object fun) ++-{ DEBUG_AVMA +++quick_call_sfun(object fun) { +++ +++ DEBUG_AVMA ++ int i=fun->sfn.sfn_argd,n=SFUN_NARGS(i); ++ enum ftype restype; ++- object *x,res,*base; ++- object *temp_ar=alloca(n*sizeof(object)); ++-/* i=fun->sfn.sfn_argd; */ ++-/* n=SFUN_NARGS(i); */ ++- base = vs_base; ++- if (n != vs_top - base) ++- {check_arg_failed(n);} +++ object *x,*base; +++ +++ if (n!=vs_top-vs_base) +++ check_arg_failed(n); +++ ++ restype = SFUN_RETURN_TYPE(i); ++ SFUN_START_ARG_TYPES(i); ++- /* for moment just support object and int */ ++ #define COERCE_ARG(a,type) (type==f_object ? a : (object)(fix(a))) ++- if (i==0) ++- x=vs_base; ++- else ++- {int j; ++- x=temp_ar; ++- for (j=0; jcf.cf_self)();return;} ++- if (type_of(fun)==t_sfun){call_sfun_no_check(fun); return;} ++- if (type_of(fun)==t_gfun) ++- {quick_call_sfun(fun); return;} ++- if (type_of(fun)==t_vfun) ++- {call_vfun(fun); return;} ++- if (type_of(fun) == t_symbol) { ++- if (fun->s.s_sfdef != NOT_SPECIAL || fun->s.s_mflag) ++- FEinvalid_function(fun); ++- if (fun->s.s_gfdef == OBJNULL) ++- FEundefined_function(fun); ++- fun = fun->s.s_gfdef; ++- if (type_of(fun)==t_cfun){(*fun->cf.cf_self)(); ++- return;} ++- } ++- funcall_no_event(fun); +++ +++ switch(type_of(fun)) { +++ case t_cfun: +++ (*fun->cf.cf_self)(); +++ return; +++ case t_sfun: +++ call_sfun_no_check(fun); return; +++ case t_gfun: +++ quick_call_sfun(fun); return; +++ case t_vfun: +++ call_vfun(fun); return; +++ case t_symbol: +++ if (fun->s.s_sfdef != NOT_SPECIAL || fun->s.s_mflag) +++ FEinvalid_function(fun); +++ if (fun->s.s_gfdef == OBJNULL) +++ FEundefined_function(fun); +++ super_funcall_no_event(fun->s.s_gfdef); +++ return; +++ default: +++ funcall_no_event(fun); +++ } +++ ++ } ++ ++ #ifdef USE_BROKEN_IEVAL ++@@ -814,13 +823,7 @@ EVAL: ++ bds_bind(siVevalhook, Cnil); ++ vs_base = vs_top; ++ vs_push(form); ++- vs_push(lex_env[0]); ++- vs_push(lex_env[1]); ++- vs_push(lex_env[2]); ++- vs_push(Cnil); ++- stack_cons(); ++- stack_cons(); ++- stack_cons(); +++ vs_push(list(3,lex_env[0],lex_env[1],lex_env[2])); ++ super_funcall(hookfun); ++ bds_unwind(old_bds_top); ++ return; ++@@ -970,22 +973,12 @@ static void ++ call_applyhook(object fun) ++ { ++ object ah; ++- object *v; ++ ++ ah = symbol_value(siVapplyhook); ++- v = vs_base + 1; ++- vs_push(Cnil); ++- while (vs_top > v) ++- stack_cons(); +++ Llist(); ++ vs_push(vs_base[0]); ++ vs_base[0] = fun; ++- vs_push(lex_env[0]); ++- vs_push(lex_env[1]); ++- vs_push(lex_env[2]); ++- vs_push(Cnil); ++- stack_cons(); ++- stack_cons(); ++- stack_cons(); +++ vs_push(list(3,lex_env[0],lex_env[1],lex_env[2])); ++ super_funcall(ah); ++ } ++ ++--- gcl-2.6.12.orig/o/fasdump.c +++++ gcl-2.6.12/o/fasdump.c ++@@ -1130,8 +1130,7 @@ read_fasd1(int i, object *loc) ++ *loc=Cnil;return; ++ case DP(d_cons:) ++ read_fasd1(GET_OP(),&tem); ++- *loc=make_cons(tem,Cnil); ++- loc= &((*loc)->c.c_cdr); +++ collect(loc,make_cons(tem,Cnil)); ++ i=GET_OP(); ++ goto BEGIN; ++ case DP(d_list1:) i=1;goto READ_LIST; ++@@ -1162,8 +1161,7 @@ read_fasd1(int i, object *loc) ++ read_fasd1(j,&tem); ++ DPRINTF("{Item=",(debug >= 2 ? pp(tem) : 0)); ++ DPRINTF("}",0); ++- *loc=make_cons(tem,Cnil); ++- loc= &((*loc)->c.c_cdr);}} +++ collect(loc,make_cons(tem,Cnil));}} ++ ++ case DP(d_delimiter:) ++ case DP(d_dot:) ++--- gcl-2.6.12.orig/o/file.d +++++ gcl-2.6.12/o/file.d ++@@ -1429,52 +1429,54 @@ LFD(Lmake_synonym_stream)() ++ vs_base[0] = x; ++ } ++ ++-LFD(Lmake_broadcast_stream)() ++-{ ++- object x; ++- int narg, i; ++- ++- narg = vs_top - vs_base; ++- for (i = 0; i < narg; i++) ++- if (type_of(vs_base[i]) != t_stream || ++- !output_stream_p(vs_base[i])) ++- cannot_write(vs_base[i]); ++- vs_push(Cnil); ++- for (i = narg; i > 0; --i) ++- stack_cons(); ++- x = alloc_object(t_stream); ++- x->sm.sm_mode = (short)smm_broadcast; ++- x->sm.sm_fp = NULL; ++- x->sm.sm_buffer = 0; ++- x->sm.sm_object0 = vs_base[0]; ++- x->sm.sm_object1 = OBJNULL; ++- x->sm.sm_int = 0; ++- x->sm.sm_flags=0; ++- vs_base[0] = x; +++LFD(Lmake_broadcast_stream)() { +++ +++ object x; +++ int narg, i; +++ +++ narg = vs_top - vs_base; +++ for (i = 0; i < narg; i++) +++ if (type_of(vs_base[i]) != t_stream || +++ !output_stream_p(vs_base[i])) +++ cannot_write(vs_base[i]); +++ +++ Llist(); +++ +++ x = alloc_object(t_stream); +++ x->sm.sm_mode = (short)smm_broadcast; +++ x->sm.sm_fp = NULL; +++ x->sm.sm_buffer = 0; +++ x->sm.sm_object0 = vs_base[0]; +++ x->sm.sm_object1 = OBJNULL; +++ x->sm.sm_int = 0; +++ x->sm.sm_flags=0; +++ vs_base[0] = x; +++ ++ } ++ ++-LFD(Lmake_concatenated_stream)() ++-{ ++- object x; ++- int narg, i; ++- ++- narg = vs_top - vs_base; ++- for (i = 0; i < narg; i++) ++- if (type_of(vs_base[i]) != t_stream || ++- !input_stream_p(vs_base[i])) ++- cannot_read(vs_base[i]); ++- vs_push(Cnil); ++- for (i = narg; i > 0; --i) ++- stack_cons(); ++- x = alloc_object(t_stream); ++- x->sm.sm_mode = (short)smm_concatenated; ++- x->sm.sm_fp = NULL; ++- x->sm.sm_buffer = 0; ++- x->sm.sm_object0 = vs_base[0]; ++- x->sm.sm_object1 = OBJNULL; ++- x->sm.sm_int = 0; ++- x->sm.sm_flags=0; ++- vs_base[0] = x; +++LFD(Lmake_concatenated_stream)() { +++ +++ object x; +++ int narg, i; +++ +++ narg = vs_top - vs_base; +++ for (i = 0; i < narg; i++) +++ if (type_of(vs_base[i]) != t_stream || +++ !input_stream_p(vs_base[i])) +++ cannot_read(vs_base[i]); +++ +++ Llist(); +++ +++ x = alloc_object(t_stream); +++ x->sm.sm_mode = (short)smm_concatenated; +++ x->sm.sm_fp = NULL; +++ x->sm.sm_buffer = 0; +++ x->sm.sm_object0 = vs_base[0]; +++ x->sm.sm_object1 = OBJNULL; +++ x->sm.sm_int = 0; +++ x->sm.sm_flags=0; +++ vs_base[0] = x; +++ ++ } ++ ++ LFD(Lmake_two_way_stream)() ++--- gcl-2.6.12.orig/o/gbc.c +++++ gcl-2.6.12/o/gbc.c ++@@ -543,7 +543,9 @@ mark_object1(object x) { ++ mark_object_address(&x->ht.ht_self[i].hte_key,i); ++ mark_object_address(&x->ht.ht_self[i].hte_value,i+1); ++ } +++ i=x->ht.ht_cache-x->ht.ht_self; ++ MARK_LEAF_DATA(x,x->ht.ht_self,x->ht.ht_size*sizeof(*x->ht.ht_self)); +++ if (x->ht.ht_cache) x->ht.ht_cache=x->ht.ht_self+i; ++ break; ++ ++ case t_array: ++@@ -662,6 +664,7 @@ mark_object1(object x) { ++ break; ++ ++ case t_readtable: +++ mark_object(x->rt.rt_case); ++ if (x->rt.rt_self) { ++ for (i=0;irt.rt_self[i].rte_macro,i); ++@@ -968,7 +971,7 @@ sweep_phase(void) { ++ tm = tm_of((enum type)v->type); ++ ++ p = pagetochar(page(v)); ++- f = tm->tm_free; +++ f = FREELIST_TAIL(tm); ++ k = 0; ++ for (j = tm->tm_nppage; j > 0; --j, p += tm->tm_size) { ++ x = (object)p; ++@@ -979,12 +982,13 @@ sweep_phase(void) { ++ continue; ++ } ++ ++- SET_LINK(x,f); +++ SET_LINK(f,x); ++ make_free(x); ++ f = x; ++ k++; ++ } ++- tm->tm_free = f; +++ SET_LINK(f,OBJNULL); +++ tm->tm_tail = f; ++ tm->tm_nfree += k; ++ pagetoinfo(page(v))->in_use-=k; ++ ++--- gcl-2.6.12.orig/o/hash.d +++++ gcl-2.6.12/o/hash.d ++@@ -196,33 +196,28 @@ DEFUN_NEW("HASH-EQUAL",object,fShash_equ ++ ++ ++ struct htent * ++-gethash(object key, object hashtable) { +++gethash(object key, object ht) { ++ ++- enum httest htest; ++- long hsize,j,s,q; ++- struct htent *e,*first_objnull=NULL; ++- object hkey; +++ long s,q; +++ struct htent *e,*ee,*first_open=NULL; ++ static struct htent dummy={OBJNULL,OBJNULL}; ++ ++- if (!hashtable->ht.ht_size) ++- return &dummy; ++- ++- htest = (enum httest)hashtable->ht.ht_test; ++- hsize = hashtable->ht.ht_size; +++ if (ht->ht.ht_cache && ht->ht.ht_cache->hte_key==key) +++ return ht->ht.ht_cache; +++ ht->ht.ht_cache=NULL; ++ ++ #define eq(x,y) x==y ++ #define hash_loop(t_,i_) \ ++- for (s=i_%hsize,q=hsize,e=first_objnull;s>=0;q=s,s=s?0:-1) \ ++- for (j=s;jht.ht_self[j]; \ ++- hkey = e->hte_key; \ +++ for (q=ht->ht.ht_size,s=i_%q;s>=0;q=s,s=s?0:-1) \ +++ for (e=ht->ht.ht_self,ee=e+q,e+=s;ehte_key; \ ++ if (hkey==OBJNULL) { \ ++- if (e->hte_value==OBJNULL) return first_objnull ? first_objnull : e; \ ++- if (!first_objnull) first_objnull=e; \ ++- } else if (t_(key,hkey)) return e; \ +++ if (e->hte_value==OBJNULL) return first_open ? first_open : e; \ +++ if (!first_open) first_open=e; \ +++ } else if (t_(key,hkey)) return ht->ht.ht_cache=e; \ ++ } ++ ++- switch (htest) { +++ switch (ht->ht.ht_test) { ++ case htt_eq: ++ hash_loop(eq,hash_eq(key)); ++ break; ++@@ -237,7 +232,7 @@ gethash(object key, object hashtable) { ++ return &dummy; ++ } ++ ++- return first_objnull ? first_objnull : (FEerror("No free spot in hashtable ~S.", 1, hashtable),&dummy); +++ return first_open ? first_open : (FEerror("No free spot in hashtable ~S.", 1, ht),&dummy); ++ ++ } ++ ++@@ -290,7 +285,7 @@ object hashtable; ++ old = alloc_object(t_hashtable); ++ old->ht = hashtable->ht; ++ vs_push(old); ++- hashtable->ht.ht_self = NULL; +++ hashtable->ht.ht_cache=hashtable->ht.ht_self = NULL; ++ hashtable->ht.ht_size = new_size; ++ if (type_of(hashtable->ht.ht_rhthresh) == t_fixnum) ++ hashtable->ht.ht_rhthresh = ++@@ -365,6 +360,7 @@ DEFVAR("*DEFAULT-HASH-TABLE-REHASH-THRES ++ h->ht.ht_size = fix(size); ++ h->ht.ht_rhsize = rehash_size; ++ h->ht.ht_rhthresh = rehash_threshold; +++ h->ht.ht_cache=NULL; ++ h->ht.ht_nent = 0; ++ h->ht.ht_static = static!=Cnil ? 1 : 0; ++ h->ht.ht_self = NULL; ++--- gcl-2.6.12.orig/o/list.d +++++ gcl-2.6.12/o/list.d ++@@ -277,93 +277,78 @@ object on_stack_list_vector_new(int n,ob ++ return ans; ++ }*/ ++ ++-object list_vector_new(int n,object first,va_list ap) ++-{object ans,*p; +++object +++list_vector_new(int n,object first,va_list ap) { +++ +++ object ans,*p; ++ ++- if (n == 0) return Cnil; ++- ans = make_cons(first==OBJNULL ? va_arg(ap,object) : first,Cnil); ++- p = & (ans->c.c_cdr); ++- while (--n > 0) ++- { *p = make_cons(va_arg(ap,object),Cnil); ++- p = & ((*p)->c.c_cdr); ++- } ++- return ans;} +++ for (p=&ans;n-->0;first=OBJNULL) +++ collect(p,make_cons(first==OBJNULL ? va_arg(ap,object) : first,Cnil)); +++ *p=Cnil; +++ return ans; ++ +++} ++ ++-/* clean this up */ ++-/* static object on_stack_list(int n, ...) ++-{va_list ap; ++- object res; ++- va_start(ap,n); ++- res=on_stack_list_vector(n,ap); ++- va_end(ap); ++- return res; ++-}*/ ++ #ifdef WIDE_CONS ++ #define maybe_set_type_of(a,b) set_type_of(a,b) ++ #else ++ #define maybe_set_type_of(a,b) ++ #endif ++ +++void +++free_check(void) { ++ +++ int n=tm_table[t_cons].tm_nfree,m; +++ object f=tm_table[t_cons].tm_free; +++ for (m=0;f!=OBJNULL;m++,f=OBJ_LINK(f)); +++ massert(n==m); +++} +++ ++ #define multi_cons(n_,next_,last_) \ ++- ({static struct typemanager *_tm=tm_table+t_cons; \ ++- object _lis=OBJNULL; \ ++- \ ++- if (n<=_tm->tm_nfree) { \ ++- \ ++- object _tail=_tm->tm_free; \ ++- \ ++- _lis=_tail; \ ++- \ +++ ({_tm->tm_nfree -= n_; \ +++ for(_x=_tm->tm_free,_p=&_x;n_-->0;_p=&(*_p)->c.c_cdr) { \ +++ object _z=*_p; \ +++ pageinfo(_z)->in_use++; \ +++ maybe_set_type_of(_z,t_cons); \ +++ _z->c.c_cdr=OBJ_LINK(_z); \ +++ _z->c.c_car=next_; \ +++ } \ +++ _tm->tm_free=*_p; \ +++ *_p=SAFE_CDR(last_); \ +++ _x;}) +++ +++#define n_cons(n_,next_,last_) \ +++ ({fixnum _n=n_;object _x=Cnil,*_p; \ +++ static struct typemanager *_tm=tm_table+t_cons; \ +++ if (_n>=0) {/*FIXME vs_toptm_nfree -= n_; \ ++- while (--n_) { \ ++- pageinfo(_tail)->in_use++; \ ++- maybe_set_type_of(_tail,t_cons); \ ++- _tail->c.c_cdr=OBJ_LINK(_tail); \ ++- _tail->c.c_car=next_; \ ++- _tail=_tail->c.c_cdr; \ +++ if (_n<=_tm->tm_nfree) \ +++ _x=multi_cons(_n,next_,last_); \ +++ else { \ +++ for (_p=&_x;_n--;) \ +++ collect(_p,make_cons(next_,Cnil)); \ +++ *_p=SAFE_CDR(last_); \ ++ } \ ++- _tm->tm_free=OBJ_LINK(_tail); \ ++- pageinfo(_tail)->in_use++; \ ++- maybe_set_type_of(_tail,t_cons); \ ++- _tail->c.c_car=next_; \ ++- _tail->c.c_cdr=SAFE_CDR(last_); \ ++- \ ++ END_NO_INTERRUPT; \ ++ } \ ++- _lis;}) ++- ++- ++- ++-object listqA(int a,int n,va_list ap) { ++- ++- object x,*p; ++- ++- if (n<=0) return Cnil; +++ _x;}) +++ +++object +++n_cons_from_x(fixnum n,object x) { ++ ++- if ((x=multi_cons(n,va_arg(ap,object),a ? va_arg(ap,object) : Cnil))!=OBJNULL) ++- return x; +++ return n_cons(n,({object _z=x->c.c_car;x=x->c.c_cdr;_z;}),Cnil); +++ +++} ++ ++- CHECK_INTERRUPT; ++ ++- p = vs_top; ++- ++- vs_push(Cnil); ++- while(--n>=0) { ++- *p=make_cons(va_arg(ap,object),Cnil); ++- p= &((*p)->c.c_cdr); ++- } ++- if (a) ++- *p=SAFE_CDR(va_arg(ap,object)); +++object +++listqA(int a,int n,va_list ap) { ++ ++- return(vs_pop); +++ return n_cons(n,va_arg(ap,object),a ? va_arg(ap,object) : Cnil); ++ ++ } ++ ++-object list(int n,...) { +++object list(fixnum n,...) { ++ ++ va_list ap; ++ object lis; ++@@ -375,7 +360,7 @@ object list(int n,...) { ++ ++ } ++ ++-object listA(int n,...) { +++object listA(fixnum n,...) { ++ ++ va_list ap; ++ object lis; ++@@ -417,163 +402,63 @@ BEGIN: ++ object ++ append(object x, object y) { ++ ++- object z; ++- fixnum n; ++- ++- if (endp(x)) ++- return(y); ++- ++- for (z=x,n=0;!endp(z);z=z->c.c_cdr,n++); ++- if ((z=multi_cons(n,({object _t=x->c.c_car;x=x->c.c_cdr;_t;}),y))!=OBJNULL) ++- return z; +++ return n_cons(length(x),({object _t=x->c.c_car;x=x->c.c_cdr;_t;}),y); ++ ++- z = make_cons(Cnil, Cnil); ++- vs_push(z); ++- for (;;) { ++- z->c.c_car = x->c.c_car; ++- x = x->c.c_cdr; ++- if (endp(x)) ++- break; ++- z->c.c_cdr = make_cons(Cnil, Cnil); ++- z = z->c.c_cdr; ++- } ++- z->c.c_cdr = SAFE_CDR(y); ++- return(vs_pop); ++ } ++ ++- ++- ++-/* object */ ++-/* append(x, y) */ ++-/* object x, y; */ ++-/* { */ ++-/* object z; */ ++- ++-/* if (endp(x)) */ ++-/* return(y); */ ++-/* z = make_cons(Cnil, Cnil); */ ++-/* vs_push(z); */ ++-/* for (;;) { */ ++-/* z->c.c_car = x->c.c_car; */ ++-/* x = x->c.c_cdr; */ ++-/* if (endp(x)) */ ++-/* break; */ ++-/* z->c.c_cdr = make_cons(Cnil, Cnil); */ ++-/* z = z->c.c_cdr; */ ++-/* } */ ++-/* z->c.c_cdr = SAFE_CDR(y); */ ++-/* return(vs_pop); */ ++-/* } */ ++- ++ /* ++ Copy_list(x) copies list x. ++ */ ++ object ++-copy_list(x) ++-object x; ++-{ ++- object y; ++- ++- if (type_of(x) != t_cons) ++- return(x); ++- y = make_cons(x->c.c_car, Cnil); ++- vs_push(y); ++- for (x = x->c.c_cdr; type_of(x) == t_cons; x = x->c.c_cdr) { ++- y->c.c_cdr = make_cons(x->c.c_car, Cnil); ++- y = y->c.c_cdr; ++- } ++- y->c.c_cdr = SAFE_CDR(x); ++- return(vs_pop); +++copy_list(object x) { +++ object h,y; +++ +++ if (type_of(x) != t_cons) +++ return(x); +++ h=y=make_cons(x->c.c_car, Cnil); +++ for (x = x->c.c_cdr; type_of(x) == t_cons; x = x->c.c_cdr) { +++ y->c.c_cdr = make_cons(x->c.c_car, Cnil); +++ y=y->c.c_cdr; +++ } +++ y->c.c_cdr=SAFE_CDR(x); +++ return(h); ++ } ++ ++ /* ++ Copy_alist(x) copies alist x. ++ */ ++ static object ++-copy_alist(x) ++-object x; ++-{ ++- object y; +++copy_alist(object x) { ++ ++- if (endp(x)) ++- return(Cnil); ++- y = make_cons(Cnil, Cnil); ++- vs_push(y); ++- for (;;) { ++- y->c.c_car = make_cons(car(x->c.c_car), cdr(x->c.c_car)); ++- x = x->c.c_cdr; ++- if (endp(x)) ++- break; ++- y->c.c_cdr = make_cons(Cnil, Cnil); ++- y = y->c.c_cdr; ++- } ++- return(vs_pop); +++ object h,y; +++ +++ if (endp(x)) +++ return(Cnil); +++ h=y=make_cons(Cnil, Cnil); +++ for (;;) { +++ y->c.c_car=make_cons(car(x->c.c_car), cdr(x->c.c_car)); +++ x=x->c.c_cdr; +++ if (endp(x)) +++ break; +++ y->c.c_cdr=make_cons(Cnil, Cnil); +++ y=y->c.c_cdr; +++ } +++ return(h); ++ } ++ ++-/* ++- Copy_tree(x) copies tree x ++- and pushes the result onto vs. ++-*/ ++-static void ++-copy_tree(x) ++-object x; ++-{ ++- cs_check(x); ++- ++- if (type_of(x) == t_cons) { ++- copy_tree(x->c.c_car); ++- copy_tree(x->c.c_cdr); ++- stack_cons(); ++- } else ++- vs_check_push(x); ++-} ++- ++-/* /\* */ ++-/* Subst(new, tree) pushes */ ++-/* the result of substituting new in tree */ ++-/* onto vs. */ ++-/* *\/ */ ++-/* static void */ ++-/* subst(new, tree) */ ++-/* object new, tree; */ ++-/* { */ ++-/* cs_check(new); */ ++- ++-/* if (TEST(tree)) */ ++-/* vs_check_push(new); */ ++-/* else if (type_of(tree) == t_cons) { */ ++-/* subst(new, tree->c.c_car); */ ++-/* subst(new, tree->c.c_cdr); */ ++-/* stack_cons(); */ ++-/* } else */ ++-/* vs_check_push(tree); */ ++-/* } */ ++- ++-/* static object */ ++-/* subst1(object new, object tree) { */ ++- ++-/* if (TEST(tree)) */ ++-/* return new; */ ++-/* else if (type_of(tree) == t_cons) { */ ++-/* object oa=tree->c.c_car,a=subst1(new,oa),od=tree->c.c_cdr,d=subst1(new,od); */ ++-/* return a==oa && d==od ? tree : make_cons(a,d); */ ++-/* } else */ ++-/* return tree; */ ++- ++-/* } */ ++- ++-/* static object */ ++-/* subst1qi(object new, object tree) { */ ++- ++-/* if (item_compared == tree) */ ++-/* return new; */ ++-/* else if (type_of(tree) == t_cons) { */ ++-/* object oa=tree->c.c_car,a=subst1qi(new,oa),od=tree->c.c_cdr,d=subst1qi(new,od); */ ++-/* return a==oa && d==od ? tree : make_cons(a,d); */ ++-/* } else */ ++-/* return tree; */ +++static object +++copy_tree(object x) { ++ ++-/* } */ +++ object y; +++ +++ if (type_of(x) == t_cons) { +++ y=make_cons(Cnil,Cnil); +++ y->c.c_car=copy_tree(x->c.c_car); +++ y->c.c_cdr=copy_tree(x->c.c_cdr); +++ x=y; +++ } +++ return x; +++} ++ ++ /* ++ Nsubst(new, treep) stores ++@@ -599,27 +484,22 @@ object new, *treep; ++ result of substituting tree by alist ++ onto vs. ++ */ ++-static void ++-sublis(alist, tree) ++-object alist, tree; ++-{ ++- object x; ++- cs_check(alist); ++- +++static object +++sublis(object alist, object tree) { ++ ++- for (x = alist; !endp(x); x = x->c.c_cdr) { ++- item_compared = car(x->c.c_car); ++- if (TEST(tree)) { ++- vs_check_push(cdr(x->c.c_car)); ++- return; ++- } ++- } ++- if (type_of(tree) == t_cons) { ++- sublis(alist, tree->c.c_car); ++- sublis(alist, tree->c.c_cdr); ++- stack_cons(); ++- } else ++- vs_check_push(tree); +++ object x; +++ cs_check(alist); +++ +++ for (x=alist;!endp(x);x=x->c.c_cdr) { +++ item_compared=car(x->c.c_car); +++ if (TEST(tree)) +++ return x->c.c_car->c.c_cdr; +++ } +++ if (type_of(tree) == t_cons) { +++ object a=sublis(alist,tree->c.c_car),d=sublis(alist,tree->c.c_cdr); +++ return (a==tree->c.c_car && d==tree->c.c_cdr) ? tree : make_cons(a,d); +++ } else +++ return tree; ++ } ++ ++ /* ++@@ -777,7 +657,7 @@ DEFUN_NEW("TENTH",object,fLtenth,LISP,1, ++ LFD(Lcons)() { ++ ++ check_arg(2); ++- stack_cons(); +++ vs_base[0]=make_cons(vs_base[0],vs_pop); ++ ++ } ++ ++@@ -907,36 +787,28 @@ LFD(Llast)() { ++ ++ } ++ ++-LFD(Llist)() ++-{ ++- vs_push(Cnil); ++- while (vs_top > vs_base + 1) ++- stack_cons(); ++-} +++LFD(Llist)() { +++ +++ object *a; +++ +++ a=vs_base; +++ vs_base[0]=n_cons(vs_top-vs_base,*a++,Cnil); +++ vs_top=vs_base+1; ++ ++-LFD(LlistA)() ++-{ ++- if (vs_top == vs_base) ++- too_few_arguments(); ++- while (vs_top > vs_base + 1) ++- stack_cons(); ++ } ++-/* static object copy_off_stack_tree(x) */ ++-/* object x; */ ++-/* {object *p; */ ++-/* p = &x; */ ++-/* TOP: */ ++-/* if (type_of(*p) ==t_cons) */ ++-/* { if(!inheap(*p)) */ ++-/* *p=make_cons(copy_off_stack_tree((*p)->c.c_car),(*p)->c.c_cdr); */ ++-/* else */ ++-/* (*p)->c.c_car = copy_off_stack_tree((*p)->c.c_car); */ ++-/* p = &((*p)->c.c_cdr); */ ++-/* goto TOP;} */ ++-/* return x; */ ++-/* } */ ++ ++- +++LFD(LlistA)() { +++ +++ object *a; +++ +++ if (vs_top == vs_base) +++ too_few_arguments(); +++ +++ a=vs_base; +++ vs_base[0]=n_cons(vs_top-vs_base-1,*a++,vs_head); +++ vs_top=vs_base+1; +++ +++} ++ ++ object on_stack_make_list(n) ++ int n; ++@@ -957,23 +829,20 @@ int n; ++ goto TOP; ++ } ++ ++-object make_list(n) ++-int n; ++-{object x =Cnil ; ++- while (n-- > 0) ++- x = make_cons(Cnil, x); ++- return x;} +++object +++make_list(int n) { +++ +++ return n_cons(n,Cnil,Cnil); +++ +++} ++ ++ @(defun make_list (size &key initial_element &aux x) ++- int i; ++ @ ++- check_type_non_negative_integer(&size); ++- if (type_of(size) != t_fixnum) ++- FEerror("Cannot make a list of the size ~D.", 1, size); ++- i = fix(size); ++- while (i-- > 0) ++- x = make_cons(initial_element, x); ++- @(return x) +++ check_type_non_negative_integer(&size); +++ if (type_of(size) != t_fixnum) +++ FEerror("Cannot make a list of the size ~D.", 1, size); +++ x=n_cons(fix(size),initial_element,Cnil); +++ @(return x) ++ @) ++ ++ LFD(Lappend)() ++@@ -1006,22 +875,19 @@ LFD(Lcopy_alist)() ++ LFD(Lcopy_tree)() ++ { ++ check_arg(1); ++- copy_tree(vs_base[0]); ++- vs_base[0] = vs_pop; +++ vs_base[0]=copy_tree(vs_base[0]); ++ } ++ ++ LFD(Lrevappend)() { ++- object x, y; ++ ++- check_arg(2); ++- y = vs_pop; ++- for (x = vs_base[0]; !endp(x); x = x->c.c_cdr) { ++- vs_push(x->c.c_car); ++- vs_push(y); ++- stack_cons(); ++- y = vs_pop; ++- } ++- vs_base[0] = y; +++ object x, y; +++ +++ check_arg(2); +++ y=vs_pop; +++ for (x=vs_base[0];!endp(x);x=x->c.c_cdr) +++ y=make_cons(x->c.c_car,y); +++ vs_base[0] = y; +++ ++ } ++ ++ object ++@@ -1078,26 +944,19 @@ LFD(Lreconc)() { ++ } ++ ++ @(defun butlast (lis &optional (nn `make_fixnum(1)`)) ++- int i; +++ int i; +++ object *p,x,y,z; ++ @ ++- check_type_non_negative_integer(&nn); ++- if (!listp(lis))/*FIXME checktype*/ ++- FEwrong_type_argument(sLlist, lis); ++- if (type_of(nn) != t_fixnum) ++- @(return Cnil) ++- for (i = 0; consp(lis); i++, lis = lis->c.c_cdr) ++- vs_check_push(lis->c.c_car); ++- if (i <= fix((nn))) { ++- vs_top -= i; ++- @(return Cnil) ++- } ++- vs_top -= fix((nn)); ++- i -= fix((nn)); ++- vs_push(Cnil); ++- while (i-- > 0) ++- stack_cons(); ++- lis = vs_pop; ++- @(return lis) +++ check_type_non_negative_integer(&nn); +++ if (!listp(lis))/*FIXME checktype*/ +++ FEwrong_type_argument(sLlist, lis); +++ if (type_of(nn) != t_fixnum) +++ @(return Cnil) +++ for (x=y=lis,i=0;ic.c_cdr); +++ for (p=&z;consp(y);x=x->c.c_cdr,y=y->c.c_cdr) +++ collect(p,make_cons(x->c.c_car,Cnil)); +++ *p=i ? Cnil : x; +++ @(return `z`) ++ @) ++ ++ @(defun nbutlast (lis &optional (nn `make_fixnum(1)`)) ++@@ -1119,21 +978,20 @@ LFD(Lreconc)() { ++ @) ++ ++ LFD(Lldiff)() { ++- fixnum i; ++- object x; ++ ++- check_arg(2); ++- x = vs_base[0]; ++- if (!listp(x))/*FIXME checktype*/ ++- FEwrong_type_argument(sLlist, x); ++- for (i = 0; consp(x) && x!=vs_base[1] ; i++, x = x->c.c_cdr) ++- vs_check_push(x->c.c_car); /*FIXME but a segfault breaker at vs_limit*/ ++- x=eql(x,vs_base[1]) ? Cnil : x; ++- vs_check_push(x); ++- while (i-- > 0) ++- stack_cons(); ++- vs_base[0] = vs_pop; ++- vs_popp; +++ fixnum i; +++ object x,y,*p,z; +++ +++ check_arg(2); +++ x=vs_base[0]; +++ z=vs_pop; +++ if (!listp(x))/*FIXME checktype*/ +++ FEwrong_type_argument(sLlist, x); +++ for (p=&y,i=0;consp(x) && x!=z;i++,x=x->c.c_cdr) +++ collect(p,make_cons(x->c.c_car,Cnil)); +++ *p=eql(x,z) ? Cnil : x; +++ vs_base[0]=y; +++ ++ } ++ ++ LFD(Lrplaca)() ++@@ -1187,18 +1045,15 @@ LFD(Lrplacd)() ++ PREDICATE(Lnsubst,Lnsubst_if,Lnsubst_if_not, 3) ++ ++ object ++-sublis1(alist,tree,tst) ++- object alist,tree; ++- bool (*tst)(); ++-{object v; ++- for (v=alist ; v!=Cnil; v=v->c.c_cdr) ++- { if ((*tst)(v->c.c_car->c.c_car ,tree)) ++- return(v->c.c_car->c.c_cdr);} ++- if (type_of(tree)==t_cons) ++- {object ntree=make_cons(sublis1(alist,tree->c.c_car,tst), ++- tree->c.c_cdr); ++- ntree->c.c_cdr=sublis1(alist,ntree->c.c_cdr,tst); ++- return ntree; +++sublis1(object alist,object tree,bool (*tst)()) { +++ +++ object v; +++ for (v=alist;v!=Cnil;v=v->c.c_cdr) { +++ if ((*tst)(v->c.c_car->c.c_car,tree)) +++ return(v->c.c_car->c.c_cdr);} +++ if (type_of(tree)==t_cons){ +++ object a=sublis1(alist,tree->c.c_car,tst),d=sublis1(alist,tree->c.c_cdr,tst); +++ return a==tree->c.c_car && d==tree->c.c_cdr ? tree : make_cons(a,d); ++ } ++ return tree; ++ } ++@@ -1226,8 +1081,7 @@ check_alist(alist) ++ @ ++ protectTEST; ++ setupTEST(Cnil, test, test_not, key); ++- sublis(alist, tree); ++- tree = vs_pop; +++ tree=sublis(alist,tree); ++ restoreTEST; ++ @(return tree) ++ @) ++@@ -1321,27 +1175,25 @@ LFD(Lacons)() ++ } ++ ++ @(defun pairlis (keys data &optional a_list) ++- object *vp, k, d; +++ object k,d,y,z,*p; ++ @ ++- vp = vs_top + 1; ++- k = keys; ++- d = data; ++- while (!endp(k)) { ++- if (endp(d)) ++- FEerror( ++- "The keys ~S and the data ~S are not of the same length", ++- 2, keys, data); ++- vs_check_push(make_cons(k->c.c_car, d->c.c_car)); ++- k = k->c.c_cdr; ++- d = d->c.c_cdr; ++- } ++- if (!endp(d)) ++- FEerror("The keys ~S and the data ~S are not of the same length", ++- 2, keys, data); ++- vs_push(a_list); ++- while (vs_top > vp) ++- stack_cons(); ++- @(return `vp[-1]`) +++ k=keys; +++ d=data; +++ p=&y; +++ while (!endp(k)) { +++ if (endp(d)) +++ FEerror("The keys ~S and the data ~S are not of the same length",2,keys,data); +++ z=make_cons(Cnil,Cnil); +++ z->c.c_car=make_cons(k->c.c_car,d->c.c_car); +++ collect(p,z); +++ k = k->c.c_cdr; +++ d = d->c.c_cdr; +++ } +++ if (!endp(d)) +++ FEerror("The keys ~S and the data ~S are not of the same length",2,keys,data); +++ *p=a_list; +++ vs_top=vs_base+1; +++ @(return `y`) ++ @) ++ ++ @(static defun assoc_or_rassoc (item a_list &key test test_not key) ++--- gcl-2.6.12.orig/o/makefile +++++ gcl-2.6.12/o/makefile ++@@ -91,8 +91,8 @@ $(DECL): $(HDIR)/make-decl.h $(INI_FILES ++ grab_defs: grab_defs.c ++ ${CC} $(OFLAGS) -o grab_defs grab_defs.c ++ ++-wpool: wpool.c ++- $(CC) $(CFLAGS) $(DEFS) -o $@ $< +++wpool: wpool.o +++ $(CC) $(LDFLAGS) -o $@ $< ++ ++ $(GCLIB): ${ALIB} ++ rm -f gcllib.a ++--- gcl-2.6.12.orig/o/makefun.c +++++ gcl-2.6.12/o/makefun.c ++@@ -6,12 +6,20 @@ ++ MakeAfun(addr,F_ARGD(min,max,flags,ARGTYPES(a,b,c,d)),0); ++ MakeAfun(addr,F_ARGD(2,3,NONE,ARGTYPES(OO,OO,OO,OO)),0); ++ */ +++ +++static int mv; +++ ++ object MakeAfun(object (*addr)(object,object), unsigned int argd, object data) ++-{int type = (F_ARG_FLAGS_P(argd,F_requires_fun_passed) ? t_closure : t_afun); +++{ +++ ufixnum at=F_TYPES(argd)>>F_TYPE_WIDTH; +++ ufixnum ma=F_MIN_ARGS(argd); +++ ufixnum xa=F_MAX_ARGS(argd); +++ ufixnum rt=F_RESULT_TYPE(argd); +++ int type = (F_ARG_FLAGS_P(argd,F_requires_fun_passed) ? t_closure : (!at&&!rt&&ma==xa&&!mv ? t_sfun : t_afun)); ++ object x = alloc_object(type); ++ x->sfn.sfn_name = Cnil; ++ x->sfn.sfn_self = addr; ++- x->sfn.sfn_argd = argd; +++ x->sfn.sfn_argd = type==t_sfun ? ma : argd; ++ if (type == t_closure) ++ { x->cl.cl_env = 0; ++ x->cl.cl_envdim=0;} ++@@ -107,7 +115,7 @@ DEFUN_NEW("SET-KEY-STRUCT",object,fSset_ ++ } ++ ++ ++-#define collect(top_,next_,val_) ({object _x=MMcons(val_,Cnil);\ +++#define mcollect(top_,next_,val_) ({object _x=MMcons(val_,Cnil);\ ++ if (top_==Cnil) top_=next_=_x; \ ++ else next_=next_->c.c_cdr=_x;}) ++ ++@@ -125,23 +133,23 @@ put_fn_procls(object sym,fixnum argd,fix ++ for (i=0;i>=F_TYPE_WIDTH) ++ switch(maxargs!=minargs ? F_object : atypes & MASK_RANGE(0,F_TYPE_WIDTH)) { ++ case F_object: ++- collect(ta,na,def); +++ mcollect(ta,na,def); ++ break; ++ case F_int: ++- collect(ta,na,sLfixnum); +++ mcollect(ta,na,sLfixnum); ++ break; ++ case F_shortfloat: ++- collect(ta,na,sLshort_float); +++ mcollect(ta,na,sLshort_float); ++ break; ++ case F_double_ptr: ++- collect(ta,na,sLlong_float); +++ mcollect(ta,na,sLlong_float); ++ break; ++ default: ++ FEerror("Bad sfn declaration",0); ++ break; ++ } ++ if (maxargs!=minargs) ++- collect(ta,na,sLA); +++ mcollect(ta,na,sLA); ++ putprop(sym,ta,sSproclaimed_arg_types); ++ ta=na=Cnil; ++ if (oneval) ++@@ -188,15 +196,19 @@ LISP_makefun(char *strg, void *fn, unsig ++ void ++ SI_makefunm(char *strg, void *fn, unsigned int argd) ++ { object sym = make_si_ordinary(strg); ++- fSfset(sym, fSmakefun(sym,fn,argd)); ++- put_fn_procls(sym,argd,0,Ct,Ct); +++ mv=1; +++ fSfset(sym, fSmakefun(sym,fn,argd)); +++ mv=0; +++ put_fn_procls(sym,argd,0,Ct,Ct); ++ } ++ ++ void ++ LISP_makefunm(char *strg, void *fn, unsigned int argd) ++ { object sym = make_ordinary(strg); ++- fSfset(sym, fSmakefun(sym,fn,argd)); ++- put_fn_procls(sym,argd,0,Ct,Ct); +++ mv=1; +++ fSfset(sym, fSmakefun(sym,fn,argd)); +++ mv=0; +++ put_fn_procls(sym,argd,0,Ct,Ct); ++ } ++ ++ ++--- gcl-2.6.12.orig/o/package.d +++++ gcl-2.6.12/o/package.d ++@@ -849,17 +849,19 @@ FFN(Lpackage_shadowing_symbols)() ++ vs_base[0] = vs_base[0]->p.p_shadowings; ++ } ++ ++-LFD(Llist_all_packages)() ++-{ ++- struct package *p; ++- int i; +++LFD(Llist_all_packages)() { +++ +++ struct package *p; +++ object x,*l; +++ int i; +++ +++ check_arg(0); +++ +++ for (l=&x,p=pack_pointer,i=0;p!=NULL;p=p->p_link,i++) +++ collect(l,make_cons((object)p,Cnil)); +++ *l=Cnil; +++ vs_push(x); ++ ++- check_arg(0); ++- for (p = pack_pointer, i = 0; p != NULL; p = p->p_link, i++) ++- vs_push((object)p); ++- vs_push(Cnil); ++- while (i-- > 0) ++- stack_cons(); ++ } ++ ++ @(defun intern (strng &optional (p `current_package()`) &aux sym) ++--- gcl-2.6.12.orig/o/predicate.c +++++ gcl-2.6.12/o/predicate.c ++@@ -425,7 +425,7 @@ eql1(register object x,register object y ++ ++ /*x and y are not == and not Cnil and not immfix*/ ++ ++- if (valid_cdr(x)||valid_cdr(y)||x->d.t!=y->d.t) return FALSE; +++ /* if (valid_cdr(x)||valid_cdr(y)||x->d.t!=y->d.t) return FALSE; */ ++ ++ switch (x->d.t) { ++ ++--- gcl-2.6.12.orig/o/print.d +++++ gcl-2.6.12/o/print.d ++@@ -41,6 +41,8 @@ int line_length = 72; ++ isLower((c)&0377) || (c) == ':') ++ ++ +++#define READ_TABLE_CASE (Vreadtable->s.s_dbind->rt.rt_case) +++ ++ #define mod(x) ((x)%Q_SIZE) ++ ++ ++@@ -619,13 +621,113 @@ object coerce_big_to_string(object,int); ++ static bool ++ potential_number_p(object,int); ++ +++#define CASE_OF(x_) ({int _x=(x_);isUpper(_x) ? 1 : (isLower(_x) ? -1 : 0);}) +++ +++static int +++constant_case(object x) { +++ +++ fixnum i,j,jj; +++ +++ for (i=j=0;is.s_fillp;i++,j=j ? j : jj) +++ if (j*(jj=CASE_OF(x->s.s_self[i]))==-1) +++ return 0; +++ +++ return j; +++ +++} +++ +++static int +++all_dots(object x) { +++ +++ fixnum i; +++ +++ for (i=0;is.s_fillp;i++) +++ if (x->s.s_self[i]!='.') +++ return 0; +++ +++ return 1; +++ +++} +++ +++static int +++needs_escape (object x,int pp) { +++ +++ fixnum i; +++ char ch; +++ +++ if (!PRINTescape) +++ return 0; +++ +++ for (i=0;is.s_fillp;i++) +++ switch((ch=x->s.s_self[i])) { +++ case '(': +++ case ')': +++ case ':': +++ case '`': +++ case '\'': +++ case '"': +++ case ';': +++ case ',': +++ case '\n': +++ return 1; +++ case ' ': +++ if (!i) return 1; +++ default: +++ if ((READ_TABLE_CASE==sKupcase && isLower(ch)) || +++ (READ_TABLE_CASE==sKdowncase && isUpper(ch))) +++ return 1; +++ } +++ +++ if (pp) +++ if (potential_number_p(x, PRINTbase) || all_dots(x)) +++ return 1; +++ +++ return !x->s.s_fillp; +++ +++} +++ +++#define convertible_upper(c) ((READ_TABLE_CASE==sKupcase ||READ_TABLE_CASE==sKinvert)&& isUpper(c)) +++#define convertible_lower(c) ((READ_TABLE_CASE==sKdowncase||READ_TABLE_CASE==sKinvert)&& isLower(c)) +++ +++static void +++print_symbol_name_body(object x,int pp) { +++ +++ int i,j,fc,tc,lw,k,cc; +++ +++ cc=constant_case(x); +++ k=needs_escape(x,pp); +++ +++ if (k) +++ write_ch('|'); +++ +++ for (lw=i=0;is.s_fillp;i++) { +++ j = x->s.s_self[i]; +++ if (PRINTescape && (j == '|' || j == '\\')) +++ write_ch('\\'); +++ fc=convertible_upper(j) ? 1 : +++ (convertible_lower(j) ? -1 : 0); +++ tc=(READ_TABLE_CASE==sKinvert ? -cc : +++ (PRINTcase == sKupcase ? 1 : +++ (PRINTcase == sKdowncase ? -1 : +++ (PRINTcase == sKcapitalize ? (i==lw ? 1 : -1) : 0)))); +++ if (ispunct(j)||isspace(j)) lw=i+1; +++ j+=(tc*fc && !k ? (tc-fc)>>1 : 0)*('A'-'a'); +++ write_ch(j); +++ +++ } +++ +++ if (k) +++ write_ch('|'); +++ +++} +++ ++ void ++ write_object(x, level) ++ object x; ++ int level; ++ { ++ object r, y; ++- int i, j, k,lw; +++ int i, j, k; ++ object *vp; ++ ++ cs_check(x); ++@@ -797,117 +899,49 @@ int level; ++ break; ++ ++ case t_symbol: ++- if (!PRINTescape) { ++- for (lw = 0,i = 0; i < x->s.s_fillp; i++) { ++- j = x->s.s_self[i]; ++- if (isUpper(j)) { ++- if (PRINTcase == sKdowncase || ++- (PRINTcase == sKcapitalize && i!=lw)) ++- j += 'a' - 'A'; ++- } else if (!isLower(j)) ++- lw = i + 1; ++- write_ch(j); +++ { ++ ++- } ++- break; ++- } ++- if (x->s.s_hpack == Cnil) { ++- if (PRINTcircle) { ++- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) ++- if (x == *vp) { ++- if (vp[1] != Cnil) { ++- write_ch('#'); ++- write_decimal((vp-PRINTvs_top)/2); ++- write_ch('#'); ++- return; ++- } else { ++- write_ch('#'); ++- write_decimal((vp-PRINTvs_top)/2); ++- write_ch('='); ++- vp[1] = Ct; ++- } ++- } +++ if (PRINTescape) { +++ if (x->s.s_hpack == Cnil) { +++ if (PRINTcircle) { +++ for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) +++ if (x == *vp) { +++ if (vp[1] != Cnil) { +++ write_ch('#'); +++ write_decimal((vp-PRINTvs_top)/2+1); +++ write_ch('#'); +++ return; +++ } else { +++ write_ch('#'); +++ write_decimal((vp-PRINTvs_top)/2+1); +++ write_ch('='); +++ vp[1] = Ct; +++ } ++ } ++- if (PRINTgensym) ++- write_str("#:"); ++- } else if (x->s.s_hpack == keyword_package) ++- write_ch(':'); ++- else if (PRINTpackage||find_symbol(x,current_package())!=x ++- || intern_flag == 0) ++- { ++- k = 0; ++- for (i = 0; ++- i < x->s.s_hpack->p.p_name->st.st_fillp; ++- i++) { ++- j = x->s.s_hpack->p.p_name ++- ->st.st_self[i]; ++- if (to_be_escaped(j)) ++- k++; ++- } ++- if (k > 0) ++- write_ch('|'); ++- for (lw = 0, i = 0; ++- i < x->s.s_hpack->p.p_name->st.st_fillp; ++- i++) { ++- j = x->s.s_hpack->p.p_name ++- ->st.st_self[i]; ++- if (j == '|' || j == '\\') ++- write_ch('\\'); ++- if (k == 0) { ++- if (isUpper(j)) { ++- if (PRINTcase == sKdowncase || ++- (PRINTcase == sKcapitalize && i!=lw)) ++- j += 'a' - 'A'; ++- } else if (!isLower(j)) ++- lw = i + 1; ++- } ++- write_ch(j); ++- } ++- if (k > 0) ++- write_ch('|'); ++- if (find_symbol(x, x->s.s_hpack) != x) ++- error("can't print symbol"); ++- if (PRINTpackage || intern_flag == INTERNAL) ++- write_str("::"); ++- else if (intern_flag == EXTERNAL) ++- write_ch(':'); ++- else ++- FEerror("Pathological symbol --- cannot print.", 0); ++ } ++- k = 0; ++- if (potential_number_p(x, PRINTbase)) ++- k++; ++- for (i = 0; i < x->s.s_fillp; i++) { ++- j = x->s.s_self[i]; ++- if (to_be_escaped(j)) ++- k++; ++- } ++- for (i = 0; i < x->s.s_fillp; i++) ++- if (x->s.s_self[i] != '.') ++- goto NOT_DOT; ++- k++; ++- ++- NOT_DOT: ++- if (k > 0) ++- write_ch('|'); ++- for (lw = 0, i = 0; i < x->s.s_fillp; i++) { ++- j = x->s.s_self[i]; ++- if (j == '|' || j == '\\') ++- write_ch('\\'); ++- if (k == 0) { ++- if (isUpper(j)) { ++- if (PRINTcase == sKdowncase || ++- (PRINTcase == sKcapitalize && i != lw)) ++- j += 'a' - 'A'; ++- } else if (!isLower(j)) ++- lw = i + 1; ++- } ++- write_ch(j); ++- } ++- if (k > 0) ++- write_ch('|'); ++- break; +++ if (PRINTgensym) +++ write_str("#:"); +++ } else if (x->s.s_hpack == keyword_package) { +++ write_ch(':'); +++ } else if (PRINTpackage||find_symbol(x,current_package())!=x || !intern_flag) { +++ +++ print_symbol_name_body(x->s.s_hpack->p.p_name,0); +++ +++ if (find_symbol(x, x->s.s_hpack) != x) +++ error("can't print symbol"); +++ if (PRINTpackage || intern_flag == INTERNAL) +++ write_str("::"); +++ else if (intern_flag == EXTERNAL) +++ write_ch(':'); +++ else +++ FEerror("Pathological symbol --- cannot print.", 0); +++ +++ } ++ +++ } +++ print_symbol_name_body(x,1); +++ break; +++ } ++ case t_array: ++ { ++ int subscripts[ARANKLIM]; ++--- gcl-2.6.12.orig/o/read.d +++++ gcl-2.6.12/o/read.d ++@@ -695,10 +695,29 @@ BEGIN: ++ goto K; ++ else ++ break; ++- } ++- else if ('a' <= char_code(c) && char_code(c) <= 'z') ++- c = code_char(char_code(c) - ('a' - 'A')); ++- else if (char_code(c) == ':') { +++ } else { +++ +++ switch(char_code(c)) { +++ case '\b': +++ case '\t': +++ case '\n': +++ case '\r': +++ case '\f': +++ case ' ': +++ case '\177': +++ READER_ERROR(in,"Cannot read character"); +++ default: +++ break; +++ } +++ +++ if ('a' <= char_code(c) && char_code(c) <= 'z') { +++ if ('a' <= char_code(c) && char_code(c) <= 'z' && +++ (READtable->rt.rt_case==sKupcase || READtable->rt.rt_case==sKinvert)) +++ c = code_char(char_code(c) - ('a' - 'A')); +++ else if ('A' <= char_code(c) && char_code(c) <= 'Z' && +++ (READtable->rt.rt_case==sKdowncase || READtable->rt.rt_case==sKinvert)) +++ c = code_char(char_code(c) + ('a' - 'A')); +++ } else if (char_code(c) == ':') { ++ if (colon_type == 0) { ++ colon_type = 1; ++ colon = length; ++@@ -707,6 +726,7 @@ BEGIN: ++ else ++ colon_type = -1; ++ /* Colon has appeared twice. */ +++ } ++ } ++ } ++ if (preserving_whitespace_flag || cat(c) != cat_whitespace) ++@@ -807,46 +827,49 @@ SYMBOL: ++ } ++ ++ static void ++-Lleft_parenthesis_reader() ++-{ ++- object in, x; ++- object *p; +++Lleft_parenthesis_reader() { ++ ++- check_arg(2); ++- in = vs_base[0]; ++- vs_head = Cnil; ++- p = &vs_head; ++- for (;;) { ++- delimiting_char = code_char(')'); ++- in_list_flag = TRUE; ++- x = read_object(in); ++- if (x == OBJNULL) ++- goto ENDUP; ++- if (dot_flag) { ++- if (p == &vs_head) ++- FEerror("A dot appeared after a left parenthesis.", 0); ++- delimiting_char = code_char(')'); ++- in_list_flag = TRUE; ++- *p = SAFE_CDR(read_object(in)); ++- if (dot_flag) ++- FEerror("Two dots appeared consecutively.", 0); ++- if (*p==OBJNULL) ++- FEerror("Object missing after dot.", 0); ++- delimiting_char = code_char(')'); ++- in_list_flag = TRUE; ++- if (read_object(in)!=OBJNULL) ++- FEerror("Two objects after dot.",0); ++- goto ENDUP; ++- } ++- vs_push(x); ++- *p = make_cons(x, Cnil); ++- vs_popp; ++- p = &((*p)->c.c_cdr); ++- } +++ object in, x; +++ object *p; +++ +++ check_arg(2); +++ in = vs_base[0]; +++ vs_top=vs_base+1; +++ p = &vs_head; +++ +++ for (;;) { +++ +++ delimiting_char = code_char(')'); +++ in_list_flag = TRUE; +++ +++ if ((x=read_object(in))==OBJNULL) { +++ *p=Cnil; +++ break; +++ } +++ +++ if (dot_flag) { +++ +++ if (p==&vs_head) READER_ERROR(in,"A dot appeared after a left parenthesis."); +++ +++ delimiting_char = code_char(')'); +++ in_list_flag = TRUE; +++ *p=SAFE_CDR(read_object(in)); +++ +++ if (dot_flag) READER_ERROR(in,"Two dots appeared consecutively."); +++ if (*p==OBJNULL) READER_ERROR(in,"Object missing after dot."); +++ +++ delimiting_char = code_char(')'); +++ in_list_flag = TRUE; +++ if (read_object(in)!=OBJNULL) READER_ERROR(in,"Two objects after dot."); +++ +++ break; +++ +++ } +++ +++ collect(p,make_cons(x,Cnil)); +++ +++ } ++ ++-ENDUP: ++- vs_base[0] = vs_pop; ++- return; ++ } ++ ++ ++@@ -959,13 +982,8 @@ static void ++ Lsingle_quote_reader() ++ { ++ check_arg(2); ++- vs_popp; ++- vs_push(sLquote); ++- vs_push(read_object(vs_base[0])); ++- vs_push(Cnil); ++- stack_cons(); ++- stack_cons(); ++- vs_base[0] = vs_pop; +++ vs_base[0] = list(2,sLquote,read_object(vs_base[0])); +++ vs_top=vs_base+1; ++ } ++ ++ static void ++@@ -1111,14 +1129,8 @@ Lsharp_single_quote_reader() ++ check_arg(3); ++ if(vs_base[2] != Cnil && !READsuppress) ++ extra_argument('#'); ++- vs_popp; ++- vs_popp; ++- vs_push(sLfunction); ++- vs_push(read_object(vs_base[0])); ++- vs_push(Cnil); ++- stack_cons(); ++- stack_cons(); ++- vs_base[0] = vs_pop; +++ vs_base[0] = list(2,sLfunction,read_object(vs_base[0])); +++ vs_top=vs_base+1; ++ } ++ ++ #define QUOTE 1 ++@@ -1163,20 +1175,7 @@ Lsharp_left_parenthesis_reader() ++ } ++ goto L; ++ } ++- vs_push(siScomma); ++- vs_push(sLapply); ++- vs_push(sLquote); ++- vs_push(sLvector); ++- vs_push(Cnil); ++- stack_cons(); ++- stack_cons(); ++- vs_push(vs_base[2]); ++- vs_push(Cnil); ++- stack_cons(); ++- stack_cons(); ++- stack_cons(); ++- stack_cons(); ++- vs_base = vs_top - 1; +++ vs_base[0]=list(4,siScomma,sLapply,list(2,sLquote,sLvector),vs_base[2]); ++ return; ++ } ++ vsp = vs_top; ++@@ -1633,6 +1632,7 @@ object from, to; ++ rtab[i].rte_dtab[j] ++ = from->rt.rt_self[i].rte_dtab[j]; ++ } +++ to->rt.rt_case=from->rt.rt_case; ++ vs_reset; ++ END_NO_INTERRUPT;} ++ return(to); ++@@ -1758,8 +1758,7 @@ READ: ++ x = read_object_recursive(strm); ++ if (x == OBJNULL) ++ break; ++- *p = make_cons(x, Cnil); ++- p = &((*p)->c.c_cdr); +++ collect(p,make_cons(x,Cnil)); ++ } ++ if (recursivep == Cnil) { ++ if (sSAsharp_eq_contextA->s.s_dbind!=Cnil) ++@@ -2181,6 +2180,18 @@ LFD(Lreadtablep)() ++ @(return Ct) ++ @) ++ +++DEFUN_NEW("READTABLE-CASE",object,fLreadtable_case,LISP,1,1,NONE,OO,OO,OO,OO,(object rt),"") { +++ check_type_readtable_no_default(&rt); +++ RETURN1(rt->rt.rt_case); +++} +++ +++DEFUN_NEW("SET-READTABLE-CASE",object,fSset_readtable_case,SI,2,2,NONE,OO,OO,OO,OO,(object rt,object cas),"") { +++ check_type_readtable_no_default(&rt); +++ if (cas!=sKupcase && cas!=sKdowncase && cas!=sKpreserve && cas!=sKinvert) +++ TYPE_ERROR(cas,list(5,sLmember,sKupcase,sKdowncase,sKpreserve,sKinvert)); +++ RETURN1(rt->rt.rt_case=cas); +++} +++ ++ @(static defun get_dispatch_macro_character (dspchr subchr ++ &optional (rdtbl `current_readtable()`)) ++ @ ++@@ -2348,6 +2359,13 @@ gcl_init_read() ++ ++ gcl_init_backq(); ++ +++ sKupcase = make_keyword("UPCASE"); +++ sKdowncase = make_keyword("DOWNCASE"); +++ sKpreserve = make_keyword("PRESERVE"); +++ sKinvert = make_keyword("INVERT"); +++ +++ standard_readtable->rt.rt_case=sKupcase; +++ ++ Vreadtable ++ = make_special("*READTABLE*", ++ copy_readtable(standard_readtable, Cnil)); ++--- gcl-2.6.12.orig/o/reference.c +++++ gcl-2.6.12/o/reference.c ++@@ -73,18 +73,14 @@ LFD(Lsymbol_function)(void) ++ if (type_of(sym) != t_symbol) ++ not_a_symbol(sym); ++ if (sym->s.s_sfdef != NOT_SPECIAL) { ++- vs_push(make_fixnum((long)(sym->s.s_sfdef))); ++- vs_base[0] = sLspecial; ++- stack_cons(); ++- return; +++ vs_base[0]=make_cons(sLspecial,make_fixnum((long)(sym->s.s_sfdef))); +++ return; ++ } ++ if (sym->s.s_gfdef==OBJNULL) ++ FEundefined_function(sym); ++ if (sym->s.s_mflag) { ++- vs_push(sym->s.s_gfdef); ++- vs_base[0] = sSmacro; ++- stack_cons(); ++- return; +++ vs_base[0]=make_cons(sSmacro,sym->s.s_gfdef); +++ return; ++ } ++ vs_base[0] = sym->s.s_gfdef; ++ } ++--- gcl-2.6.12.orig/o/sequence.d +++++ gcl-2.6.12/o/sequence.d ++@@ -205,16 +205,7 @@ E: ++ } ++ if (e < 0) ++ @(return `copy_list(sequence)`) ++- for (i = 0; i < e; i++) { ++- if (type_of(sequence) != t_cons) ++- goto ILLEGAL_START_END; ++- vs_check_push(sequence->c.c_car); ++- sequence = sequence->c.c_cdr; ++- } ++- vs_push(Cnil); ++- while (e-- > 0) ++- stack_cons(); ++- x = vs_pop; +++ x=n_cons_from_x(e,sequence); ++ @(return x) ++ ++ case t_vector: ++--- gcl-2.6.12.orig/o/sgbc.c +++++ gcl-2.6.12/o/sgbc.c ++@@ -165,7 +165,7 @@ sgc_sweep_phase(void) { ++ tm = tm_of((enum type)v->type); ++ ++ p = pagetochar(page(v)); ++- f = tm->tm_free; +++ f = FREELIST_TAIL(tm); ++ k = 0; ++ size=tm->tm_size; ++ ++@@ -189,7 +189,7 @@ sgc_sweep_phase(void) { ++ ++ /* it is ok to free x */ ++ ++- SET_LINK(x,f); +++ SET_LINK(f,x); ++ make_free(x); ++ #ifndef SGC_WHOLE_PAGE ++ if (TYPEWORD_TYPE_P(v->type)) x->d.s = SGC_RECENT; ++@@ -198,7 +198,8 @@ sgc_sweep_phase(void) { ++ k++; ++ ++ } ++- tm->tm_free = f; +++ SET_LINK(f,OBJNULL); +++ tm->tm_tail = f; ++ tm->tm_nfree += k; ++ v->in_use-=k; ++ ++@@ -674,34 +675,38 @@ sgc_start(void) { ++ contain the others */ ++ for (i= t_start; i < t_contiguous ; i++) ++ if (TM_BASE_TYPE_P(i) && (np=(tm=tm_of(i))->tm_sgc)) { ++- object f=tm->tm_free ,x,y,next; +++ object f=tm->tm_free,xf,yf; +++ struct freelist x,y;/*the f_link heads have to be separated on the stack*/ ++ fixnum count=0; ++- x=y=OBJNULL; ++ +++ xf=PHANTOM_FREELIST(x.f_link); +++ yf=PHANTOM_FREELIST(y.f_link); ++ while (f!=OBJNULL) { ++- next=OBJ_LINK(f); ++ #ifdef SDEBUG ++ if (!is_free(f)) ++ printf("Not FREE in freelist f=%d",f); ++ #endif ++ if (pageinfo(f)->sgc_flags&SGC_PAGE_FLAG) { ++- SET_LINK(f,x); +++ SET_LINK(xf,f); ++ #ifndef SGC_WHOLE_PAGE ++ if (TYPEWORD_TYPE_P(pageinfo(f)->type)) f->d.s = SGC_RECENT; ++ #endif ++- x=f; +++ xf=f; ++ count++; ++ } else { ++- SET_LINK(f,y); +++ SET_LINK(yf,f); ++ #ifndef SGC_WHOLE_PAGE ++ if (TYPEWORD_TYPE_P(pageinfo(f)->type)) f->d.s = SGC_NORMAL; ++ #endif ++- y=f; +++ yf=f; ++ } ++- f=next; +++ f=OBJ_LINK(f); ++ } ++- tm->tm_free = x; ++- tm->tm_alt_free = y; +++ SET_LINK(xf,OBJNULL); +++ tm->tm_free = OBJ_LINK(&x); +++ tm->tm_tail = xf; +++ SET_LINK(yf,OBJNULL); +++ tm->tm_alt_free = OBJ_LINK(&y); ++ tm->tm_alt_nfree = tm->tm_nfree - count; ++ tm->tm_nfree=count; ++ } ++@@ -853,38 +858,21 @@ sgc_quit(void) { ++ for (i= t_start; i < t_contiguous ; i++) ++ ++ if (TM_BASE_TYPE_P(i) && (np=(tm=tm_of(i))->tm_sgc)) { ++- ++- object f,y; ++- ++- f=tm->tm_free; ++- if (f==OBJNULL) ++- tm->tm_free=tm->tm_alt_free; ++- else { ++- /* tack the alt_free onto the end of free */ ++-#ifdef SDEBUG ++- fixnum count=0; ++- f=tm->tm_free; ++- while(y= (object) F_LINK(f)) { ++- if(y->d.s != SGC_RECENT) ++- printf("[bad %d]",y); ++- count++; f=y; +++ +++ object n=tm->tm_free,o=tm->tm_alt_free,f=PHANTOM_FREELIST(tm->tm_free); +++ +++ for (;n!=OBJNULL && o!=OBJNULL;) +++ if (o!=OBJNULL && (n==OBJNULL || otm_alt_free) ++- while(y= F_LINK(f)) { ++- if(y->d.s != SGC_NORMAL) ++- printf("[alt_bad %d]",y); ++- count++; f=y; ++- } ++- ++-#endif ++- f=tm->tm_free; ++- while((y= (object) F_LINK(f))!=OBJNULL) ++- f=y; ++- F_LINK(f)= (long)(tm->tm_alt_free); ++- } ++- /* tm->tm_free has all of the free objects */ +++ SET_LINK(f,OBJNULL); +++ tm->tm_tail=f; ++ tm->tm_nfree += tm->tm_alt_nfree; ++ tm->tm_alt_nfree = 0; ++ tm->tm_alt_free = OBJNULL; ++--- gcl-2.6.12.orig/o/structure.c +++++ gcl-2.6.12/o/structure.c ++@@ -182,22 +182,19 @@ object ++ structure_to_list(object x) ++ { ++ ++- object *p, s; ++- struct s_data *def=S_DATA(x->str.str_def); ++- int i, n; ++- ++- s = def->slot_descriptions; ++- vs_push(def->name); ++- vs_push(Cnil); ++- p = &vs_head; ++- for (i=0, n=def->length; !endp(s)&&ic.c_cdr, i++) { ++- *p = make_cons(car(s->c.c_car), Cnil); ++- p = &((*p)->c.c_cdr); ++- *p = make_cons(structure_ref(x,x->str.str_def,i), Cnil); ++- p = &((*p)->c.c_cdr); ++- } ++- stack_cons(); ++- return(vs_pop); +++ object *p,s,v; +++ struct s_data *def=S_DATA(x->str.str_def); +++ int i,n; +++ +++ s=def->slot_descriptions; +++ for (p=&v,i=0,n=def->length;!endp(s)&&ic.c_cdr,i++) { +++ collect(p,make_cons(car(s->c.c_car),Cnil)); +++ collect(p,make_cons(structure_ref(x,x->str.str_def,i),Cnil)); +++ } +++ *p=Cnil; +++ +++ return make_cons(def->name,v); +++ ++ } ++ ++ LFD(siLmake_structure)(void) ++--- gcl-2.6.12.orig/o/unixfsys.c +++++ gcl-2.6.12/o/unixfsys.c ++@@ -169,9 +169,8 @@ DEF_ORDINARY("DIRECTORY",sKdirectory,KEY ++ DEF_ORDINARY("LINK",sKlink,KEYWORD,""); ++ DEF_ORDINARY("FILE",sKfile,KEYWORD,""); ++ ++-DEFUNM_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++- ++- struct stat ss; +++static int +++stat_internal(object x,struct stat *ssp) { ++ ++ if (type_of(x)==t_string) { ++ ++@@ -180,19 +179,43 @@ DEFUNM_NEW("STAT",object,fSstat,SI,1,1,N ++ #ifdef __MINGW32__ ++ {char *p=FN1+strlen(FN1)-1;for (;p>FN1 && *p=='/';p--) *p=0;} ++ #endif ++- if (lstat(FN1,&ss)) ++- RETURN1(Cnil); +++ if (lstat(FN1,ssp)) +++ return 0; ++ } else if ((x=file_stream(x))!=Cnil&&x->sm.sm_fp) { ++- if (fstat(fileno(x->sm.sm_fp),&ss)) ++- RETURN1(Cnil); +++ if (fstat(fileno(x->sm.sm_fp),ssp)) +++ return 0; ++ } else ++- RETURN1(Cnil); +++ return 0; +++ return 1; +++} +++ +++static object +++stat_mode_key(struct stat *ssp) { ++ ++- RETURN4(S_ISDIR(ss.st_mode) ? sKdirectory : ++- (S_ISLNK(ss.st_mode) ? sKlink : sKfile), ++- make_fixnum(ss.st_size), ++- make_fixnum(ss.st_mtime), ++- make_fixnum(ss.st_uid)); +++ return S_ISDIR(ssp->st_mode) ? sKdirectory : (S_ISLNK(ssp->st_mode) ? sKlink : sKfile); +++ +++} +++ +++DEFUN_NEW("STAT1",object,fSstat1,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ +++ struct stat ss; +++ +++ RETURN1(stat_internal(x,&ss) ? stat_mode_key(&ss) : Cnil); +++ +++} +++ +++ +++DEFUNM_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ +++ struct stat ss; +++ +++ if (stat_internal(x,&ss)) +++ RETURN4(stat_mode_key(&ss), +++ make_fixnum(ss.st_size), +++ make_fixnum(ss.st_mtime), +++ make_fixnum(ss.st_uid)); +++ else +++ RETURN1(Cnil); ++ ++ } ++ ++--- gcl-2.6.12.orig/o/wpool.c +++++ gcl-2.6.12/o/wpool.c ++@@ -3,7 +3,7 @@ ++ #define NO_PRELINK_UNEXEC_DIVERSION ++ char *rb_end=NULL,*rb_start=NULL,*heap_end=NULL; ++ void *data_start=NULL; ++-int use_pool=1; +++int multiprocess_memory_pool=1; ++ ++ #include "include.h" ++ #include "page.h" ++@@ -20,9 +20,9 @@ assert_error(const char *a,unsigned l,co ++ int ++ main(int argc,char * argv[],char * envp[]) { ++ ++- int s; +++ int s=3; ++ ++- sscanf(argv[1],"%d",&s); +++ if (argc>1) sscanf(argv[1],"%d",&s); ++ open_pool(); ++ for (;;) { ++ lock_pool(); ++--- gcl-2.6.12.orig/pcl/sys-proclaim.lisp +++++ gcl-2.6.12/pcl/sys-proclaim.lisp ++@@ -2,402 +2,1009 @@ ++ (COMMON-LISP::IN-PACKAGE "PCL") ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM COMMON-LISP::T) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ PCL::NON-NEGATIVE-FIXNUM) +++ PCL::CACHE-SIZE PCL::CACHE-MASK PCL::CACHE-NLINES +++ PCL::CACHE-MAX-LOCATION)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +++ PCL::COMPILE-LAMBDA-DEFERRED +++ PCL::EARLY-SLOT-DEFINITION-LOCATION PCL::FGEN-SYSTEM +++ PCL::EARLY-CLASS-PRECEDENCE-LIST PCL::MAKE-CLASS-EQ-PREDICATE +++ PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS PCL::USE-CACHING-DFUN-P +++ WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE +++ PCL::SFUN-P PCL::INTERN-EQL-SPECIALIZER +++ PCL::ACCESSOR-DFUN-INFO-P WALKER::ENV-WALK-FORM +++ PCL::ARG-INFO-NUMBER-OPTIONAL PCL::TWO-CLASS-ACCESSOR-TYPE +++ PCL::FREE-CACHE PCL::SHOW-DFUN-COSTS PCL::CHECKING-CACHE +++ PCL::EARLY-GF-P PCL::EARLY-COLLECT-CPL PCL::NO-METHODS-CACHE +++ PCL::EXTRACT-PARAMETERS PCL::DEFAULT-CONSTANTP +++ PCL::PARSE-SPECIALIZERS +++ PCL::MAKE-OPTIMIZED-STRUCTURE-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +++ PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-NIL-FUNCTION +++ PCL::DFUN-INFO-P PCL::CLASS-PRECEDENCE-DESCRIPTION-P +++ PCL::%FBOUNDP PCL::ONE-INDEX-DFUN-INFO-INDEX +++ PCL::ONE-CLASS-CACHE PCL::DEFAULT-STRUCTURE-INSTANCE-P +++ PCL::CONSTANT-VALUE-CACHE PCL::STRUCTURE-SVUC-METHOD +++ PCL::CLASS-HAS-A-FORWARD-REFERENCED-SUPERCLASS-P +++ PCL::METHODS-CONTAIN-EQL-SPECIALIZER-P +++ PCL::STRUCTURE-SLOTD-WRITER-FUNCTION PCL::CCLOSUREP +++ PCL::COUNT-DFUN PCL::COMPUTE-STD-CPL-PHASE-2 +++ PCL::EARLY-METHOD-STANDARD-ACCESSOR-SLOT-NAME +++ PCL::EARLY-SLOT-DEFINITION-NAME PCL::MAP-SPECIALIZERS +++ PCL::MAKE-CONSTANT-FUNCTION PCL::GF-PRECOMPUTE-DFUN-AND-EMF-P +++ PCL::DEFAULT-TEST-CONVERTER +++ PCL::PROCLAIM-INCOMPATIBLE-SUPERCLASSES PCL::TWO-CLASS-INDEX +++ PCL::CACHE-P PCL::ARG-INFO-PRECEDENCE +++ PCL::STRUCTURE-SLOTD-INIT-FORM PCL::INITIAL-P +++ PCL::EXTRACT-REQUIRED-PARAMETERS PCL::%STD-INSTANCE-WRAPPER +++ PCL::FUNCTION-PRETTY-ARGLIST PCL::INTERN-FUNCTION-NAME +++ PCL::INITIALIZE-INFO-CACHED-COMBINED-INITARGS-FORM-LIST +++ PCL::FLUSH-CACHE-VECTOR-INTERNAL PCL::TWO-CLASS-P +++ PCL::CHECK-CACHE PCL::RESET-INITIALIZE-INFO +++ PCL::ONE-INDEX-DFUN-INFO-P PCL::LEGAL-CLASS-NAME-P +++ PCL::UPDATE-PV-TABLE-CACHE-INFO +++ PCL::RESET-CLASS-INITIALIZE-INFO PCL::DISPATCH-P +++ PCL::%STD-INSTANCE-SLOTS PCL::SETFBOUNDP PCL::LOOKUP-FGEN +++ PCL::MAKE-INITFUNCTION PCL::FORCE-CACHE-FLUSHES +++ PCL::COMPLICATED-INSTANCE-CREATION-METHOD +++ PCL::NET-TEST-CONVERTER WALKER::ENV-DECLARATIONS +++ SYSTEM::%STRUCTURE-NAME PCL::GMAKUNBOUND PCL::TWO-CLASS-CACHE +++ PCL::STRUCTURE-TYPE PCL::CPD-CLASS PCL::CPD-AFTER +++ PCL::FAST-METHOD-CALL-P PCL::FGEN-GENERATOR-LAMBDA +++ PCL::CHECKING-FUNCTION PCL::DEFAULT-CONSTANT-CONVERTER +++ PCL::BUILT-IN-OR-STRUCTURE-WRAPPER1 +++ PCL::GET-MAKE-INSTANCE-FUNCTION-SYMBOL PCL::EARLY-METHOD-CLASS +++ PCL::BUILT-IN-WRAPPER-OF PCL::EXPAND-SHORT-DEFCOMBIN +++ PCL::WRAPPER-OF +++ PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION +++ PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-T-FUNCTION +++ PCL::PV-TABLEP PCL::EARLY-CLASS-NAME-OF +++ PCL::GET-MAKE-INSTANCE-FUNCTION PCL::ARG-INFO-KEY/REST-P +++ PCL::MAKE-EQL-PREDICATE PCL::STRUCTURE-SLOTD-READER-FUNCTION +++ PCL::CACHING-DFUN-INFO PCL::GF-INFO-SIMPLE-ACCESSOR-TYPE +++ PCL::N-N-ACCESSOR-TYPE PCL::FAST-METHOD-CALL-PV-CELL +++ PCL::MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION +++ PCL::EXTRACT-SPECIALIZER-NAMES PCL::MAKE-TYPE-PREDICATE +++ PCL::GET-CACHE-VECTOR PCL::SORT-SLOTS +++ PCL::DEFAULT-STRUCTURE-TYPE SYSTEM::%COMPILED-FUNCTION-NAME +++ PCL::DO-STANDARD-DEFSETFS-FOR-DEFCLASS WALKER::ENV-LOCK +++ PCL::ONE-INDEX-DFUN-INFO-CACHE PCL::ONE-INDEX-P +++ PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION +++ PCL::STANDARD-SVUC-METHOD PCL::MAKE-FUNCTION-INLINE +++ PCL::ALLOCATE-CACHE-VECTOR PCL::SLOT-BOUNDP-SYMBOL +++ PCL::METHOD-CALL-P PCL::STD-INSTANCE-P +++ PCL::GET-BUILT-IN-WRAPPER-SYMBOL PCL::FUNCALLABLE-INSTANCE-P +++ PCL::ECD-CANONICAL-SLOTS PCL::GET-BUILT-IN-CLASS-SYMBOL +++ PCL::FREE-CACHE-VECTOR PCL::GF-INFO-STATIC-C-A-M-EMF +++ PCL::EARLY-GF-NAME PCL::UPDATE-CLASS-CAN-PRECEDE-P +++ PCL::USE-DEFAULT-METHOD-ONLY-DFUN-P +++ PCL::ACCESSOR-DFUN-INFO-CACHE PCL::ARG-INFO-VALID-P +++ PCL::ONE-CLASS-INDEX WALKER::GET-WALKER-TEMPLATE +++ PCL::GFS-OF-TYPE PCL::N-N-P PCL::METHOD-CALL-CALL-METHOD-ARGS +++ PCL::BOOTSTRAP-CLASS-PREDICATES PCL::MAKE-INITIAL-DFUN +++ PCL::ONE-CLASS-WRAPPER0 PCL::ECD-OTHER-INITARGS +++ PCL::TWO-CLASS-WRAPPER1 PCL::MAKE-INSTANCE-FUNCTION-SYMBOL +++ PCL::FUNCTION-RETURNING-T PCL::STRUCTURE-SLOTD-TYPE +++ PCL::ARG-INFO-APPLYP PCL::ECD-SUPERCLASS-NAMES +++ PCL::EARLY-ACCESSOR-METHOD-SLOT-NAME +++ PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION +++ PCL::FGEN-GENSYMS PCL::EARLY-METHOD-STANDARD-ACCESSOR-P +++ PCL::DEFAULT-METHOD-ONLY-CACHE WALKER::ENV-LEXICAL-VARIABLES +++ PCL::ECD-CLASS-NAME PCL::GET-MAKE-INSTANCE-FUNCTIONS +++ PCL::EARLY-CLASS-DEFINITION PCL::ECD-METACLASS +++ PCL::UNDEFMETHOD-1 PCL::MAKE-CALL-METHODS +++ PCL::METHOD-LL->GENERIC-FUNCTION-LL PCL::SORT-CALLS +++ ITERATE::VARIABLES-FROM-LET PCL::GF-LAMBDA-LIST +++ PCL::INITIALIZE-INFO-KEY PCL::EARLY-CLASS-DIRECT-SUBCLASSES +++ PCL::ACCESSOR-DFUN-INFO-ACCESSOR-TYPE +++ PCL::MAKE-PERMUTATION-VECTOR PCL::EXTRACT-LAMBDA-LIST +++ PCL::CONSTANT-VALUE-DFUN-INFO PCL::DNET-METHODS-P +++ PCL::STRUCTURE-TYPE-INCLUDED-TYPE-NAME +++ PCL::UPDATE-GFS-OF-CLASS PCL::SLOT-VECTOR-SYMBOL +++ PCL::COMPUTE-MCASE-PARAMETERS PCL::GBOUNDP +++ PCL::SLOT-INITARGS-FROM-STRUCTURE-SLOTD PCL::CONSTANT-SYMBOL-P +++ PCL::CPD-SUPERS PCL::DEFAULT-METHOD-ONLY-P +++ PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +++ PCL::CACHE-OWNER PCL::FAST-INSTANCE-BOUNDP-P +++ PCL::INITIALIZE-INFO-WRAPPER +++ PCL::INITIALIZE-INFO-CACHED-VALID-P PCL::EVAL-FORM +++ PCL::DEFAULT-STRUCTUREP PCL::FUNCTION-RETURNING-NIL +++ PCL::ONE-CLASS-P PCL::ARG-INFO-KEYWORDS +++ PCL::EARLY-CLASS-SLOTDS PCL::GET-PV-CELL-FOR-CLASS +++ PCL::ONE-CLASS-ACCESSOR-TYPE PCL::GENERIC-CLOBBERS-FUNCTION +++ PCL::DFUN-INFO-CACHE PCL::MAKE-PV-TABLE-TYPE-DECLARATION +++ PCL::RESET-CLASS-INITIALIZE-INFO-1 PCL::CLASS-FROM-TYPE +++ PCL::FTYPE-DECLARATION-FROM-LAMBDA-LIST +++ PCL::EARLY-METHOD-LAMBDA-LIST +++ PCL::EARLY-COLLECT-DEFAULT-INITARGS +++ PCL::COMPILE-LAMBDA-UNCOMPILED +++ PCL::INITIALIZE-INFO-CACHED-RI-VALID-P PCL::STRUCTURE-TYPE-P +++ PCL::%SYMBOL-FUNCTION PCL::MAKE-CALLS-TYPE-DECLARATION +++ PCL::SLOT-READER-SYMBOL PCL::KEYWORD-SPEC-NAME +++ PCL::FIND-CYCLE-REASONS PCL::UPDATE-ALL-C-A-M-GF-INFO +++ PCL::INITIALIZE-INFO-P +++ PCL::METHOD-FUNCTION-NEEDS-NEXT-METHODS-P +++ PCL::INITIAL-DISPATCH-CACHE PCL::CACHING-CACHE +++ PCL::INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS +++ PCL::INITIALIZE-INFO-CACHED-INITARGS-FORM-LIST +++ PCL::STRUCTURE-TYPE-INTERNAL-SLOTDS PCL::CONSTANT-VALUE-P +++ PCL::FAST-METHOD-CALL-NEXT-METHOD-CALL PCL::EARLY-CLASS-SLOTS +++ PCL::UPDATE-C-A-M-GF-INFO PCL::GDEFINITION +++ PCL::ARG-INFO-LAMBDA-LIST PCL::STRUCTURE-SLOTD-ACCESSOR-SYMBOL +++ PCL::DEFAULT-SECONDARY-DISPATCH-FUNCTION +++ PCL::MAKE-PV-TYPE-DECLARATION +++ PCL::COMPUTE-APPLICABLE-METHODS-EMF-STD-P PCL::DISPATCH-CACHE +++ PCL::ONE-INDEX-ACCESSOR-TYPE +++ PCL::INITIALIZE-INFO-CACHED-CONSTANTS PCL::NO-METHODS-P +++ PCL::INITIALIZE-INFO-CACHED-COMBINED-INITIALIZE-FUNCTION +++ PCL::CACHING-DFUN-COST PCL::ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE +++ PCL::COMPUTE-CLASS-SLOTS PCL::UPDATE-GF-SIMPLE-ACCESSOR-TYPE +++ PCL::GF-INFO-FAST-MF-P PCL::GF-INFO-C-A-M-EMF-STD-P +++ PCL::FGEN-TEST PCL::STRUCTURE-SLOTD-NAME PCL::CLASS-PREDICATE +++ PCL::STRUCTURE-SLOT-BOUNDP PCL::EARLY-CLASS-NAME +++ PCL::LIST-LARGE-CACHE PCL::ONE-INDEX-CACHE +++ PCL::SYMBOL-PKG-NAME PCL::INITIAL-CACHE +++ PCL::UNENCAPSULATED-FDEFINITION PCL::STORE-FGEN +++ PCL::FINAL-ACCESSOR-DFUN-TYPE +++ PCL::INITIALIZE-INFO-CACHED-NEW-KEYS PCL::TYPE-CLASS +++ PCL::%CCLOSURE-ENV PCL::INITIALIZE-INFO-BOUND-SLOTS +++ PCL::GF-DFUN-CACHE PCL::EXPAND-LONG-DEFCOMBIN +++ PCL::FGEN-GENERATOR PCL::DFUN-ARG-SYMBOL +++ PCL::STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST +++ PCL::EARLY-METHOD-QUALIFIERS +++ WALKER::VARIABLE-GLOBALLY-SPECIAL-P COMMON-LISP::CLASS-OF +++ PCL::INITIALIZE-INFO-CACHED-DEFAULT-INITARGS-FUNCTION +++ PCL::GET-SETF-FUNCTION-NAME PCL::ARG-INFO-P +++ WALKER::ENV-WALK-FUNCTION PCL::LIST-DFUN +++ PCL::CHECK-WRAPPER-VALIDITY PCL::ARG-INFO-METATYPES +++ PCL::EXPAND-MAKE-INSTANCE-FORM PCL::STRUCTURE-OBJECT-P +++ PCL::COMPUTE-LINE-SIZE PCL::CANONICAL-SLOT-NAME +++ PCL::INITIAL-DISPATCH-P PCL::NEXT-WRAPPER-FIELD +++ PCL::WRAPPER-FIELD PCL::WRAPPER-FOR-STRUCTURE +++ PCL::METHOD-FUNCTION-PV-TABLE PCL::COPY-CACHE PCL::ECD-SOURCE +++ PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION-SYMBOL +++ PCL::UNPARSE-SPECIALIZERS PCL::CHECKING-P +++ PCL::FORMAT-CYCLE-REASONS PCL::N-N-CACHE +++ PCL::MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION +++ PCL::MAP-ALL-GENERIC-FUNCTIONS PCL::METHOD-FUNCTION-METHOD +++ PCL::UPDATE-GF-INFO PCL::ARG-INFO-NKEYS +++ PCL::TWO-CLASS-WRAPPER0 PCL::GF-DFUN-INFO PCL::ONE-INDEX-INDEX +++ PCL::EARLY-COLLECT-SLOTS PCL::CACHING-P +++ PCL::METHOD-FUNCTION-PLIST PCL::SLOT-WRITER-SYMBOL +++ PCL::FAST-METHOD-CALL-ARG-INFO PCL::INTERNED-SYMBOL-P +++ ITERATE::SEQUENCE-ACCESSOR)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) +++ PCL::LIST-LARGE-CACHES +++ PCL::UPDATE-MAKE-INSTANCE-FUNCTION-TABLE PCL::UNTRACE-METHOD +++ COMMON-LISP::INVALID-METHOD-ERROR +++ COMMON-LISP::METHOD-COMBINATION-ERROR)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +++ PCL::|__si::MAKE-CLASS-PRECEDENCE-DESCRIPTION| +++ PCL::|__si::MAKE-TWO-CLASS| PCL::FALSE PCL::MAKE-PV-TABLE +++ PCL::|__si::MAKE-DISPATCH| PCL::MAKE-INITIALIZE-INFO +++ PCL::|__si::MAKE-PV-TABLE| PCL::MAKE-FAST-INSTANCE-BOUNDP +++ PCL::|__si::MAKE-DEFAULT-METHOD-ONLY| +++ WALKER::UNBOUND-LEXICAL-FUNCTION +++ PCL::|__si::MAKE-ACCESSOR-DFUN-INFO| PCL::|__si::MAKE-N-N| +++ PCL::USE-PACKAGE-PCL PCL::|__si::MAKE-CHECKING| +++ PCL::|STRUCTURE-OBJECT class constructor| +++ PCL::|__si::MAKE-CONSTANT-VALUE| +++ PCL::CALLED-FIN-WITHOUT-FUNCTION PCL::|__si::MAKE-INITIAL| +++ PCL::|__si::MAKE-CACHE| PCL::|__si::MAKE-ONE-INDEX| +++ PCL::MAKE-PROGN PCL::TRUE PCL::MAKE-FAST-METHOD-CALL +++ PCL::|__si::MAKE-ARG-INFO| PCL::INTERN-PV-TABLE +++ PCL::|__si::MAKE-DFUN-INFO| PCL::|__si::MAKE-STD-INSTANCE| +++ PCL::|__si::MAKE-CACHING| PCL::|__si::MAKE-ONE-CLASS| +++ PCL::PV-WRAPPERS-FROM-PV-ARGS PCL::ZERO +++ PCL::|__si::MAKE-INITIAL-DISPATCH| +++ PCL::|__si::MAKE-NO-METHODS| PCL::STRING-APPEND +++ PCL::|__si::MAKE-ONE-INDEX-DFUN-INFO| PCL::MAKE-METHOD-CALL +++ PCL::FIX-EARLY-GENERIC-FUNCTIONS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) +++ PCL::METHOD-PROTOTYPE-FOR-GF PCL::SPECIALIZER-FROM-TYPE +++ PCL::EMIT-ONE-INDEX-WRITERS PCL::*NORMALIZE-TYPE +++ PCL::COMPUTE-APPLICABLE-METHODS-EMF PCL::ANALYZE-LAMBDA-LIST +++ PCL::PARSE-DEFMETHOD PCL::GET-DISPATCH-FUNCTION +++ PCL::PROTOTYPES-FOR-MAKE-METHOD-LAMBDA +++ PCL::EMIT-CONSTANT-VALUE PCL::FIND-WRAPPER +++ PCL::MAKE-FINAL-DISPATCH-DFUN PCL::EARLY-COLLECT-INHERITANCE +++ PCL::GENERIC-FUNCTION-NAME-P PCL::EMIT-TWO-CLASS-READER +++ PCL::PARSE-METHOD-GROUP-SPECIFIER PCL::EMIT-ONE-CLASS-READER +++ PCL::FIND-STRUCTURE-CLASS PCL::EMIT-TWO-CLASS-WRITER +++ PCL::CONVERT-TO-SYSTEM-TYPE PCL::TYPE-FROM-SPECIALIZER +++ PCL::EMIT-ONE-CLASS-WRITER PCL::EARLY-METHOD-FUNCTION +++ PCL::MAKE-DISPATCH-DFUN PCL::NET-CODE-CONVERTER +++ PCL::GET-GENERIC-FUNCTION-INFO PCL::DEFAULT-CODE-CONVERTER +++ PCL::COMPILE-IIS-FUNCTIONS PCL::EMIT-ONE-INDEX-READERS +++ PCL::STRUCTURE-WRAPPER PCL::CLASS-EQ-TYPE +++ PCL::EMIT-IN-CHECKING-CACHE-P PCL::PCL-DESCRIBE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- PCL::%CCLOSURE-ENV-NTHCDR)) +++ ITERATE::RENAME-AND-CAPTURE-VARIABLES +++ PCL::|(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| +++ WALKER::WALK-PROG PCL::INVALIDATE-WRAPPER +++ PCL::COMPUTE-PRECEDENCE +++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| +++ WALKER::WALK-LAMBDA PCL::STANDARD-COMPUTE-EFFECTIVE-METHOD +++ PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| +++ WALKER::WALK-MULTIPLE-VALUE-BIND +++ PCL::|(FAST-METHOD SPECIALIZER-CLASS (CLASS))| +++ PCL::|(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| +++ PCL::NOTE-PV-TABLE-REFERENCE +++ PCL::|(FAST-METHOD CLASS-PREDICATE-NAME (T))| +++ PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| +++ WALKER::WALK-MULTIPLE-VALUE-SETQ PCL::CONVERT-TABLE +++ WALKER::WALK-LET +++ PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| +++ PCL::|(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| +++ PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| +++ PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| +++ PCL::SKIP-FAST-SLOT-ACCESS-P +++ PCL::|(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| +++ PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| +++ PCL::OPTIMIZE-SLOT-BOUNDP PCL::TRACE-EMF-CALL-INTERNAL +++ ITERATE::SIMPLE-EXPAND-GATHERING-FORM +++ PCL::MAKE-OPTIMIZED-STD-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +++ WALKER::WALK-FLET PCL::ONE-CLASS-DFUN-INFO +++ WALKER::WALK-COMPILER-LET +++ PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| +++ PCL::FIRST-FORM-TO-LISP WALKER::WALK-DO* +++ PCL::|(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| +++ PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| +++ PCL::|(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| +++ PCL::|(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| +++ PCL::PRINT-STD-INSTANCE +++ PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| +++ WALKER::WALK-MACROLET PCL::GET-FUNCTION-GENERATOR +++ PCL::INITIALIZE-INTERNAL-SLOT-GFS* +++ PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| +++ PCL::COMPUTE-EFFECTIVE-METHOD PCL::EXPAND-DEFGENERIC +++ PCL::OBSOLETE-INSTANCE-TRAP WALKER::WALK-TAGBODY-1 +++ PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL +++ PCL::GET-NEW-FUNCTION-GENERATOR PCL::SORT-METHODS +++ WALKER::WALK-DO PCL::MAKE-DFUN-CALL +++ PCL::OPTIMIZE-GF-CALL-INTERNAL +++ PCL::|(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| +++ PCL::OPTIMIZE-SET-SLOT-VALUE +++ PCL::|(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| +++ PCL::ENTRY-IN-CACHE-P +++ PCL::|(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| +++ WALKER::WALK-IF PCL::MAKE-METHOD-SPEC PCL::SET-FUNCTION-NAME-1 +++ WALKER::WALK-SETQ +++ PCL::|(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| +++ PCL::|(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| +++ PCL::DECLARE-STRUCTURE PCL::EMIT-BOUNDP-CHECK +++ WALKER::WALK-LOCALLY +++ PCL::MAKE-OPTIMIZED-STD-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION +++ PCL::CAN-OPTIMIZE-ACCESS PCL::|SETF PCL PLIST-VALUE| +++ WALKER::WALK-LABELS PCL::EMIT-1-T-DLAP +++ PCL::|(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| +++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| +++ PCL::|(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| +++ PCL::SORT-APPLICABLE-METHODS +++ PCL::|(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +++ WALKER::WALK-NAMED-LAMBDA ITERATE::OPTIMIZE-ITERATE-FORM +++ PCL::MAP-ALL-ORDERS +++ PCL::|(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| +++ ITERATE::OPTIMIZE-GATHERING-FORM +++ PCL::|(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| +++ PCL::ONE-INDEX-DFUN-INFO +++ PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| +++ PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| +++ PCL::FLUSH-CACHE-TRAP WALKER::WALK-PROG* +++ ITERATE::VARIABLE-SAME-P PCL::EMIT-SLOT-READ-FORM +++ PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| +++ PCL::EMIT-GREATER-THAN-1-DLAP +++ PCL::|(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| +++ PCL::WRAP-METHOD-GROUP-SPECIFIER-BINDINGS WALKER::WALK-LET* +++ WALKER::WALK-SYMBOL-MACROLET WALKER::VARIABLE-DECLARATION +++ PCL::|(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| +++ WALKER::RECONS +++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| +++ PCL::OPTIMIZE-SLOT-VALUE WALKER::RELIST-INTERNAL +++ PCL::MAKE-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +++ PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| +++ PCL::|SETF PCL METHOD-FUNCTION-GET| WALKER::WALK-TAGBODY +++ WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL +++ PCL::|(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| +++ PCL::PRINT-CACHE PCL::MAKE-TOP-LEVEL-FORM +++ PCL::FIX-SLOT-ACCESSORS WALKER::WALK-UNEXPECTED-DECLARE +++ PCL::SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P +++ PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))|)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::FIXNUM) ++- PCL::GET-WRAPPER-CACHE-NUMBER)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ PCL::GET-DECLARATION +++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE +++ PCL::EXPAND-EFFECTIVE-METHOD-FUNCTION +++ PCL::GET-METHOD-FUNCTION-PV-CELL +++ PCL::NAMED-OBJECT-PRINT-FUNCTION +++ PCL::FIND-CLASS-PREDICATE-FROM-CELL +++ PCL::GET-EFFECTIVE-METHOD-FUNCTION1 PCL::RECORD-DEFINITION +++ PCL::PROBE-CACHE PCL::INITIALIZE-INFO PCL::EMIT-MISS +++ PCL::REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION +++ PCL::FIND-CLASS-FROM-CELL PCL::PRECOMPUTE-EFFECTIVE-METHODS +++ PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION1 +++ PCL::METHOD-FUNCTION-GET PCL::MAP-CACHE +++ WALKER::CONVERT-MACRO-TO-LAMBDA PCL::MAKE-EMF-FROM-METHOD +++ PCL::ENSURE-GENERIC-FUNCTION-USING-CLASS +++ PCL::REAL-ENSURE-GF-USING-CLASS--NULL)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++- PCL::NON-NEGATIVE-FIXNUM) ++- PCL::CACHE-NLINES PCL::CACHE-MASK PCL::CACHE-SIZE ++- PCL::CACHE-MAX-LOCATION)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) +++ COMMON-LISP::T) +++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-INTERNAL +++ PCL::BOOTSTRAP-SET-SLOT +++ PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| +++ PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +++ PCL::|(FAST-METHOD PRINT-OBJECT (T T))| +++ PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +++ WALKER::WALK-TEMPLATE +++ PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| +++ PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| +++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| +++ PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| +++ PCL::|(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| +++ PCL::|(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| +++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| +++ PCL::OPTIMIZE-WRITER +++ PCL::|(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| +++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| +++ PCL::|(FAST-METHOD DOCUMENTATION (T))| +++ PCL::|(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| +++ PCL::|(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| +++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| +++ PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| +++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION1 +++ PCL::|(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| +++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| +++ PCL::LOAD-PRECOMPILED-IIS-ENTRY PCL::ADJUST-CACHE +++ WALKER::WALK-PROG/PROG* +++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| +++ PCL::|(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| +++ PCL::OPTIMIZE-READER +++ PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| +++ PCL::|(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| +++ WALKER::WALK-BINDINGS-2 PCL::MEMF-TEST-CONVERTER +++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| +++ PCL::|(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| +++ PCL::|(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +++ PCL::LOAD-PRECOMPILED-DFUN-CONSTRUCTOR +++ PCL::|(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| +++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| +++ PCL::|(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| +++ PCL::MAKE-DISPATCH-LAMBDA +++ PCL::|(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| +++ PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| +++ PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +++ PCL::|(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +++ PCL::|(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +++ WALKER::WALK-DO/DO* PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-TYPE +++ PCL::|(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| +++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| +++ PCL::GET-WRAPPERS-FROM-CLASSES +++ PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| +++ PCL::EXPAND-CACHE +++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| +++ PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| +++ PCL::|(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| +++ PCL::|(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| +++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| +++ PCL::EXPAND-SYMBOL-MACROLET-INTERNAL +++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| +++ PCL::|(FAST-METHOD MAKE-INSTANCE (CLASS))| +++ WALKER::WALK-LET/LET* +++ PCL::|(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| +++ PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| +++ PCL::|(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| +++ PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +++ PCL::|(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| +++ PCL::|(FAST-METHOD PRINT-OBJECT (CLASS T))| +++ PCL::|(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| +++ PCL::EXPAND-DEFCLASS PCL::INITIALIZE-INSTANCE-SIMPLE +++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))| +++ PCL::|(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| +++ PCL::MAYBE-EXPAND-ACCESSOR-FORM +++ PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| +++ PCL::FILL-CACHE-P +++ PCL::|(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| +++ PCL::|(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| +++ PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| +++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| +++ PCL::EMIT-CHECKING-OR-CACHING-FUNCTION-PRELIMINARY +++ PCL::TWO-CLASS-DFUN-INFO)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++- COMMON-LISP::SIMPLE-VECTOR) ++- PCL::CACHE-VECTOR)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ PCL::EXPAND-EMF-CALL-METHOD +++ PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| +++ PCL::BOOTSTRAP-MAKE-SLOT-DEFINITIONS +++ PCL::|(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| +++ PCL::MAKE-INSTANCE-FUNCTION-COMPLEX +++ PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| +++ PCL::UPDATE-SLOTS-IN-PV +++ PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::|(FAST-METHOD SLOT-UNBOUND (T T T))| +++ PCL::MAKE-PARAMETER-REFERENCES +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| +++ PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS1 +++ PCL::OPTIMIZE-INSTANCE-ACCESS PCL::OPTIMIZE-ACCESSOR-CALL +++ PCL::OPTIMIZE-GENERIC-FUNCTION-CALL +++ PCL::REAL-MAKE-METHOD-INITARGS-FORM +++ PCL::|(FAST-METHOD REMOVE-NAMED-METHOD (T T))| +++ PCL::|(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| +++ PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| +++ PCL::COMPUTE-PV-SLOT PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL1 +++ PCL::LOAD-FUNCTION-GENERATOR +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| +++ PCL::|(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| +++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| +++ PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::GET-MAKE-INSTANCE-FUNCTION-INTERNAL +++ PCL::|(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| +++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T T))| +++ PCL::MAKE-FINAL-ORDINARY-DFUN-INTERNAL +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| +++ WALKER::WALK-BINDINGS-1 PCL::MAKE-INSTANCE-FUNCTION-SIMPLE +++ PCL::MAKE-FGEN WALKER::WALK-TEMPLATE-HANDLE-REPEAT +++ PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| +++ PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| +++ PCL::MAKE-EMF-CACHE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::T) +++ PCL::BOOTSTRAP-INITIALIZE-CLASS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ PCL::REAL-LOAD-DEFCLASS PCL::LOAD-DEFCLASS +++ PCL::OPTIMIZE-GF-CALL PCL::MAKE-EARLY-CLASS-DEFINITION +++ WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1 PCL::EMIT-SLOT-ACCESS +++ PCL::BOOTSTRAP-MAKE-SLOT-DEFINITION +++ PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::SET-ARG-INFO1)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::T) +++ PCL::FILL-CACHE PCL::REAL-GET-METHOD PCL::MAKE-EMF-CALL +++ PCL::EMIT-FETCH-WRAPPER PCL::CHECK-INITARGS-1 +++ PCL::CAN-OPTIMIZE-ACCESS1 PCL::CHECK-INITARGS-2-PLIST +++ PCL::CHECK-INITARGS-2-LIST WALKER::WALK-ARGLIST +++ PCL::GET-METHOD)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ PCL::GET-SECONDARY-DISPATCH-FUNCTION1 PCL::EMIT-DLAP)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ PCL::FILL-DFUN-CACHE PCL::EARLY-ADD-NAMED-METHOD +++ PCL::REAL-ADD-NAMED-METHOD)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++- PCL::ACCESSOR-VALUES-INTERNAL +++ PCL::ACCESSOR-VALUES1 PCL::CHECK-METHOD-ARG-INFO +++ PCL::EMIT-READER/WRITER PCL::OPTIMIZE-SLOT-VALUE-BY-CLASS-P +++ PCL::|(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| +++ PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION +++ PCL::CACHE-MISS-VALUES +++ PCL::GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +++ PCL::MAKE-FINAL-CACHING-DFUN ++ PCL::MAKE-OPTIMIZED-STD-READER-METHOD-FUNCTION +++ PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| +++ PCL::MAKE-FINAL-CONSTANT-VALUE-DFUN +++ PCL::|(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| ++ PCL::|(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| ++- PCL::MAKE-FINAL-N-N-ACCESSOR-DFUN ++- PCL::|(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| ++- PCL::CHECK-METHOD-ARG-INFO ++- PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| ++- PCL::GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION ++- PCL::GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++- PCL::|(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| +++ PCL::ACCESSOR-VALUES-INTERNAL ITERATE::EXPAND-INTO-LET ++ PCL::MAKE-OPTIMIZED-STD-BOUNDP-METHOD-FUNCTION ++- PCL::OPTIMIZE-SLOT-VALUE-BY-CLASS-P ++- ITERATE::WALK-GATHERING-BODY +++ PCL::CONSTANT-VALUE-MISS +++ PCL::GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION +++ WALKER::WALK-LET-IF ITERATE::WALK-GATHERING-BODY ++ PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER ++- PCL::|(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| ++- PCL::SLOT-BOUNDP-USING-CLASS-DFUN WALKER::WALK-FORM-INTERNAL ++- PCL::LOAD-LONG-DEFCOMBIN PCL::MAKE-FINAL-CACHING-DFUN ++- PCL::EMIT-READER/WRITER ++- PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION ++- PCL::SLOT-VALUE-USING-CLASS-DFUN PCL::CACHING-MISS ++- PCL::|(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| ++- PCL::EMIT-READER/WRITER-FUNCTION PCL::ACCESSOR-VALUES1 ++- PCL::GENERATING-LISP PCL::GET-CLASS-SLOT-VALUE-1 ++- PCL::MAKE-FINAL-CONSTANT-VALUE-DFUN PCL::CACHE-MISS-VALUES ++- WALKER::WALK-LET-IF ++ PCL::|(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| ++- PCL::|(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| ++- PCL::CHECKING-MISS ITERATE::EXPAND-INTO-LET +++ PCL::CHECKING-MISS PCL::MAKE-FINAL-N-N-ACCESSOR-DFUN +++ PCL::GENERATING-LISP ITERATE::RENAME-VARIABLES +++ PCL::|(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| +++ PCL::CONVERT-METHODS PCL::SLOT-VALUE-USING-CLASS-DFUN +++ PCL::EMIT-READER/WRITER-FUNCTION +++ PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| +++ PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| +++ PCL::CACHING-MISS ++ PCL::MAKE-OPTIMIZED-STD-WRITER-METHOD-FUNCTION ++- PCL::CONSTANT-VALUE-MISS ITERATE::RENAME-VARIABLES ++- PCL::|(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| +++ PCL::GET-CLASS-SLOT-VALUE-1 WALKER::WALK-FORM-INTERNAL +++ PCL::SLOT-BOUNDP-USING-CLASS-DFUN PCL::LOAD-LONG-DEFCOMBIN +++ PCL::|(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| +++ PCL::|(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| ++ PCL::SET-SLOT-VALUE ++- PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| ++- PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| ++ PCL::|(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| ++- PCL::CONVERT-METHODS)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::*) ++- PCL::|(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| ++- PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| ++- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| ++- PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++- PCL::|(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| ++- PCL::|(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| ++- PCL::MAKE-TWO-CLASS-ACCESSOR-DFUN ++- PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| ++- PCL::|(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| ++- PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| ++- PCL::ADD-METHOD-DECLARATIONS ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| ++- PCL::|(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| ++- PCL::WALK-METHOD-LAMBDA ++- PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++- PCL::COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))|)) +++ PCL::|(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))|)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::*) ++- PCL::GET-ACCESSOR-METHOD-FUNCTION ++- PCL::|(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| +++ PCL::SETF-SLOT-VALUE-USING-CLASS-DFUN +++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| +++ PCL::ORDER-SPECIALIZERS +++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| +++ PCL::EMIT-CHECKING-OR-CACHING +++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| +++ PCL::|(FAST-METHOD MAKE-INSTANCE (SYMBOL))| ++ PCL::|(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| +++ PCL::GENERATE-DISCRIMINATION-NET +++ PCL::|(FAST-METHOD CHANGE-CLASS (T SYMBOL))| ++ PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| ++- PCL::MAKE-ONE-CLASS-ACCESSOR-DFUN +++ PCL::|(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| +++ PCL::GET-ACCESSOR-METHOD-FUNCTION ++ PCL::|(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| ++- PCL::GENERATE-DISCRIMINATION-NET ++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| ++- PCL::LOAD-SHORT-DEFCOMBIN ++- PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| ++- PCL::|(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| ++- PCL::REAL-MAKE-METHOD-LAMBDA PCL::SET-CLASS-SLOT-VALUE-1 ++- PCL::BOOTSTRAP-ACCESSOR-DEFINITION ++ PCL::MAKE-FINAL-ONE-INDEX-ACCESSOR-DFUN ++- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| ++- PCL::ACCESSOR-MISS PCL::|(FAST-METHOD MAKE-INSTANCE (SYMBOL))| ++- PCL::ACCESSOR-VALUES +++ PCL::EMIT-CHECKING-OR-CACHING-FUNCTION PCL::ACCESSOR-MISS +++ PCL::|(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| +++ PCL::LOAD-SHORT-DEFCOMBIN PCL::MAKE-FINAL-CHECKING-DFUN +++ PCL::|(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| +++ PCL::MAKE-SHARED-INITIALIZE-FORM-LIST ++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (T T))| ++- PCL::|(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| ++- PCL::EMIT-CHECKING-OR-CACHING-FUNCTION ++ PCL::INITIALIZE-INSTANCE-SIMPLE-FUNCTION ++- PCL::MAKE-FINAL-CHECKING-DFUN ++- PCL::MAKE-SHARED-INITIALIZE-FORM-LIST ++- PCL::|(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| ++- PCL::EMIT-CHECKING-OR-CACHING ++- PCL::|(FAST-METHOD CHANGE-CLASS (T SYMBOL))| ++- PCL::|(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| ++- PCL::|(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| ++ PCL::|(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| ++- PCL::SETF-SLOT-VALUE-USING-CLASS-DFUN +++ PCL::ACCESSOR-VALUES PCL::REAL-MAKE-METHOD-LAMBDA +++ PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| +++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| +++ PCL::|(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))| +++ PCL::BOOTSTRAP-ACCESSOR-DEFINITION +++ PCL::|(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| +++ PCL::MAKE-ONE-CLASS-ACCESSOR-DFUN ++ PCL::GET-ACCESSOR-FROM-SVUC-METHOD-FUNCTION ++ PCL::|(FAST-METHOD NO-APPLICABLE-METHOD (T))| ++- PCL::ORDER-SPECIALIZERS ++- PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| ++- PCL::|(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))|)) +++ PCL::SET-CLASS-SLOT-VALUE-1)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++- PCL::MAKE-N-N-ACCESSOR-DFUN ++- PCL::GET-SIMPLE-INITIALIZATION-FUNCTION ++- PCL::MAKE-FINAL-ACCESSOR-DFUN ++- PCL::GET-EFFECTIVE-METHOD-FUNCTION PCL::MAKE-ACCESSOR-TABLE ++- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION PCL::MAKE-CHECKING-DFUN ++- PCL::GET-COMPLEX-INITIALIZATION-FUNCTIONS ++- PCL::MAKE-DEFAULT-INITARGS-FORM-LIST PCL::REAL-ADD-METHOD ++- PCL::SLOT-VALUE-OR-DEFAULT PCL::LOAD-DEFGENERIC PCL::CPL-ERROR ++- WALKER::NESTED-WALK-FORM PCL::TYPES-FROM-ARGUMENTS ++- PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION)) +++ PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| +++ PCL::|(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| +++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| +++ PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::WALK-METHOD-LAMBDA +++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| +++ PCL::COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL +++ PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| +++ PCL::|(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| +++ PCL::MAKE-TWO-CLASS-ACCESSOR-DFUN +++ PCL::|(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| +++ PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| +++ PCL::|(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| +++ PCL::ADD-METHOD-DECLARATIONS +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))|)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::LIST) +++ PCL::PV-TABLE-CALL-LIST PCL::CACHE-OVERFLOW +++ PCL::PV-TABLE-SLOT-NAME-LISTS)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++- PCL::MAKE-LONG-METHOD-COMBINATION-FUNCTION ++- PCL::GENERATE-DISCRIMINATION-NET-INTERNAL ++- PCL::CACHE-MISS-VALUES-INTERNAL ++- PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++- PCL::DO-SHORT-METHOD-COMBINATION PCL::MEMF-CODE-CONVERTER)) +++ PCL::MAKE-DEFAULT-INITARGS-FORM-LIST +++ PCL::GET-EFFECTIVE-METHOD-FUNCTION PCL::LOAD-DEFGENERIC +++ PCL::GET-COMPLEX-INITIALIZATION-FUNCTIONS +++ PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION +++ PCL::SLOT-VALUE-OR-DEFAULT PCL::MAKE-CHECKING-DFUN +++ PCL::MAKE-FINAL-ACCESSOR-DFUN WALKER::NESTED-WALK-FORM +++ PCL::MAKE-ACCESSOR-TABLE PCL::REAL-ADD-METHOD +++ PCL::TYPES-FROM-ARGUMENTS +++ PCL::GET-SIMPLE-INITIALIZATION-FUNCTION PCL::CPL-ERROR +++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION +++ PCL::MAKE-N-N-ACCESSOR-DFUN)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::*) ++- PCL::MAKE-ONE-INDEX-ACCESSOR-DFUN WALKER::WALK-DECLARATIONS ++- PCL::GET-SECONDARY-DISPATCH-FUNCTION)) +++ PCL::REAL-MAKE-A-METHOD)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++- COMMON-LISP::*) ++- PCL::|(FAST-METHOD SLOT-MISSING (T T T T))| ++- PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| ++- ITERATE::ITERATE-TRANSFORM-BODY)) +++ COMMON-LISP::T) +++ PCL::LOAD-DEFMETHOD-INTERNAL PCL::EXPAND-DEFMETHOD)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::*) ++- ITERATE::RENAME-LET-BINDINGS ++- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1)) +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::T) +++ PCL::EARLY-MAKE-A-METHOD PCL::LOAD-DEFMETHOD +++ PCL::MAKE-DEFMETHOD-FORM PCL::MAKE-DEFMETHOD-FORM-INTERNAL)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::*) +++ COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++- PCL::REAL-MAKE-A-METHOD)) ++-(COMMON-LISP::MAPC ++- (COMMON-LISP::LAMBDA (COMPILER::X) ++- (COMMON-LISP::SETF ++- (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) ++- COMMON-LISP::T)) ++- '(PCL::REDEFINE-FUNCTION PCL::DO-STANDARD-DEFSETF-1 ++- PCL::TRACE-METHOD-INTERNAL PCL::FDEFINE-CAREFULLY)) +++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1 +++ ITERATE::RENAME-LET-BINDINGS)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++- PCL::ANALYZE-LAMBDA-LIST PCL::GET-DISPATCH-FUNCTION ++- PCL::PARSE-DEFMETHOD PCL::MAKE-DISPATCH-DFUN ++- PCL::EMIT-IN-CHECKING-CACHE-P PCL::EMIT-ONE-INDEX-READERS ++- PCL::METHOD-PROTOTYPE-FOR-GF PCL::EMIT-ONE-CLASS-READER ++- PCL::GENERIC-FUNCTION-NAME-P PCL::DEFAULT-CODE-CONVERTER ++- PCL::CLASS-EQ-TYPE PCL::CONVERT-TO-SYSTEM-TYPE ++- PCL::COMPILE-IIS-FUNCTIONS PCL::EMIT-CONSTANT-VALUE ++- PCL::GET-GENERIC-FUNCTION-INFO PCL::EARLY-METHOD-FUNCTION ++- PCL::FIND-STRUCTURE-CLASS PCL::PCL-DESCRIBE ++- PCL::NET-CODE-CONVERTER PCL::PARSE-METHOD-GROUP-SPECIFIER ++- PCL::TYPE-FROM-SPECIALIZER PCL::EMIT-TWO-CLASS-WRITER ++- PCL::COMPUTE-APPLICABLE-METHODS-EMF PCL::EMIT-ONE-CLASS-WRITER ++- PCL::PROTOTYPES-FOR-MAKE-METHOD-LAMBDA ++- PCL::SPECIALIZER-FROM-TYPE PCL::EARLY-COLLECT-INHERITANCE ++- PCL::EMIT-TWO-CLASS-READER PCL::FIND-WRAPPER ++- PCL::*NORMALIZE-TYPE PCL::EMIT-ONE-INDEX-WRITERS ++- PCL::STRUCTURE-WRAPPER PCL::MAKE-FINAL-DISPATCH-DFUN)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ PCL::DO-SHORT-METHOD-COMBINATION +++ PCL::GENERATE-DISCRIMINATION-NET-INTERNAL +++ PCL::CACHE-MISS-VALUES-INTERNAL +++ PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::MEMF-CODE-CONVERTER +++ PCL::MAKE-LONG-METHOD-COMBINATION-FUNCTION)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++- PCL::|__si::MAKE-INITIAL| PCL::|__si::MAKE-ARG-INFO| ++- PCL::STRING-APPEND PCL::|__si::MAKE-ONE-INDEX| ++- PCL::MAKE-INITIALIZE-INFO PCL::MAKE-FAST-METHOD-CALL ++- PCL::|__si::MAKE-STD-INSTANCE| ++- PCL::|__si::MAKE-ONE-INDEX-DFUN-INFO| ++- PCL::|__si::MAKE-CONSTANT-VALUE| PCL::|__si::MAKE-N-N| ++- PCL::FIX-EARLY-GENERIC-FUNCTIONS PCL::INTERN-PV-TABLE ++- PCL::FALSE PCL::|__si::MAKE-DFUN-INFO| ++- PCL::|__si::MAKE-CACHING| PCL::MAKE-PV-TABLE ++- PCL::MAKE-METHOD-CALL PCL::TRUE PCL::MAKE-PROGN ++- PCL::|__si::MAKE-CACHE| ++- PCL::|STRUCTURE-OBJECT class constructor| ++- PCL::|__si::MAKE-CLASS-PRECEDENCE-DESCRIPTION| ++- PCL::|__si::MAKE-NO-METHODS| PCL::|__si::MAKE-ONE-CLASS| ++- PCL::|__si::MAKE-PV-TABLE| PCL::PV-WRAPPERS-FROM-PV-ARGS ++- WALKER::UNBOUND-LEXICAL-FUNCTION PCL::|__si::MAKE-TWO-CLASS| ++- PCL::|__si::MAKE-ACCESSOR-DFUN-INFO| ++- PCL::|__si::MAKE-DEFAULT-METHOD-ONLY| ++- PCL::MAKE-FAST-INSTANCE-BOUNDP ++- PCL::CALLED-FIN-WITHOUT-FUNCTION PCL::USE-PACKAGE-PCL ++- PCL::|__si::MAKE-CHECKING| PCL::|__si::MAKE-INITIAL-DISPATCH| ++- PCL::|__si::MAKE-DISPATCH|)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::*) +++ WALKER::WALK-DECLARATIONS PCL::GET-SECONDARY-DISPATCH-FUNCTION +++ PCL::MAKE-ONE-INDEX-ACCESSOR-DFUN)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FUNCTION) ++- PCL::METHOD-CALL-FUNCTION PCL::FAST-METHOD-CALL-FUNCTION ++- PCL::CACHE-LIMIT-FN)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ PCL::GET-SECONDARY-DISPATCH-FUNCTION2)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::BOOLEAN) ++- PCL::CACHE-VALUEP)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) +++ COMMON-LISP::*) +++ ITERATE::ITERATE-TRANSFORM-BODY +++ PCL::|(FAST-METHOD SLOT-MISSING (T T T T))| +++ PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))|)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++- (COMMON-LISP::INTEGER 1 255)) ++- PCL::CACHE-NKEYS)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807)) +++ COMMON-LISP::T) +++ PCL::COMPUTE-STD-CPL-PHASE-3)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++- (COMMON-LISP::INTEGER 1 256)) ++- PCL::CACHE-LINE-SIZE)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::FIXNUM) +++ COMMON-LISP::T) +++ PCL::FILL-CACHE-FROM-CACHE-P PCL::GET-CACHE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++- (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) ++- PCL::SYMBOL-APPEND)) +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::FIXNUM) +++ PCL::GET-WRAPPER-CACHE-NUMBER)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++- (COMMON-LISP::*)) ++- PCL::SORT-APPLICABLE-METHODS PCL::SORT-METHODS)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FUNCTION) +++ PCL::METHOD-CALL-FUNCTION PCL::FAST-METHOD-CALL-FUNCTION +++ PCL::CACHE-LIMIT-FN)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- PCL::COMPUTE-CALLS PCL::SET-STRUCTURE-SVUC-METHOD ++- PCL::UPDATE-STD-OR-STR-METHODS PCL::SET-METHODS ++- WALKER::NOTE-LEXICAL-BINDING +++ PCL::MEC-ALL-CLASS-LISTS PCL::REMOVE-SLOT-ACCESSORS +++ PCL::PARSE-GSPEC PCL::STANDARD-INSTANCE-ACCESS +++ PCL::DOCTOR-DFUN-FOR-THE-DEBUGGER +++ PCL::UPDATE-STD-OR-STR-METHODS PCL::CLASS-MIGHT-PRECEDE-P +++ PCL::ACCESSOR-SET-SLOT-VALUE PCL::DOPLIST +++ PCL::ADD-SLOT-ACCESSORS PCL::DFUN-MISS +++ PCL::FSC-INSTANCE-WRAPPER PCL::CLASS-EQ-TEST +++ PCL::MAKE-INTERNAL-READER-METHOD-FUNCTION +++ PCL::MAKE-EARLY-ACCESSOR WALKER::ENVIRONMENT-MACRO +++ PCL::WITH-DFUN-WRAPPERS PCL::WRAPPER-STATE +++ PCL::DFUN-INFO-WRAPPER0 +++ WALKER::WITH-NEW-DEFINITION-IN-ENVIRONMENT PCL::IF* +++ PCL::CHECK-WRAPPER-VALIDITY1 +++ PCL::INITIALIZE-INFO-MAKE-INSTANCE-FUNCTION-SYMBOL +++ PCL::BUILT-IN-OR-STRUCTURE-WRAPPER +++ PCL::FIND-CLASS-CELL-PREDICATE PCL::CLASS-CAN-PRECEDE-P +++ COMMON-LISP::CALL-METHOD PCL::NET-CONSTANT-CONVERTER +++ PCL::UPDATE-INITIALIZE-INFO-INTERNAL +++ PCL::GET-CACHE-VECTOR-LOCK-COUNT PCL::UNDEFMETHOD +++ PCL::%SET-SVREF PCL::PV-WRAPPERS-FROM-ALL-WRAPPERS +++ PCL::WRAPPER-NO-OF-INSTANCE-SLOTS PCL::CACHE-VECTOR-LOCK-COUNT +++ WALKER::VARIABLE-LEXICAL-P PCL::FIN-LAMBDA-FN +++ PCL::INITIAL-CLASSES-AND-WRAPPERS PCL::MLOOKUP +++ PCL::RAISE-METATYPE ITERATE::WHILE PCL::EARLY-GF-ARG-INFO +++ PCL::INVALID-WRAPPER-P WALKER::VARIABLE-SPECIAL-P +++ PCL::EMIT-N-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION +++ PCL::EMIT-CHECKING-OR-CACHING-FUNCTION-PRECOMPILED +++ PCL::INSTANCE-WRITE-INTERNAL WALKER::WALK-REPEAT-EVAL +++ WALKER::GET-WALKER-TEMPLATE-INTERNAL ITERATE::PLIST-ELEMENTS +++ PCL::MAKE-FIND-CLASS-CELL COMMON-LISP::WITH-ACCESSORS +++ PCL::MAKE-METHOD-FUNCTION PCL::SIMPLE-LEXICAL-METHOD-FUNCTIONS +++ PCL::CANONICALIZE-DEFCLASS-OPTION PCL::UPDATE-INITS PCL::SCASE +++ PCL::INSTANCE-BOUNDP-INTERNAL PCL::FMC-FUNCALL +++ PCL::SET-METHODS PCL::CACHE-LOCK-COUNT PCL::GET-WRAPPER +++ PCL::INVOKE-METHOD-CALL1 PCL::MAKE-CLASS-PREDICATE +++ PCL::PRINTING-RANDOM-THING PCL::UPDATE-SLOTS +++ PCL::FUNCTION-APPLY PCL::AUGMENT-TYPE ITERATE::WITH-GATHERING +++ PCL::CHECKING-DFUN-INFO PCL::LIST-EQ PCL::CACHE-VECTOR-SIZE +++ PCL::DESCRIBE-PACKAGE PCL::WRAPPER-REF PCL::PLIST-VALUE +++ PCL::%INSTANCE-REF WALKER::NOTE-DECLARATION +++ PCL::MAKE-STD-READER-METHOD-FUNCTION +++ PCL::EMIT-READER/WRITER-MACRO WALKER::ENVIRONMENT-FUNCTION +++ PCL::N-N-DFUN-INFO +++ PCL::FIND-CLASS-CELL-MAKE-INSTANCE-FUNCTION-KEYS +++ PCL::DEFCONSTRUCTOR PCL::INSTANCE-SLOT-INDEX +++ PCL::CLASS-NO-OF-INSTANCE-SLOTS ITERATE::ELEMENTS +++ PCL::NEXT-WRAPPER-CACHE-NUMBER-INDEX +++ PCL::INITIALIZE-INFO-COMBINED-INITARGS-FORM-LIST +++ COMMON-LISP::DEFINE-METHOD-COMBINATION PCL::MDOTIMES +++ PCL::REMOVE-DIRECT-SUBCLASSES PCL::MAKE-WRAPPER-INTERNAL +++ ITERATE::MAXIMIZING PCL::PV-OFFSET +++ PCL::DEAL-WITH-ARGUMENTS-OPTION PCL::INSTANCE-READER +++ PCL::ALLOCATE-STANDARD-INSTANCE--MACRO PCL::DEFINE-INLINES +++ PCL::WRAPPER-CACHE-NUMBER-VECTOR PCL::GATHERING1 +++ PCL::FIND-CLASS-CELL-CLASS PCL::SWAP-WRAPPERS-AND-SLOTS +++ PCL::COMPUTE-APPLICABLE-METHODS-FUNCTION PCL::PV-TABLE-LOOKUP +++ PCL::WRAPPER-INSTANCE-SLOTS-LAYOUT +++ WALKER::WALKER-ENVIRONMENT-BIND PCL::COPY-SLOTS PCL::MCASE +++ PCL::ADD-TO-CVECTOR PCL::ADD-DIRECT-SUBCLASSES +++ PCL::%SET-CCLOSURE-ENV PCL::PRECOMPILE-RANDOM-CODE-SEGMENTS +++ PCL::UPDATE-CLASS PCL::SLOT-SYMBOL PCL::VALUE-FOR-CACHING +++ PCL::EXPANDING-MAKE-INSTANCE-TOP-LEVEL PCL::REMTAIL +++ PCL::MAKE-DISCRIMINATING-FUNCTION-ARGLIST +++ PCL::CLASSES-HAVE-COMMON-SUBCLASS-P +++ PCL::FIRST-WRAPPER-CACHE-NUMBER-INDEX +++ PCL::INITIALIZE-INFO-INITARGS-FORM-LIST +++ PCL::WITH-MAKE-INSTANCE-FUNCTION-VALID-P-CHECK +++ PCL::FUNCALLABLE-INSTANCE-DATA-1 PCL::SAUT-NOT-EQL +++ PCL::EARLY-GF-METHODS ITERATE::EXTRACT-SPECIAL-BINDINGS +++ PCL::MEMQ PCL::DFUN-UPDATE +++ PCL::MAKE-CHECKING-OR-CACHING-FUNCTION-LIST PCL::ONCE-ONLY +++ PCL::GET-INSTANCE-WRAPPER-OR-NIL PCL::SYMBOL-LESSP +++ PCL::|SETF PCL FIND-CLASS| PCL::PARSE-QUALIFIER-PATTERN ++ ITERATE::SIMPLE-EXPAND-ITERATE-FORM ++- PCL::|SETF PCL METHOD-FUNCTION-PLIST| PCL::SAUT-NOT-PROTOTYPE ++- PCL::VALUE-FOR-CACHING PCL::PROCLAIM-DEFMETHOD ++- PCL::MAKE-FAST-METHOD-CALL-LAMBDA-LIST ++- PCL::MAKE-STD-BOUNDP-METHOD-FUNCTION PCL::METHODS-CONVERTER ++- PCL::DEAL-WITH-ARGUMENTS-OPTION ++- PCL::UPDATE-ALL-PV-TABLE-CACHES ++- PCL::MAP-PV-TABLE-REFERENCES-OF PCL::UPDATE-CLASS ++- PCL::FIND-STANDARD-II-METHOD ++- PCL::METHOD-FUNCTION-RETURNING-NIL ++- PCL::REDIRECT-EARLY-FUNCTION-INTERNAL PCL::UPDATE-CPL ++- PCL::QUALIFIER-CHECK-RUNTIME PCL::COMPUTE-STD-CPL ++- PCL::COMPUTE-CONSTANTS PCL::ADD-FORMS PCL::AUGMENT-TYPE ++- PCL::MEMF-CONSTANT-CONVERTER PCL::SWAP-WRAPPERS-AND-SLOTS ++- PCL::SET-WRAPPER PCL::GET-KEY-ARG PCL::MAKE-PLIST ++- PCL::MAKE-PV-TABLE-INTERNAL ITERATE::EXTRACT-SPECIAL-BINDINGS ++- PCL::SAUT-NOT-EQL WALKER::VARIABLE-SYMBOL-MACRO-P ++- PCL::EMIT-1-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION ++- PCL::SET-FUNCTION-PRETTY-ARGLIST ++- PCL::GF-MAKE-FUNCTION-FROM-EMF PCL::FIND-SLOT-DEFINITION ++- PCL::SET-STANDARD-SVUC-METHOD PCL::ADD-TO-CVECTOR ++- PCL::PV-WRAPPERS-FROM-ALL-WRAPPERS COMMON-LISP::REMOVE-METHOD ++- PCL::CHECKING-DFUN-INFO PCL::PARSE-QUALIFIER-PATTERN ++- PCL::%SET-CCLOSURE-ENV PCL::MAKE-CDXR ++- PCL::FUNCALLABLE-STANDARD-INSTANCE-ACCESS ++- PCL::NET-CONSTANT-CONVERTER PCL::|SETF PCL FIND-CLASS| +++ PCL::INITIALIZE-INFO-SHARED-INITIALIZE-T-FUNCTION +++ PCL::RESET-INITIALIZE-INFO-INTERNAL +++ PCL::INITIALIZE-INFO-DEFAULT-INITARGS-FUNCTION +++ PCL::DESTRUCTURE-INTERNAL PCL::DFUN-INFO-INDEX +++ PCL::PRECOMPILE-IIS-FUNCTIONS PCL::INSTANCE-WRITE +++ COMMON-LISP::DEFCLASS PCL::UPDATE-ALL-PV-TABLE-CACHES +++ PCL::WRAPPER-CACHE-NUMBER-VECTOR-REF +++ PCL::INITIALIZE-INFO-COMBINED-INITIALIZE-FUNCTION +++ PCL::MODIFY-CACHE PCL::BOOTSTRAP-SLOT-INDEX +++ PCL::SET-FUNCTION-PRETTY-ARGLIST PCL::COMPUTE-LAYOUT +++ PCL::CALL-METHOD-LIST PCL::GET-KEY-ARG ITERATE::LIST-TAILS +++ PCL::INITIALIZE-INFO-MAKE-INSTANCE-FUNCTION ITERATE::EACHTIME +++ PCL::INSTANCE-REF PCL::WITH-EQ-HASH-TABLE +++ PCL::QUALIFIER-CHECK-RUNTIME PCL::CALLSREF ITERATE::MV-SETQ +++ PCL::PRINTING-RANDOM-THING-INTERNAL PCL::CHECK-MEMBER +++ PCL::INSTANCE-WRITER PCL::CANONICALIZE-SLOT-SPECIFICATION +++ PCL::BIND-LEXICAL-METHOD-FUNCTIONS ITERATE::LIST-ELEMENTS +++ PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST +++ PCL::INVOKE-METHOD-CALL PCL::INITIALIZE-INFO-RI-VALID-P +++ PCL::SET-WRAPPER PCL::STD-INSTANCE-CLASS +++ PCL::EXPANDING-MAKE-INSTANCE PCL::BIND-ARGS +++ PCL::INITIALIZE-INFO-VALID-P PCL::STD-INSTANCE-WRAPPER +++ PCL::FSC-INSTANCE-SLOTS PCL::REAL-ENSURE-GF-INTERNAL PCL::NEQ +++ PCL::PRECOMPILE-DFUN-CONSTRUCTORS PCL::MAKE-DLAP-LAMBDA-LIST +++ PCL::FIND-SLOT-DEFINITION +++ PCL::BIND-SIMPLE-LEXICAL-METHOD-MACROS +++ PCL::ACCESSOR-SLOT-VALUE PCL::METHOD-FUNCTION-RETURNING-NIL +++ PCL::MAKE-DFUN-LAMBDA-LIST WALKER::VARIABLE-SYMBOL-MACRO-P +++ PCL::DFUN-INFO-FUNCTION COMMON-LISP::WITH-SLOTS +++ PCL::FUNCTION-FUNCALL PCL::EQL-TEST +++ PCL::INITIALIZE-INFO-CONSTANTS PCL::POSQ PCL::DOLIST-CAREFULLY +++ PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER-MACRO PCL::MAKE-CAXR +++ ITERATE::ITERATE PCL::DEFINE-INITIALIZE-INFO PCL::ALIST-ENTRY +++ PCL::WITH-LOCAL-CACHE-FUNCTIONS PCL::WRAPPER-OF-MACRO +++ PCL::RASSQ PCL::SUPERCLASSES-COMPATIBLE-P ++ PCL::METHOD-FUNCTION-RETURNING-T PCL::CHANGE-CLASS-INTERNAL ++- PCL::MAKE-DFUN-ARG-LIST PCL::DOCTOR-DFUN-FOR-THE-DEBUGGER ++- PCL::MAKE-STD-WRITER-METHOD-FUNCTION ITERATE::MV-SETQ ++- PCL::MAKE-EARLY-ACCESSOR PCL::GET-KEY-ARG1 ++- PCL::ADD-DIRECT-SUBCLASSES PCL::DO-SATISFIES-DEFTYPE ++- PCL::N-N-DFUN-INFO PCL::CLASSES-HAVE-COMMON-SUBCLASS-P ++- PCL::SAUT-NOT-CLASS PCL::CANONICALIZE-DEFCLASS-OPTION ++- PCL::MAKE-DISCRIMINATING-FUNCTION-ARGLIST ++- WALKER::VARIABLE-LEXICAL-P WALKER::ENVIRONMENT-FUNCTION ++- PCL::PV-TABLE-LOOKUP PCL::DESTRUCTURE-INTERNAL ++- PCL::MAKE-INTERNAL-READER-METHOD-FUNCTION ++- PCL::REMOVE-SLOT-ACCESSORS +++ PCL::PRECOMPILE-FUNCTION-GENERATORS +++ WALKER::DEFINE-WALKER-TEMPLATE PCL::CACHE-VECTOR-REF +++ PCL::GET-SLOTS PCL::MEC-ALL-CLASSES-INTERNAL +++ COMMON-LISP::SLOT-EXISTS-P PCL::WITHOUT-INTERRUPTS +++ PCL::MAKE-UNORDERED-METHODS-EMF PCL::GET-KEY-ARG1 +++ PCL::MAKE-STD-WRITER-METHOD-FUNCTION PCL::COMPUTE-CONSTANTS +++ PCL::BOOTSTRAP-GET-SLOT PCL::DEFINE-GF-PREDICATE +++ PCL::REDIRECT-EARLY-FUNCTION-INTERNAL +++ PCL::SET-STRUCTURE-SVUC-METHOD PCL::WRAPPER-CLASS +++ ITERATE::UNTIL PCL::PV-BINDING1 PCL::UPDATE-CPL PCL::PV-ENV +++ PCL::PV-BINDING PCL::INSTANCE-READ-INTERNAL +++ COMMON-LISP::DEFGENERIC ITERATE::COLLECTING +++ WALKER::NOTE-LEXICAL-BINDING PCL::ORIGINAL-DEFINITION +++ PCL::COLLECTING-ONCE PCL::GET-SLOTS-OR-NIL PCL::TRACE-EMF-CALL +++ PCL::WITH-HASH-TABLE PCL::FUNCALLABLE-INSTANCE-MARKER +++ PCL::INITIALIZE-INFO-NEW-KEYS PCL::STD-INSTANCE-SLOTS +++ PCL::ACCESSOR-SLOT-BOUNDP PCL::SAUT-NOT-PROTOTYPE +++ PCL::MAP-PV-TABLE-REFERENCES-OF COMMON-LISP::ADD-METHOD +++ PCL::MAKE-CDXR PCL::CALL-INITIALIZE-FUNCTION PCL::ASV-FUNCALL +++ PCL::MAKE-STD-BOUNDP-METHOD-FUNCTION PCL::IIS-BODY +++ COMMON-LISP::DEFMETHOD PCL::SYMBOL-OR-CONS-LESSP +++ PCL::SAUT-NOT-CLASS-EQ PCL::METHODS-CONVERTER PCL::PVREF +++ PCL::EMIT-1-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION +++ PCL::EMIT-CHECKING-OR-CACHING-MACRO ITERATE::SUMMING +++ PCL::|SETF PCL GDEFINITION| PCL::ESETF PCL::COPY-PV +++ PCL::WRAPPER-CLASS* COMMON-LISP::REMOVE-METHOD ++ PCL::|SETF PCL FIND-CLASS-PREDICATE| ++- PCL::|SETF PCL GDEFINITION| PCL::MAKE-DFUN-LAMBDA-LIST ++- PCL::CANONICALIZE-SLOT-SPECIFICATION WALKER::WALK-REPEAT-EVAL ++- PCL::STANDARD-INSTANCE-ACCESS ++- PCL::PRINTING-RANDOM-THING-INTERNAL PCL::REMTAIL ++- PCL::ACCESSOR-MISS-FUNCTION PCL::COMPUTE-LAYOUT ++- PCL::CLASS-MIGHT-PRECEDE-P ++- PCL::EMIT-N-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION ++- SYSTEM::%SET-COMPILED-FUNCTION-NAME PCL::PLIST-VALUE ++- PCL::MAKE-CAXR PCL::MAKE-DLAP-LAMBDA-LIST ++- PCL::MAKE-STD-READER-METHOD-FUNCTION WALKER::ENVIRONMENT-MACRO ++- PCL::UPDATE-SLOTS PCL::VARIABLE-CLASS ++- PCL::SET-FUNCALLABLE-INSTANCE-FUNCTION PCL::LIST-EQ ++- PCL::ADD-SLOT-ACCESSORS PCL::SAUT-NOT-CLASS-EQ PCL::COMPUTE-PV ++- PCL::PV-WRAPPERS-FROM-ALL-ARGS PCL::UPDATE-INITS ++- PCL::MEC-ALL-CLASS-LISTS PCL::RAISE-METATYPE ++- WALKER::NOTE-DECLARATION PCL::EMIT-1-NIL-DLAP ++- PCL::BOOTSTRAP-SLOT-INDEX PCL::SUPERCLASSES-COMPATIBLE-P ++- PCL::MEC-ALL-CLASSES-INTERNAL COMMON-LISP::SLOT-EXISTS-P ++- PCL::DESCRIBE-PACKAGE PCL::NO-SLOT PCL::PROCLAIM-DEFGENERIC ++- COMMON-LISP::ADD-METHOD PCL::MAKE-UNORDERED-METHODS-EMF ++- PCL::MEC-ALL-CLASSES PCL::SYMBOL-OR-CONS-LESSP ++- PCL::UPDATE-INITIALIZE-INFO-INTERNAL PCL::CLASS-CAN-PRECEDE-P ++- PCL::SYMBOL-LESSP PCL::COMPUTE-APPLICABLE-METHODS-FUNCTION ++- PCL::MAKE-CLASS-PREDICATE WALKER::VARIABLE-SPECIAL-P ++- PCL::REMOVE-DIRECT-SUBCLASSES)) +++ PCL::ACCESSOR-MISS-FUNCTION PCL::MEMF-CONSTANT-CONVERTER +++ PCL::DELQ PCL::VECTORIZING PCL::MAKE-DFUN-ARG-LIST +++ PCL::VARIABLE-CLASS PCL::INSTANCE-ACCESSOR-PARAMETER +++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE-SLOTS +++ PCL::EMIT-DEFAULT-ONLY-MACRO PCL::NO-SLOT +++ PCL::MAYBE-CHECK-CACHE PCL::FUNCALLABLE-INSTANCE-DATA-POSITION +++ PCL::MAKE-FAST-METHOD-CALL-LAMBDA-LIST +++ PCL::DO-STANDARD-DEFSETF PCL::SAUT-NOT-CLASS +++ PCL::DFUN-INFO-ACCESSOR-TYPE PCL::DEFINE-CACHED-READER +++ PCL::SET-STANDARD-SVUC-METHOD PCL::CLASS-TEST +++ PCL::MAKE-PV-TABLE-INTERNAL PCL::PROCLAIM-DEFGENERIC +++ PCL::GF-MAKE-FUNCTION-FROM-EMF PCL::COMPUTE-PV +++ PCL::EMIT-1-NIL-DLAP PCL::FIND-STANDARD-II-METHOD +++ PCL::BIND-FAST-LEXICAL-METHOD-MACROS PCL::DO-SATISFIES-DEFTYPE +++ PCL::FAST-LEXICAL-METHOD-FUNCTIONS PCL::COMPUTE-CALLS +++ PCL::COPY-INSTANCE-INTERNAL COMMON-LISP::SYMBOL-MACROLET +++ PCL::FSC-INSTANCE-P PCL::MAKE-PLIST PCL::%SVREF +++ PCL::PCL-DESTRUCTURING-BIND +++ SYSTEM::%SET-COMPILED-FUNCTION-NAME ITERATE::JOINING +++ ITERATE::MINIMIZING PCL::METHOD-FUNCTION-CLOSURE-GENERATOR +++ PCL::PV-WRAPPERS-FROM-ALL-ARGS PCL::*LIST-ELEMENTS +++ PCL::ADD-FORMS +++ PCL::INITIALIZE-INFO-SHARED-INITIALIZE-NIL-FUNCTION +++ ITERATE::INTERVAL PCL::INSTANCE-BOUNDP PCL::FSC-INSTANCE-CLASS +++ WALKER::WITH-AUGMENTED-ENVIRONMENT +++ PCL::CACHE-NUMBER-VECTOR-REF +++ PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION PCL::ASSQ +++ PCL::SET-FUNCALLABLE-INSTANCE-FUNCTION +++ PCL::WRAPPER-CLASS-SLOTS PCL::MEC-ALL-CLASSES +++ ITERATE::GATHERING PCL::INSTANCE-READ PCL::COMPUTE-STD-CPL +++ PCL::PROCLAIM-DEFMETHOD +++ PCL::%ALLOCATE-STATIC-SLOT-STORAGE--CLASS PCL::*LIST-TAILS +++ PCL::|SETF PCL METHOD-FUNCTION-PLIST| +++ PCL::FUNCALLABLE-STANDARD-INSTANCE-ACCESS +++ PCL::DFUN-INFO-WRAPPER1 PCL::INVOKE-FAST-METHOD-CALL)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) +++ PCL::COMPILE-LAMBDA PCL::COERCE-TO-CLASS ++ PCL::MAKE-METHOD-FUNCTION-INTERNAL ++- PCL::MAKE-FINAL-DFUN-INTERNAL WALKER::MACROEXPAND-ALL ++- COMMON-LISP::ENSURE-GENERIC-FUNCTION ++- PCL::MAKE-METHOD-LAMBDA-INTERNAL PCL::MAKE-CONSTANT-VALUE-DFUN ++- PCL::GET-FUNCTION PCL::EXTRACT-DECLARATIONS ++- PCL::COERCE-TO-CLASS PCL::PARSE-METHOD-OR-SPEC ++- PCL::DISPATCH-DFUN-COST PCL::PARSE-SPECIALIZED-LAMBDA-LIST ++- PCL::MAP-ALL-CLASSES PCL::COMPILE-LAMBDA PCL::ENSURE-CLASS ++- PCL::GET-METHOD-FUNCTION WALKER::WALK-FORM ++- PCL::ALLOCATE-STRUCTURE-INSTANCE PCL::GET-FUNCTION1 +++ PCL::MAKE-CONSTANT-VALUE-DFUN PCL::GET-FUNCTION ++ PCL::MAKE-CACHING-DFUN PCL::MAKE-INSTANCE-1 ++- PCL::GET-DFUN-CONSTRUCTOR)) +++ PCL::MAKE-FINAL-DFUN-INTERNAL WALKER::MACROEXPAND-ALL +++ COMMON-LISP::ENSURE-GENERIC-FUNCTION PCL::MAP-ALL-CLASSES +++ PCL::GET-METHOD-FUNCTION PCL::MAKE-METHOD-LAMBDA-INTERNAL +++ PCL::PARSE-SPECIALIZED-LAMBDA-LIST PCL::GET-FUNCTION1 +++ WALKER::WALK-FORM PCL::ALLOCATE-STRUCTURE-INSTANCE +++ PCL::ENSURE-CLASS PCL::GET-DFUN-CONSTRUCTOR +++ PCL::EXTRACT-DECLARATIONS PCL::DISPATCH-DFUN-COST +++ PCL::PARSE-METHOD-OR-SPEC)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++- (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) ++- PCL::MAKE-CLASS-PREDICATE-NAME PCL::MAKE-KEYWORD)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ PCL::SDFUN-FOR-CACHING PCL::SAUT-AND PCL::EMIT-CHECKING +++ PCL::SPLIT-DECLARATIONS +++ PCL::COMPUTE-APPLICABLE-METHODS-USING-TYPES PCL::COMPUTE-CODE +++ PCL::*SUBTYPEP ITERATE::PARSE-DECLARATIONS +++ PCL::GENERATE-FAST-CLASS-SLOT-ACCESS-P +++ PCL::SLOT-NAME-LISTS-FROM-SLOTS COMMON-LISP::SLOT-VALUE +++ PCL::COMPUTE-STD-CPL-PHASE-1 PCL::SAUT-CLASS +++ PCL::FORM-LIST-TO-LISP PCL::INITIAL-DFUN +++ PCL::FIND-SUPERCLASS-CHAIN PCL::EMIT-CACHING PCL::SAUT-NOT +++ PCL::CHECK-INITARGS-VALUES PCL::REAL-REMOVE-METHOD +++ PCL::CPL-INCONSISTENT-ERROR COMMON-LISP::SLOT-BOUNDP +++ PCL::SPECIALIZER-APPLICABLE-USING-TYPE-P +++ PCL::MAKE-INSTANCE-FUNCTION-TRAP PCL::SAUT-CLASS-EQ +++ PCL::SLOT-UNBOUND-INTERNAL PCL::SAUT-PROTOTYPE +++ PCL::CPL-FORWARD-REFERENCED-CLASS-ERROR +++ PCL::GET-NEW-FUNCTION-GENERATOR-INTERNAL +++ PCL::EMIT-DEFAULT-ONLY PCL::CLASS-APPLICABLE-USING-CLASS-P +++ PCL::COMPUTE-TEST PCL::MUTATE-SLOTS-AND-CALLS +++ PCL::EMIT-DEFAULT-ONLY-FUNCTION PCL::ENSURE-CLASS-VALUES +++ PCL::INVOKE-EMF COMMON-LISP::SLOT-MAKUNBOUND +++ PCL::MAKE-DIRECT-SLOTD PCL::INSURE-DFUN PCL::SET-FUNCTION-NAME +++ PCL::DESTRUCTURE PCL::SAUT-EQL PCL::UPDATE-SLOT-VALUE-GF-INFO)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++- (COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++- COMMON-LISP::*)) ++- PCL::CAPITALIZE-WORDS)) +++ COMMON-LISP::T) +++ WALKER::RELIST* PCL::UPDATE-DFUN +++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE PCL::MAKE-SPECIALIZABLE +++ PCL::TRACE-METHOD PCL::ALLOCATE-STANDARD-INSTANCE +++ WALKER::RELIST COMMON-LISP::FIND-CLASS PCL::MAKE-WRAPPER +++ PCL::PV-TABLE-LOOKUP-PV-ARGS ITERATE::FUNCTION-LAMBDA-P +++ PCL::SET-DFUN PCL::EARLY-METHOD-SPECIALIZERS +++ WALKER::WALKER-ENVIRONMENT-BIND-1 +++ PCL::INITIALIZE-METHOD-FUNCTION PCL::MAKE-TYPE-PREDICATE-NAME +++ PCL::MAKE-FINAL-DFUN PCL::FIND-CLASS-CELL +++ PCL::INITIALIZE-INTERNAL-SLOT-GFS PCL::MAKE-EARLY-GF +++ PCL::USE-DISPATCH-DFUN-P ITERATE::MAYBE-WARN +++ PCL::USE-CONSTANT-VALUE-DFUN-P PCL::FIND-CLASS-PREDICATE +++ PCL::SET-ARG-INFO PCL::CAPITALIZE-WORDS)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++- PCL::ALLOCATE-FUNCALLABLE-INSTANCE-1 PCL::SHOW-EMF-CALL-TRACE ++- PCL::CACHES-TO-ALLOCATE PCL::MAKE-CACHE ++- PCL::SHOW-FREE-CACHE-VECTORS PCL::MAKE-ARG-INFO ++- PCL::NO-METHODS-DFUN-INFO PCL::STRUCTURE-FUNCTIONS-EXIST-P ++- PCL::INITIALIZE-CHECKING-OR-CACHING-FUNCTION-LIST ++- PCL::BOOTSTRAP-BUILT-IN-CLASSES ++- PCL::%%ALLOCATE-INSTANCE--CLASS PCL::DISPATCH-DFUN-INFO ++- PCL::INITIAL-DISPATCH-DFUN-INFO PCL::BOOTSTRAP-META-BRAID ++- PCL::UPDATE-DISPATCH-DFUNS PCL::LIST-ALL-DFUNS ++- PCL::DEFAULT-METHOD-ONLY-DFUN-INFO PCL::RENEW-SYS-FILES ++- PCL::IN-THE-COMPILER-P PCL::GET-EFFECTIVE-METHOD-GENSYM ++- PCL::MAKE-CPD PCL::INITIAL-DFUN-INFO ++- PCL::SHOW-DFUN-CONSTRUCTORS ++- PCL::ALLOCATE-FUNCALLABLE-INSTANCE-2)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::STREAM COMMON-LISP::T) +++ COMMON-LISP::T) +++ PCL::PRINT-DFUN-INFO)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::FIXNUM) ++- PCL::ZERO)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ COMMON-LISP::SIMPLE-VECTOR) +++ PCL::CACHE-VECTOR)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::STREAM COMMON-LISP::T) ++- COMMON-LISP::T) ++- PCL::PRINT-DFUN-INFO)) +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) +++ PCL::SYMBOL-APPEND)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ (COMMON-LISP::OR PCL::CACHE COMMON-LISP::NULL)) +++ PCL::PV-TABLE-CACHE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++@@ -412,70 +1019,11 @@ ++ PCL::COMPUTE-CACHE-PARAMETERS)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) ++- PCL::COUNT-ALL-DFUNS PCL::EMIT-N-N-WRITERS ++- PCL::EMIT-N-N-READERS)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::T) ++- PCL::MAKE-FINAL-DFUN PCL::SET-ARG-INFO PCL::TRACE-METHOD ++- PCL::MAKE-SPECIALIZABLE WALKER::WALKER-ENVIRONMENT-BIND-1 ++- ITERATE::FUNCTION-LAMBDA-P COMMON-LISP::FIND-CLASS ++- PCL::MAKE-WRAPPER PCL::UPDATE-DFUN ++- PCL::MAKE-TYPE-PREDICATE-NAME PCL::PV-TABLE-LOOKUP-PV-ARGS ++- PCL::USE-CONSTANT-VALUE-DFUN-P WALKER::RELIST ++- PCL::MAKE-EARLY-GF PCL::INITIALIZE-METHOD-FUNCTION ++- PCL::FIND-CLASS-CELL PCL::USE-DISPATCH-DFUN-P ++- PCL::FIND-CLASS-PREDICATE PCL::ALLOCATE-STANDARD-INSTANCE ++- PCL::INITIALIZE-INTERNAL-SLOT-GFS ITERATE::MAYBE-WARN ++- PCL::ALLOCATE-FUNCALLABLE-INSTANCE ++- PCL::EARLY-METHOD-SPECIALIZERS WALKER::RELIST* PCL::SET-DFUN)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::*) ++- PCL::SLOT-UNBOUND-INTERNAL ITERATE::PARSE-DECLARATIONS ++- PCL::EMIT-CACHING PCL::COMPUTE-STD-CPL-PHASE-1 ++- PCL::INITIAL-DFUN PCL::INSURE-DFUN PCL::EMIT-CHECKING ++- PCL::COMPUTE-TEST PCL::COMPUTE-CODE PCL::MAKE-DIRECT-SLOTD ++- PCL::SAUT-CLASS COMMON-LISP::SLOT-MAKUNBOUND ++- PCL::CPL-FORWARD-REFERENCED-CLASS-ERROR PCL::INVOKE-EMF ++- PCL::*SUBTYPEP PCL::SPECIALIZER-APPLICABLE-USING-TYPE-P ++- PCL::COMPUTE-APPLICABLE-METHODS-USING-TYPES ++- PCL::REAL-REMOVE-METHOD PCL::SAUT-PROTOTYPE ++- PCL::MUTATE-SLOTS-AND-CALLS PCL::FIND-SUPERCLASS-CHAIN ++- COMMON-LISP::SLOT-BOUNDP PCL::FORM-LIST-TO-LISP ++- PCL::CPL-INCONSISTENT-ERROR PCL::EMIT-DEFAULT-ONLY-FUNCTION ++- PCL::ENSURE-CLASS-VALUES PCL::CHECK-INITARGS-VALUES ++- PCL::SAUT-EQL PCL::SPLIT-DECLARATIONS ++- PCL::UPDATE-SLOT-VALUE-GF-INFO PCL::SAUT-AND ++- PCL::SLOT-NAME-LISTS-FROM-SLOTS ++- PCL::MAKE-INSTANCE-FUNCTION-TRAP PCL::EMIT-DEFAULT-ONLY ++- PCL::SAUT-NOT PCL::SAUT-CLASS-EQ COMMON-LISP::SLOT-VALUE ++- PCL::DESTRUCTURE PCL::GENERATE-FAST-CLASS-SLOT-ACCESS-P ++- PCL::GET-NEW-FUNCTION-GENERATOR-INTERNAL ++- PCL::CLASS-APPLICABLE-USING-CLASS-P PCL::SDFUN-FOR-CACHING ++- PCL::SET-FUNCTION-NAME)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++- PCL::ARG-INFO-NUMBER-REQUIRED PCL::CACHING-LIMIT-FN ++- PCL::PV-CACHE-LIMIT-FN PCL::ONE-INDEX-LIMIT-FN ++- PCL::PV-TABLE-PV-SIZE PCL::CACHE-COUNT PCL::DEFAULT-LIMIT-FN ++- PCL::CPD-COUNT PCL::CHECKING-LIMIT-FN ++- PCL::N-N-ACCESSORS-LIMIT-FN PCL::EARLY-CLASS-SIZE ++- PCL::FAST-INSTANCE-BOUNDP-INDEX)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) ++- PCL::POWER-OF-TWO-CEILING)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::*) ++ COMMON-LISP::T) ++- PCL::GET-CACHE-FROM-CACHE)) +++ PCL::GET-CACHE-FROM-CACHE +++ PCL::COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++@@ -484,544 +1032,81 @@ ++ PCL::COMPUTE-PRIMARY-CACHE-LOCATION)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) PCL::FIELD-TYPE) ++- PCL::CACHE-FIELD)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++- (COMMON-LISP::OR PCL::CACHE COMMON-LISP::NULL)) ++- PCL::PV-TABLE-CACHE)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T) ++- COMMON-LISP::T) ++- PCL::|(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| ++- WALKER::WALK-TEMPLATE PCL::|(FAST-METHOD PRINT-OBJECT (T T))| ++- WALKER::WALK-DO/DO* PCL::LOAD-PRECOMPILED-DFUN-CONSTRUCTOR ++- PCL::|(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| ++- WALKER::WALK-LET/LET* ++- PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| ++- PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| ++- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-TYPE ++- PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| ++- PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| ++- PCL::|(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| ++- PCL::INITIALIZE-INSTANCE-SIMPLE ++- PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| ++- PCL::EXPAND-SYMBOL-MACROLET-INTERNAL ++- PCL::|(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| ++- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION1 ++- PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| ++- PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| ++- PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++- PCL::|(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| ++- PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++- PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++- PCL::|(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| ++- PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++- PCL::|(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++- PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| ++- PCL::|(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| ++- PCL::|(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| ++- PCL::|(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| ++- PCL::|(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| ++- PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| ++- PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| ++- PCL::|(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| ++- PCL::|(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| ++- PCL::MAKE-DISPATCH-LAMBDA ++- PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++- PCL::EXPAND-DEFCLASS ++- PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++- PCL::|(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| ++- PCL::OPTIMIZE-WRITER ++- PCL::|(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| ++- PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| ++- PCL::|(FAST-METHOD DOCUMENTATION (T))| ++- PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| ++- PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| ++- PCL::OPTIMIZE-READER WALKER::WALK-PROG/PROG* ++- PCL::BOOTSTRAP-SET-SLOT ++- PCL::EMIT-CHECKING-OR-CACHING-FUNCTION-PRELIMINARY ++- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| ++- PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++- PCL::TWO-CLASS-DFUN-INFO ++- PCL::|(FAST-METHOD MAKE-INSTANCE (CLASS))| ++- PCL::|(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++- PCL::ADJUST-CACHE ++- PCL::|(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| ++- PCL::|(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| ++- PCL::EXPAND-CACHE ++- PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| ++- PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| ++- PCL::|(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| ++- PCL::|(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| ++- PCL::|(FAST-METHOD PRINT-OBJECT (CLASS T))| ++- PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| ++- PCL::|(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++- PCL::|(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++- PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| ++- PCL::|(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| ++- PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| ++- PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| ++- PCL::|(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| ++- PCL::GET-WRAPPERS-FROM-CLASSES ++- PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| ++- PCL::MAYBE-EXPAND-ACCESSOR-FORM WALKER::WALK-BINDINGS-2 ++- PCL::FILL-CACHE-P PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-INTERNAL ++- PCL::|(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| ++- PCL::|(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| ++- PCL::|(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| ++- PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| ++- PCL::LOAD-PRECOMPILED-IIS-ENTRY PCL::MEMF-TEST-CONVERTER ++- PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))|)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::T) ++- PCL::REAL-ADD-NAMED-METHOD PCL::EARLY-ADD-NAMED-METHOD ++- PCL::FILL-DFUN-CACHE)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::T) ++- PCL::OBSOLETE-INSTANCE-TRAP ++- PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| ++- WALKER::WALK-TAGBODY ++- PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++- PCL::ENTRY-IN-CACHE-P WALKER::WALK-COMPILER-LET ++- PCL::|(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| ++- PCL::NOTE-PV-TABLE-REFERENCE PCL::COMPUTE-EFFECTIVE-METHOD ++- PCL::MAKE-DFUN-CALL PCL::|SETF PCL PLIST-VALUE| ++- PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| ++- PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| ++- PCL::|(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| ++- PCL::|(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++- WALKER::WALK-UNEXPECTED-DECLARE ++- PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL ++- PCL::SKIP-FAST-SLOT-ACCESS-P PCL::SET-FUNCTION-NAME-1 ++- WALKER::WALK-DO PCL::EMIT-1-T-DLAP PCL::PRINT-STD-INSTANCE ++- PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| ++- WALKER::WALK-LAMBDA PCL::MAKE-METHOD-SPEC ++- PCL::|(FAST-METHOD CLASS-PREDICATE-NAME (T))| ++- PCL::|(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| ++- PCL::OPTIMIZE-SET-SLOT-VALUE ++- PCL::MAKE-OPTIMIZED-STD-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++- PCL::EXPAND-DEFGENERIC WALKER::VARIABLE-DECLARATION ++- ITERATE::RENAME-AND-CAPTURE-VARIABLES ++- PCL::|(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| ++- PCL::MAP-ALL-ORDERS ++- PCL::|(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| ++- PCL::DECLARE-STRUCTURE WALKER::WALK-PROG ++- PCL::|(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| ++- PCL::OPTIMIZE-SLOT-VALUE WALKER::WALK-MULTIPLE-VALUE-BIND ++- PCL::|(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| ++- PCL::STANDARD-COMPUTE-EFFECTIVE-METHOD WALKER::WALK-LOCALLY ++- PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| ++- WALKER::WALK-DO* ++- PCL::|(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| ++- PCL::MAKE-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++- PCL::EMIT-BOUNDP-CHECK WALKER::RECONS ++- PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| ++- PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| ++- WALKER::WALK-LET* WALKER::WALK-TAGBODY-1 PCL::FLUSH-CACHE-TRAP ++- WALKER::WALK-FLET ++- PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| ++- PCL::|(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| ++- PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| ++- PCL::PRINT-CACHE ++- PCL::|(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| ++- PCL::INVALIDATE-WRAPPER PCL::GET-NEW-FUNCTION-GENERATOR ++- ITERATE::OPTIMIZE-ITERATE-FORM WALKER::RELIST-INTERNAL ++- PCL::CAN-OPTIMIZE-ACCESS PCL::MAKE-TOP-LEVEL-FORM ++- PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| ++- WALKER::WALK-MULTIPLE-VALUE-SETQ WALKER::WALK-LABELS ++- PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| ++- PCL::|(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| ++- PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| ++- WALKER::WALK-SETQ WALKER::WALK-LET ++- PCL::|SETF PCL METHOD-FUNCTION-GET| WALKER::WALK-IF ++- PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| ++- ITERATE::SIMPLE-EXPAND-GATHERING-FORM ++- PCL::|(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| ++- WALKER::WALK-NAMED-LAMBDA PCL::FIRST-FORM-TO-LISP ++- PCL::ONE-CLASS-DFUN-INFO ++- WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL ++- PCL::EMIT-GREATER-THAN-1-DLAP PCL::CONVERT-TABLE ++- PCL::|(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| ++- PCL::INITIALIZE-INTERNAL-SLOT-GFS* ++- ITERATE::OPTIMIZE-GATHERING-FORM ++- PCL::|(FAST-METHOD SPECIALIZER-CLASS (CLASS))| ++- PCL::OPTIMIZE-SLOT-BOUNDP ++- PCL::|(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| ++- PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| ++- PCL::WRAP-METHOD-GROUP-SPECIFIER-BINDINGS ++- WALKER::WALK-SYMBOL-MACROLET ITERATE::VARIABLE-SAME-P ++- PCL::EMIT-SLOT-READ-FORM ++- PCL::SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P ++- PCL::|(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| ++- PCL::GET-FUNCTION-GENERATOR ++- PCL::MAKE-OPTIMIZED-STD-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION ++- PCL::FIX-SLOT-ACCESSORS ++- PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| ++- PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| ++- PCL::OPTIMIZE-GF-CALL-INTERNAL ++- PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| ++- PCL::|(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| ++- PCL::|(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| ++- PCL::|(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| ++- PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++- PCL::|(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++- WALKER::WALK-PROG* PCL::ONE-INDEX-DFUN-INFO ++- PCL::COMPUTE-PRECEDENCE PCL::TRACE-EMF-CALL-INTERNAL ++- WALKER::WALK-MACROLET)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::*) ++- COMMON-LISP::T) ++- PCL::MAKE-DEFMETHOD-FORM-INTERNAL PCL::LOAD-DEFMETHOD ++- PCL::EARLY-MAKE-A-METHOD PCL::MAKE-DEFMETHOD-FORM)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::T) ++- PCL::GET-EFFECTIVE-METHOD-FUNCTION1 ++- PCL::ENSURE-GENERIC-FUNCTION-USING-CLASS ++- PCL::MAKE-EMF-FROM-METHOD ++- PCL::REAL-ENSURE-GF-USING-CLASS--NULL PCL::PROBE-CACHE ++- PCL::MAP-CACHE PCL::GET-DECLARATION ++- PCL::REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION ++- WALKER::CONVERT-MACRO-TO-LAMBDA ++- PCL::EXPAND-EFFECTIVE-METHOD-FUNCTION PCL::EMIT-MISS ++- PCL::GET-METHOD-FUNCTION-PV-CELL PCL::METHOD-FUNCTION-GET ++- PCL::FIND-CLASS-FROM-CELL PCL::RECORD-DEFINITION ++- PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION1 ++- PCL::FIND-CLASS-PREDICATE-FROM-CELL ++- PCL::NAMED-OBJECT-PRINT-FUNCTION ++- PCL::PRECOMPUTE-EFFECTIVE-METHODS PCL::INITIALIZE-INFO ++- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::T) ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| ++- PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL1 ++- PCL::GET-MAKE-INSTANCE-FUNCTION-INTERNAL ++- PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS1 PCL::MAKE-EMF-CACHE ++- PCL::|(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| ++- PCL::MAKE-FGEN ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| ++- PCL::BOOTSTRAP-MAKE-SLOT-DEFINITIONS ++- PCL::|(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| ++- PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++- PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++- PCL::OPTIMIZE-ACCESSOR-CALL ++- PCL::MAKE-INSTANCE-FUNCTION-COMPLEX PCL::UPDATE-SLOTS-IN-PV ++- PCL::COMPUTE-PV-SLOT ++- PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| ++- PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| ++- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| ++- PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T T))| ++- PCL::OPTIMIZE-INSTANCE-ACCESS ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| ++- PCL::MAKE-INSTANCE-FUNCTION-SIMPLE ++- PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++- PCL::OPTIMIZE-GENERIC-FUNCTION-CALL ++- PCL::LOAD-FUNCTION-GENERATOR WALKER::WALK-BINDINGS-1 ++- PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| ++- PCL::REAL-MAKE-METHOD-INITARGS-FORM ++- PCL::|(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| ++- PCL::|(FAST-METHOD REMOVE-NAMED-METHOD (T T))| ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| ++- WALKER::WALK-TEMPLATE-HANDLE-REPEAT ++- PCL::MAKE-PARAMETER-REFERENCES ++- PCL::|(FAST-METHOD SLOT-UNBOUND (T T T))| ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| ++- PCL::EXPAND-EMF-CALL-METHOD ++- PCL::|(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| ++- PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| ++- PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| ++- PCL::MAKE-FINAL-ORDINARY-DFUN-INTERNAL)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::*) ++- COMMON-LISP::T) ++- PCL::GET-METHOD WALKER::WALK-ARGLIST PCL::REAL-GET-METHOD ++- PCL::EMIT-FETCH-WRAPPER PCL::CHECK-INITARGS-2-LIST ++- PCL::FILL-CACHE PCL::CHECK-INITARGS-2-PLIST PCL::MAKE-EMF-CALL ++- PCL::CHECK-INITARGS-1 PCL::CAN-OPTIMIZE-ACCESS1)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::T) ++- PCL::GET-SECONDARY-DISPATCH-FUNCTION2)) +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) +++ PCL::EMIT-N-N-WRITERS PCL::COUNT-ALL-DFUNS +++ PCL::EMIT-N-N-READERS)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::T) ++- PCL::REAL-LOAD-DEFCLASS PCL::LOAD-DEFCLASS PCL::SET-ARG-INFO1 ++- PCL::BOOTSTRAP-MAKE-SLOT-DEFINITION PCL::EMIT-SLOT-ACCESS ++- WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1 PCL::OPTIMIZE-GF-CALL ++- PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++- PCL::MAKE-EARLY-CLASS-DEFINITION)) +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +++ PCL::GET-EFFECTIVE-METHOD-GENSYM PCL::RENEW-SYS-FILES +++ PCL::UPDATE-DISPATCH-DFUNS PCL::IN-THE-COMPILER-P +++ PCL::SHOW-FREE-CACHE-VECTORS PCL::BOOTSTRAP-BUILT-IN-CLASSES +++ PCL::MAKE-CACHE PCL::ALLOCATE-FUNCALLABLE-INSTANCE-2 +++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE-1 +++ PCL::STRUCTURE-FUNCTIONS-EXIST-P PCL::NO-METHODS-DFUN-INFO +++ PCL::SHOW-EMF-CALL-TRACE PCL::INITIAL-DFUN-INFO +++ PCL::DISPATCH-DFUN-INFO PCL::MAKE-ARG-INFO +++ PCL::INITIALIZE-CHECKING-OR-CACHING-FUNCTION-LIST +++ PCL::%%ALLOCATE-INSTANCE--CLASS +++ PCL::INITIAL-DISPATCH-DFUN-INFO PCL::CACHES-TO-ALLOCATE +++ PCL::MAKE-CPD PCL::LIST-ALL-DFUNS PCL::SHOW-DFUN-CONSTRUCTORS +++ PCL::BOOTSTRAP-META-BRAID PCL::DEFAULT-METHOD-ONLY-DFUN-INFO)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::FIXNUM) ++- COMMON-LISP::T) ++- PCL::GET-CACHE PCL::FILL-CACHE-FROM-CACHE-P)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::BOOLEAN) +++ PCL::CACHE-VALUEP)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::*) ++- COMMON-LISP::FIXNUM) ++- PCL::COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) PCL::FIELD-TYPE) +++ PCL::CACHE-FIELD)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++- PCL::EVAL-FORM PCL::EARLY-CLASS-NAME-OF PCL::DFUN-INFO-CACHE ++- PCL::MAKE-CONSTANT-FUNCTION PCL::EXPAND-SHORT-DEFCOMBIN ++- PCL::COPY-CACHE PCL::PROCLAIM-INCOMPATIBLE-SUPERCLASSES ++- PCL::MAKE-INITIAL-DFUN PCL::ECD-METACLASS ++- PCL::EXTRACT-SPECIALIZER-NAMES PCL::GBOUNDP ++- PCL::GET-SETF-FUNCTION-NAME PCL::USE-CACHING-DFUN-P ++- PCL::INITIALIZE-INFO-CACHED-CONSTANTS ++- PCL::STRUCTURE-TYPE-INTERNAL-SLOTDS COMMON-LISP::CLASS-OF ++- PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-NIL-FUNCTION ++- PCL::ARG-INFO-KEY/REST-P PCL::METHOD-CALL-CALL-METHOD-ARGS ++- PCL::FGEN-GENSYMS PCL::EARLY-CLASS-PRECEDENCE-LIST ++- PCL::EARLY-SLOT-DEFINITION-LOCATION ++- PCL::EXPAND-MAKE-INSTANCE-FORM PCL::INTERN-EQL-SPECIALIZER ++- PCL::METHOD-FUNCTION-METHOD PCL::FGEN-GENERATOR-LAMBDA ++- PCL::SLOT-READER-SYMBOL PCL::CACHING-P ++- PCL::EARLY-METHOD-QUALIFIERS ++- PCL::EARLY-COLLECT-DEFAULT-INITARGS PCL::KEYWORD-SPEC-NAME ++- PCL::ONE-INDEX-P PCL::COMPLICATED-INSTANCE-CREATION-METHOD ++- PCL::DFUN-ARG-SYMBOL PCL::N-N-CACHE ++- PCL::ONE-INDEX-DFUN-INFO-INDEX PCL::INITIAL-DISPATCH-CACHE ++- PCL::CPD-CLASS PCL::FAST-METHOD-CALL-ARG-INFO ++- PCL::MAKE-PV-TYPE-DECLARATION PCL::COMPUTE-STD-CPL-PHASE-2 ++- PCL::GET-BUILT-IN-CLASS-SYMBOL ++- PCL::INITIALIZE-INFO-CACHED-RI-VALID-P ++- PCL::UPDATE-GFS-OF-CLASS PCL::STRUCTURE-SVUC-METHOD ++- PCL::SLOT-BOUNDP-SYMBOL PCL::FGEN-SYSTEM ++- PCL::FIND-CYCLE-REASONS ITERATE::SEQUENCE-ACCESSOR ++- PCL::GF-INFO-C-A-M-EMF-STD-P PCL::STRUCTURE-TYPE-P ++- PCL::TWO-CLASS-CACHE PCL::METHOD-LL->GENERIC-FUNCTION-LL ++- PCL::ONE-CLASS-ACCESSOR-TYPE PCL::WRAPPER-FOR-STRUCTURE ++- PCL::ACCESSOR-DFUN-INFO-CACHE PCL::%SYMBOL-FUNCTION ++- PCL::STRUCTURE-TYPE PCL::NET-TEST-CONVERTER ++- PCL::CONSTANT-SYMBOL-P PCL::GMAKUNBOUND PCL::INITIAL-P ++- PCL::GF-DFUN-CACHE PCL::STRUCTURE-SLOTD-TYPE ++- PCL::%STD-INSTANCE-WRAPPER PCL::INITIALIZE-INFO-P ++- PCL::CACHING-DFUN-INFO ++- PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++- PCL::FAST-METHOD-CALL-P PCL::GF-DFUN-INFO ++- PCL::INITIALIZE-INFO-BOUND-SLOTS PCL::ECD-CLASS-NAME ++- PCL::MAKE-INSTANCE-FUNCTION-SYMBOL ++- PCL::INITIALIZE-INFO-CACHED-DEFAULT-INITARGS-FUNCTION ++- PCL::STD-INSTANCE-P PCL::EXTRACT-PARAMETERS ++- WALKER::GET-WALKER-TEMPLATE PCL::SYMBOL-PKG-NAME ++- PCL::CCLOSUREP PCL::LOOKUP-FGEN PCL::CPD-SUPERS ++- PCL::ARG-INFO-KEYWORDS PCL::DISPATCH-P ++- PCL::INITIALIZE-INFO-CACHED-NEW-KEYS ++- PCL::MAKE-CALLS-TYPE-DECLARATION PCL::INITIALIZE-INFO-WRAPPER ++- PCL::%FBOUNDP PCL::DEFAULT-STRUCTURE-INSTANCE-P ++- WALKER::ENV-WALK-FORM PCL::EARLY-CLASS-DEFINITION ++- PCL::SORT-CALLS PCL::EARLY-METHOD-STANDARD-ACCESSOR-SLOT-NAME ++- PCL::DISPATCH-CACHE PCL::INITIALIZE-INFO-KEY ++- PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION ++- PCL::ARG-INFO-METATYPES PCL::GF-LAMBDA-LIST ++- WALKER::ENV-LEXICAL-VARIABLES PCL::ACCESSOR-DFUN-INFO-P ++- PCL::GF-PRECOMPUTE-DFUN-AND-EMF-P PCL::COMPUTE-LINE-SIZE ++- PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-T-FUNCTION ++- PCL::FORCE-CACHE-FLUSHES PCL::TWO-CLASS-P PCL::DFUN-INFO-P ++- PCL::MAP-SPECIALIZERS PCL::MAKE-PERMUTATION-VECTOR ++- WALKER::ENV-LOCK PCL::CPD-AFTER PCL::EARLY-CLASS-SLOTS ++- PCL::GET-PV-CELL-FOR-CLASS PCL::ARG-INFO-P ++- PCL::EXTRACT-REQUIRED-PARAMETERS ++- PCL::STRUCTURE-SLOTD-READER-FUNCTION PCL::COMPUTE-CLASS-SLOTS ++- PCL::INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS ++- PCL::TWO-CLASS-WRAPPER0 ++- PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION-SYMBOL ++- PCL::COMPILE-LAMBDA-UNCOMPILED PCL::EARLY-CLASS-NAME ++- PCL::SFUN-P PCL::EXTRACT-LAMBDA-LIST PCL::UNDEFMETHOD-1 ++- PCL::ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE PCL::WRAPPER-OF ++- PCL::ARG-INFO-LAMBDA-LIST PCL::LIST-DFUN ++- PCL::NEXT-WRAPPER-FIELD PCL::CHECK-WRAPPER-VALIDITY ++- PCL::STRUCTURE-SLOTD-NAME PCL::BUILT-IN-WRAPPER-OF ++- PCL::GET-MAKE-INSTANCE-FUNCTIONS ++- PCL::GENERIC-CLOBBERS-FUNCTION PCL::NO-METHODS-P ++- PCL::CONSTANT-VALUE-P WALKER::ENV-WALK-FUNCTION ++- PCL::INITIAL-CACHE PCL::SLOT-INITARGS-FROM-STRUCTURE-SLOTD ++- PCL::MAKE-CLASS-EQ-PREDICATE ++- PCL::GET-MAKE-INSTANCE-FUNCTION-SYMBOL ++- PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS ++- PCL::FUNCTION-PRETTY-ARGLIST ++- PCL::MAKE-OPTIMIZED-STRUCTURE-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++- PCL::FTYPE-DECLARATION-FROM-LAMBDA-LIST PCL::TYPE-CLASS ++- PCL::CHECK-CACHE PCL::STANDARD-SVUC-METHOD ++- PCL::STRUCTURE-SLOTD-ACCESSOR-SYMBOL PCL::GF-INFO-FAST-MF-P ++- PCL::STRUCTURE-SLOTD-WRITER-FUNCTION ++- PCL::BOOTSTRAP-CLASS-PREDICATES PCL::DEFAULT-METHOD-ONLY-CACHE ++- PCL::GET-CACHE-VECTOR PCL::SLOT-WRITER-SYMBOL ++- PCL::FGEN-GENERATOR PCL::DNET-METHODS-P ++- PCL::DEFAULT-STRUCTURE-TYPE ++- PCL::INITIALIZE-INFO-CACHED-COMBINED-INITARGS-FORM-LIST ++- PCL::N-N-ACCESSOR-TYPE ++- PCL::STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST ++- WALKER::ENV-DECLARATIONS WALKER::VARIABLE-GLOBALLY-SPECIAL-P ++- PCL::ONE-INDEX-INDEX PCL::ONE-INDEX-DFUN-INFO-CACHE ++- PCL::EARLY-ACCESSOR-METHOD-SLOT-NAME PCL::EARLY-CLASS-SLOTDS ++- PCL::CANONICAL-SLOT-NAME PCL::EARLY-COLLECT-CPL ++- PCL::RESET-CLASS-INITIALIZE-INFO-1 ++- PCL::BUILT-IN-OR-STRUCTURE-WRAPPER1 PCL::ONE-INDEX-CACHE ++- PCL::MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION ++- PCL::MAKE-TYPE-PREDICATE PCL::FREE-CACHE ++- ITERATE::VARIABLES-FROM-LET ++- PCL::EARLY-METHOD-STANDARD-ACCESSOR-P ++- PCL::DEFAULT-CONSTANT-CONVERTER PCL::CLASS-PREDICATE ++- PCL::CHECKING-CACHE PCL::ARG-INFO-PRECEDENCE ++- PCL::METHOD-FUNCTION-NEEDS-NEXT-METHODS-P ++- PCL::DEFAULT-METHOD-ONLY-P ++- PCL::COMPUTE-APPLICABLE-METHODS-EMF-STD-P ++- PCL::STRUCTURE-SLOT-BOUNDP PCL::ONE-INDEX-ACCESSOR-TYPE ++- PCL::TWO-CLASS-ACCESSOR-TYPE ++- PCL::USE-DEFAULT-METHOD-ONLY-DFUN-P PCL::METHOD-CALL-P ++- PCL::UPDATE-CLASS-CAN-PRECEDE-P PCL::CONSTANT-VALUE-DFUN-INFO ++- PCL::COMPILE-LAMBDA-DEFERRED PCL::SETFBOUNDP ++- PCL::CLASS-HAS-A-FORWARD-REFERENCED-SUPERCLASS-P ++- PCL::PV-TABLEP PCL::STRUCTURE-OBJECT-P PCL::TWO-CLASS-INDEX ++- PCL::METHOD-FUNCTION-PV-TABLE PCL::ECD-OTHER-INITARGS ++- WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE ++- PCL::EARLY-GF-P PCL::STRUCTURE-SLOTD-INIT-FORM ++- PCL::FUNCALLABLE-INSTANCE-P PCL::CHECKING-FUNCTION ++- PCL::FUNCTION-RETURNING-NIL PCL::FUNCTION-RETURNING-T ++- PCL::UPDATE-C-A-M-GF-INFO PCL::COUNT-DFUN ++- PCL::UNPARSE-SPECIALIZERS PCL::CACHE-OWNER ++- PCL::EARLY-METHOD-CLASS ++- PCL::INITIALIZE-INFO-CACHED-COMBINED-INITIALIZE-FUNCTION ++- PCL::EARLY-SLOT-DEFINITION-NAME ++- PCL::GET-MAKE-INSTANCE-FUNCTION ++- PCL::STRUCTURE-TYPE-INCLUDED-TYPE-NAME ++- PCL::ECD-SUPERCLASS-NAMES PCL::GFS-OF-TYPE PCL::SORT-SLOTS ++- PCL::DO-STANDARD-DEFSETFS-FOR-DEFCLASS ++- PCL::COMPUTE-MCASE-PARAMETERS PCL::METHOD-FUNCTION-PLIST ++- PCL::ARG-INFO-NKEYS PCL::FINAL-ACCESSOR-DFUN-TYPE ++- PCL::EARLY-COLLECT-SLOTS PCL::EARLY-METHOD-LAMBDA-LIST ++- PCL::FAST-INSTANCE-BOUNDP-P PCL::GDEFINITION ++- PCL::%CCLOSURE-ENV SYSTEM::%COMPILED-FUNCTION-NAME ++- PCL::RESET-INITIALIZE-INFO PCL::ARG-INFO-NUMBER-OPTIONAL ++- PCL::RESET-CLASS-INITIALIZE-INFO ++- PCL::INITIALIZE-INFO-CACHED-VALID-P PCL::INTERNED-SYMBOL-P ++- PCL::EARLY-GF-NAME PCL::FGEN-TEST PCL::MAKE-INITFUNCTION ++- PCL::MAP-ALL-GENERIC-FUNCTIONS PCL::SHOW-DFUN-COSTS ++- PCL::CLASS-FROM-TYPE PCL::EXPAND-LONG-DEFCOMBIN ++- PCL::MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION ++- PCL::FREE-CACHE-VECTOR PCL::%STD-INSTANCE-SLOTS ++- PCL::ALLOCATE-CACHE-VECTOR PCL::ONE-CLASS-P ++- PCL::CLASS-PRECEDENCE-DESCRIPTION-P PCL::SLOT-VECTOR-SYMBOL ++- PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION ++- PCL::ONE-CLASS-WRAPPER0 PCL::N-N-P ++- PCL::UPDATE-ALL-C-A-M-GF-INFO PCL::CHECKING-P ++- PCL::TWO-CLASS-WRAPPER1 PCL::PARSE-SPECIALIZERS ++- PCL::FORMAT-CYCLE-REASONS PCL::FLUSH-CACHE-VECTOR-INTERNAL ++- PCL::UNENCAPSULATED-FDEFINITION PCL::ONE-CLASS-INDEX ++- PCL::DEFAULT-CONSTANTP PCL::UPDATE-GF-INFO ++- PCL::ACCESSOR-DFUN-INFO-ACCESSOR-TYPE ++- PCL::INITIALIZE-INFO-CACHED-INITARGS-FORM-LIST ++- PCL::MAKE-EQL-PREDICATE PCL::ARG-INFO-VALID-P ++- PCL::CACHING-CACHE PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION ++- PCL::FAST-METHOD-CALL-NEXT-METHOD-CALL ++- PCL::DEFAULT-SECONDARY-DISPATCH-FUNCTION ++- PCL::MAKE-FUNCTION-INLINE PCL::STORE-FGEN ++- PCL::LIST-LARGE-CACHE PCL::METHODS-CONTAIN-EQL-SPECIALIZER-P ++- PCL::ARG-INFO-APPLYP SYSTEM::%STRUCTURE-NAME ++- PCL::GF-INFO-SIMPLE-ACCESSOR-TYPE PCL::ECD-SOURCE ++- PCL::EARLY-CLASS-DIRECT-SUBCLASSES ++- PCL::UPDATE-PV-TABLE-CACHE-INFO PCL::DEFAULT-TEST-CONVERTER ++- PCL::MAKE-CALL-METHODS PCL::GET-BUILT-IN-WRAPPER-SYMBOL ++- PCL::GF-INFO-STATIC-C-A-M-EMF PCL::DEFAULT-STRUCTUREP ++- PCL::CONSTANT-VALUE-CACHE PCL::INITIAL-DISPATCH-P ++- PCL::ECD-CANONICAL-SLOTS PCL::WRAPPER-FIELD ++- PCL::UPDATE-GF-SIMPLE-ACCESSOR-TYPE PCL::ONE-CLASS-CACHE ++- PCL::CACHING-DFUN-COST PCL::LEGAL-CLASS-NAME-P ++- PCL::INTERN-FUNCTION-NAME PCL::FAST-METHOD-CALL-PV-CELL ++- PCL::CACHE-P PCL::ONE-INDEX-DFUN-INFO-P ++- PCL::MAKE-PV-TABLE-TYPE-DECLARATION PCL::NO-METHODS-CACHE)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) +++ PCL::ONE-INDEX-LIMIT-FN PCL::EARLY-CLASS-SIZE PCL::CACHE-COUNT +++ PCL::PV-TABLE-PV-SIZE PCL::DEFAULT-LIMIT-FN +++ PCL::CHECKING-LIMIT-FN PCL::CACHING-LIMIT-FN +++ PCL::N-N-ACCESSORS-LIMIT-FN PCL::CPD-COUNT +++ PCL::FAST-INSTANCE-BOUNDP-INDEX PCL::ARG-INFO-NUMBER-REQUIRED +++ PCL::PV-CACHE-LIMIT-FN)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++- PCL::UPDATE-MAKE-INSTANCE-FUNCTION-TABLE PCL::UNTRACE-METHOD ++- COMMON-LISP::METHOD-COMBINATION-ERROR ++- COMMON-LISP::INVALID-METHOD-ERROR PCL::LIST-LARGE-CACHES)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) +++ PCL::POWER-OF-TWO-CEILING)) +++(COMMON-LISP::MAPC +++ (COMMON-LISP::LAMBDA (COMPILER::X) +++ (COMMON-LISP::SETF +++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) +++ COMMON-LISP::T)) +++ '(PCL::TRACE-METHOD-INTERNAL PCL::FDEFINE-CAREFULLY +++ PCL::REDEFINE-FUNCTION PCL::DO-STANDARD-DEFSETF-1)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::T) ++- PCL::EMIT-DLAP PCL::GET-SECONDARY-DISPATCH-FUNCTION1)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) +++ PCL::MAKE-CLASS-PREDICATE-NAME PCL::MAKE-KEYWORD)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T ++- (COMMON-LISP::INTEGER -9223372036854775808 ++- 9223372036854775807)) ++- COMMON-LISP::T) ++- PCL::COMPUTE-STD-CPL-PHASE-3)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ (COMMON-LISP::INTEGER 1 255)) +++ PCL::CACHE-NKEYS)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T) ++- COMMON-LISP::T) ++- PCL::EXPAND-DEFMETHOD PCL::LOAD-DEFMETHOD-INTERNAL)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ (COMMON-LISP::INTEGER 1 256)) +++ PCL::CACHE-LINE-SIZE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::*) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM COMMON-LISP::T) ++ COMMON-LISP::T) ++- PCL::BOOTSTRAP-INITIALIZE-CLASS)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::LIST) ++- PCL::PV-TABLE-CALL-LIST PCL::CACHE-OVERFLOW ++- PCL::PV-TABLE-SLOT-NAME-LISTS)) +++ PCL::%CCLOSURE-ENV-NTHCDR)) ++ (IN-PACKAGE "PCL") ++ ++-(DOLIST (V '(|(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-METHODS)| +++(DOLIST (V '(|(FAST-WRITER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-METHODS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT SLOTS)| ++ |(FAST-WRITER-METHOD SLOT-CLASS SLOTS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SLOTS)| ++ |(FAST-WRITER-METHOD SLOT-CLASS DIRECT-SLOTS)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT METHODS)| ++ |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHODS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT OPTIONS)| ++@@ -1063,16 +1148,17 @@ ++ COMPATIBLE-META-CLASS-CHANGE-P ++ |(FAST-READER-METHOD SLOT-OBJECT CLASS-EQ-SPECIALIZER)| ++ |(FAST-READER-METHOD CLASS CLASS-EQ-SPECIALIZER)| ++- |(BOUNDP READER-FUNCTION)| |(BOUNDP PREDICATE-NAME)| ++- |(BOUNDP READERS)| UPDATE-GF-DFUN ++- |(BOUNDP CLASS-PRECEDENCE-LIST)| +++ |(BOUNDP READER-FUNCTION)| TRACE-METHOD-INTERNAL +++ |(BOUNDP PREDICATE-NAME)| |(BOUNDP READERS)| +++ UPDATE-GF-DFUN |(BOUNDP CLASS-PRECEDENCE-LIST)| ++ |(BOUNDP ACCESSOR-FLAGS)| |(BOUNDP LOCATION)| ++ |(BOUNDP DOCUMENTATION)| SPECIALIZER-OBJECT ++ |(BOUNDP INCOMPATIBLE-SUPERCLASS-LIST)| ++ ACCESSOR-METHOD-SLOT-NAME |(BOUNDP SPECIALIZERS)| ++ |(BOUNDP IDENTITY-WITH-ONE-ARGUMENT)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)| ++- SPECIALIZER-CLASS |(BOUNDP PRETTY-ARGLIST)| +++ REDEFINE-FUNCTION SPECIALIZER-CLASS +++ |(BOUNDP PRETTY-ARGLIST)| ++ |PCL::PCL-CLASS class predicate| ++ |PCL::STD-CLASS class predicate| ++ |(BOUNDP DEFSTRUCT-FORM)| ++@@ -1110,104 +1196,104 @@ ++ |(BOUNDP OPTIONS)| |(WRITER METHOD)| ++ |PCL::DEPENDENT-UPDATE-MIXIN class predicate| ++ GENERIC-FUNCTION-PRETTY-ARGLIST |(WRITER SOURCE)| ++- |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| ++- |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| ++ |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| ++- |(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| +++ |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| ++ |(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))| +++ |(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| +++ |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| ++ |(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))| +++ |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| ++ |(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| ++- |(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| ++- |(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| ++- |(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| ++ |(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| ++- |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| +++ |(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| +++ |(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| +++ |(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| ++ MAKE-BOUNDP-METHOD-FUNCTION ++ |(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| ++ |(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| ++ |PCL::METAOBJECT class predicate| ++- |(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| ++- |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| ++- |(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| ++- |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| ++- |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| +++ |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +++ |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +++ |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +++ |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +++ |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +++ |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| +++ |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| +++ |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| +++ |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| ++ |(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| ++- |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| ++- |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| ++- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++- |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| ++- |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| ++- |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| +++ |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| ++ |(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| +++ |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +++ |(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++ |(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| ++- |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| ++- |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| ++- |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| ++- |(FAST-METHOD CHANGE-CLASS (T SYMBOL))| ++- |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| ++ |(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++- |(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++- |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| +++ |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| +++ |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| +++ |(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| +++ |(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| +++ |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| +++ |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| +++ |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| +++ |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| +++ |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| +++ |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| +++ |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| +++ |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| +++ |(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| ++- |(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| ++- |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| ++- |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| +++ |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD MAKE-INSTANCE (SYMBOL))| ++- |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +++ |(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| +++ |(FAST-METHOD CHANGE-CLASS (T SYMBOL))| ++ |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD SPECIALIZER-CLASS (CLASS))| ++- |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| ++- |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| ++- |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| ++- |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| ++- |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +++ |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| ++ |(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++- |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| ++- |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| ++- |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| ++ |(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++- |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++- |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| ++- |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| ++- |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| ++- |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| ++- |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| ++- |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| +++ |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| +++ |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| ++ |(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| ++- |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| +++ |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| +++ |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| +++ |(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| +++ |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| +++ |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| +++ |(FAST-METHOD SPECIALIZER-CLASS (CLASS))| +++ |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| +++ |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| ++ |(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| ++- |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| +++ |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| +++ |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| +++ |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| +++ |(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| +++ |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| ++ |(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| +++ |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| ++ |(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| ++- |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| ++- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| ++- |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| ++- |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| ++- |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| ++- |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| +++ |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| +++ |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| +++ |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| +++ |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +++ |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| +++ |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| +++ |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| +++ |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| +++ |(FAST-METHOD MAKE-INSTANCE (CLASS))| +++ |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| ++ |(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| ++ |(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| ++- |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| ++- |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| ++- |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| ++- |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| ++- |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| +++ |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| +++ |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| +++ |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| +++ |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| +++ |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| +++ |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| ++- |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| ++- |(FAST-METHOD MAKE-INSTANCE (CLASS))| +++ |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| ++ |(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| ++- |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| ++- |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| ++- |(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| ++- |(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| +++ |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| ++ CLASS-PREDICATE-NAME ++ |PCL::STRUCTURE-SLOT-DEFINITION class predicate| ++ |PCL::STRUCTURE-DIRECT-SLOT-DEFINITION class predicate| ++@@ -1233,8 +1319,8 @@ ++ |(WRITER PREDICATE-NAME)| |(WRITER READERS)| ++ |(READER WRITER-FUNCTION)| |(READER INITFUNCTION)| ++ INITIALIZE-INTERNAL-SLOT-FUNCTIONS ++- |SETF PCL SLOT-DEFINITION-TYPE| ++- |(WRITER CLASS-PRECEDENCE-LIST)| |(READER WRITERS)| +++ |SETF PCL SLOT-DEFINITION-TYPE| |(READER WRITERS)| +++ |(WRITER CLASS-PRECEDENCE-LIST)| ++ |(WRITER ACCESSOR-FLAGS)| |(READER INITFORM)| ++ METHOD-COMBINATION-P |(WRITER LOCATION)| ++ |(WRITER DOCUMENTATION)| ++@@ -1248,11 +1334,11 @@ ++ |(READER ALLOCATION)| |(WRITER SPECIALIZERS)| ++ |(CALL REAL-ENSURE-GF-USING-CLASS--NULL)| ++ |(WRITER IDENTITY-WITH-ONE-ARGUMENT)| ++- |(SETF METHOD-GENERIC-FUNCTION)| LEGAL-SPECIALIZERS-P ++- |(WRITER PRETTY-ARGLIST)| |SETF PCL OBJECT-PLIST| ++- |(WRITER DEFSTRUCT-FORM)| |(READER FUNCTION)| ++- |(READER GENERIC-FUNCTION)| |(READER LAMBDA-LIST)| ++- |(READER SLOT-DEFINITION)| +++ |(SETF METHOD-GENERIC-FUNCTION)| +++ |(WRITER PRETTY-ARGLIST)| LEGAL-SPECIALIZERS-P +++ |SETF PCL OBJECT-PLIST| |(WRITER DEFSTRUCT-FORM)| +++ |(READER FUNCTION)| |(READER GENERIC-FUNCTION)| +++ |(READER LAMBDA-LIST)| |(READER SLOT-DEFINITION)| ++ |PCL::CLASS-PROTOTYPE-SPECIALIZER class predicate| ++ |SETF PCL SLOT-DEFINITION-INITFORM| ++ |SETF PCL CLASS-DEFSTRUCT-FORM| ++@@ -1273,17 +1359,16 @@ ++ |SETF PCL SLOT-DEFINITION-ALLOCATION| ++ |SETF PCL SLOT-DEFINITION-INITFUNCTION| ++ |(WRITER SLOT-NAME)| |(BOUNDP NAME)| ++- |(WRITER ALLOCATION)| |(READER FAST-FUNCTION)| +++ |(READER FAST-FUNCTION)| |(WRITER ALLOCATION)| ++ |(READER METHOD-CLASS)| |(SETF OBJECT-PLIST)| ++ |(READER INTERNAL-WRITER-FUNCTION)| ++ |(READER INTERNAL-READER-FUNCTION)| ++ |(READER METHOD-COMBINATION)| ++ METHOD-COMBINATION-OPTIONS |(READER DIRECT-SLOTS)| ++ |(READER DIRECT-METHODS)| ++- |SETF PCL SLOT-DEFINITION-READERS| ++- |(READER BOUNDP-FUNCTION)| |(WRITER FUNCTION)| ++- |(WRITER GENERIC-FUNCTION)| |SETF PCL DOCUMENTATION| ++- |(READER DIRECT-SUBCLASSES)| +++ |SETF PCL SLOT-DEFINITION-READERS| |(WRITER FUNCTION)| +++ |(WRITER GENERIC-FUNCTION)| |(READER BOUNDP-FUNCTION)| +++ |SETF PCL DOCUMENTATION| |(READER DIRECT-SUBCLASSES)| ++ |(READER DIRECT-SUPERCLASSES)| |(WRITER LAMBDA-LIST)| ++ FUNCALLABLE-STANDARD-CLASS-P ++ |(FAST-WRITER-METHOD SLOT-OBJECT METHOD)| ++@@ -1294,7 +1379,7 @@ ++ |SETF PCL SLOT-VALUE-USING-CLASS| ++ |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)| ++ |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)| ++- |(WRITER PROTOTYPE)| |(BOUNDP OBJECT)| |(BOUNDP TYPE)| +++ |(WRITER PROTOTYPE)| |(BOUNDP TYPE)| |(BOUNDP OBJECT)| ++ CLASS-CAN-PRECEDE-LIST |SETF PCL CLASS-DIRECT-SLOTS| ++ |SETF PCL CLASS-SLOTS| SLOT-ACCESSOR-FUNCTION ++ |(BOUNDP PLIST)| ++@@ -1309,11 +1394,11 @@ ++ |(FAST-WRITER-METHOD SLOT-OBJECT ARG-INFO)| ++ |PCL::PLIST-MIXIN class predicate| ++ |(WRITER FAST-FUNCTION)| |(WRITER METHOD-CLASS)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT WRAPPER)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT WRAPPER)| GET-METHOD ++ |(WRITER INTERNAL-WRITER-FUNCTION)| ++ |(WRITER INTERNAL-READER-FUNCTION)| ++- |(WRITER METHOD-COMBINATION)| GET-METHOD ++- |(WRITER DIRECT-SLOTS)| |(WRITER DIRECT-METHODS)| +++ |(WRITER METHOD-COMBINATION)| |(WRITER DIRECT-SLOTS)| +++ |(WRITER DIRECT-METHODS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT INITARGS)| ++ |(FAST-WRITER-METHOD SLOT-DEFINITION INITARGS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT OPERATOR)| ++@@ -1383,18 +1468,18 @@ ++ |(FAST-READER-METHOD SLOT-DEFINITION READERS)| ++ |(FAST-READER-METHOD SLOT-OBJECT SPECIALIZERS)| ++ |(FAST-READER-METHOD STANDARD-METHOD SPECIALIZERS)| ++- |(FAST-READER-METHOD SHORT-METHOD-COMBINATION IDENTITY-WITH-ONE-ARGUMENT)| ++- |(FAST-READER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| ++ |(FAST-READER-METHOD SPECIALIZER TYPE)| ++ |(FAST-READER-METHOD SLOT-OBJECT PROTOTYPE)| ++ |(FAST-READER-METHOD PCL-CLASS PROTOTYPE)| +++ |(FAST-READER-METHOD SLOT-DEFINITION TYPE)| +++ |(FAST-READER-METHOD SLOT-OBJECT TYPE)| +++ |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION TYPE)| +++ |(FAST-READER-METHOD SHORT-METHOD-COMBINATION IDENTITY-WITH-ONE-ARGUMENT)| +++ |(FAST-READER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| ++ |(FAST-READER-METHOD CLASS-EQ-SPECIALIZER OBJECT)| ++ |(FAST-READER-METHOD CLASS-PROTOTYPE-SPECIALIZER OBJECT)| ++ |(FAST-READER-METHOD SLOT-OBJECT OBJECT)| ++ |(FAST-READER-METHOD EQL-SPECIALIZER OBJECT)| ++- |(FAST-READER-METHOD SLOT-DEFINITION TYPE)| ++- |(FAST-READER-METHOD SLOT-OBJECT TYPE)| ++- |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION TYPE)| ++ |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| ++ |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)| ++ |(FAST-READER-METHOD SLOT-OBJECT INITFORM)| ++@@ -1416,11 +1501,11 @@ ++ |(FAST-READER-METHOD SLOT-CLASS SLOTS)| ++ |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SLOTS)| ++ |(FAST-READER-METHOD SLOT-CLASS DIRECT-SLOTS)| ++- |(FAST-READER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| ++ |(FAST-READER-METHOD SLOT-OBJECT METHODS)| ++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHODS)| ++ |(FAST-READER-METHOD SLOT-OBJECT OPTIONS)| ++ |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION OPTIONS)| +++ |(FAST-READER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| ++ |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)| ++ |(FAST-READER-METHOD CLASS DIRECT-SUBCLASSES)| ++ |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)| ++@@ -1458,8 +1543,8 @@ ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT READERS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT SPECIALIZERS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT PROTOTYPE)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT OBJECT)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT TYPE)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT OBJECT)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT INITFORM)| ++ |(SETF SLOT-VALUE-USING-CLASS)| ++@@ -1485,10 +1570,10 @@ ++ |(SETF SLOT-DEFINITION-TYPE)| ++ |(SETF SLOT-DEFINITION-INITFORM)| ++ |(BOUNDP INITIALIZE-INFO)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-METHODS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOTS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SLOTS)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT METHODS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT OPTIONS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)| ++@@ -1498,94 +1583,94 @@ ++ GENERIC-FUNCTION-P ++ |PCL::SLOT-DEFINITION class predicate| |(READER NAME)| ++ |(READER CLASS)| ++- |(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| ++- |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| ++- |(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| ++- |(FAST-METHOD DESCRIBE-OBJECT (T T))| ++- |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| +++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| +++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| +++ |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| +++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| +++ |(FAST-METHOD SLOT-UNBOUND (T T T))| +++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| +++ |(FAST-METHOD REMOVE-NAMED-METHOD (T T))| +++ |(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| +++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| +++ |(FAST-METHOD (SETF DOCUMENTATION) (T T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| +++ |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| +++ |(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| +++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| ++ |(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| ++- |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| ++- |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| ++- |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| ++- |(FAST-METHOD REMOVE-NAMED-METHOD (T T))| ++- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| ++- |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| ++- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| ++- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| +++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| +++ |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| ++ |(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| ++- |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| ++- |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| ++- |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| ++- |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| ++- |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| ++- |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| +++ |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| +++ |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| +++ |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| +++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| +++ |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +++ |(FAST-METHOD PRINT-OBJECT (CLASS T))| +++ |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| ++ |(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| +++ |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| +++ |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| +++ |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| +++ |(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +++ |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| ++ |(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| ++ |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| ++- |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| ++- |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| ++- |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| ++- |(FAST-METHOD PRINT-OBJECT (CLASS T))| ++- |(FAST-METHOD PRINT-OBJECT (T T))| ++- |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++- |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +++ |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| +++ |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| +++ |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| +++ |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| +++ |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| +++ |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| +++ |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| +++ |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| ++ |(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| ++- |(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +++ |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| ++ |(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| ++- |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| ++- |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| ++- |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| ++- |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| ++- |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| ++- |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| +++ |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +++ |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| +++ |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++ |(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| ++- |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| ++- |(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| ++- |(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| ++- |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| +++ |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| +++ |(FAST-METHOD PRINT-OBJECT (T T))| +++ |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| ++ |(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| ++- |(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| ++- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| ++- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| ++- |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++- |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| ++- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| ++- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| +++ |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| ++- |(FAST-METHOD (SETF DOCUMENTATION) (T T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| ++- |(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| ++- |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| ++- |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| +++ |(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| +++ |(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| +++ |(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| +++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| +++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| ++ |(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| +++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| +++ |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| +++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| +++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| +++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| +++ |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| +++ |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| +++ |(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| +++ |(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| ++ |(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| ++- |(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| ++- |(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| +++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| +++ |(FAST-METHOD DESCRIBE-OBJECT (T T))| ++ |(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| ++- |(FAST-METHOD SLOT-UNBOUND (T T T))| +++ |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| +++ |(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| +++ |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| ++ |(FAST-METHOD SLOT-MISSING (T T T T))| ++- |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| ++- |(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| ++- LEGAL-SLOT-NAME-P |(READER OBJECT)| |(READER TYPE)| +++ |(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| +++ LEGAL-SLOT-NAME-P |(READER TYPE)| |(READER OBJECT)| ++ CLASS-WRAPPER |(READER PLIST)| ++ |(FAST-METHOD CLASS-PREDICATE-NAME (T))| ++ |(FAST-METHOD DOCUMENTATION (T))| ++ |(FAST-METHOD NO-APPLICABLE-METHOD (T))| ++ |(READER SLOTS)| |(WRITER NAME)| DEFINITION-SOURCE ++ |PCL::SLOT-OBJECT class predicate| DEFAULT-INITARGS ++- |(WRITER CLASS)| CLASS-SLOT-VALUE |(WRITER OBJECT)| ++- |(WRITER TYPE)| +++ |(WRITER CLASS)| CLASS-SLOT-VALUE |(WRITER TYPE)| +++ |(WRITER OBJECT)| ++ |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| ++ |(WRITER PLIST)| |(WRITER SLOTS)| ++ |PCL::DOCUMENTATION-MIXIN class predicate| ++@@ -1625,10 +1710,10 @@ ++ |COMMON-LISP::STANDARD-OBJECT class predicate| ++ |COMMON-LISP::BUILT-IN-CLASS class predicate| ++ |SETF PCL CLASS-SLOT-VALUE| |(SETF CLASS-SLOTS)| ++- |(SETF CLASS-DIRECT-SLOTS)| |(READER OPERATOR)| ++- |(CALL REAL-GET-METHOD)| |(CALL REAL-REMOVE-METHOD)| ++- |(CALL REAL-ADD-METHOD)| |(READER ARG-INFO)| ++- METHOD-COMBINATION-TYPE +++ |(SETF CLASS-DIRECT-SLOTS)| DO-STANDARD-DEFSETF-1 +++ |(READER OPERATOR)| |(CALL REAL-GET-METHOD)| +++ |(CALL REAL-REMOVE-METHOD)| |(CALL REAL-ADD-METHOD)| +++ |(READER ARG-INFO)| METHOD-COMBINATION-TYPE ++ |(READER DEFSTRUCT-CONSTRUCTOR)| ++ |(INTERNAL-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)| ++ |(READER INITIALIZE-INFO)| |(WRITER WRAPPER)| ++@@ -1637,8 +1722,8 @@ ++ |(WRITER DEFSTRUCT-ACCESSOR-SYMBOL)| ++ COMPUTE-SLOT-ACCESSOR-INFO |(READER INITARGS)| ++ |(WRITER CLASS-EQ-SPECIALIZER)| ++- STANDARD-BOUNDP-METHOD-P |(SETF DOCUMENTATION)| ++- RAW-INSTANCE-ALLOCATOR +++ STANDARD-BOUNDP-METHOD-P FDEFINE-CAREFULLY +++ |(SETF DOCUMENTATION)| RAW-INSTANCE-ALLOCATOR ++ |SETF PCL SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL| ++ |SETF PCL CLASS-INITIALIZE-INFO| |(WRITER OPERATOR)| ++ |(WRITER ARG-INFO)| ++@@ -1651,9 +1736,8 @@ ++ METHOD-COMBINATION-DOCUMENTATION ++ |SETF PCL SLOT-DEFINITION-INITARGS| ++ REMOVE-BOUNDP-METHOD ADD-NAMED-METHOD ++- |(WRITER INITARGS)| ++ |SETF PCL CLASS-DEFSTRUCT-CONSTRUCTOR| ++- |(BOUNDP METHOD)| +++ |(WRITER INITARGS)| |(BOUNDP METHOD)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT PREDICATE-NAME)| ++ |(FAST-WRITER-METHOD CLASS NAME)| ++ |(FAST-WRITER-METHOD SLOT-DEFINITION NAME)| ++@@ -1699,11 +1783,11 @@ ++ |(FAST-WRITER-METHOD SLOT-OBJECT READERS)| ++ |(FAST-WRITER-METHOD SLOT-DEFINITION READERS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT SPECIALIZERS)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT PROTOTYPE)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT OBJECT)| ++ |(FAST-WRITER-METHOD SLOT-DEFINITION TYPE)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT TYPE)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT OBJECT)| ++ REMOVE-NAMED-METHOD ++ |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| ++ |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)| ++@@ -1756,5 +1840,6 @@ ++ ENSURE-CLASS-USING-CLASS NO-APPLICABLE-METHOD ++ SLOT-DEFINITION-WRITERS ++ COMPUTE-APPLICABLE-METHODS-USING-CLASSES ++- CLASS-PRECEDENCE-LIST DESCRIBE-OBJECT)) +++ CLASS-PRECEDENCE-LIST DISASSEMBLE DESCRIBE-OBJECT +++ COMPILE)) ++ (SETF (GET V 'COMPILER::PROCLAIMED-CLOSURE) T)) ++--- gcl-2.6.12.orig/unixport/sys_init.lsp.in +++++ gcl-2.6.12/unixport/sys_init.lsp.in ++@@ -79,7 +79,7 @@ ++ #+ansi-cl (use-package :pcl :user) ++ ++ (import 'si::(clines defentry defcfun object void int double quit bye gbc system ++- *lib-directory* *system-directory*) :user) +++ *lib-directory* *system-directory* while) :user) ++ ++ (let* ((i 4096)(j (si::equal-tail-recursion-check i))) ++ (unless (<= (ash i -1) j) diff --cc debian/patches/list_order.11 index 00000000,00000000..b97390c9 new file mode 100644 --- /dev/null +++ b/debian/patches/list_order.11 @@@ -1,0 -1,0 +1,600 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-53) unstable; urgency=medium ++ . ++ * list_order.9 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2017-08-23 ++ ++--- gcl-2.6.12.orig/o/print.d +++++ gcl-2.6.12/o/print.d ++@@ -35,12 +35,6 @@ int line_length = 72; ++ #define WRITEC_NEWLINE(strm) (writec_stream('\n',strm)) ++ #endif ++ ++-#define to_be_escaped(c) \ ++- (standard_readtable->rt.rt_self[(c)&0377].rte_chattrib \ ++- != cat_constituent || \ ++- isLower((c)&0377) || (c) == ':') ++- ++- ++ #define READ_TABLE_CASE (Vreadtable->s.s_dbind->rt.rt_case) ++ ++ #define mod(x) ((x)%Q_SIZE) ++@@ -637,50 +631,31 @@ constant_case(object x) { ++ } ++ ++ static int ++-all_dots(object x) { ++- ++- fixnum i; ++- ++- for (i=0;is.s_fillp;i++) ++- if (x->s.s_self[i]!='.') ++- return 0; +++needs_escape (object x) { ++ ++- return 1; ++- ++-} ++- ++-static int ++-needs_escape (object x,int pp) { ++- ++- fixnum i; ++- char ch; +++ fixnum i,all_dots=1; +++ int ch; ++ ++ if (!PRINTescape) ++ return 0; ++ ++ for (i=0;is.s_fillp;i++) ++ switch((ch=x->s.s_self[i])) { ++- case '(': ++- case ')': ++ case ':': ++- case '`': ++- case '\'': ++- case '"': ++- case ';': ++- case ',': ++- case '\n': ++ return 1; ++- case ' ': ++- if (!i) return 1; +++ case '.': +++ break; ++ default: +++ all_dots=0; +++ if (Vreadtable->s.s_dbind->rt.rt_self[ch].rte_chattrib!=cat_constituent) +++ return 1; ++ if ((READ_TABLE_CASE==sKupcase && isLower(ch)) || ++ (READ_TABLE_CASE==sKdowncase && isUpper(ch))) ++ return 1; ++ } ++ ++- if (pp) ++- if (potential_number_p(x, PRINTbase) || all_dots(x)) ++- return 1; +++ if (potential_number_p(x, PRINTbase) || all_dots) +++ return 1; ++ ++ return !x->s.s_fillp; ++ ++@@ -690,19 +665,21 @@ needs_escape (object x,int pp) { ++ #define convertible_lower(c) ((READ_TABLE_CASE==sKdowncase||READ_TABLE_CASE==sKinvert)&& isLower(c)) ++ ++ static void ++-print_symbol_name_body(object x,int pp) { +++print_symbol_name_body(object x) { ++ ++ int i,j,fc,tc,lw,k,cc; ++ ++ cc=constant_case(x); ++- k=needs_escape(x,pp); +++ k=needs_escape(x); ++ ++ if (k) ++ write_ch('|'); ++ ++ for (lw=i=0;is.s_fillp;i++) { ++ j = x->s.s_self[i]; ++- if (PRINTescape && (j == '|' || j == '\\')) +++ if (PRINTescape && +++ (Vreadtable->s.s_dbind->rt.rt_self[j].rte_chattrib==cat_single_escape || +++ Vreadtable->s.s_dbind->rt.rt_self[j].rte_chattrib==cat_multiple_escape)) ++ write_ch('\\'); ++ fc=convertible_upper(j) ? 1 : ++ (convertible_lower(j) ? -1 : 0); ++@@ -711,7 +688,7 @@ print_symbol_name_body(object x,int pp) ++ (PRINTcase == sKdowncase ? -1 : ++ (PRINTcase == sKcapitalize ? (i==lw ? 1 : -1) : 0)))); ++ if (ispunct(j)||isspace(j)) lw=i+1; ++- j+=(tc*fc && !k ? (tc-fc)>>1 : 0)*('A'-'a'); +++ j+=(tc && fc && !k ? (tc-fc)>>1 : 0)*('A'-'a'); ++ write_ch(j); ++ ++ } ++@@ -721,6 +698,42 @@ print_symbol_name_body(object x,int pp) ++ ++ } ++ +++#define DONE 1 +++#define FOUND -1 +++ +++static int +++write_sharp_eq(object *vp,bool dot) { +++ +++ bool defined=vp[1]!=Cnil; +++ +++ if (dot) { +++ write_str(" . "); +++ if (!defined) return FOUND; +++ } +++ +++ vp[1]=Ct; +++ write_ch('#'); +++ write_decimal((vp-PRINTvs_top)/2); +++ write_ch(defined ? '#' : '='); +++ +++ return defined ? DONE : FOUND; +++ +++} +++ +++static int +++write_sharp_eqs(object x,bool dot) { +++ +++ object *vp; +++ +++ for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) +++ if (x == *vp) +++ return write_sharp_eq(vp,dot); +++ +++ return 0; +++ +++} +++ +++ ++ void ++ write_object(x, level) ++ object x; ++@@ -728,7 +741,6 @@ int level; ++ { ++ object r, y; ++ int i, j, k; ++- object *vp; ++ ++ cs_check(x); ++ ++@@ -903,29 +915,15 @@ int level; ++ ++ if (PRINTescape) { ++ if (x->s.s_hpack == Cnil) { ++- if (PRINTcircle) { ++- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) ++- if (x == *vp) { ++- if (vp[1] != Cnil) { ++- write_ch('#'); ++- write_decimal((vp-PRINTvs_top)/2+1); ++- write_ch('#'); ++- return; ++- } else { ++- write_ch('#'); ++- write_decimal((vp-PRINTvs_top)/2+1); ++- write_ch('='); ++- vp[1] = Ct; ++- } ++- } ++- } +++ if (PRINTcircle) +++ if (write_sharp_eqs(x,FALSE)==DONE) return; ++ if (PRINTgensym) ++ write_str("#:"); ++ } else if (x->s.s_hpack == keyword_package) { ++ write_ch(':'); ++ } else if (PRINTpackage||find_symbol(x,current_package())!=x || !intern_flag) { ++ ++- print_symbol_name_body(x->s.s_hpack->p.p_name,0); +++ print_symbol_name_body(x->s.s_hpack->p.p_name); ++ ++ if (find_symbol(x, x->s.s_hpack) != x) ++ error("can't print symbol"); ++@@ -939,7 +937,7 @@ int level; ++ } ++ ++ } ++- print_symbol_name_body(x,1); +++ print_symbol_name_body(x); ++ break; ++ } ++ case t_array: ++@@ -953,23 +951,8 @@ int level; ++ write_str(">"); ++ break; ++ } ++- if (PRINTcircle) { ++- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) ++- if (x == *vp) { ++- if (vp[1] != Cnil) { ++- write_ch('#'); ++- write_decimal((vp-PRINTvs_top)/2); ++- write_ch('#'); ++- return; ++- } else { ++- write_ch('#'); ++- write_decimal((vp-PRINTvs_top)/2); ++- write_ch('='); ++- vp[1] = Ct; ++- break; ++- } ++- } ++- } +++ if (PRINTcircle) +++ if (write_sharp_eqs(x,FALSE)==DONE) return; ++ if (PRINTlevel >= 0 && level >= PRINTlevel) { ++ write_ch('#'); ++ break; ++@@ -1044,23 +1027,8 @@ int level; ++ write_str(">"); ++ break; ++ } ++- if (PRINTcircle) { ++- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) ++- if (x == *vp) { ++- if (vp[1] != Cnil) { ++- write_ch('#'); ++- write_decimal((vp-PRINTvs_top)/2); ++- write_ch('#'); ++- return; ++- } else { ++- write_ch('#'); ++- write_decimal((vp-PRINTvs_top)/2); ++- write_ch('='); ++- vp[1] = Ct; ++- break; ++- } ++- } ++- } +++ if (PRINTcircle) +++ if (write_sharp_eqs(x,FALSE)==DONE) return; ++ if (PRINTlevel >= 0 && level >= PRINTlevel) { ++ write_ch('#'); ++ break; ++@@ -1130,23 +1098,8 @@ int level; ++ write_object(x->c.c_cdr, level); ++ break; ++ } ++- if (PRINTcircle) { ++- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) ++- if (x == *vp) { ++- if (vp[1] != Cnil) { ++- write_ch('#'); ++- write_decimal((vp-PRINTvs_top)/2); ++- write_ch('#'); ++- return; ++- } else { ++- write_ch('#'); ++- write_decimal((vp-PRINTvs_top)/2); ++- write_ch('='); ++- vp[1] = Ct; ++- break; ++- } ++- } ++- } +++ if (PRINTcircle) +++ if (write_sharp_eqs(x,FALSE)==DONE) return; ++ if (PRINTpretty) { ++ if (x->c.c_car == sLquote && ++ type_of(x->c.c_cdr) == t_cons && ++@@ -1192,22 +1145,15 @@ int level; ++ } ++ break; ++ } ++- if (PRINTcircle) { ++- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) ++- if (x == *vp) { ++- if (vp[1] != Cnil) { ++- write_str(" . #"); ++- write_decimal((vp-PRINTvs_top)/2); ++- write_ch('#'); ++- goto RIGHT_PAREN; ++- } else { ++- write_ch(INDENT); ++- write_str(". "); ++- write_object(x, level); ++- goto RIGHT_PAREN; ++- } ++- } ++- } +++ if (PRINTcircle) +++ switch (write_sharp_eqs(x,TRUE)) { +++ case FOUND: +++ write_object(x, level); +++ case DONE: +++ goto RIGHT_PAREN; +++ default: +++ break; +++ } ++ if (i == 0 && y != OBJNULL && type_of(y) == t_symbol) ++ write_ch(INDENT1); ++ else ++@@ -1369,23 +1315,8 @@ int level; ++ break; ++ ++ case t_structure: ++- if (PRINTcircle) { ++- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) ++- if (x == *vp) { ++- if (vp[1] != Cnil) { ++- write_ch('#'); ++- write_decimal((vp-PRINTvs_top)/2); ++- write_ch('#'); ++- return; ++- } else { ++- write_ch('#'); ++- write_decimal((vp-PRINTvs_top)/2); ++- write_ch('='); ++- vp[1] = Ct; ++- break; ++- } ++- } ++- } +++ if (PRINTcircle) +++ if (write_sharp_eqs(x,FALSE)==DONE) return; ++ if (PRINTlevel >= 0 && level >= PRINTlevel) { ++ write_ch('#'); ++ break; ++@@ -1468,48 +1399,73 @@ static int dgs; ++ ++ #include "page.h" ++ +++#define travel_seen(x) x->d.m +++#define travel_pushed(x) x->d.f +++#define travel_bits(x) x->md.mf +++ ++ static void ++-travel_push_new(object x) { +++travel_push(object x) { ++ ++- object y; ++ int i; ++ ++- BEGIN: ++- if (NULL_OR_ON_C_STACK(x)) return; ++- if (is_marked(x)) { ++- vs_check_push(x); ++- vs_check_push(Cnil); +++ if (NULL_OR_ON_C_STACK(x)) +++ return; +++ +++ if (travel_seen(x)) { +++ +++ if (!travel_pushed(x)) { +++ vs_check_push(x); +++ vs_check_push(Cnil); +++ travel_pushed(x)=1; +++ } +++ ++ return; +++ ++ } +++ ++ switch (type_of(x)) { +++ ++ case t_symbol: ++- if (dgs && x->s.s_hpack==Cnil) {mark(x);} +++ +++ if (dgs && x->s.s_hpack==Cnil) +++ travel_seen(x)=1; ++ break; +++ ++ case t_cons: ++- y=x->c.c_cdr; ++- mark(x); ++- travel_push_new(x->c.c_car); ++- x=y; ++- goto BEGIN; +++ +++ { +++ object y=x->c.c_cdr; +++ travel_seen(x)=1; +++ travel_push(x->c.c_car); +++ travel_push(y); +++ } ++ break; +++ ++ case t_array: ++- mark(x); +++ +++ travel_seen(x)=1; ++ if ((enum aelttype)x->a.a_elttype == aet_object) ++ for (i=0;ia.a_dim;i++) ++- travel_push_new(x->a.a_self[i]); +++ travel_push(x->a.a_self[i]); ++ break; +++ ++ case t_vector: ++- mark(x); +++ +++ travel_seen(x)=1; ++ if ((enum aelttype)x->v.v_elttype == aet_object) ++ for (i=0;iv.v_fillp;i++) ++- travel_push_new(x->v.v_self[i]); +++ travel_push(x->v.v_self[i]); ++ break; +++ ++ case t_structure: ++- mark(x); +++ +++ travel_seen(x)=1; ++ for (i = 0; i < S_DATA(x->str.str_def)->length; i++) ++- travel_push_new(structure_ref(x,x->str.str_def,i)); +++ travel_push(structure_ref(x,x->str.str_def,i)); ++ break; +++ ++ default: +++ ++ break; ++ ++ } ++@@ -1518,34 +1474,45 @@ travel_push_new(object x) { ++ ++ ++ static void ++-travel_clear_new(object x) { +++travel_clear(object x) { ++ ++ int i; ++ ++- BEGIN: ++- if (NULL_OR_ON_C_STACK(x) || !is_marked(x)) return; ++- unmark(x); +++ if (NULL_OR_ON_C_STACK(x) || !travel_bits(x)) +++ return; +++ +++ travel_bits(x)=0; +++ ++ switch (type_of(x)) { +++ ++ case t_cons: ++- travel_clear_new(x->c.c_car); ++- x=x->c.c_cdr; ++- goto BEGIN; +++ +++ travel_clear(x->c.c_car); +++ travel_clear(x->c.c_cdr); ++ break; +++ ++ case t_array: +++ ++ if ((enum aelttype)x->a.a_elttype == aet_object) ++ for (i=0;ia.a_dim;i++) ++- travel_clear_new(x->a.a_self[i]); +++ travel_clear(x->a.a_self[i]); ++ break; +++ ++ case t_vector: +++ ++ if ((enum aelttype)x->v.v_elttype == aet_object) ++ for (i=0;iv.v_fillp;i++) ++- travel_clear_new(x->v.v_self[i]); +++ travel_clear(x->v.v_self[i]); ++ break; +++ ++ case t_structure: +++ ++ for (i = 0; i < S_DATA(x->str.str_def)->length; i++) ++- travel_clear_new(structure_ref(x,x->str.str_def,i)); +++ travel_clear(structure_ref(x,x->str.str_def,i)); ++ break; +++ ++ default: +++ ++ break; ++ ++ } ++@@ -1558,74 +1525,14 @@ setupPRINTcircle(object x,int dogensyms) ++ ++ BEGIN_NO_INTERRUPT; ++ dgs=dogensyms; ++- travel_push_new(x); +++ travel_push(x); ++ dgs=0; ++ PRINTvs_limit = vs_top; ++- travel_clear_new(x); +++ travel_clear(x); ++ END_NO_INTERRUPT; ++ ++ } ++ ++-/* char travel_push_type[32]; */ ++- ++-/* static void */ ++-/* travel_push_object(x) */ ++-/* object x; */ ++-/* { */ ++-/* enum type t; */ ++-/* int i; */ ++-/* object *vp; */ ++- ++-/* cs_check(x); */ ++- ++-/* BEGIN: */ ++-/* t = type_of(x); */ ++-/* if(travel_push_type[(int)t]==0) return; */ ++-/* if(t==t_symbol && x->s.s_hpack != Cnil) return; */ ++- ++-/* for (vp = PRINTvs_top; vp < vs_top; vp += 2) */ ++-/* if (x == *vp) { */ ++-/* if (vp[1] != Cnil) */ ++-/* return; */ ++-/* vp[1] = Ct; */ ++-/* return; */ ++-/* } */ ++-/* vs_check_push(x); */ ++-/* vs_check_push(Cnil); */ ++-/* if (t == t_array && (enum aelttype)x->a.a_elttype == aet_object) */ ++-/* for (i = 0; i < x->a.a_dim; i++) */ ++-/* travel_push_object(x->a.a_self[i]); */ ++-/* else if (t == t_vector && (enum aelttype)x->v.v_elttype == aet_object) */ ++-/* for (i = 0; i < x->v.v_fillp; i++) */ ++-/* travel_push_object(x->v.v_self[i]); */ ++-/* else if (t == t_cons) { */ ++-/* travel_push_object(x->c.c_car); */ ++-/* x = x->c.c_cdr; */ ++-/* goto BEGIN; */ ++-/* } else if (t == t_structure) { */ ++-/* for (i = 0; i < S_DATA(x->str.str_def)->length; i++) */ ++-/* travel_push_object(structure_ref(x,x->str.str_def,i)); */ ++-/* } */ ++-/* } */ ++- ++-/* static void */ ++-/* setupPRINTcircle(x,dogensyms) */ ++-/* object x; */ ++-/* int dogensyms; */ ++-/* { object *vp,*vq; */ ++-/* travel_push_type[(int)t_symbol]=dogensyms; */ ++-/* travel_push_type[(int)t_array]= */ ++-/* (travel_push_type[(int)t_vector]=PRINTarray); */ ++-/* travel_push_object(x); */ ++-/* for (vp = vq = PRINTvs_top; vp < vs_top; vp += 2) */ ++-/* if (vp[1] != Cnil) { */ ++-/* vq[0] = vp[0]; */ ++-/* vq[1] = Cnil; */ ++-/* vq += 2; */ ++-/* } */ ++-/* PRINTvs_limit = vs_top = vq; */ ++-/* } */ ++- ++ void ++ setupPRINTdefault(x) ++ object x; ++@@ -1640,8 +1547,8 @@ object x; ++ vs_push(PRINTstream); ++ FEwrong_type_argument(sLstream, PRINTstream); ++ } ++- PRINTescape = symbol_value(sLAprint_escapeA) != Cnil; ++ PRINTreadably = symbol_value(sLAprint_readablyA) != Cnil; +++ PRINTescape = PRINTreadably || symbol_value(sLAprint_escapeA) != Cnil; ++ PRINTpretty = symbol_value(sLAprint_prettyA) != Cnil; ++ PRINTcircle = symbol_value(sLAprint_circleA) != Cnil; ++ y = symbol_value(sLAprint_baseA); diff --cc debian/patches/list_order.12 index 00000000,00000000..e5991588 new file mode 100644 --- /dev/null +++ b/debian/patches/list_order.12 @@@ -1,0 -1,0 +1,50 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-55) unstable; urgency=medium ++ . ++ * disable gprof on aarch64 ++ * Bug fix: "gcl FTBFS on arm64: Unrecoverable error: Segmentation ++ violation..", thanks to Adrian Bunk (Closes: #873052). ++Author: Camm Maguire ++Bug-Debian: https://bugs.debian.org/873052 ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2017-08-24 ++ ++--- gcl-2.6.12.orig/o/regexpr.c +++++ gcl-2.6.12/o/regexpr.c ++@@ -66,6 +66,7 @@ DEFUN_NEW("COMPILE-REGEXP",object,fScomp ++ ++ char *tmp; ++ object res; +++ ufixnum i=0; ++ ++ if (type_of(p)!= t_string && type_of(p)!=t_symbol) ++ not_a_string_or_symbol(p); ++@@ -82,9 +83,9 @@ DEFUN_NEW("COMPILE-REGEXP",object,fScomp ++ res->v.v_adjustable=0; ++ res->v.v_offset=0; ++ res->v.v_self=NULL; ++- if (!(res->v.v_self=(void *)regcomp(tmp,&res->v.v_dim))) +++ if (!(res->v.v_self=(void *)regcomp(tmp,&i))) ++ FEerror("regcomp failure",0); ++- res->v.v_fillp=res->v.v_dim; +++ res->v.v_fillp=res->v.v_dim=i; ++ ++ RETURN1(res); ++ diff --cc debian/patches/list_order.13 index 00000000,00000000..3a95b63a new file mode 100644 --- /dev/null +++ b/debian/patches/list_order.13 @@@ -1,0 -1,0 +1,36 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-57) unstable; urgency=medium ++ . ++ * list_order.13 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2017-08-29 ++ ++--- gcl-2.6.12.orig/h/elf32_mips_reloc.h +++++ gcl-2.6.12/h/elf32_mips_reloc.h ++@@ -35,7 +35,7 @@ ++ if (a) add_vals(where,MASK(16),(s>>16)+a); ++ break; ++ case R_MIPS_LO16: ++- if (sym->st_other) s=gpd; +++ if (sym->st_other) s=gpd ? gpd : ({massert(sym->st_other==2);(ul)got;}); ++ a=*where&MASK(16); ++ if (a&0x8000) a|=0xffff0000; ++ a+=s&MASK(16); diff --cc debian/patches/list_order.16 index 00000000,00000000..d4b69556 new file mode 100644 --- /dev/null +++ b/debian/patches/list_order.16 @@@ -1,0 -1,0 +1,412 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-58) unstable; urgency=medium ++ . ++ * list_order.14 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-01-12 ++ ++--- gcl-2.6.12.orig/h/protoize.h +++++ gcl-2.6.12/h/protoize.h ++@@ -1964,3 +1964,9 @@ vsystem(const char *); ++ ++ object ++ n_cons_from_x(fixnum,object); +++ +++int +++seek_to_end_ofile(FILE *); +++ +++void +++travel_find_sharing(object,object); ++--- gcl-2.6.12.orig/o/fasdump.c +++++ gcl-2.6.12/o/fasdump.c ++@@ -976,100 +976,13 @@ fasd_patch_sharp(object x, int depth) ++ } ++ ++ object sharing_table; ++-static enum circ_ind ++-is_it_there(object x) ++-{ struct htent *e; ++- object table=sharing_table; ++- switch(type_of(x)){ ++- case t_cons: ++- case t_symbol: ++- case t_structure: ++- case t_array: ++- case t_vector: ++- case t_package: ++- e= gethash(x,table); ++- if (e->hte_key ==OBJNULL) ++- {sethash(x,table,make_fixnum(-1)); ++- return FIRST_INDEX; ++- } ++- else ++- {int n=fix(e->hte_value); ++- if (n <0) ++- e->hte_value=make_fixnum(n-1); ++- return LATER_INDEX;} ++- break; ++- default: ++- return NOT_INDEXED;}} ++ ++- ++- ++-static void ++-find_sharing(object x) ++-{ ++- cs_check(x); ++- BEGIN: ++- if(is_it_there(x)!=FIRST_INDEX) return; ++- ++- switch (type_of(x)) { ++- ++- case DP(t_cons:) ++- ++- find_sharing(x->c.c_car); ++- x=x->c.c_cdr; ++- goto BEGIN; ++- ++- break; ++- ++- case DP(t_vector:) ++- { ++- int i; ++- ++- if ((enum aelttype)x->v.v_elttype != aet_object) ++- break; ++- ++- for (i = 0; i < x->v.v_fillp; i++) ++- find_sharing(x->v.v_self[i]); ++- break; ++- } ++- case DP(t_array:) ++- { ++- int i, j; ++- ++- if ((enum aelttype)x->a.a_elttype != aet_object) ++- break; ++- ++- for (i = 0, j = 1; i < x->a.a_rank; i++) ++- j *= x->a.a_dims[i]; ++- for (i = 0; i < j; i++) ++- find_sharing(x->a.a_self[i]); ++- break; ++- } ++- case DP(t_structure:) ++- {object def = x->str.str_def; ++- int i; ++- i=S_DATA(def)->length; ++- while (i--> 0) ++- find_sharing(structure_ref(x,def,i)); ++- break; ++- } ++- default: ++- break; ++- } ++- return; ++-} ++- ++-DEFUN_NEW("FIND-SHARING-TOP",object,fSfind_sharing_top,SI,2,2,NONE,OO,OO,OO,OO,(object x, object table),"") ++-/* static object */ ++-/* FFN(find_sharing_top)(object x, object table) */ ++-{sharing_table=table; ++- find_sharing(x); ++- return Ct; +++DEFUN_NEW("FIND-SHARING-TOP",object,fSfind_sharing_top,SI,2,2,NONE,OO,OO,OO,OO,(object x, object table),"") { +++ sharing_table=table; +++ travel_find_sharing(x,table); +++ return Ct; ++ } ++ ++- ++- ++- ++- ++ /* static object */ ++ /* read_fasd(int i) */ ++ /* {object tem; */ ++--- gcl-2.6.12.orig/o/print.d +++++ gcl-2.6.12/o/print.d ++@@ -490,7 +490,6 @@ int level; ++ void (*wf)(int) = write_ch_fun; ++ ++ object *vt = PRINTvs_top; ++- object *vl = PRINTvs_limit; ++ bool e = PRINTescape; ++ bool ra = PRINTreadably; ++ bool r = PRINTradix; ++@@ -599,7 +598,6 @@ L: ++ PRINTradix = r; ++ PRINTescape = e; ++ PRINTreadably = ra; ++- PRINTvs_limit = vl; ++ PRINTvs_top = vt; ++ ++ write_ch_fun = wf; ++@@ -702,18 +700,19 @@ print_symbol_name_body(object x) { ++ #define FOUND -1 ++ ++ static int ++-do_write_sharp_eq(object x,bool dot) { +++do_write_sharp_eq(struct htent *e,bool dot) { ++ ++- bool defined=x->c.c_cdr!=Cnil; +++ fixnum val=fix(e->hte_value); +++ bool defined=val&1; ++ ++ if (dot) { ++ write_str(" . "); ++ if (!defined) return FOUND; ++ } ++ ++- x->c.c_cdr=Ct; +++ if (!defined) e->hte_value=make_fixnum(val|1); ++ write_ch('#'); ++- write_decimal(fix(x->c.c_car)); +++ write_decimal(val>>1); ++ write_ch(defined ? '#' : '='); ++ ++ return defined ? DONE : FOUND; ++@@ -726,7 +725,7 @@ write_sharp_eq(object x,bool dot) { ++ struct htent *e; ++ ++ return PRINTvs_top[0]!=Cnil && (e=gethash(x,PRINTvs_top[0]))->hte_key!=OBJNULL ? ++- do_write_sharp_eq(e->hte_value,dot) : 0; +++ do_write_sharp_eq(e,dot) : 0; ++ ++ } ++ ++@@ -1392,79 +1391,65 @@ int level; ++ } ++ } ++ ++-static int dgs; +++static int dgs,dga; ++ ++ #include "page.h" ++ ++-#define travel_seen(x) x->d.m ++-#define travel_pushed(x) x->d.f ++-#define travel_bits(x) x->md.mf ++- ++ static void ++ travel_push(object x) { ++ ++ int i; ++ ++- if (NULL_OR_ON_C_STACK(x)) +++ if (is_imm_fixnum(x)) ++ return; ++ ++- if (travel_seen(x)) { +++ if (is_marked(x)) { ++ ++- if (!travel_pushed(x)) { +++ if (imcdr(x) || !x->d.f) ++ vs_check_push(x); ++- travel_pushed(x)=1; ++- } ++- ++- return; +++ if (!imcdr(x)) +++ x->d.f=1; ++ ++- } ++- ++- switch (type_of(x)) { +++ } else switch (type_of(x)) { ++ ++- case t_symbol: +++ case t_symbol: ++ ++- if (dgs && x->s.s_hpack==Cnil) ++- travel_seen(x)=1; ++- break; ++- ++- case t_cons: ++- ++- { ++- object y=x->c.c_cdr; ++- travel_seen(x)=1; ++- travel_push(x->c.c_car); ++- travel_push(y); ++- } ++- break; +++ if (dgs && x->s.s_hpack==Cnil) { +++ mark(x); +++ } +++ break; ++ ++- case t_array: +++ case t_cons: ++ ++- travel_seen(x)=1; ++- if ((enum aelttype)x->a.a_elttype == aet_object) ++- for (i=0;ia.a_dim;i++) ++- travel_push(x->a.a_self[i]); ++- break; +++ { +++ object y=x->c.c_cdr; +++ mark(x); +++ travel_push(x->c.c_car); +++ travel_push(y); +++ } +++ break; ++ ++- case t_vector: +++ case t_vector: +++ case t_array: ++ ++- travel_seen(x)=1; ++- if ((enum aelttype)x->v.v_elttype == aet_object) ++- for (i=0;iv.v_fillp;i++) ++- travel_push(x->v.v_self[i]); ++- break; +++ mark(x); +++ if (dga && (enum aelttype)x->a.a_elttype==aet_object) +++ for (i=0;ia.a_dim;i++) +++ travel_push(x->a.a_self[i]); +++ break; ++ ++- case t_structure: +++ case t_structure: ++ ++- travel_seen(x)=1; ++- for (i = 0; i < S_DATA(x->str.str_def)->length; i++) ++- travel_push(structure_ref(x,x->str.str_def,i)); ++- break; +++ mark(x); +++ for (i = 0; i < S_DATA(x->str.str_def)->length; i++) +++ travel_push(structure_ref(x,x->str.str_def,i)); +++ break; ++ ++- default: +++ default: ++ ++- break; +++ break; ++ ++- } +++ } ++ ++ } ++ ++@@ -1474,10 +1459,15 @@ travel_clear(object x) { ++ ++ int i; ++ ++- if (NULL_OR_ON_C_STACK(x) || !travel_bits(x)) +++ if (is_imm_fixnum(x)) +++ return; +++ +++ if (!is_marked(x)) ++ return; ++ ++- travel_bits(x)=0; +++ unmark(x); +++ if (!imcdr(x)) +++ x->d.f=0; ++ ++ switch (type_of(x)) { ++ ++@@ -1487,20 +1477,14 @@ travel_clear(object x) { ++ travel_clear(x->c.c_cdr); ++ break; ++ +++ case t_vector: ++ case t_array: ++ ++- if ((enum aelttype)x->a.a_elttype == aet_object) +++ if (dga && (enum aelttype)x->a.a_elttype == aet_object) ++ for (i=0;ia.a_dim;i++) ++ travel_clear(x->a.a_self[i]); ++ break; ++ ++- case t_vector: ++- ++- if ((enum aelttype)x->v.v_elttype == aet_object) ++- for (i=0;iv.v_fillp;i++) ++- travel_clear(x->v.v_self[i]); ++- break; ++- ++ case t_structure: ++ ++ for (i = 0; i < S_DATA(x->str.str_def)->length; i++) ++@@ -1515,26 +1499,47 @@ travel_clear(object x) { ++ ++ } ++ ++-object sLeq; ++- ++ static void ++-setupPRINTcircle(object x,int dogensyms) { ++- ++- object *xp; +++travel(object x,int mdgs,int mdga) { ++ ++ BEGIN_NO_INTERRUPT; ++- dgs=dogensyms; +++ dgs=mdgs; +++ dga=mdga; ++ travel_push(x); ++- dgs=0; ++- PRINTvs_limit = vs_top; ++ travel_clear(x); ++ END_NO_INTERRUPT; ++ ++- vs_check_push(PRINTvs_limit>PRINTvs_top ? funcall_cfun(Lmake_hash_table,2,sKtest,sLeq) : Cnil); ++- for (xp=PRINTvs_top;xpvp ? funcall_cfun(Lmake_hash_table,2,sKtest,sLeq) : Cnil; +++ for (j=0;vhte_key==OBJNULL) +++ sethash(*v,h,make_fixnum((j++)<<1)); +++ +++ vs_top=vp; +++ vs_push(h); +++ +++} +++ +++void +++travel_find_sharing(object x,object table) { +++ +++ object *vp=vs_top; +++ +++ travel(x,1,1); +++ +++ for (;vs_top>vp;vs_top--) +++ sethash(vs_head,table,make_fixnum(-2)); ++ ++ } ++ diff --cc debian/patches/list_order.17 index 00000000,00000000..02a38973 new file mode 100644 --- /dev/null +++ b/debian/patches/list_order.17 @@@ -1,0 -1,0 +1,1136 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-59) unstable; urgency=medium ++ . ++ * list_order.16 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-01-23 ++ ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp ++@@ -98,7 +98,9 @@ ++ (defvar *default-c-file* nil) ++ (defvar *default-h-file* nil) ++ (defvar *default-data-file* nil) +++(defvar *default-prof-p* nil) ++ (defvar *keep-gaz* nil) +++(defvar *prof-p* nil) ++ ++ ;; (list section-length split-file-names next-section-start-file-position) ++ ;; Many c compilers cannot handle the large C files resulting from large lisp files. ++@@ -167,10 +169,12 @@ ++ (data-file *default-data-file*) ++ (c-debug nil) ++ (system-p *default-system-p*) +++ (prof-p *default-prof-p*) ++ (print nil) ++ (load nil) ++ &aux (*standard-output* *standard-output*) ++- (*error-output* *error-output*) +++ (*prof-p* prof-p) +++ (*error-output* *error-output*) ++ (*compiler-in-use* *compiler-in-use*) ++ (*c-debug* c-debug) ++ (*compile-print* (or print *compile-print*)) ++@@ -488,8 +492,9 @@ Cannot compile ~a.~%" ++ (t (setq dir "."))) ++ (setq na (namestring ++ (make-pathname :name name :type (pathname-type(first args))))) ++- (format nil "~a -I~a ~a ~a -c ~a -o ~a ~a" +++ (format nil "~a ~a -I~a ~a ~a -c ~a -o ~a ~a" ++ *cc* +++ (if *prof-p* " -pg " "") ++ (concatenate 'string si::*system-directory* "../h") ++ (if (and (boundp '*c-debug*) *c-debug*) " -g " "") ++ (case *speed* ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpwt.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpwt.lsp ++@@ -124,6 +124,7 @@ ++ x)) ++ ++ (defun wt-data-file () +++ (when *prof-p* (add-init `(si::mark-memory-as-profiling))) ++ (verify-data-vector (data-vector)) ++ (let* ((vec (coerce (nreverse (data-inits)) 'vector))) ++ (verify-data-vector vec) ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -4131,30 +4131,11 @@ $as_echo "disabled" >&6; } ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5 ++ $as_echo "ok" >&6; } ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for text start" >&5 ++-$as_echo_n "checking for text start... " >&6; } ++- echo 'int main () {return(0);}' >foo.c ++- $CC foo.c -o foo ++- GCL_GPROF_START=`nm foo | $AWK '/ *[TD] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc ++- rm -f foo.c foo ++- if test "$GCL_GPROF_START" != "" ; then ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GCL_GPROF_START" >&5 ++-$as_echo "$GCL_GPROF_START" >&6; } ++- ++-cat >>confdefs.h <<_ACEOF ++-#define GCL_GPROF_START $GCL_GPROF_START ++-_ACEOF ++- ++- assert_arg_to_cflags -pg ++- case $use in ++- s390*) ;; # relocation truncation bug in gcc ++- *) TLIBS="$TLIBS -pg";; ++- esac ++- TFPFLAG="" +++ assert_arg_to_cflags -pg +++ TFPFLAG="" ++ ++ $as_echo "#define GCL_GPROF 1" >>confdefs.h ++ ++- fi ++ fi ++ fi ++ fi ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -342,22 +342,25 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof ++ AC_MSG_RESULT([disabled]) ++ else ++ AC_MSG_RESULT([ok]) ++- AC_MSG_CHECKING([for text start]) ++- echo 'int main () {return(0);}' >foo.c ++- $CC foo.c -o foo ++- GCL_GPROF_START=`nm foo | $AWK '/ *[[TD]] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc ++- rm -f foo.c foo ++- if test "$GCL_GPROF_START" != "" ; then ++- AC_MSG_RESULT($GCL_GPROF_START) ++- AC_DEFINE_UNQUOTED(GCL_GPROF_START,$GCL_GPROF_START,[starting address for gprof]) ++- assert_arg_to_cflags -pg ++- case $use in ++- s390*) ;; # relocation truncation bug in gcc ++- *) TLIBS="$TLIBS -pg";; ++- esac ++- TFPFLAG="" ++- AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) ++- fi +++ assert_arg_to_cflags -pg +++ TFPFLAG="" +++ AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) +++dnl AC_MSG_CHECKING([for text start]) +++dnl echo 'int main () {return(0);}' >foo.c +++dnl $CC foo.c -o foo +++dnl GCL_GPROF_START=`nm foo | $AWK '/ *[[TD]] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc +++dnl rm -f foo.c foo +++dnl if test "$GCL_GPROF_START" != "" ; then +++dnl AC_MSG_RESULT($GCL_GPROF_START) +++dnl AC_DEFINE_UNQUOTED(GCL_GPROF_START,$GCL_GPROF_START,[starting address for gprof]) +++dnl assert_arg_to_cflags -pg +++dnl # case $use in +++dnl # s390*) ;; # relocation truncation bug in gcc +++dnl # *) TLIBS="$TLIBS -pg";; +++dnl # esac +++dnl TFPFLAG="" +++dnl AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) +++dnl fi ++ fi ++ fi]) ++ ++--- gcl-2.6.12.orig/h/gclincl.h.in +++++ gcl-2.6.12/h/gclincl.h.in ++@@ -53,9 +53,6 @@ ++ /* use gprof profiling */ ++ #undef GCL_GPROF ++ ++-/* starting address for gprof */ ++-#undef GCL_GPROF_START ++- ++ /* No gettimeofday call -- fixme */ ++ #undef GETTOD_NOT_DECLARED ++ ++@@ -153,6 +150,9 @@ ++ /* use libbfd */ ++ #undef HAVE_LIBBFD ++ +++/* Define to 1 if you have the `dl' library (-ldl). */ +++#undef HAVE_LIBDL +++ ++ /* Define to 1 if you have the `opcodes' library (-lopcodes). */ ++ #undef HAVE_LIBOPCODES ++ ++@@ -255,9 +255,6 @@ ++ /* using xgcl */ ++ #undef HAVE_XGCL ++ ++-/* number of pages to use for hole */ ++-#undef HOLEPAGE ++- ++ /* Host cpu */ ++ #undef HOST_CPU ++ ++@@ -267,9 +264,6 @@ ++ /* Host system */ ++ #undef HOST_SYSTEM ++ ++-/* time system constant */ ++-#undef HZ ++- ++ /* invocation history stack size */ ++ #undef IHSSIZE ++ ++@@ -321,7 +315,7 @@ ++ /* can use C extension for object alignment */ ++ #undef OBJ_ALIGN ++ ++-/* needed object alignment in bytes */ +++/* needed object alignment bytes */ ++ #undef OBJ_ALIGNMENT ++ ++ /* Define to the address where bug reports for this package should be sent. */ ++@@ -345,7 +339,7 @@ ++ /* system pagewidth */ ++ #undef PAGEWIDTH ++ ++-/* have sigcontext in signal.h */ +++/* have sigcontext of signal.h */ ++ #undef SIGNAL_H_HAS_SIGCONTEXT ++ ++ /* sizeof linked list for contiguous pages */ ++--- gcl-2.6.12.orig/h/lu.h +++++ gcl-2.6.12/h/lu.h ++@@ -355,7 +355,8 @@ struct cfdata { ++ FIRSTWORD; ++ char *cfd_start; ++ int cfd_size; ++- int cfd_fillp; +++ int cfd_fillp:31; +++ int cfd_prof:1; ++ object *cfd_self; ++ SPAD; ++ }; ++--- gcl-2.6.12.orig/h/protoize.h +++++ gcl-2.6.12/h/protoize.h ++@@ -1788,10 +1788,8 @@ int sigprocmask ( int how, const sigset_ ++ void recreate_heap1 ( void ); ++ #endif ++ ++-#ifdef GCL_GPROF ++ void ++ gprof_cleanup(void); ++-#endif ++ ++ int ++ msystem(const char *); ++@@ -1970,3 +1968,6 @@ seek_to_end_ofile(FILE *); ++ ++ void ++ travel_find_sharing(object,object); +++ +++object +++new_cfdata(void); ++--- gcl-2.6.12.orig/h/ptable.h +++++ gcl-2.6.12/h/ptable.h ++@@ -38,6 +38,8 @@ typedef struct node TABL[]; ++ struct string_address_table ++ { struct node *ptable; ++ unsigned int length; +++ struct node *local_ptable; +++ unsigned int local_length; ++ unsigned int alloc_length; ++ }; ++ ++--- gcl-2.6.12.orig/lsp/gcl_mislib.lsp +++++ gcl-2.6.12/lsp/gcl_mislib.lsp ++@@ -165,3 +165,27 @@ ++ (push (string-concatenate s l) nl)) ++ (setq *load-path* nl)) ++ nil) +++ +++(defun default-symtab nil (concatenate 'string *tmp-dir* "gcl_symtab")) +++ +++(defun gprof-output (symtab gmon) +++ (with-open-file +++ (s (format nil "|gprof -S '~a' '~a' '~a'" symtab (kcl-self) gmon)) +++ (copy-stream s *standard-output*))) +++ +++ +++(defun gprof-start (&optional (start 0 start-p) (end 0 end-p) (symtab (default-symtab))) +++ (unless end-p +++ (multiple-value-bind +++ (s e) +++ (gprof-addresses) +++ (setq start (if start-p start s) end e))) +++ (when (monstartup start end) +++ (write-symtab symtab start end))) +++ +++(defun gprof-quit (&optional (symtab (default-symtab)) &aux (gmon (mcleanup))) +++ (when gmon +++ (gprof-output symtab gmon))) +++ +++ +++ ++--- gcl-2.6.12.orig/o/alloc.c +++++ gcl-2.6.12/o/alloc.c ++@@ -1177,24 +1177,6 @@ init_tm(enum type t, char *name, int els ++ call is too fragile. 20050115 CM*/ ++ static int gcl_alloc_initialized; ++ ++- ++-#ifdef GCL_GPROF ++-static unsigned long textstart,textend,textpage; ++-static void init_textpage() { ++- ++- extern void *GCL_GPROF_START; ++- unsigned long s=(unsigned long)GCL_GPROF_START; ++- ++- textstart=(unsigned long)&GCL_GPROF_START; ++- textend=(unsigned long)&etext; ++- if (stextend || s>textstart)) ++- textstart=s; ++- ++- textpage=2*(textend-textstart)/PAGESIZE; ++- ++-} ++-#endif ++- ++ object malloc_list=Cnil; ++ ++ #include ++@@ -1220,10 +1202,6 @@ gcl_init_alloc(void *cs_start) { ++ init_darwin_zone_compat (); ++ #endif ++ ++-#ifdef GCL_GPROF ++- init_textpage(); ++-#endif ++- ++ #if defined(BSD) && defined(RLIMIT_STACK) ++ { ++ struct rlimit rl; ++@@ -1301,11 +1279,6 @@ gcl_init_alloc(void *cs_start) { ++ initial_sbrk=data_start=heap_end; ++ first_data_page=page(data_start); ++ ++-/* #ifdef GCL_GPROF */ ++-/* if (new_holepage>PAGEWIDTH)); ++ } ++ ++- ++-#ifdef GCL_GPROF ++- ++-static unsigned long start,end,gprof_on; ++-static void *initial_monstartup_pointer; ++- ++-void ++-gprof_cleanup(void) { ++- ++- extern void _mcleanup(void); ++- ++- if (initial_monstartup_pointer) { ++- _mcleanup(); ++- gprof_on=0; ++- } ++- ++- if (gprof_on) { ++- ++- char b[PATH_MAX],b1[PATH_MAX]; ++- ++- if (!getcwd(b,sizeof(b))) ++- FEerror("Cannot get working directory", 0); ++- if (chdir(P_tmpdir)) ++- FEerror("Cannot change directory to tmpdir", 0); ++- _mcleanup(); ++- if (snprintf(b1,sizeof(b1),"gmon.out.%u",getpid())<=0) ++- FEerror("Cannot write temporary gmon filename", 0); ++- if (rename("gmon.out",b1)) ++- FEerror("Cannot rename gmon.out",0); ++- if (chdir(b)) ++- FEerror("Cannot restore working directory", 0); ++- gprof_on=0; ++- ++- } ++- ++-} ++- ++-static inline int ++-my_monstartup(unsigned long start,unsigned long end) { ++- ++- extern void monstartup(unsigned long,unsigned long); ++- ++- monstartup(start,end); ++- ++- return 0; ++- ++-} ++- ++-DEFUN_NEW("GPROF-START",object,fSgprof_start,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { ++- ++- extern void *GCL_GPROF_START; ++- static int n; ++- ++- if (!gprof_on) { ++- start=start ? start : textstart; ++- end=end ? end : textend; ++- writable_malloc_wrap(my_monstartup,int,start,end); ++- gprof_on=1; ++- if (!n && atexit(gprof_cleanup)) { ++- FEerror("Cannot setup gprof_cleanup on exit", 0); ++- n=1; ++- } ++- } ++- ++- return Cnil; ++- ++-} ++- ++-DEFUN_NEW("GPROF-SET",object,fSgprof_set,SI ++- ,2,2,NONE,OI,IO,OO,OO,(fixnum dstart,fixnum dend),"") ++-{ ++- ++- start=dstart; ++- end=dend; ++- ++- return Cnil; ++- ++-} ++- ++-DEFUN_NEW("GPROF-QUIT",object,fSgprof_quit,SI ++- ,0,0,NONE,OO,OO,OO,OO,(void),"") ++-{ ++- extern void _mcleanup(void); ++- char b[PATH_MAX],b1[PATH_MAX]; ++- FILE *pp; ++- unsigned n; ++- ++- if (!gprof_on) ++- return Cnil; ++- ++- massert(getcwd(b,sizeof(b))); ++- massert(!chdir(P_tmpdir)); ++- _mcleanup(); ++- massert(snprintf(b1,sizeof(b1),"gprof '%s'",kcl_self)>0); ++- massert((pp=popen(b1,"r"))); ++- while ((n=fread(b1,1,sizeof(b1),pp))) ++- massert(fwrite(b1,1,n,stdout)); ++- massert(pclose(pp)>=0); ++- massert(!chdir(b)); ++- gprof_on=0; ++- ++- return Cnil; ++- ++-} ++- ++-#endif ++- ++ DEFUN_NEW("SET-STARTING-HOLE-DIVISOR",object,fSset_starting_hole_divisor,SI,1,1,NONE,II,OO,OO,OO,(fixnum div),"") { ++ if (div>0 && div <100) ++ starting_hole_div=div; ++@@ -1808,20 +1670,7 @@ malloc_internal(size_t size) { ++ void * ++ malloc(size_t size) { ++ ++- void *v=malloc_internal(size);; ++- ++- /* FIXME: this is just to handle clean freeing of the ++- monstartup memory allocated automatically on raw image ++- startup. In saved images, monstartup memory is only ++- allocated with gprof-start. 20040804 CM*/ ++-#ifdef GCL_GPROF ++- if (raw_image && size>(textend-textstart) && !initial_monstartup_pointer) { ++- massert(!atexit(gprof_cleanup)); ++- initial_monstartup_pointer=v; ++- } ++-#endif ++- ++- return v; +++ return malloc_internal(size); ++ ++ } ++ ++@@ -1830,7 +1679,6 @@ void ++ free(void *ptr) { ++ ++ object *p,pp; ++- static void *initial_monstartup_pointer_echo; ++ ++ if (ptr == 0) ++ return; ++@@ -1839,15 +1687,9 @@ free(void *ptr) { ++ if ((pp)->c.c_car->st.st_self == ptr) { ++ (pp)->c.c_car->st.st_self = NULL; ++ *p = pp->c.c_cdr; ++-#ifdef GCL_GPROF ++- if (initial_monstartup_pointer==ptr) { ++- initial_monstartup_pointer_echo=ptr; ++- initial_monstartup_pointer=NULL; ++- } ++-#endif ++ return; ++ } ++- if (ptr!=initial_monstartup_pointer_echo) { +++ { ++ static void *old_ptr; ++ if (old_ptr==ptr) return; ++ old_ptr=ptr; ++@@ -1855,7 +1697,6 @@ free(void *ptr) { ++ FEerror("free(3) error.",0); ++ #endif ++ } ++- initial_monstartup_pointer_echo=NULL; ++ return; ++ } ++ ++--- gcl-2.6.12.orig/o/cmpaux.c +++++ gcl-2.6.12/o/cmpaux.c ++@@ -393,6 +393,15 @@ call_init(int init_address, object memor ++ ++ */ ++ +++DEFUN_NEW("MARK-MEMORY-AS-PROFILING",object,fSmark_memory_as_profiling,SI,0,0, +++ NONE,OO,OO,OO,OO,(void),"") { +++ +++ sSPmemory->s.s_dbind->cfd.cfd_prof=1; +++ +++ return Cnil; +++ +++} +++ ++ void ++ do_init(object *statVV) ++ {object fasl_vec=sSPinit->s.s_dbind; ++@@ -467,6 +476,22 @@ char *s; ++ ++ #endif ++ +++object +++new_cfdata(void) { +++ +++ object memory=alloc_object(t_cfdata); +++ +++ memory->cfd.cfd_size=0; +++ memory->cfd.cfd_fillp=0; +++ memory->cfd.cfd_prof=0; +++ memory->cfd.cfd_self=0; +++ memory->cfd.cfd_start=0; +++ +++ return memory; +++ +++} +++ +++ ++ void ++ gcl_init_or_load1(void (*fn)(void),const char *file) { ++ ++@@ -476,10 +501,7 @@ gcl_init_or_load1(void (*fn)(void),const ++ object fasl_data; ++ file=FIX_PATH_STRING(file); ++ ++- memory=alloc_object(t_cfdata); ++- memory->cfd.cfd_self=0; ++- memory->cfd.cfd_fillp=0; ++- memory->cfd.cfd_size = 0; +++ memory=new_cfdata(); ++ memory->cfd.cfd_start= (char *)fn; ++ printf("Initializing %s\n",file); fflush(stdout); ++ fasl_data = read_fasl_data(file); ++--- gcl-2.6.12.orig/o/fasldlsym.c +++++ gcl-2.6.12/o/fasldlsym.c ++@@ -101,10 +101,7 @@ fasload(object faslfile) { ++ SEEK_TO_END_OFILE(faslstream->sm.sm_fp); ++ ++ data = read_fasl_vector(faslstream); ++- memory = alloc_object(t_cfdata); ++- memory->cfd.cfd_self = NULL; ++- memory->cfd.cfd_start = NULL; ++- memory->cfd.cfd_size = 0; +++ memory=new_cfdata(); ++ ++ if(symbol_value(sLAload_verboseA)!=Cnil) ++ printf(" start address (dynamic) %p ",fptr); ++--- /dev/null +++++ gcl-2.6.12/o/gprof.c ++@@ -0,0 +1,137 @@ +++#include "include.h" +++#include "page.h" +++#include "ptable.h" +++ +++ +++static unsigned long gprof_on; +++ +++DEFUN_NEW("MCLEANUP",object,fSmcleanup,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { +++ +++ extern void _mcleanup(void); +++ +++ if (!gprof_on) +++ return Cnil; +++ +++ massert(getcwd(FN1,sizeof(FN1))); +++ massert(!chdir(P_tmpdir)); +++ _mcleanup(); +++ massert(!chdir(FN1)); +++ gprof_on=0; +++ massert(snprintf(FN1,sizeof(FN1),"%s/gmon.out",P_tmpdir)>0); +++ return make_simple_string(FN1); +++} +++ +++static inline int +++my_monstartup(unsigned long start,unsigned long end) { +++ +++ extern void monstartup(unsigned long,unsigned long); +++ +++ monstartup(start,end); +++ +++ return 0; +++ +++} +++ +++DEFUN_NEW("MONSTARTUP",object,fSmonstartup,SI,2,2,NONE,OI,IO,OO,OO,(ufixnum start,ufixnum end),"") { +++ +++ if (gprof_on) +++ return Cnil; +++ +++ writable_malloc_wrap(my_monstartup,int,start,end); +++ gprof_on=1; +++ +++ return Ct; +++ +++} +++ +++void +++gprof_cleanup(void) { +++ +++ FFN(fSmcleanup)(); +++ /*rename gmon?*/ +++ +++} +++ +++DEFUNM_NEW("GPROF-ADDRESSES",object,fSgprof_addresses,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { +++ +++ void *min=heap_end,*max=data_start,*c; +++ static void *mintext; +++ struct pageinfo *v; +++ object x; +++ fixnum i; +++ struct typemanager *tm=tm_of(t_cfdata); +++ +++ for (v=cell_list_head;v;v=v->next) +++ if (v->type==tm->tm_type) +++ for (c=pagetochar(page(v)),i=0;itm_nppage;i++,c+=tm->tm_size) +++ if (!is_free((x=c)) && type_of(x)==t_cfdata && x->cfd.cfd_prof) { +++ min=(void *)x->cfd.cfd_startcfd.cfd_start : min; +++ max=(void *)x->cfd.cfd_start+x->cfd.cfd_size>max ? x->cfd.cfd_start+x->cfd.cfd_size : max; +++ } +++ +++ if (maxp_link) +++ for (i=0,b=p->p_internal,be=b+p->p_internal_size;b; +++ b=i ? NULL : p->p_external,be=b+p->p_external_size,i=1) +++ for (;bc.c_cdr) +++ if ((f=(s=l->c.c_car)->s.s_gfdef)!=OBJNULL && s->s.s_hpack==(object)p) +++ switch(type_of(f)) { +++ case t_cfun:case t_sfun:case t_vfun:case t_afun:case t_gfun: +++ if ((ufixnum)f->cf.cf_self>=start && (ufixnum)f->cf.cf_selfcf.cf_self, +++ p->p_name->st.st_fillp,p->p_name->st.st_self, +++ s->st.st_fillp,s->st.st_self); +++ break; +++ } +++ fprintf(pp,"%016lx T GCL_MONEND\n",end); +++ +++ for (i=0;icfd.cfd_self = 0; ++- memory->cfd.cfd_start = 0; ++- memory->cfd.cfd_size = datasize+textsize+bsssize + extra_bss; ++- vs_push(memory); ++- the_start=start_address= ++- memory->cfd.cfd_start = ++- alloc_contblock(memory->cfd.cfd_size); ++- sfaslp->s_start_data = start_address + textsize; ++- sfaslp->s_start_bss = start_address + textsize + datasize; ++- END_NO_INTERRUPT; +++ memory=new_cfdata(); +++ memory->cfd.cfd_size = datasize+textsize+bsssize + extra_bss; +++ vs_push(memory); +++ the_start=start_address= +++ memory->cfd.cfd_start= +++ alloc_contblock(memory->cfd.cfd_size); +++ sfaslp->s_start_data = start_address + textsize; +++ sfaslp->s_start_bss = start_address + textsize + datasize; +++ END_NO_INTERRUPT; ++ } ++ #else ++ the_start = start_address ++--- gcl-2.6.12.orig/o/sfaslbfd.c +++++ gcl-2.6.12/o/sfaslbfd.c ++@@ -269,9 +269,7 @@ fasload(object faslfile) { ++ curr_size=(unsigned long)current; ++ max_align=1<cfd.cfd_self = 0; ++- memory->cfd.cfd_start = 0; +++ memory=new_cfdata(); ++ memory->cfd.cfd_size = curr_size + (max_align > sizeof(char *) ? max_align :0); ++ ++ memory->cfd.cfd_start=alloc_contblock(memory->cfd.cfd_size); ++--- gcl-2.6.12.orig/o/sfaslcoff.c +++++ gcl-2.6.12/o/sfaslcoff.c ++@@ -207,10 +207,8 @@ load_memory(struct scnhdr *sec1,struct s ++ if (ALLOC_SEC(sec)) ++ sec->s_paddr=sz; ++ ++- memory = alloc_object(t_cfdata); +++ memory=new_cfdata(); ++ memory->cfd.cfd_size=sz; ++- memory->cfd.cfd_self=0; ++- memory->cfd.cfd_start=0; ++ memory->cfd.cfd_start=alloc_code_space(sz); ++ ++ for (sec=sec1;secn_sclass!=2 || sym->n_scnum<1) +++ if (sym->n_sclass<2 || sym->n_sclass>3 || sym->n_scnum<1) ++ continue; ++ ++ ns++; ++@@ -270,7 +268,7 @@ load_self_symbols() { ++ ++ } ++ ++- c_table.alloc_length=c_table.length=ns; +++ c_table.alloc_length=ns; ++ assert(c_table.ptable=malloc(sizeof(*c_table.ptable)*c_table.alloc_length)); ++ assert(st=malloc(sl)); ++ ++@@ -296,9 +294,36 @@ load_self_symbols() { ++ sym+=sym->n_numaux; ++ ++ } ++- +++ c_table.length=a-c_table.ptable; ++ qsort(c_table.ptable,c_table.length,sizeof(*c_table.ptable),node_compare); ++ +++ for (c_table.local_ptable=a,sym=sy1;symn_sclass!=3 || sym->n_scnum<1) +++ continue; +++ +++ NM(sym,st1,s,strcpy(st,s)); +++ +++ sec=sec1+sym->n_scnum-1; +++ jj=sym->n_value+sec->s_vaddr+h->h_ibase; +++ +++#ifdef FIX_ADDRESS +++ FIX_ADDRESS(jj); +++#endif +++ +++ a->address=jj; +++ a->string=st; +++ +++ a++; +++ st+=strlen(st)+1; +++ sym+=sym->n_numaux; +++ +++ } +++ c_table.local_length=a-c_table.local_ptable; +++ qsort(c_table.local_ptable,c_table.local_length,sizeof(*c_table.local_ptable),node_compare); +++ +++ massert(c_table.alloc_length==c_table.length+c_table.local_length); +++ ++ massert(!un_mmap(v1,ve)); ++ massert(!fclose(f)); ++ ++--- gcl-2.6.12.orig/o/sfaslelf.c +++++ gcl-2.6.12/o/sfaslelf.c ++@@ -55,9 +55,12 @@ License for more details. ++ #define ulmax(a_,b_) ({ul _a=a_,_b=b_;_a<_b ? _b : _a;}) ++ #define ALLOC_SEC(sec) (sec->sh_flags&SHF_ALLOC && (sec->sh_type==SHT_PROGBITS || sec->sh_type==SHT_NOBITS)) ++ #define LOAD_SEC(sec) (sec->sh_flags&SHF_ALLOC && sec->sh_type==SHT_PROGBITS) ++-#define LOAD_SYM_BY_BIND(sym) ({ul _b=ELF_ST_BIND(sym->st_info); sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK);}) ++-#define LOAD_SYM_BY_NAME(sym,st1) 0 ++-#define LOAD_SYM(sym,st1) (LOAD_SYM_BY_BIND(sym)||LOAD_SYM_BY_NAME(sym,st1)) +++#define EXT_SYM(sym) ({ul _b=ELF_ST_BIND(sym->st_info); \ +++ sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK);}) +++#define LOCAL_SYM(sym) (sym->st_value && \ +++ ELF_ST_BIND(sym->st_info)==STB_LOCAL) +++ /* && ELF_ST_TYPE(sym->st_info)==STT_FUNC) */ +++#define LOAD_SYM(sym) (EXT_SYM(sym)||LOCAL_SYM(sym)) ++ ++ #define MASK(n) (~(~0ULL << (n))) ++ ++@@ -271,10 +274,8 @@ load_memory(Shdr *sec1,Shdr *sece,void * ++ sz+=gsz; ++ } ++ ++- memory=alloc_object(t_cfdata); +++ memory=new_cfdata(); ++ memory->cfd.cfd_size=sz; ++- memory->cfd.cfd_self=0; ++- memory->cfd.cfd_start=0; ++ memory->cfd.cfd_start=alloc_code_space(sz); ++ ++ a=(ul)memory->cfd.cfd_start; ++@@ -411,7 +412,7 @@ calc_space(ul *ns,ul *sl,Sym *sym1,Sym * ++ ++ for (sym=sym1;symcfd.cfd_size=sz; ++- memory->cfd.cfd_self=0; ++- memory->cfd.cfd_start=0; ++ memory->cfd.cfd_start=alloc_code_space(sz); ++ ++ a=(ul)memory->cfd.cfd_start; ++@@ -411,23 +409,19 @@ load_self_symbols() { ++ ++ if (sym->n_type & N_STAB) ++ continue; ++- if (!(sym->n_type & N_EXT)) ++- continue; ++ ++ ns++; ++ sl+=strlen(sym->n_un.n_strx+strtab)+1; ++ ++ } ++ ++- c_table.alloc_length=c_table.length=ns; +++ c_table.alloc_length=ns; ++ assert(c_table.ptable=malloc(sizeof(*c_table.ptable)*c_table.alloc_length)); ++ assert(s=malloc(sl)); ++ ++ for (a=c_table.ptable,sym=sym1;symn_type & N_STAB) ++- continue; ++- if (!(sym->n_type & N_EXT)) +++ if (sym->n_type & N_STAB || !(sym->n_type & N_EXT)) ++ continue; ++ ++ a->address=sym->n_value; ++@@ -438,9 +432,28 @@ load_self_symbols() { ++ s+=strlen(s)+1; ++ ++ } ++- +++ c_table.length=a-c_table.ptable; ++ qsort(c_table.ptable,c_table.length,sizeof(*c_table.ptable),node_compare); ++ +++ c_table.local_ptable=a; +++ for (a=c_table.ptable,sym=sym1;symn_type & N_STAB || sym->n_type & N_EXT) +++ continue; +++ +++ a->address=sym->n_value; +++ a->string=s; +++ strcpy(s,sym->n_un.n_strx+strtab); +++ +++ a++; +++ s+=strlen(s)+1; +++ +++ } +++ c_table.local_length=a-c_table.local_ptable; +++ qsort(c_table.local_ptable,c_table.local_length,sizeof(*c_table.local_ptable),node_compare); +++ +++ massert(c_table.alloc_length==c_table.length+c_table.local_length); +++ ++ massert(!un_mmap(addr,addre)); ++ massert(!fclose(f)); ++ ++--- gcl-2.6.12.orig/o/sfaslmacosx.c +++++ gcl-2.6.12/o/sfaslmacosx.c ++@@ -232,10 +232,7 @@ int fasload (object faslfile) ++ ++ close_stream (faslstream); ++ ++- memory = alloc_object (t_cfdata); ++- memory->cfd.cfd_self = NULL; ++- memory->cfd.cfd_start = NULL; ++- memory->cfd.cfd_size = 0; +++ memory=new_cfdata(); ++ ++ if (symbol_value (sLAload_verboseA) != Cnil) ++ printf (" start address (dynamic) %p ", fptr); ++--- gcl-2.6.12.orig/o/unixfasl.c +++++ gcl-2.6.12/o/unixfasl.c ++@@ -146,9 +146,7 @@ object faslfile; ++ fread(&header, sizeof(header), 1, fp); ++ #endif ++ ++- memory = alloc_object(t_cfdata); ++- memory->cfd.cfd_self = NULL; ++- memory->cfd.cfd_start = NULL; +++ memory=new_cfdata(); ++ memory->cfd.cfd_size = textsize + datasize + bsssize; ++ vs_push(memory); ++ /* If the file is smaller than the space asked for, typically the file ++@@ -314,12 +312,10 @@ DEFUN_NEW("FASLINK-INT",object,fSfaslink ++ setbuf(fp, buf); ++ fread(&header, sizeof(header), 1, fp); ++ {BEGIN_NO_INTERRUPT; ++- memory = alloc_object(t_cfdata); ++- memory->cfd.cfd_self=0; ++- memory->cfd.cfd_start = NULL; ++- memory->cfd.cfd_size = textsize + datasize + bsssize; ++- vs_push(memory); ++- memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock, +++ memory=new_cfdata(); +++ memory->cfd.cfd_size = textsize + datasize + bsssize; +++ vs_push(memory); +++ memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock, ++ memory->cfd.cfd_size, ++ sizeof(double)); ++ END_NO_INTERRUPT;} ++--- gcl-2.6.12.orig/unixport/makefile +++++ gcl-2.6.12/unixport/makefile ++@@ -69,28 +69,26 @@ $(LSPDIR)/auto_new.lsp: $(LSPDIR)/auto.l ++ [ "$(RL_OBJS)" = "" ] || \ ++ echo "(AUTOLOAD 'init-readline '|readline|)" >>$@ ++ ++-sys_init.lsp: sys_init.lsp.in +++saved_%:raw_% $(RSYM) sys_init.lsp.in raw_%_map msys \ +++ $(CMPDIR)/gcl_cmpmain.lsp \ +++ $(CMPDIR)/gcl_lfun_list.lsp \ +++ $(CMPDIR)/gcl_cmpopt.lsp $(HDIR)/cmpinclude.h \ +++ $(LSPDIR)/gcl_auto_new.lsp ++ ++- cat $< | sed \ +++ cat sys_init.lsp.in | sed \ ++ -e "s#@LI-VERS@#(`cat ../majvers`.`cat ../minvers`) `cat ../release`#1" \ ++ -e "s#@LI-EXTVERS@#`cat ../minvers | cut -f2 -d.`#1" \ ++ -e "s#@LI-MINVERS@#`cat ../minvers | cut -f1 -d.`#1" \ ++ -e "s#@LI-MAJVERS@#`cat ../majvers`#1" \ ++ -e "s#@LI-RELEASE@#`cat ../release`#1" \ ++- -e "s#@LI-CC@#\"$(GCL_CC) -c $(FINAL_CFLAGS)\"#1" \ +++ -e "s#@LI-CC@#\"$(GCL_CC) -c $(filter-out -pg,$(FINAL_CFLAGS))\"#1" \ +++ -e "s#@LI-DFP@#\"$(filter -pg,$(FINAL_CFLAGS))\"#1" \ ++ -e "s#@LI-LD@#\"$(GCL_CC) $(LD_FLAGS) -o \"#1" \ ++- -e "s#@LI-LD-LIBS@#\" $(LD_LIBS_PRE) -l$* $(LD_LIBS_POST)\"#1" \ +++ -e "s#@LI-LD-LIBS@#\" $(LD_LIBS_POST)\"#1" \ ++ -e "s#@LI-OPT-THREE@#\"$(O3FLAGS)\"#1" \ ++ -e "s#@LI-OPT-TWO@#\"$(O2FLAGS)\"#1" \ ++- -e "s#@LI-INIT-LSP@#\"$@\"#1" >$@ ++- ++-saved_%:raw_% $(RSYM) sys_init.lsp raw_%_map msys \ ++- $(CMPDIR)/gcl_cmpmain.lsp \ ++- $(CMPDIR)/gcl_lfun_list.lsp \ ++- $(CMPDIR)/gcl_cmpopt.lsp $(HDIR)/cmpinclude.h \ ++- $(LSPDIR)/gcl_auto_new.lsp +++ -e "s#@LI-INIT-LSP@#\"$@\"#1" >foo ++ ++- cp sys_init.lsp foo ++ echo "(unless si::*quit-tags* (in-package \"USER\")(system:save-system \"$@\"))" >>foo ++ j=$$(ar t lib$*.a |grep ^gcl_);[ "$$j" = "" ] || ar x lib$*.a $$j #accelerator ++ $(PORTDIR)/raw_$*$(EXE) $(PORTDIR)/ -libdir $(GCLDIR)/ < foo ++@@ -160,7 +158,7 @@ map_%: ++ clean: ++ rm -rf saved_*$(EXE) raw_*$(EXE) *.o core a.out $(RSYM) \ ++ $(LSPDIR)/auto_new.lsp foo *maxima* init_*.lsp lib*.a gmp* bfd* *.lsp.tmp \ ++- gazonk*.lsp plt*h *_map saved_* lib* raw_* msys out* log* tmp* gcl.script sys_init.lsp +++ gazonk*.lsp plt*h *_map saved_* lib* raw_* msys out* log* tmp* gcl.script ++ ++ .INTERMEDIATE: init_ansi_gcl.lsp.tmp init_gcl.lsp.tmp raw_gcl raw_ansi_gcl ++ .PRECIOUS: init_pre_gcl.lsp init_gcl.lsp init_ansi_gcl.lsp ++--- gcl-2.6.12.orig/unixport/sys_init.lsp.in +++++ gcl-2.6.12/unixport/sys_init.lsp.in ++@@ -59,8 +59,10 @@ ++ ++ (in-package :compiler) ++ (setq *cc* @LI-CC@ +++ *default-prof-p* (> (length @LI-DFP@) 0) ++ *ld* @LI-LD@ ++ *ld-libs* @LI-LD-LIBS@ +++ *ld-libs* (concatenate 'string "-l" #+ansi-cl "ansi_" "gcl " *ld-libs*) ++ *opt-three* @LI-OPT-THREE@ ++ *opt-two* @LI-OPT-TWO@ ++ *init-lsp* @LI-INIT-LSP@) diff --cc debian/patches/list_order.18 index 00000000,00000000..8528b67b new file mode 100644 --- /dev/null +++ b/debian/patches/list_order.18 @@@ -1,0 -1,0 +1,60 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-60) unstable; urgency=medium ++ . ++ * list_order.17 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-01-23 ++ ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp ++@@ -483,6 +483,12 @@ Cannot compile ~a.~%" ++ ++ (defvar *use-buggy* nil) ++ +++(defun remove-flag (flag flags) +++ (let ((i (search flag flags))) +++ (if i +++ (concatenate 'string (subseq flags 0 i) (remove-flag flag (subseq flags (+ i (length flag))))) +++ flags))) +++ ++ (defun compiler-command (&rest args &aux na ) ++ (declare (special *c-debug*)) ++ (let ((dirlist (pathname-directory (first args))) ++@@ -493,7 +499,7 @@ Cannot compile ~a.~%" ++ (setq na (namestring ++ (make-pathname :name name :type (pathname-type(first args))))) ++ (format nil "~a ~a -I~a ~a ~a -c ~a -o ~a ~a" ++- *cc* +++ (if *prof-p* (remove-flag "-fomit-frame-pointer" *cc*) *cc*) ++ (if *prof-p* " -pg " "") ++ (concatenate 'string si::*system-directory* "../h") ++ (if (and (boundp '*c-debug*) *c-debug*) " -g " "") ++--- gcl-2.6.12.orig/o/makefile +++++ gcl-2.6.12/o/makefile ++@@ -34,7 +34,7 @@ boot.o: boot.c $(DECL) boot.h ++ $(CC) -c $(CFLAGS) $(DEFS) -fPIC $*.c $(AUX_INFO) ++ ++ gprof.o: gprof.c $(DECL) ++- $(CC) -c $(CFLAGS) $(DEFS) -pg $*.c $(AUX_INFO) +++ $(CC) -c $(filter-out -fomit-frame-pointer,$(CFLAGS)) $(DEFS) -pg $*.c $(AUX_INFO) ++ ++ prelink.o: prelink.c $(DECL) ++ $(CC) -c $(filter-out -pg,$(CFLAGS)) -fPIE $(DEFS) $*.c $(AUX_INFO) diff --cc debian/patches/list_order.19 index 00000000,00000000..2c82b592 new file mode 100644 --- /dev/null +++ b/debian/patches/list_order.19 @@@ -1,0 -1,0 +1,218 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-60) unstable; urgency=medium ++ . ++ * list_order.18 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-01-24 ++ ++--- gcl-2.6.12.orig/lsp/gcl_mislib.lsp +++++ gcl-2.6.12/lsp/gcl_mislib.lsp ++@@ -166,24 +166,45 @@ ++ (setq *load-path* nl)) ++ nil) ++ ++-(defun default-symtab nil (concatenate 'string *tmp-dir* "gcl_symtab")) ++- ++ (defun gprof-output (symtab gmon) ++ (with-open-file ++ (s (format nil "|gprof -S '~a' '~a' '~a'" symtab (kcl-self) gmon)) ++ (copy-stream s *standard-output*))) ++ +++(defun write-symtab (symtab start end &aux (*package* (find-package "KEYWORD"))) +++ +++ (with-open-file +++ (s symtab :direction :output :if-exists :supersede) +++ +++ (format s "~16,'0x T ~a~%" start "GCL_MONSTART") ++ ++-(defun gprof-start (&optional (start 0 start-p) (end 0 end-p) (symtab (default-symtab))) ++- (unless end-p ++- (multiple-value-bind ++- (s e) ++- (gprof-addresses) ++- (setq start (if start-p start s) end e))) ++- (when (monstartup start end) ++- (write-symtab symtab start end))) +++ (dolist (p (list-all-packages)) +++ (do-symbols (x p) +++ (when (and (eq (symbol-package x) p) (fboundp x)) +++ (let* ((y (symbol-function x)) +++ (y (if (and (consp y) (eq 'macro (car y))) (cdr y) y)) +++ (y (if (compiled-function-p y) (function-start y) 0))) +++ (when (<= start y end) +++ (format s "~16,'0x T ~s~%" y x)))))) +++ +++ (let ((string-register "")) +++ (dotimes (i (ptable-alloc-length)) +++ (multiple-value-bind +++ (x y) (ptable i string-register) +++ (when (<= start x end) +++ (format s "~16,'0x T ~a~%" x y))))) +++ +++ (format s "~16,'0x T ~a~%" end "GCL_MONEND")) +++ +++ symtab) +++ +++(defun gprof-start (&optional (symtab "gcl_symtab") (adrs (gprof-addresses)) +++ &aux (start (car adrs))(end (cdr adrs))) +++ (let ((symtab (write-symtab symtab start end))) +++ (when (monstartup start end) +++ symtab))) ++ ++-(defun gprof-quit (&optional (symtab (default-symtab)) &aux (gmon (mcleanup))) +++(defun gprof-quit (&optional (symtab "gcl_symtab") &aux (gmon (mcleanup))) ++ (when gmon ++ (gprof-output symtab gmon))) ++ ++--- gcl-2.6.12.orig/o/fat_string.c +++++ gcl-2.6.12/o/fat_string.c ++@@ -59,17 +59,16 @@ DEFUN_NEW("PROFILE",object,fSprofile,SI ++ } ++ ++ #endif ++-DEFUN_NEW("FUNCTION-START",object,fSfunction_start,SI ++- ,1,1,NONE,OO,OO,OO,OO,(object funobj),"") ++-{/* 1 args */ ++- if(type_of(funobj)!=t_cfun ++- && type_of(funobj)!=t_sfun ++- && type_of(funobj)!=t_vfun ++- && type_of(funobj)!=t_afun ++- && type_of(funobj)!=t_gfun) ++- FEerror("not compiled function",0); ++- funobj=make_fixnum((long) (funobj->cf.cf_self)); ++- RETURN1(funobj); +++DEFUN_NEW("FUNCTION-START",object,fSfunction_start,SI,1,1,NONE,OO,OO,OO,OO,(object funobj),"") { +++ +++ switch (type_of(funobj)) { +++ case t_cfun:case t_sfun:case t_vfun:case t_afun:case t_gfun:case t_closure:case t_cclosure: +++ return make_fixnum((long) (funobj->cf.cf_self)); +++ default: +++ TYPE_ERROR(funobj,sLcompiled_function); +++ return Cnil; +++ } +++ ++ } ++ ++ /* begin fasl stuff*/ ++--- gcl-2.6.12.orig/o/gprof.c +++++ gcl-2.6.12/o/gprof.c ++@@ -12,13 +12,11 @@ DEFUN_NEW("MCLEANUP",object,fSmcleanup,S ++ if (!gprof_on) ++ return Cnil; ++ ++- massert(getcwd(FN1,sizeof(FN1))); ++- massert(!chdir(P_tmpdir)); ++- _mcleanup(); ++- massert(!chdir(FN1)); +++ massert((_mcleanup(),1)); ++ gprof_on=0; ++- massert(snprintf(FN1,sizeof(FN1),"%s/gmon.out",P_tmpdir)>0); ++- return make_simple_string(FN1); +++ +++ return make_simple_string("gmon.out"); +++ ++ } ++ ++ static inline int ++@@ -48,11 +46,10 @@ void ++ gprof_cleanup(void) { ++ ++ FFN(fSmcleanup)(); ++- /*rename gmon?*/ ++ ++ } ++ ++-DEFUNM_NEW("GPROF-ADDRESSES",object,fSgprof_addresses,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { +++DEFUN_NEW("GPROF-ADDRESSES",object,fSgprof_addresses,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { ++ ++ void *min=heap_end,*max=data_start,*c; ++ static void *mintext; ++@@ -77,10 +74,8 @@ DEFUNM_NEW("GPROF-ADDRESSES",object,fSgp ++ mintext=data_start; ++ ++ #ifdef GCL_GPROF ++- for (i=0;ip_link) ++- for (i=0,b=p->p_internal,be=b+p->p_internal_size;b; ++- b=i ? NULL : p->p_external,be=b+p->p_external_size,i=1) ++- for (;bc.c_cdr) ++- if ((f=(s=l->c.c_car)->s.s_gfdef)!=OBJNULL && s->s.s_hpack==(object)p) ++- switch(type_of(f)) { ++- case t_cfun:case t_sfun:case t_vfun:case t_afun:case t_gfun: ++- if ((ufixnum)f->cf.cf_self>=start && (ufixnum)f->cf.cf_selfcf.cf_self, ++- p->p_name->st.st_fillp,p->p_name->st.st_self, ++- s->st.st_fillp,s->st.st_self); ++- break; ++- } ++- fprintf(pp,"%016lx T GCL_MONEND\n",end); ++- ++- for (i=0;ist.st_self=(void *)c_table.ptable[i].string; +++ s->st.st_fillp=s->st.st_dim=strlen(s->st.st_self); +++ RETURN2(make_fixnum(c_table.ptable[i].address),s); ++ } diff --cc debian/patches/list_order.20 index 00000000,00000000..7e87bf07 new file mode 100644 --- /dev/null +++ b/debian/patches/list_order.20 @@@ -1,0 -1,0 +1,72 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-60) unstable; urgency=medium ++ . ++ * list_order.19 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-01-30 ++ ++--- gcl-2.6.12.orig/h/elf64_ppcle_reloc_special.h +++++ gcl-2.6.12/h/elf64_ppcle_reloc_special.h ++@@ -16,7 +16,7 @@ find_special_params(void *v,Shdr *sec1,S ++ Rela *r; ++ void *ve; ++ ++- massert((sec=get_section(".rela.plt",sec1,sece,sn))); +++ massert((sec=get_section(".rela.dyn",sec1,sece,sn))); ++ ++ v+=sec->sh_offset; ++ ve=v+sec->sh_size; ++--- gcl-2.6.12.orig/h/object.h +++++ gcl-2.6.12/h/object.h ++@@ -401,9 +401,9 @@ char *tmp_alloc; ++ */ ++ ++ #define ALLOC_ALIGNED(f, size,align) \ ++- (align <= sizeof(plong) ? (char *)((f)(size)) : \ ++- (tmp_alloc = (char *)((f)(size+(size ?(align)-1 : 0)))+(align)-1 , \ ++- (char *)(align * (((unsigned long)tmp_alloc)/align)))) +++ ({ufixnum _size=size,_align=align;_align <= sizeof(plong) ? (char *)((f)(_size)) : \ +++ (tmp_alloc = (char *)((f)(_size+(_size ?(_align)-1 : 0)))+(_align)-1 , \ +++ (char *)(_align * (((unsigned long)tmp_alloc)/_align)));}) ++ #define AR_ALLOC(f,n,type) (type *) \ ++ (ALLOC_ALIGNED(f,(n)*sizeof(type),sizeof(type))) ++ ++--- gcl-2.6.12.orig/o/fat_string.c +++++ gcl-2.6.12/o/fat_string.c ++@@ -47,13 +47,17 @@ DEFUN_NEW("PROFILE",object,fSprofile,SI ++ ++ object ar=sSAprofile_arrayA->s.s_dbind; ++ void *x; +++ fixnum a,s; ++ ++ if (type_of(ar)!=t_string) ++ FEerror("si:*Profile-array* not a string",0); ++ if( type_of(start_address)!=t_fixnum || type_of(scale)!=t_fixnum) ++ FEerror("Needs start address and scale as args",0); ++ ++- x=!(fix(start_address)*fix(scale)) ? NULL : (void *) (ar->ust.ust_self); +++ massert((a=fix(start_address))>=0); +++ massert((s=fix(scale))>=0); +++ +++ x=a&&s ? (void *) (ar->ust.ust_self) : NULL; ++ profil(x, (ar->ust.ust_dim),fix(start_address),fix(scale) << 8); ++ RETURN1(start_address); ++ } diff --cc debian/patches/list_order.21 index 00000000,00000000..a8fc1531 new file mode 100644 --- /dev/null +++ b/debian/patches/list_order.21 @@@ -1,0 -1,0 +1,48 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-61) unstable; urgency=medium ++ . ++ * list_order.20 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-01-30 ++ ++--- gcl-2.6.12.orig/h/alpha-linux.h +++++ gcl-2.6.12/h/alpha-linux.h ++@@ -5,12 +5,14 @@ ++ ++ #undef MPROTECT_ACTION_FLAGS ++ #define MPROTECT_ACTION_FLAGS SA_RESTART|SA_SIGINFO ++-#ifdef IN_GBC ++-#include ++-#define GET_FAULT_ADDR(sig,code,scp,addr) \ ++- (char *)((struct ucontext *)scp )->uc_mcontext.sc_traparg_a0 ++-#endif ++-#define SGC +++/* #ifdef IN_GBC */ +++/* #include */ +++/* #define GET_FAULT_ADDR(sig,code,scp,addr) \ no longer working*/ +++/* (char *)((struct ucontext *)scp )->uc_mcontext.sc_traparg_a0 */ +++/*#define GET_FAULT_ADDR(sig,code,sv,a) ((siginfo_t *)code)->si_addr perhaps try this when get access*/ +++/* #endif */ +++/* #define SGC */ +++#undef SGC ++ ++ #define RELOC_H "elf64_alpha_reloc.h" ++ #define SPECIAL_RELOC_H "elf64_alpha_reloc_special.h" diff --cc debian/patches/list_order.22 index 00000000,00000000..26481812 new file mode 100644 --- /dev/null +++ b/debian/patches/list_order.22 @@@ -1,0 -1,0 +1,62 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-61) unstable; urgency=medium ++ . ++ * list_order.21 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-02-01 ++ ++--- gcl-2.6.12.orig/o/sfaslelf.c +++++ gcl-2.6.12/o/sfaslelf.c ++@@ -55,12 +55,10 @@ License for more details. ++ #define ulmax(a_,b_) ({ul _a=a_,_b=b_;_a<_b ? _b : _a;}) ++ #define ALLOC_SEC(sec) (sec->sh_flags&SHF_ALLOC && (sec->sh_type==SHT_PROGBITS || sec->sh_type==SHT_NOBITS)) ++ #define LOAD_SEC(sec) (sec->sh_flags&SHF_ALLOC && sec->sh_type==SHT_PROGBITS) ++-#define EXT_SYM(sym) ({ul _b=ELF_ST_BIND(sym->st_info); \ ++- sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK);}) ++-#define LOCAL_SYM(sym) (sym->st_value && \ ++- ELF_ST_BIND(sym->st_info)==STB_LOCAL) ++- /* && ELF_ST_TYPE(sym->st_info)==STT_FUNC) */ ++-#define LOAD_SYM(sym) (EXT_SYM(sym)||LOCAL_SYM(sym)) +++#define LOAD_SYM(sym,st1) (sym->st_value && (EXT_SYM(sym,st1)||LOCAL_SYM(sym))) +++#define EXT_SYM(sym,st1) (ELF_ST_BIND(sym->st_info)==STB_GLOBAL||ELF_ST_BIND(sym->st_info)==STB_WEAK||LOAD_SYM_BY_NAME(sym,st1)) +++#define LOCAL_SYM(sym) ELF_ST_BIND(sym->st_info)==STB_LOCAL +++#define LOAD_SYM_BY_NAME(sym,st1) 0 ++ ++ #define MASK(n) (~(~0ULL << (n))) ++ ++@@ -412,7 +410,7 @@ calc_space(ul *ns,ul *sl,Sym *sym1,Sym * ++ ++ for (sym=sym1;sym ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-62) unstable; urgency=medium ++ . ++ * list_order.22 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-02-01 ++ ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp ++@@ -658,7 +658,7 @@ Cannot compile ~a.~%" ++ (defun make-user-init (files outn) ++ ++ (let* ((c (pathname outn)) ++- (c (merge-pathnames c (make-pathname :directory '(:current)))) +++ (c (merge-pathnames c (make-pathname :directory '(:relative)))) ++ (o (merge-pathnames (make-pathname :type "o") c)) ++ (c (merge-pathnames (make-pathname :type "c") c))) ++ ++@@ -769,7 +769,7 @@ Cannot compile ~a.~%" ++ ++ (with-open-file (st (namestring map) :direction :output)) ++ (safe-system ++- (let* ((par (namestring (make-pathname :directory '(:back)))) +++ (let* ((par (namestring (make-pathname :directory '(:relative :back)))) ++ (i (concatenate 'string " " par)) ++ (j (concatenate 'string " " si::*system-directory* par))) ++ (format nil "~a ~a ~a ~a -L~a ~a ~a ~a" ++--- gcl-2.6.12.orig/gcl-tk/makefile +++++ gcl-2.6.12/gcl-tk/makefile ++@@ -38,13 +38,13 @@ clean:: ++ rm -f ${GUIOS} $(OFILES) gcltkaux gcltksrv *.o */*.o demos/index.lsp *.fn demos/*.fn ++ ++ .c.o: ++- $(GCLTKCC) -c $(CFLAGS1) ${ODIR_DEBUG} $*.c +++ $(GCLTKCC) -c $(filter-out -pg,$(CFLAGS1)) -fPIE ${ODIR_DEBUG} $*.c ++ ++ ++ # for some reason -lieee is on various linux systems in the list of requireds.. ++ ++ gcltkaux: $(GUIOS) ++- $(LD_ORDINARY_CC) $(GUIOS) $(LDFLAGS) -o gcltkaux ${TK_LIB_SPEC} ${TCL_LIB_SPEC} +++ $(LD_ORDINARY_CC) $(GUIOS) $(filter-out %gcl.script,$(LDFLAGS)) -pie -o gcltkaux ${TK_LIB_SPEC} ${TCL_LIB_SPEC} ++ ++ gcltksrv: makefile ++ cat gcltksrv.in | sed -e "s!TK_LIBRARY=.*!TK_LIBRARY=${TK_LIBRARY}!g" \ ++--- gcl-2.6.12.orig/h/386-gnu.h +++++ gcl-2.6.12/h/386-gnu.h ++@@ -60,4 +60,4 @@ ++ ++ #define NEED_STACK_CHK_GUARD ++ ++-#define DEFINED_REAL_MAXPAGE (1UL<<18) /*FIXME brk probe broken*/ +++#undef HAVE_D_TYPE /*FIXME defined, but not implemented in readdir*/ ++--- gcl-2.6.12.orig/o/unixfsys.c +++++ gcl-2.6.12/o/unixfsys.c ++@@ -307,8 +307,11 @@ DEFUN_NEW("D-TYPE-LIST",object,fSd_type_ ++ MMcons(make_fixnum(DT_UNKNOWN),make_keyword("UNKNOWN")) ++ ) ++ #else +++#undef DT_UNKNOWN ++ #define DT_UNKNOWN 0 +++#undef DT_REG ++ #define DT_REG 1 +++#undef DT_DIR ++ #define DT_DIR 2 ++ list(3, ++ MMcons(make_fixnum(DT_REG),make_keyword("FILE")), diff --cc debian/patches/list_order.24 index 00000000,00000000..04332178 new file mode 100644 --- /dev/null +++ b/debian/patches/list_order.24 @@@ -1,0 -1,0 +1,44 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-63) unstable; urgency=medium ++ . ++ * list_order.23 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-02-04 ++ ++--- gcl-2.6.12.orig/h/gmp_wrappers.h +++++ gcl-2.6.12/h/gmp_wrappers.h ++@@ -148,6 +148,8 @@ MEM_GMP_CALL(1,gmp_ulint,mpz_popcount,0, ++ /*MEM_GMP_CALL(2,void *,mpz_realloc,mpz_t,mp_size_t)*/ ++ MEM_GMP_CALL(1,size_t,mpz_size,0,mpz_t) ++ MEM_GMP_CALL(2,size_t,mpz_sizeinbase,0,mpz_t,int) +++MEM_GMP_CALL(1,void,gmp_randinit_default,0,__gmp_randstate_struct *) +++MEM_GMP_CALL(2,void,gmp_randseed_ui,0,__gmp_randstate_struct *,unsigned long int) ++ ++ /* FIXME: find a way to have this follow the convention in gmp.h*/ ++ ++@@ -191,5 +193,7 @@ MEM_GMP_CALL(2,size_t,mpz_sizeinbase,0,m ++ /*#define __gmpz_realloc m__gmpz_realloc*/ ++ #define __gmpz_size m__gmpz_size ++ #define __gmpz_sizeinbase m__gmpz_sizeinbase +++#define __gmp_randinit_default m__gmp_randinit_default +++#define __gmp_randseed_ui m__gmp_randseed_ui ++ ++ #endif /*GMP_WRAPPERS_H*/ diff --cc debian/patches/list_order.25 index 00000000,00000000..ee4e2fb7 new file mode 100644 --- /dev/null +++ b/debian/patches/list_order.25 @@@ -1,0 -1,0 +1,81 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-64) unstable; urgency=medium ++ . ++ * list_order.24 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2018-02-22 ++ ++--- gcl-2.6.12.orig/makefile +++++ gcl-2.6.12/makefile ++@@ -149,7 +149,7 @@ command: ++ merge: ++ $(CC) -o merge merge.c ++ ++-LISP_LIB=cmpnew/gcl_collectfn.o cmpnew/gcl_collectfn.lsp xgcl-2/sysdef.lisp xgcl-2/gcl_dwtest.lsp xgcl-2/gcl_dwtestcases.lsp lsp/gcl_gprof.lsp lsp/gcl_info.o lsp/gcl_profile.lsp lsp/gcl_export.lsp lsp/gcl_autoload.lsp cmpnew/gcl_cmpmain.lsp cmpnew/gcl_cmpopt.lsp cmpnew/gcl_lfun_list.lsp lsp/gcl_auto_new.lsp h/cmpinclude.h unixport/init_$(SYSTEM).lsp unixport/lib$(SYSTEM).a unixport/libgclp.a gcl-tk/tk-package.lsp $(TK_LISP_LIB) $(RL_LIB) $(FIRST_FILE) $(LAST_FILE) $(addsuffix /sys-proclaim.lisp,lsp cmpnew pcl clcs) unixport/gcl.script +++LISP_LIB=cmpnew/gcl_collectfn.o cmpnew/gcl_collectfn.lsp xgcl-2/sysdef.lisp xgcl-2/gcl_dwtest.lsp xgcl-2/gcl_dwtestcases.lsp lsp/gcl_gprof.lsp lsp/gcl_info.o lsp/gcl_profile.lsp lsp/gcl_export.lsp lsp/gcl_autoload.lsp cmpnew/gcl_cmpmain.lsp cmpnew/gcl_cmpopt.lsp cmpnew/gcl_lfun_list.lsp lsp/gcl_auto_new.lsp h/cmpinclude.h unixport/sys_init.lsp unixport/lib$(SYSTEM).a unixport/libgclp.a gcl-tk/tk-package.lsp $(TK_LISP_LIB) $(RL_LIB) $(FIRST_FILE) $(LAST_FILE) $(addsuffix /sys-proclaim.lisp,lsp cmpnew pcl clcs) unixport/gcl.script ++ ++ install-command: ++ rm -f $(DESTDIR)$(prefix)/bin/gcl ++--- gcl-2.6.12.orig/unixport/makefile +++++ gcl-2.6.12/unixport/makefile ++@@ -69,13 +69,9 @@ $(LSPDIR)/auto_new.lsp: $(LSPDIR)/auto.l ++ [ "$(RL_OBJS)" = "" ] || \ ++ echo "(AUTOLOAD 'init-readline '|readline|)" >>$@ ++ ++-saved_%:raw_% $(RSYM) sys_init.lsp.in raw_%_map msys \ ++- $(CMPDIR)/gcl_cmpmain.lsp \ ++- $(CMPDIR)/gcl_lfun_list.lsp \ ++- $(CMPDIR)/gcl_cmpopt.lsp $(HDIR)/cmpinclude.h \ ++- $(LSPDIR)/gcl_auto_new.lsp +++sys_init.lsp: sys_init.lsp.in ++ ++- cat sys_init.lsp.in | sed \ +++ cat $< | sed \ ++ -e "s#@LI-VERS@#(`cat ../majvers`.`cat ../minvers`) `cat ../release`#1" \ ++ -e "s#@LI-EXTVERS@#`cat ../minvers | cut -f2 -d.`#1" \ ++ -e "s#@LI-MINVERS@#`cat ../minvers | cut -f1 -d.`#1" \ ++@@ -87,8 +83,16 @@ saved_%:raw_% $(RSYM) sys_init.lsp.in ra ++ -e "s#@LI-LD-LIBS@#\" $(LD_LIBS_POST)\"#1" \ ++ -e "s#@LI-OPT-THREE@#\"$(O3FLAGS)\"#1" \ ++ -e "s#@LI-OPT-TWO@#\"$(O2FLAGS)\"#1" \ ++- -e "s#@LI-INIT-LSP@#\"$@\"#1" >foo +++ -e "s#@LI-INIT-LSP@#\"$@\"#1" >$@ +++ +++ +++saved_%:raw_% $(RSYM) sys_init.lsp raw_%_map msys \ +++ $(CMPDIR)/gcl_cmpmain.lsp \ +++ $(CMPDIR)/gcl_lfun_list.lsp \ +++ $(CMPDIR)/gcl_cmpopt.lsp $(HDIR)/cmpinclude.h \ +++ $(LSPDIR)/gcl_auto_new.lsp ++ +++ cp sys_init.lsp foo ++ echo "(unless si::*quit-tags* (in-package \"USER\")(system:save-system \"$@\"))" >>foo ++ j=$$(ar t lib$*.a |grep ^gcl_);[ "$$j" = "" ] || ar x lib$*.a $$j #accelerator ++ $(PORTDIR)/raw_$*$(EXE) $(PORTDIR)/ -libdir $(GCLDIR)/ < foo ++@@ -156,7 +160,7 @@ map_%: ++ # $(CC) $(LD_FLAGS) -c -o $@ plt.c $(CFLAGS) -I$(HDIR) -I$(ODIR) ++ ++ clean: ++- rm -rf saved_*$(EXE) raw_*$(EXE) *.o core a.out $(RSYM) \ +++ rm -rf saved_*$(EXE) raw_*$(EXE) *.o core a.out $(RSYM) sys_init.lsp \ ++ $(LSPDIR)/auto_new.lsp foo *maxima* init_*.lsp lib*.a gmp* bfd* *.lsp.tmp \ ++ gazonk*.lsp plt*h *_map saved_* lib* raw_* msys out* log* tmp* gcl.script ++ diff --cc debian/patches/list_order.4 index 00000000,00000000..bebb20d1 new file mode 100644 --- /dev/null +++ b/debian/patches/list_order.4 @@@ -1,0 -1,0 +1,36 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-57) unstable; urgency=medium ++ . ++ * list_order.13 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2017-09-18 ++ ++--- gcl-2.6.12.orig/lsp/gcl_directory.lsp +++++ gcl-2.6.12/lsp/gcl_directory.lsp ++@@ -62,7 +62,7 @@ ++ (when (pathname-match-p dir v) ++ (push (merge-pathnames (parse-namestring dir nil *default-pathname-defaults* :start pos) pexp nil) r))) ++ :file) ++- (when (pathname-match-p dir v) (push pexp r)))) +++ (when (pathname-match-p dir v) (push (pathname (copy-seq (namestring pexp))) r)))) ++ (make-frame "")) ++ r) ++ diff --cc debian/patches/list_order.5 index 00000000,00000000..c3f200f8 new file mode 100644 --- /dev/null +++ b/debian/patches/list_order.5 @@@ -1,0 -1,0 +1,205 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-48) unstable; urgency=medium ++ . ++ * list_order.1 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2017-06-08 ++ ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -4188,6 +4188,7 @@ case $use in ++ mips*) ++ case $canonical in ++ mips64*linux*) +++# assert_arg_to_cflags -mxgot ++ assert_arg_to_ldflags -Wl,-z,now;; ++ esac ++ ;; ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -389,6 +389,7 @@ case $use in ++ mips*) ++ case $canonical in ++ mips64*linux*) +++# assert_arg_to_cflags -mxgot ++ assert_arg_to_ldflags -Wl,-z,now;; ++ esac ++ ;; ++--- gcl-2.6.12.orig/h/elf64_mips_reloc.h +++++ gcl-2.6.12/h/elf64_mips_reloc.h ++@@ -32,23 +32,14 @@ ++ if (s>=ggot && sr_addend=((void *)gote-(void *)got)-s; ++- switch(tp) { ++- case R_MIPS_GOT_HI16: ++- case R_MIPS_CALL_HI16: ++- r->r_info=((ul)R_MIPS_HI16<<56)|(r->r_info&MASK(32)); ++- relocate(sym1,r,((Rela *)r)->r_addend,start,got,gote); ++- break; ++- case R_MIPS_GOT_LO16: ++- case R_MIPS_CALL_LO16: ++- r->r_info=((ul)R_MIPS_LO16<<56)|(r->r_info&MASK(32)); ++- relocate(sym1,r,((Rela *)r)->r_addend,start,got,gote); ++- break; ++- default: ++- store_val(where,MASK(16),((void *)gote-(void *)got)); ++- break; ++- } +++ *gote=s+(MIPS_HIGH(a)<<16); +++ a=(void *)gote-(void *)got; +++ if (tp==R_MIPS_GOT_HI16||tp==R_MIPS_CALL_HI16) +++ a=MIPS_HIGH(a); +++ else if (tp==R_MIPS_GOT_LO16||tp==R_MIPS_CALL_LO16) +++ a&=MASK(16); +++ massert(!(a&~MASK(16))); +++ store_val(where,MASK(16),a); ++ break; ++ case R_MIPS_GOT_OFST: ++ recurse(s+a); ++@@ -63,8 +54,7 @@ ++ case R_MIPS_LO16: ++ recurse(s+a); ++ s+=a; ++- a=*where&MASK(16); ++- if (a&0x8000) a|=0xffffffffffff0000; +++ a=(short)*where; ++ a+=s&MASK(16); ++ a+=(a&0x8000)<<1; ++ store_val(where,MASK(16),a); ++--- gcl-2.6.12.orig/h/elf64_mips_reloc_special.h +++++ gcl-2.6.12/h/elf64_mips_reloc_special.h ++@@ -16,6 +16,7 @@ static ul ggot,ggote,la; static Rela *hr ++ ++ #undef ELF_R_TYPE ++ #define ELF_R_TYPE(a_) ELF_R_TYPE1(a_) +++#define MIPS_HIGH(a_) ({ul _a=(a_);(_a-(short)_a)>>16;}) ++ ++ typedef struct { ++ ul entry,gotoff; ++@@ -98,12 +99,12 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ Sym *sym; ++ Shdr *sec; ++ void *v,*ve; ++- ul q=0,a,b; +++ ul a,b; ++ ++ for (sym=sym1;symst_size=0; +++ sym->st_other=sym->st_size=0; ++ ++- for (*gs=0,sec=sec1;secsh_type==SHT_RELA) ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++ if (ELF_R_TYPE(r->r_info)==R_MIPS_CALL16|| ++@@ -116,24 +117,37 @@ label_got_symbols(void *v1,Shdr *sec1,Sh ++ ++ sym=sym1+ELF_R_SYM(r->r_info); ++ ++- a=r->r_addend>>15; +++ /*unlikely to save got space by recording possible holes in addend range*/ +++ if ((a=MIPS_HIGH(r->r_addend)+1)>sym->st_other) +++ sym->st_other=a; +++ +++ } ++ ++- if (2*a>=sizeof(sym->st_size) || !((sym->st_size>>(a*16))&0xffff)) { +++ for (*gs=0,sec=sec1;secsh_type==SHT_RELA) +++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) +++ if (ELF_R_TYPE(r->r_info)==R_MIPS_CALL16|| +++ ELF_R_TYPE(r->r_info)==R_MIPS_GOT_DISP|| +++ ELF_R_TYPE(r->r_info)==R_MIPS_GOT_HI16|| +++ ELF_R_TYPE(r->r_info)==R_MIPS_GOT_LO16|| +++ ELF_R_TYPE(r->r_info)==R_MIPS_CALL_HI16|| +++ ELF_R_TYPE(r->r_info)==R_MIPS_CALL_LO16|| +++ ELF_R_TYPE(r->r_info)==R_MIPS_GOT_PAGE) { ++ ++- q=++*gs; ++- if (2*ast_size)) { ++- massert(q<=0xffff); ++- sym->st_size|=(q<<(a*16)); ++- } ++- ++- massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); +++ sym=sym1+ELF_R_SYM(r->r_info); ++ +++ if (sym->st_other) { +++ sym->st_size=++*gs; +++ if (sym->st_other>1) +++ (*gs)+=sym->st_other-1; +++ else +++ massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); +++ sym->st_other=0; ++ } ++ ++ b=sizeof(r->r_addend)*4; ++ massert(!(r->r_addend>>b)); ++- q=2*a>=sizeof(sym->st_size) ? q : (sym->st_size>>(a*16))&0xffff; ++- r->r_addend|=(q<<=b); +++ r->r_addend|=((sym->st_size+MIPS_HIGH(r->r_addend))<s=0; ++ unlock_pool(); ++ ++- f.l_type=F_UNLCK; ++- massert(!fcntl(pool,F_SETLK,&f)); ++- ++- fprintf(stderr,"Initializing pool\n"); ++- fflush(stderr); ++- ++ } ++ ++ f.l_type=F_RDLCK; ++- massert(!fcntl(pool,F_SETLK,&f)); +++ plp=&f; +++ massert(!set_lock()); +++ +++ plp=&pl; ++ ++ register_pool(1); ++ massert(!atexit(close_pool)); diff --cc debian/patches/list_order.6 index 00000000,00000000..285f16e7 new file mode 100644 --- /dev/null +++ b/debian/patches/list_order.6 @@@ -1,0 -1,0 +1,103 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-49) unstable; urgency=medium ++ . ++ * list_order.5 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2017-06-13 ++ ++--- gcl-2.6.12.orig/o/eval.c +++++ gcl-2.6.12/o/eval.c ++@@ -96,18 +96,18 @@ quick_call_sfun(object fun) { ++ ++ } ++ ++-/* only for sfun not gfun !! Does not check number of args */ ++-static void ++-call_sfun_no_check(object fun) ++-{ DEBUG_AVMA ++- int n; ++- object *base=vs_base; ++- n=vs_top - base; ++- base[0]=c_apply_n_fun(fun,n,base); ++- vs_top=(vs_base=base)+1; ++- CHECK_AVMA; ++- return; ++-} +++/* /\* only for sfun not gfun !! Does not check number of args *\/ */ +++/* static void */ +++/* call_sfun_no_check(object fun) */ +++/* { DEBUG_AVMA */ +++/* int n; */ +++/* object *base=vs_base; */ +++/* n=vs_top - base; */ +++/* base[0]=c_apply_n_fun(fun,n,base); */ +++/* vs_top=(vs_base=base)+1; */ +++/* CHECK_AVMA; */ +++/* return; */ +++/* } */ ++ static void ++ call_vfun(object fun) ++ { DEBUG_AVMA ++@@ -615,10 +615,11 @@ super_funcall_no_event(object fun) { ++ ++ switch(type_of(fun)) { ++ case t_cfun: ++- (*fun->cf.cf_self)(); ++- return; +++ (*fun->cf.cf_self)(); return; +++ case t_cclosure: +++ (*fun->cc.cc_self)(fun); return; ++ case t_sfun: ++- call_sfun_no_check(fun); return; +++ /* call_sfun_no_check(fun); return; */ ++ case t_gfun: ++ quick_call_sfun(fun); return; ++ case t_vfun: ++@@ -631,7 +632,7 @@ super_funcall_no_event(object fun) { ++ super_funcall_no_event(fun->s.s_gfdef); ++ return; ++ default: ++- funcall_no_event(fun); +++ funcall(fun); ++ } ++ ++ } ++--- gcl-2.6.12.orig/o/read.d +++++ gcl-2.6.12/o/read.d ++@@ -1176,6 +1176,7 @@ Lsharp_left_parenthesis_reader() ++ goto L; ++ } ++ vs_base[0]=list(4,siScomma,sLapply,list(2,sLquote,sLvector),vs_base[2]); +++ vs_top=vs_base+1; ++ return; ++ } ++ vsp = vs_top; ++--- gcl-2.6.12.orig/o/sgbc.c +++++ gcl-2.6.12/o/sgbc.c ++@@ -369,7 +369,7 @@ memprotect_handler_test(int sig, long co ++ do_gcl_abort(); ++ } ++ memprotect_handler_invocations=1; ++- if (faddr!=memprotect_test_address) +++ if (page(faddr)!=page(memprotect_test_address)) ++ memprotect_result=memprotect_bad_fault_address; ++ else ++ memprotect_result=memprotect_none; diff --cc debian/patches/list_order.7 index 00000000,00000000..526b7ee5 new file mode 100644 --- /dev/null +++ b/debian/patches/list_order.7 @@@ -1,0 -1,0 +1,47 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-50) unstable; urgency=medium ++ . ++ * list_order.6 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2017-06-14 ++ ++--- gcl-2.6.12.orig/h/m68k-linux.h +++++ gcl-2.6.12/h/m68k-linux.h ++@@ -63,7 +63,7 @@ ++ ++ ++ #define M68K ++-#define SGC +++/* #define SGC *//*FIXME: Unknown m68k cpu in modern emulators*/ ++ ++ #include ++ int cacheflush(void *,int,int,int); ++--- gcl-2.6.12.orig/o/sgbc.c +++++ gcl-2.6.12/o/sgbc.c ++@@ -871,7 +871,7 @@ sgc_quit(void) { ++ f=n; ++ n=OBJ_LINK(n); ++ } ++- SET_LINK(f,OBJNULL); +++ SET_LINK(f,n!=OBJNULL ? n : o); ++ tm->tm_tail=f; ++ tm->tm_nfree += tm->tm_alt_nfree; ++ tm->tm_alt_nfree = 0; diff --cc debian/patches/list_order.8 index 00000000,00000000..37103e27 new file mode 100644 --- /dev/null +++ b/debian/patches/list_order.8 @@@ -1,0 -1,0 +1,78 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-51) unstable; urgency=medium ++ . ++ * list_order.7 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2017-06-15 ++ ++--- gcl-2.6.12.orig/o/gbc.c +++++ gcl-2.6.12/o/gbc.c ++@@ -966,6 +966,11 @@ sweep_phase(void) { ++ STATIC object f; ++ STATIC struct pageinfo *v; ++ +++ for (j= t_start; j < t_contiguous ; j++) { +++ tm_of(j)->tm_free=OBJNULL; +++ tm_of(j)->tm_nfree=0; +++ } +++ ++ for (v=cell_list_head;v;v=v->next) { ++ ++ tm = tm_of((enum type)v->type); ++@@ -975,22 +980,23 @@ sweep_phase(void) { ++ k = 0; ++ for (j = tm->tm_nppage; j > 0; --j, p += tm->tm_size) { ++ x = (object)p; ++- if (is_free(x)) ++- continue; ++- else if (is_marked(x)) { +++ +++ if (is_marked(x)) { ++ unmark(x); ++ continue; ++ } ++ ++- SET_LINK(f,x); ++ make_free(x); +++ SET_LINK(f,x); ++ f = x; ++ k++; +++ ++ } +++ ++ SET_LINK(f,OBJNULL); ++ tm->tm_tail = f; ++ tm->tm_nfree += k; ++- pagetoinfo(page(v))->in_use-=k; +++ pagetoinfo(page(v))->in_use=tm->tm_nppage-k; ++ ++ } ++ ++--- gcl-2.6.12.orig/o/sgbc.c +++++ gcl-2.6.12/o/sgbc.c ++@@ -873,6 +873,7 @@ sgc_quit(void) { ++ } ++ SET_LINK(f,n!=OBJNULL ? n : o); ++ tm->tm_tail=f; +++ for (;OBJ_LINK(tm->tm_tail)!=OBJNULL;tm->tm_tail=OBJ_LINK(tm->tm_tail)); ++ tm->tm_nfree += tm->tm_alt_nfree; ++ tm->tm_alt_nfree = 0; ++ tm->tm_alt_free = OBJNULL; diff --cc debian/patches/list_order.9 index 00000000,00000000..4cbf3b41 new file mode 100644 --- /dev/null +++ b/debian/patches/list_order.9 @@@ -1,0 -1,0 +1,146 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-52) unstable; urgency=medium ++ . ++ * list_order.8 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2017-06-18 ++ ++--- gcl-2.6.12.orig/o/gbc.c +++++ gcl-2.6.12/o/gbc.c ++@@ -959,7 +959,7 @@ mark_c_stack(jmp_buf env1, int n, void ( ++ static void ++ sweep_phase(void) { ++ ++- STATIC long j, k; +++ STATIC long j, k, l; ++ STATIC object x; ++ STATIC char *p; ++ STATIC struct typemanager *tm; ++@@ -977,26 +977,28 @@ sweep_phase(void) { ++ ++ p = pagetochar(page(v)); ++ f = FREELIST_TAIL(tm); ++- k = 0; +++ l = k = 0; ++ for (j = tm->tm_nppage; j > 0; --j, p += tm->tm_size) { ++ x = (object)p; ++ ++ if (is_marked(x)) { ++ unmark(x); +++ l++; ++ continue; ++ } ++ +++ k++; +++ ++ make_free(x); ++ SET_LINK(f,x); ++ f = x; ++- k++; ++ ++ } ++ ++ SET_LINK(f,OBJNULL); ++ tm->tm_tail = f; ++ tm->tm_nfree += k; ++- pagetoinfo(page(v))->in_use=tm->tm_nppage-k; +++ pagetoinfo(page(v))->in_use=l; ++ ++ } ++ ++--- gcl-2.6.12.orig/o/sgbc.c +++++ gcl-2.6.12/o/sgbc.c ++@@ -152,7 +152,7 @@ sgc_mark_phase(void) { ++ ++ static void ++ sgc_sweep_phase(void) { ++- STATIC long j, k; +++ STATIC long j, k, l; ++ STATIC object x; ++ STATIC char *p; ++ STATIC struct typemanager *tm; ++@@ -160,13 +160,18 @@ sgc_sweep_phase(void) { ++ int size; ++ STATIC struct pageinfo *v; ++ +++ for (j= t_start; j < t_contiguous ; j++) { +++ tm_of(j)->tm_free=OBJNULL; +++ tm_of(j)->tm_nfree=0; +++ } +++ ++ for (v=cell_list_head;v;v=v->next) { ++ ++ tm = tm_of((enum type)v->type); ++ ++ p = pagetochar(page(v)); ++ f = FREELIST_TAIL(tm); ++- k = 0; +++ l = k = 0; ++ size=tm->tm_size; ++ ++ if (v->sgc_flags&SGC_PAGE_FLAG) { ++@@ -175,10 +180,9 @@ sgc_sweep_phase(void) { ++ ++ x = (object)p; ++ ++- if (is_free(x)) ++- continue; ++- else if (is_marked(x)) { +++ if (is_marked(x)) { ++ unmark(x); +++ l++; ++ continue; ++ } ++ ++@@ -187,26 +191,26 @@ sgc_sweep_phase(void) { ++ continue; ++ #endif ++ ++- /* it is ok to free x */ ++- ++- SET_LINK(f,x); +++ k++; ++ make_free(x); +++ SET_LINK(f,x); +++ f = x; +++ ++ #ifndef SGC_WHOLE_PAGE ++ if (TYPEWORD_TYPE_P(v->type)) x->d.s = SGC_RECENT; ++ #endif ++- f = x; ++- k++; ++ ++ } +++ ++ SET_LINK(f,OBJNULL); ++ tm->tm_tail = f; ++ tm->tm_nfree += k; ++- v->in_use-=k; +++ v->in_use=l; ++ ++ } else if (WRITABLE_PAGE_P(page(v))) /*non sgc_page */ ++ for (j = tm->tm_nppage; --j >= 0; p += size) { ++ x = (object)p; ++- if (is_marked(x) && !is_free(x)) { +++ if (is_marked(x)) { ++ unmark(x); ++ } ++ } diff --cc debian/patches/pathnames1.1 index 00000000,00000000..d4b661e1 new file mode 100644 --- /dev/null +++ b/debian/patches/pathnames1.1 @@@ -1,0 -1,0 +1,18763 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-38) unstable; urgency=medium ++ . ++ * Version_2_6_13pre50 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2016-10-11 ++ ++--- gcl-2.6.12.orig/ansi-tests/ansi-aux.lsp +++++ gcl-2.6.12/ansi-tests/ansi-aux.lsp ++@@ -80,6 +80,10 @@ Results: ~A~%" expected-number form n re ++ "Like EQUALP, but guaranteed to return T for true." ++ (apply #'values (mapcar #'notnot (multiple-value-list (equalp x y))))) ++ +++(defun equalpt-or-report (x y) +++ "Like EQUALPT, but return either T or a list of the arguments." +++ (or (equalpt x y) (list x y))) +++ ++ (defun =t (x &rest args) ++ "Like =, but guaranteed to return T for true." ++ (apply #'values (mapcar #'notnot (multiple-value-list (apply #'= x args))))) ++@@ -223,6 +227,13 @@ Results: ~A~%" expected-number form n re ++ P x p1 x TYPE p2) ++ t))))) ++ +++(defun check-predicate (predicate &optional guard (universe *universe*)) +++ "Return all elements of UNIVERSE for which the guard (if present) is false +++ and for which PREDICATE is false." +++ (remove-if #'(lambda (e) (or (and guard (funcall guard e)) +++ (funcall predicate e))) +++ universe)) +++ ++ (declaim (special *catch-error-type*)) ++ ++ (defun catch-continue-debugger-hook (condition dbh) ++@@ -296,7 +307,167 @@ the condition to go uncaught if it canno ++ (defmacro classify-error (form) ++ `(classify-error** ',form)) ++ +++(defun sequencep (x) (typep x 'sequence)) +++ ++ ;;; +++(defun typef (type) #'(lambda (x) (typep x type))) +++ +++(defmacro signals-error (form error-name &key (safety 3) (name nil name-p) (inline nil)) +++ `(handler-bind +++ ((warning #'(lambda (c) (declare (ignore c)) +++ (muffle-warning)))) +++ (proclaim '(optimize (safety 3))) +++ (handler-case +++ (apply #'values +++ nil +++ (multiple-value-list +++ ,(cond +++ (inline form) +++ (regression-test::*compile-tests* +++ `(funcall (compile nil '(lambda () +++ (declare (optimize (safety ,safety))) +++ ,form)))) +++ (t `(eval ',form))))) +++ (,error-name (c) +++ (cond +++ ,@(case error-name +++ (type-error +++ `(((typep (type-error-datum c) +++ (type-error-expected-type c)) +++ (values +++ nil +++ (list (list 'typep (list 'quote +++ (type-error-datum c)) +++ (list 'quote +++ (type-error-expected-type c))) +++ "==> true"))))) +++ ((undefined-function unbound-variable) +++ (and name-p +++ `(((not (eq (cell-error-name c) ',name)) +++ (values +++ nil +++ (list 'cell-error-name "==>" +++ (cell-error-name c))))))) +++ ((stream-error end-of-file reader-error) +++ `(((not (streamp (stream-error-stream c))) +++ (values +++ nil +++ (list 'stream-error-stream "==>" +++ (stream-error-stream c)))))) +++ (file-error +++ `(((not (pathnamep (pathname (file-error-pathname c)))) +++ (values +++ nil +++ (list 'file-error-pathname "==>" +++ (file-error-pathname c)))))) +++ (t nil)) +++ (t (printable-p c))))))) +++ +++(defmacro signals-error-always (form error-name) +++ `(values +++ (signals-error ,form ,error-name) +++ (signals-error ,form ,error-name :safety 0))) +++ +++(defmacro signals-type-error (var datum-form form &key (safety 3) (inline nil)) +++ (let ((lambda-form +++ `(lambda (,var) +++ (declare (optimize (safety ,safety))) +++ ,form))) +++ `(let ((,var ,datum-form)) +++ (declare (optimize safety)) +++ (handler-bind +++ ((warning #'(lambda (c) (declare (ignore c)) +++ (muffle-warning)))) +++ ; (proclaim '(optimize (safety 3))) +++ (handler-case +++ (apply #'values +++ nil +++ (multiple-value-list +++ (funcall +++ ,(cond +++ (inline `(function ,lambda-form)) +++ (regression-test::*compile-tests* +++ `(compile nil ',lambda-form)) +++ (t `(eval ',lambda-form))) +++ ,var))) +++ (type-error +++ (c) +++ (let ((datum (type-error-datum c)) +++ (expected-type (type-error-expected-type c))) +++ (cond +++ ((not (eql ,var datum)) +++ (list :datum-mismatch ,var datum)) +++ ((typep datum expected-type) +++ (list :is-typep datum expected-type)) +++ (t (printable-p c)))))))))) +++ +++(declaim (special *mini-universe*)) +++ +++(defun check-type-error* (pred-fn guard-fn &optional (universe *mini-universe*)) +++ "Check that for all elements in some set, either guard-fn is true or +++ pred-fn signals a type error." +++ (let (val) +++ (loop for e in universe +++ unless (or (funcall guard-fn e) +++ (equal +++ (setf val (multiple-value-list +++ (signals-type-error x e (funcall pred-fn x) :inline t))) +++ '(t))) +++ collect (list e val)))) +++ +++(defmacro check-type-error (&body args) +++ `(locally (declare (optimize safety)) (check-type-error* ,@args))) +++ +++(defun printable-p (obj) +++ "Returns T iff obj can be printed to a string." +++ (with-standard-io-syntax +++ (let ((*print-readably* nil) +++ (*print-escape* nil)) +++ (declare (optimize safety)) +++ (handler-case (and (stringp (write-to-string obj)) t) +++ (condition (c) (declare (ignore c)) nil))))) +++ +++(defun make-special-string (string &key fill adjust displace base) +++ (let* ((len (length string)) +++ (len2 (if fill (+ len 4) len)) +++ (etype (if base 'base-char 'character))) +++ (if displace +++ (let ((s0 (make-array (+ len2 5) +++ :initial-contents +++ (concatenate 'string +++ (make-string 2 :initial-element #\X) +++ string +++ (make-string (if fill 7 3) +++ :initial-element #\Y)) +++ :element-type etype))) +++ (make-array len2 :element-type etype +++ :adjustable adjust +++ :fill-pointer (if fill len nil) +++ :displaced-to s0 +++ :displaced-index-offset 2)) +++ (make-array len2 :element-type etype +++ :initial-contents +++ (if fill (concatenate 'string string "ZZZZ") string) +++ :fill-pointer (if fill len nil) +++ :adjustable adjust)))) +++ +++(defmacro do-special-strings ((var string-form &optional ret-form) &body forms) +++ (let ((string (gensym)) +++ (fill (gensym "FILL")) +++ (adjust (gensym "ADJUST")) +++ (base (gensym "BASE")) +++ (displace (gensym "DISPLACE"))) +++ `(let ((,string ,string-form)) +++ (dolist (,fill '(nil t) ,ret-form) +++ (dolist (,adjust '(nil t)) +++ (dolist (,base '(nil t)) +++ (dolist (,displace '(nil t)) +++ (let ((,var (make-special-string +++ ,string +++ :fill ,fill :adjust ,adjust +++ :base ,base :displace ,displace))) +++ ,@forms)))))))) +++ ++ ;;; A scaffold is a structure that is used to remember the object ++ ;;; identities of the cons cells in a (noncircular) data structure. ++ ;;; This lets us check if the data structure has been changed by ++@@ -1307,6 +1478,13 @@ the condition to go uncaught if it canno ++ (unuse-package package using-package))) ++ (delete-package package)))) ++ +++(defun delete-all-versions (pathspec) +++ "Replace the versions field of the pathname specified by pathspec with +++ :wild, and delete all the files this refers to." +++ (let* ((wild-pathname (make-pathname :version :wild :defaults (pathname pathspec))) +++ (truenames (directory wild-pathname))) +++ (mapc #'delete-file truenames))) +++ ++ (defconstant +fail-count-limit+ 20) ++ ++ (defmacro test-with-package-iterator (package-list-expr &rest symbol-types) ++@@ -1455,3 +1633,5 @@ the condition to go uncaught if it canno ++ (list n1) ++ (random-partition n3 (- p 1 r)))))))))) ++ +++(defmacro expand-in-current-env (macro-form &environment env) +++ (macroexpand macro-form env)) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/broadcast-stream-streams.lsp ++@@ -0,0 +1,30 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Thu Jan 29 22:06:28 2004 +++;;;; Contains: Tests of BROADCAST-STREAM-STREAMS +++ +++(in-package :cl-test) +++ +++(deftest broadcast-stream-streams.1 +++ (broadcast-stream-streams (make-broadcast-stream)) +++ nil) +++ +++(deftest broadcast-stream-streams.2 +++ (equalt +++ (broadcast-stream-streams (make-broadcast-stream *standard-output*)) +++ (list *standard-output*)) +++ t) +++ +++(deftest broadcast-stream-streams.error.1 +++ (signals-error (broadcast-stream-streams) program-error) +++ t) +++ +++(deftest broadcast-stream-streams.error.2 +++ (signals-error (broadcast-stream-streams (make-broadcast-stream) nil) +++ program-error) +++ t) +++ +++ +++ +++ +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/clear-input.lsp ++@@ -0,0 +1,64 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Wed Jan 28 06:12:39 2004 +++;;;; Contains: Tests of CLEAR-INPUT +++ +++(in-package :cl-test) +++ +++;;; These tests are limited, since whether an input stream can be +++;;; cleared is not well specified. +++ +++(deftest clear-input.1 +++ (loop for s in (list *debug-io* *query-io* +++ *standard-input* *terminal-io*) +++ always (eq (clear-input s) nil)) +++ t) +++ +++(deftest clear-input.2 +++ (clear-input) +++ nil) +++ +++(deftest clear-input.3 +++ (clear-input nil) +++ nil) +++ +++(deftest clear-input.4 +++ (clear-input t) +++ nil) +++ +++(deftest clear-input.5 +++ (with-input-from-string +++ (is "!?*") +++ (let ((*terminal-io* (make-two-way-stream is (make-broadcast-stream)))) +++ (clear-input t))) +++ nil) +++ +++(deftest clear-input.6 +++ (with-input-from-string +++ (*standard-input* "345") +++ (clear-input nil)) +++ nil) +++ +++;;; Error cases +++ +++(deftest clear-input.error.1 +++ :notes (:assume-no-simple-streams) +++ (signals-error (clear-input t nil) program-error) +++ t) +++ +++(deftest clear-input.error.2 +++ :notes (:assume-no-simple-streams) +++ (signals-error (clear-input nil nil) program-error) +++ t) +++ +++(deftest clear-input.error.3 +++ (signals-error (clear-input t nil nil) program-error) +++ t) +++ +++(deftest clear-input.error.4 +++ (signals-error (clear-input nil nil nil) program-error) +++ t) +++ +++(deftest clear-input.error.5 +++ (check-type-error #'clear-input #'(lambda (x) (typep x '(or stream (member nil t))))) +++ nil) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/clear-output.lsp ++@@ -0,0 +1,53 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Wed Jan 28 06:43:17 2004 +++;;;; Contains: Tests of CLEAR-OUTPUT +++ +++(in-package :cl-test) +++ +++(deftest clear-output.1 +++ (progn (finish-output) (clear-output)) +++ nil) +++ +++(deftest clear-output.2 +++ (progn (finish-output) (clear-output t)) +++ nil) +++ +++(deftest clear-output.3 +++ (progn (finish-output) (clear-output nil)) +++ nil) +++ +++(deftest clear-output.4 +++ (loop for s in (list *debug-io* *error-output* *query-io* +++ *standard-output* *trace-output* *terminal-io*) +++ for dummy = (finish-output s) +++ for results = (multiple-value-list (clear-output s)) +++ unless (equal results '(nil)) +++ collect s) +++ nil) +++ +++(deftest clear-output.5 +++ (let ((os (make-string-output-stream))) +++ (let ((*terminal-io* (make-two-way-stream (make-string-input-stream "") +++ os))) +++ (clear-output t))) +++ nil) +++ +++(deftest clear-output.6 +++ (let ((*standard-output* (make-string-output-stream))) +++ (clear-output nil)) +++ nil) +++ +++;;; Error tests +++ +++(deftest clear-output.error.1 +++ (signals-error (clear-output nil nil) program-error) +++ t) +++ +++(deftest clear-output.error.2 +++ (signals-error (clear-output t nil) program-error) +++ t) +++ +++(deftest clear-output.error.3 +++ (check-type-error #'clear-output #'(lambda (x) (typep x '(or stream (member nil t))))) +++ nil) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/compile-file-test-file.lsp ++@@ -0,0 +1,3 @@ +++(in-package "CL-TEST") +++ +++(defun compile-file-test-fun.1 () nil) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/concatenated-stream-streams.lsp ++@@ -0,0 +1,67 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Feb 14 08:43:45 2004 +++;;;; Contains: Tests of CONCATENATED-STREAM-STREAMS +++ +++(in-package :cl-test) +++ +++(deftest concatenated-stream-streams.1 +++ (concatenated-stream-streams (make-concatenated-stream)) +++ nil) +++ +++(deftest concatenated-stream-streams.2 +++ (equalt (list (list *standard-input*)) +++ (multiple-value-list +++ (concatenated-stream-streams +++ (make-concatenated-stream *standard-input*)))) +++ t) +++ +++(deftest concatenated-stream-streams.3 +++ (with-input-from-string +++ (s1 "abc") +++ (with-input-from-string +++ (s2 "def") +++ (let ((s (make-concatenated-stream s1 s2))) +++ (equalt (list (list s1 s2)) +++ (multiple-value-list +++ (concatenated-stream-streams s)))))) +++ t) +++ +++(deftest concatenated-stream-streams.4 +++ (with-input-from-string +++ (s1 "") +++ (with-input-from-string +++ (s2 "def") +++ (let ((s (make-concatenated-stream s1 s2))) +++ (equalt (list (list s1 s2)) +++ (multiple-value-list +++ (concatenated-stream-streams s)))))) +++ t) +++ +++(deftest concatenated-stream-streams.5 +++ (with-input-from-string +++ (s1 "") +++ (with-input-from-string +++ (s2 "def") +++ (let ((s (make-concatenated-stream s1 s2))) +++ (values +++ (read-char s) +++ (equalt (list (list s2)) +++ (multiple-value-list +++ (concatenated-stream-streams s))))))) +++ #\d t) +++ +++;;; Error cases +++ +++(deftest concatenated-stream-streams.error.1 +++ (signals-error (concatenated-stream-streams) program-error) +++ t) +++ +++(deftest concatenated-stream-streams.error.2 +++ (signals-error (concatenated-stream-streams +++ (make-concatenated-stream) +++ nil) +++ program-error) +++ t) +++ +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/delete-file.lsp ++@@ -0,0 +1,95 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Tue Jan 13 18:42:29 2004 +++;;;; Contains: Tests for DELETE-FILE +++ +++(in-package :cl-test) +++ +++(deftest delete-file.1 +++ (let ((pn "scratchfile.txt")) +++ (unless (probe-file pn) +++ (with-open-file (s pn :direction :output) +++ (format s "Contents~%"))) +++ (values +++ (notnot (probe-file pn)) +++ (multiple-value-list (delete-file pn)) +++ (probe-file pn))) +++ t (t) nil) +++ +++(deftest delete-file.2 +++ (let ((pn #p"scratchfile.txt")) +++ (unless (probe-file pn) +++ (with-open-file (s pn :direction :output) +++ (format s "Contents~%"))) +++ (values +++ (notnot (probe-file pn)) +++ (multiple-value-list (delete-file pn)) +++ (probe-file pn))) +++ t (t) nil) +++ +++(deftest delete-file.3 +++ (let ((pn "CLTEST:SCRATCHFILE.TXT")) +++ (assert (typep (pathname pn) 'logical-pathname)) +++ (unless (probe-file pn) +++ (with-open-file (s pn :direction :output) +++ (format s "Contents~%"))) +++ (values +++ (notnot (probe-file pn)) +++ (multiple-value-list (delete-file pn)) +++ (probe-file pn))) +++ t (t) nil) +++ +++(deftest delete-file.4 +++ (let ((pn "CLTEST:SCRATCHFILE.TXT")) +++ (assert (typep (pathname pn) 'logical-pathname)) +++ (unless (probe-file pn) +++ (with-open-file (s pn :direction :output) +++ (format s "Contents~%"))) +++ (let ((s (open pn :direction :input))) +++ (close s) +++ (values +++ (notnot (probe-file pn)) +++ (multiple-value-list (delete-file s)) +++ (probe-file pn)))) +++ t (t) nil) +++ +++;;; Specialized string tests +++ +++(deftest delete-file.5 +++ (do-special-strings +++ (pn "scratchfile.txt" nil) +++ (unless (probe-file pn) +++ (with-open-file (s pn :direction :output) +++ (format s "Contents~%"))) +++ (assert (probe-file pn)) +++ (assert (equal (multiple-value-list (delete-file pn)) '(t))) +++ (assert (not (probe-file pn)))) +++ nil) +++ +++;;; Error tests +++ +++(deftest delete-file.error.1 +++ (signals-error (delete-file) program-error) +++ t) +++ +++(deftest delete-file.error.2 +++ (let ((pn "scratch.txt")) +++ (unless (probe-file pn) +++ (with-open-file (s pn :direction :output) +++ (format s "Contents~%"))) +++ (values +++ (notnot (probe-file pn)) +++ (signals-error (delete-file "scratch.txt" nil) program-error) +++ (notnot (probe-file pn)) +++ (delete-file pn) +++ (probe-file pn))) +++ t t t t nil) +++ +++#| +++(deftest delete-file.error.3 +++ (let ((pn "nonexistent.txt")) +++ (when (probe-file pn) (delete-file pn)) +++ (signals-error (delete-file "nonexistent.txt") file-error)) +++ t) +++|# +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/directory-namestring.lsp ++@@ -0,0 +1,50 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sun Sep 12 06:21:42 2004 +++;;;; Contains: Tests for DIRECTORY-NAMESTRING +++ +++(in-package :cl-test) +++ +++(deftest directory-namestring.1 +++ (let* ((vals (multiple-value-list +++ (directory-namestring "directory-namestring.lsp"))) +++ (s (first vals))) +++ (if (and (null (cdr vals)) +++ (stringp s) +++ (equal (directory-namestring s) s)) +++ :good +++ vals)) +++ :good) +++ +++(deftest directory-namestring.2 +++ (do-special-strings +++ (s "directory-namestring.lsp" nil) +++ (let ((ns (directory-namestring s))) +++ (assert (stringp ns)) +++ (assert (string= (directory-namestring ns) ns)))) +++ nil) +++ +++;;; Lispworks makes another assumption about filename normalization +++;;; when using file streams as pathname designators, so this test +++;;; doesn't work there. +++;;; (This is another example of the difficulty of testing a feature +++;;; in which so much is left up to the implementation.) +++#-lispworks +++(deftest directory-namestring.3 +++ (let* ((name "directory-namestring.lsp") +++ (pn (merge-pathnames (pathname name))) +++ (name2 (with-open-file (s pn :direction :input) +++ (directory-namestring s))) +++ (name3 (directory-namestring pn))) +++ (or (equalt name2 name3) (list name2 name3))) +++ t) +++ +++;;; Error tests +++ +++(deftest directory-namestring.error.1 +++ (signals-error (directory-namestring) program-error) +++ t) +++ +++(deftest directory-namestring.error.2 +++ (signals-error (directory-namestring "directory-namestring.lsp" nil) program-error) +++ t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/directory.lsp ++@@ -0,0 +1,71 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Thu Jan 1 12:00:18 2004 +++;;;; Contains: Tests of DIRECTORY +++ +++(in-package :cl-test) +++ +++(deftest directory.1 +++ (directory "nonexistent") +++ nil) +++ +++(deftest directory.2 +++ (directory #p"nonexistent") +++ nil) +++ +++(deftest directory.3 +++ (directory "nonexistent" :allow-other-keys nil) +++ nil) +++ +++(deftest directory.4 +++ (directory "nonexistent" :allow-other-keys t :foo 'bar) +++ nil) +++ +++(deftest directory.5 +++ (directory "nonexistent" :foo 0 :allow-other-keys t) +++ nil) +++ +++(deftest directory.6 +++ (let* ((pattern-pathname (make-pathname :name :wild :type :wild +++ :defaults *default-pathname-defaults*)) +++ (pathnames (directory pattern-pathname))) +++ (values +++ (remove-if #'pathnamep pathnames) +++ (loop for pn in pathnames +++ unless (equal pn (truename pn)) +++ collect pn) +++;; (loop for pn in pathnames +++;; unless (pathname-match-p pn pattern-pathname) +++;; collect pn)) +++ )) +++ nil nil ;; nil +++ ) +++ +++(deftest directory.7 +++ (let* ((pattern-pathname (make-pathname :name :wild :type :wild +++ :defaults *default-pathname-defaults*)) +++ (pathnames (directory pattern-pathname))) +++ (loop for pn in pathnames +++ unless (equal pn (probe-file pn)) +++ collect pn)) +++ nil) +++ +++(deftest directory.8 +++ (let* ((pathname-pattern "CLTEST:*.*") +++ (len (length (directory pathname-pattern)))) +++ (if (< len 300) len nil)) +++ nil) +++ +++;;; Specialized string tests +++ +++(deftest directory.9 +++ (do-special-strings +++ (s "nonexistent" nil) +++ (assert (null (directory s)))) +++ nil) +++ +++;;; Error tests +++ +++(deftest directory.error.1 +++ (signals-error (directory) program-error) +++ t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/echo-stream-input-stream.lsp ++@@ -0,0 +1,27 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Thu Feb 12 04:30:40 2004 +++;;;; Contains: Tests of ECHO-STREAM-INPUT-STREAM +++ +++(in-package :cl-test) +++ +++(deftest echo-stream-input-stream.1 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-echo-stream is os))) +++ (equalt (multiple-value-list (echo-stream-input-stream s)) +++ (list is))) +++ t) +++ +++(deftest echo-stream-input-stream.error.1 +++ (signals-error (echo-stream-input-stream) program-error) +++ t) +++ +++(deftest echo-stream-input-stream.error.2 +++ (signals-error (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-echo-stream is os))) +++ (echo-stream-input-stream s nil)) +++ program-error) +++ t) +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/echo-stream-output-stream.lsp ++@@ -0,0 +1,26 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Thu Feb 12 04:32:33 2004 +++;;;; Contains: Tests off ECHO-STREAM-OUTPUT-STREAM +++ +++(in-package :cl-test) +++ +++(deftest echo-stream-output-stream.1 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-echo-stream is os))) +++ (equalt (multiple-value-list (echo-stream-output-stream s)) +++ (list os))) +++ t) +++ +++(deftest echo-stream-output-stream.error.1 +++ (signals-error (echo-stream-output-stream) program-error) +++ t) +++ +++(deftest echo-stream-output-stream.error.2 +++ (signals-error (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-echo-stream is os))) +++ (echo-stream-output-stream s nil)) +++ program-error) +++ t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/enough-namestring.lsp ++@@ -0,0 +1,84 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sun Sep 12 06:23:50 2004 +++;;;; Contains: Tests of ENOUGH-NAMESTRING +++ +++(in-package :cl-test) +++ +++(deftest enough-namestring.1 +++ (let* ((vals (multiple-value-list (enough-namestring "enough-namestring.lsp"))) +++ (s (first vals))) +++ (if (and (null (cdr vals)) +++ (stringp s) +++ (equal (enough-namestring s) s)) +++ :good +++ vals)) +++ :good) +++ +++(deftest enough-namestring.2 +++ (do-special-strings +++ (s "enough-namestring.lsp" nil) +++ (let ((ns (enough-namestring s))) +++ (assert (stringp ns)) +++ (assert (string= (enough-namestring ns) ns)))) +++ nil) +++ +++(deftest enough-namestring.3 +++ (let* ((name "enough-namestring.lsp") +++ (pn (merge-pathnames (pathname name))) +++ (name2 (enough-namestring pn)) +++ (name3 (enough-namestring name))) +++ (or (equalt name2 name3) (list name2 name3))) +++ t) +++ +++(deftest enough-namestring.4 +++ (let* ((name "enough-namestring.lsp") +++ (pn (merge-pathnames (pathname name))) +++ (name2 (with-open-file (s pn :direction :input) (enough-namestring s))) +++ (name3 (enough-namestring name))) +++ (or (equalt name2 name3) (list name2 name3))) +++ t) +++ +++(deftest enough-namestring.5 +++ (let* ((vals (multiple-value-list (enough-namestring "enough-namestring.lsp" +++ *default-pathname-defaults*))) +++ (s (first vals))) +++ (if (and (null (cdr vals)) +++ (stringp s) +++ (equal (enough-namestring s) s)) +++ :good +++ vals)) +++ :good) +++ +++(deftest enough-namestring.6 +++ (let* ((vals (multiple-value-list (enough-namestring "enough-namestring.lsp" +++ (namestring *default-pathname-defaults*)))) +++ (s (first vals))) +++ (if (and (null (cdr vals)) +++ (stringp s) +++ (equal (enough-namestring s) s)) +++ :good +++ vals)) +++ :good) +++ +++(deftest enough-namestring.7 +++ (do-special-strings +++ (s (namestring *default-pathname-defaults*) nil) +++ (let* ((vals (multiple-value-list (enough-namestring "enough-namestring.lsp" s))) +++ (s2 (first vals))) +++ (assert (null (cdr vals))) +++ (assert (stringp s2)) +++ (assert (equal (enough-namestring s2) s2)))) +++ nil) +++ +++;;; Error tests +++ +++(deftest enough-namestring.error.1 +++ (signals-error (enough-namestring) program-error) +++ t) +++ +++(deftest enough-namestring.error.2 +++ (signals-error +++ (enough-namestring "enough-namestring.lsp" *default-pathname-defaults* nil) +++ program-error) +++ t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/ensure-directories-exist.lsp ++@@ -0,0 +1,166 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Mon Jan 5 20:53:03 2004 +++;;;; Contains: Tests of ENSURE-DIRECTORIES-EXIST +++ +++(in-package :cl-test) +++ +++(deftest ensure-directories-exist.1 +++ (let* ((pn (make-pathname :name "ensure-directories-exist.lsp" +++ :defaults *default-pathname-defaults*)) +++ (results nil) +++ (verbosity +++ (with-output-to-string +++ (*standard-output*) +++ (setq results (multiple-value-list (ensure-directories-exist pn)))))) +++ (values +++ (length results) +++ (equalt (truename pn) (truename (first results))) +++ (second results) +++ verbosity)) +++ 2 t nil "") +++ +++(deftest ensure-directories-exist.2 +++ (with-open-file +++ (s "ensure-directories-exist.lsp" :direction :input) +++ (let* ((results (multiple-value-list (ensure-directories-exist s)))) +++ (values +++ (length results) +++ (equalt (truename (first results)) (truename s)) +++ (second results)))) +++ 2 t nil) +++ +++(deftest ensure-directories-exist.3 +++ (let ((s (open "ensure-directories-exist.lsp" :direction :input))) +++ (close s) +++ (let* ((results (multiple-value-list (ensure-directories-exist s)))) +++ (values +++ (length results) +++ (equalt (truename (first results)) (truename s)) +++ (second results)))) +++ 2 t nil) +++ +++(deftest ensure-directories-exist.4 +++ (let* ((pn (make-pathname :name "ensure-directories-exist.lsp" +++ :defaults *default-pathname-defaults*)) +++ (results nil) +++ (verbosity +++ (with-output-to-string +++ (*standard-output*) +++ (setq results (multiple-value-list +++ (ensure-directories-exist pn :verbose nil)))))) +++ (values +++ (length results) +++ (equalt (truename pn) (truename (first results))) +++ (second results) +++ verbosity)) +++ 2 t nil "") +++ +++(deftest ensure-directories-exist.5 +++ (let* ((pn (make-pathname :name "ensure-directories-exist.lsp" +++ :defaults *default-pathname-defaults*)) +++ (results nil) +++ (verbosity +++ (with-output-to-string +++ (*standard-output*) +++ (setq results (multiple-value-list +++ (ensure-directories-exist pn :verbose t)))))) +++ (values +++ (length results) +++ (equalt (truename pn) (truename (first results))) +++ (second results) +++ verbosity)) +++ 2 t nil "") +++ +++(deftest ensure-directories-exist.6 +++ (let* ((pn (make-pathname :name "ensure-directories-exist.lsp" +++ :defaults *default-pathname-defaults*)) +++ (results nil) +++ (verbosity +++ (with-output-to-string +++ (*standard-output*) +++ (setq results (multiple-value-list +++ (ensure-directories-exist +++ pn :allow-other-keys nil)))))) +++ (values +++ (length results) +++ (equalt (truename pn) (truename (first results))) +++ (second results) +++ verbosity)) +++ 2 t nil "") +++ +++(deftest ensure-directories-exist.7 +++ (let* ((pn (make-pathname :name "ensure-directories-exist.lsp" +++ :defaults *default-pathname-defaults*)) +++ (results nil) +++ (verbosity +++ (with-output-to-string +++ (*standard-output*) +++ (setq results (multiple-value-list +++ (ensure-directories-exist +++ pn :allow-other-keys t :nonsense t)))))) +++ (values +++ (length results) +++ (equalt (truename pn) (truename (first results))) +++ (second results) +++ verbosity)) +++ 2 t nil "") +++ +++;;; Case where directory shouldn't exist +++ +++;; The directort ansi-tests/scratch must not exist before this +++;; test is run +++(deftest ensure-directories-exist.8 +++ (let* ((subdir (make-pathname :directory '(:relative "scratch") +++ :defaults *default-pathname-defaults*)) +++ (pn (make-pathname :name "foo" :type "txt" +++ :defaults subdir))) +++ (ignore-errors (delete-file pn) (delete-file subdir)) +++ (assert (not (probe-file pn)) () +++ "Delete subdirectory scratch and its contents!") +++ (let* ((results nil) +++ (verbosity +++ (with-output-to-string +++ (*standard-output*) +++ (setq results (multiple-value-list (ensure-directories-exist pn))))) +++ (result-pn (first results)) +++ (created (second results))) +++ ;; Create the file and write to it +++ (with-open-file (*standard-output* +++ pn :direction :output :if-exists :error +++ :if-does-not-exist :create) +++ (print nil)) +++ (values +++ (length results) +++ (notnot created) +++ (equalt pn result-pn) +++ (notnot (probe-file pn)) +++ verbosity +++ ))) +++ 2 t t t "") +++ +++;;; Specialized string tests +++ +++(deftest ensure-directories-exist.9 +++ (do-special-strings +++ (str "ensure-directories-exist.lsp" nil) +++ (let* ((results (multiple-value-list (ensure-directories-exist str)))) +++ (assert (eql (length results) 2)) +++ (assert (equalt (truename (first results)) (truename str))) +++ (assert (null (second results))))) +++ nil) +++ +++;; FIXME +++;; Need to add a LPN test +++ +++(deftest ensure-directories-exist.error.1 +++ (signals-error-always +++ (ensure-directories-exist +++ (make-pathname :directory '(:relative :wild) +++ :defaults *default-pathname-defaults*)) +++ file-error) +++ t t) +++ +++(deftest ensure-directories-exist.error.2 +++ (signals-error (ensure-directories-exist) program-error) +++ t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/file-author.lsp ++@@ -0,0 +1,88 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Tue Jan 6 05:41:06 2004 +++;;;; Contains: Tests of FILE-AUTHOR +++ +++(in-package :cl-test) +++ +++(deftest file-author.1 +++ (loop for pn in +++ (directory (make-pathname :name :wild :type :wild +++ :defaults *default-pathname-defaults*)) +++ for author = (file-author pn) +++ unless (or (null author) (stringp author)) +++ collect (list pn author)) +++ nil) +++ +++(deftest file-author.2 +++ (let ((author (file-author "file-author.lsp"))) +++ (if (or (null author) (stringp author)) +++ nil +++ author)) +++ nil) +++ +++(deftest file-author.3 +++ (let ((author (file-author #p"file-author.lsp"))) +++ (if (or (null author) (stringp author)) +++ nil +++ author)) +++ nil) +++ +++(deftest file-author.4 +++ (let ((author (file-author (truename "file-author.lsp")))) +++ (if (or (null author) (stringp author)) +++ nil +++ author)) +++ nil) +++ +++(deftest file-author.5 +++ (let ((author (with-open-file (s "file-author.lsp" :direction :input) +++ (file-author s)))) +++ (if (or (null author) (stringp author)) +++ nil +++ author)) +++ nil) +++ +++(deftest file-author.6 +++ (let ((author (let ((s (open "file-author.lsp" :direction :input))) +++ (close s) +++ (file-author s)))) +++ (if (or (null author) (stringp author)) +++ nil +++ author)) +++ nil) +++ +++;;; Specialized string tests +++ +++(deftest file-author.7 +++ (do-special-strings +++ (s "file-author.lsp" nil) +++ (assert (equal (file-author s) (file-author "file-author.lsp")))) +++ nil) +++ +++;;; FIXME +++;;; Add LPN test +++ +++;;; Error tests +++ +++(deftest file-author.error.1 +++ (signals-error (file-author) program-error) +++ t) +++ +++(deftest file-author.error.2 +++ (signals-error (file-author "file-author.lsp" nil) program-error) +++ t) +++ +++(deftest file-author.error.3 +++ (signals-error-always +++ (file-author (make-pathname :name :wild :type "lsp" +++ :defaults *default-pathname-defaults*)) +++ file-error) +++ t t) +++ +++(deftest file-author.error.4 +++ (signals-error-always +++ (file-author (make-pathname :name "file-author" :type :wild +++ :defaults *default-pathname-defaults*)) +++ file-error) +++ t t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/file-error.lsp ++@@ -0,0 +1,89 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Tue Jan 13 19:10:02 2004 +++;;;; Contains: Tests of the FILE-ERROR condition, and associated accessor function +++ +++(in-package :cl-test) +++ +++(deftest file-error.1 +++ (let ((pn (make-pathname :name :wild +++ :type "txt" +++ :version :newest +++ :defaults *default-pathname-defaults*))) +++ (handler-case +++ (probe-file pn) +++ (error (c) +++ (values +++ (notnot (typep c 'file-error)) +++ (if (equalp (file-error-pathname c) pn) +++ t +++ (list (file-error-pathname c) pn)))))) +++ t t) +++ +++(deftest file-error-pathname.1 +++ (let ((c (make-condition 'file-error :pathname "foo.txt"))) +++ (values +++ (notnot (typep c 'file-error)) +++ (eqlt (class-of c) (find-class 'file-error)) +++ (file-error-pathname c))) +++ t t "foo.txt") +++ +++(deftest file-error-pathname.2 +++ (let ((c (make-condition 'file-error :pathname #p"foo.txt"))) +++ (values +++ (notnot (typep c 'file-error)) +++ (eqlt (class-of c) (find-class 'file-error)) +++ (equalt #p"foo.txt" (file-error-pathname c)))) +++ t t t) +++ +++(deftest file-error-pathname.3 +++ (let ((c (make-condition 'file-error :pathname "CLTEST:FOO.TXT"))) +++ (values +++ (notnot (typep c 'file-error)) +++ (eqlt (class-of c) (find-class 'file-error)) +++ (equalpt "CLTEST:FOO.TXT" +++ (file-error-pathname c)))) +++ t t t) +++ +++(deftest file-error-pathname.4 +++ (let ((c (make-condition 'file-error :pathname (logical-pathname "CLTEST:FOO.TXT")))) +++ (values +++ (notnot (typep c 'file-error)) +++ (eqlt (class-of c) (find-class 'file-error)) +++ (equalpt (logical-pathname "CLTEST:FOO.TXT") +++ (file-error-pathname c)))) +++ t t t) +++ +++(deftest file-error-pathname.5 +++ (with-open-file (s "file-error.lsp" :direction :input) +++ (let ((c (make-condition 'file-error :pathname s))) +++ (values +++ (notnot (typep c 'file-error)) +++ (eqlt (class-of c) (find-class 'file-error)) +++ (equalpt s (file-error-pathname c))))) +++ t t t) +++ +++(deftest file-error-pathname.6 +++ (let ((s (open "file-error.lsp" :direction :input))) +++ (close s) +++ (let ((c (make-condition 'file-error :pathname s))) +++ (values +++ (notnot (typep c 'file-error)) +++ (eqlt (class-of c) (find-class 'file-error)) +++ (equalpt s (file-error-pathname c))))) +++ t t t) +++ +++(deftest file-error-pathname.error.1 +++ (signals-error (file-error-pathname) program-error) +++ t) +++ +++(deftest file-error-pathname.error.2 +++ (signals-error +++ (file-error-pathname (make-condition 'file-error :pathname "foo.txt") nil) +++ program-error) +++ t) +++ +++ +++ +++ +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/file-length.lsp ++@@ -0,0 +1,176 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Wed Jan 21 06:21:11 2004 +++;;;; Contains: Tests of FILE-LENGTH +++ +++(in-package :cl-test) +++ +++(deftest file-length.error.1 +++ (signals-error (file-length) program-error) +++ t) +++ +++(deftest file-length.error.2 +++ (signals-error +++ (with-open-file (is "file-length.lsp" :direction :input) +++ (file-length is nil)) +++ program-error) +++ t) +++ +++(deftest file-length.error.3 +++ (loop for x in *mini-universe* +++ unless (or (typep x 'file-stream) +++ (typep x 'broadcast-stream) +++ (handler-case (progn (file-length x) nil) +++ (type-error (c) +++ (assert (not (typep x (type-error-expected-type c)))) +++ t) +++ (condition () nil))) +++ collect x) +++ nil) +++ +++(deftest file-length.error.4 +++ :notes (:assume-no-simple-streams :assume-no-gray-streams) +++ (signals-error (with-input-from-string (s "abc") (file-length s)) +++ type-error) +++ t) +++ +++(deftest file-length.error.5 +++ (signals-error +++ (with-open-file +++ (is "file-length.lsp" :direction :input) +++ (with-open-file +++ (os "tmp.txt" :direction :output :if-exists :supersede) +++ (let ((s (make-two-way-stream is os))) +++ (unwind-protect (file-length s) (close s))))) +++ type-error) +++ t) +++ +++(deftest file-length.error.6 +++ (signals-error +++ (with-open-file +++ (is "file-length.lsp" :direction :input) +++ (with-open-file +++ (os "tmp.txt" :direction :output :if-exists :supersede) +++ (let ((s (make-echo-stream is os))) +++ (unwind-protect (file-length s) (close s))))) +++ type-error) +++ t) +++ +++(deftest file-length.error.8 +++ (with-open-file +++ (os "tmp.txt" :direction :output :if-exists :supersede) +++ (let ((s (make-broadcast-stream os))) +++ (eqlt (file-length s) (file-length os)))) +++ t) +++ +++(deftest file-length.error.9 +++ (signals-type-error s (make-concatenated-stream) +++ (unwind-protect (file-length s) (close s))) +++ t) +++ +++(deftest file-length.error.10 +++ (signals-error +++ (with-open-file +++ (is "file-length.lsp" :direction :input) +++ (let ((s (make-concatenated-stream is))) +++ (unwind-protect (file-length s) (close s)))) +++ type-error) +++ t) +++ +++(deftest file-length.error.11 +++ :notes (:assume-no-simple-streams :assume-no-gray-streams) +++ (signals-type-error s (make-string-input-stream "abcde") +++ (unwind-protect (file-length s) (close s))) +++ t) +++ +++(deftest file-length.error.12 +++ :notes (:assume-no-simple-streams :assume-no-gray-streams) +++ (signals-type-error s (make-string-output-stream) +++ (unwind-protect (file-length s) (close s))) +++ t) +++ +++;;; Non-error tests +++ +++(deftest file-length.1 +++ (let ((results (multiple-value-list +++ (with-open-file +++ (is "file-length.lsp" :direction :input) +++ (file-length is))))) +++ (and (= (length results) 1) +++ (typep (car results) '(integer 1)) +++ t)) +++ t) +++ +++(deftest file-length.2 +++ (loop for i from 1 to 32 +++ for etype = `(unsigned-byte ,i) +++ for e = (max 0 (- (ash 1 i) 5)) +++ for os = (open "tmp.dat" :direction :output +++ :if-exists :supersede +++ :element-type etype) +++ do (loop repeat 17 do (write-byte e os)) +++ do (finish-output os) +++ unless (= (file-length os) 17) +++ collect (list i (file-length os)) +++ do (close os)) +++ nil) +++ +++(deftest file-length.3 +++ (loop for i from 1 to 32 +++ for etype = `(unsigned-byte ,i) +++ for e = (max 0 (- (ash 1 i) 5)) +++ for os = (open "tmp.dat" :direction :output +++ :if-exists :supersede +++ :element-type etype) +++ for len = 0 +++ do (loop repeat 17 do (write-byte e os)) +++ do (close os) +++ unless (let ((is (open "tmp.dat" :direction :input +++ :element-type etype))) +++ (prog1 +++ (= (file-length is) 17) +++ (close is))) +++ collect i) +++ nil) +++ +++(deftest file-length.4 +++ (loop for i from 33 to 100 +++ for etype = `(unsigned-byte ,i) +++ for e = (max 0 (- (ash 1 i) 5)) +++ for os = (open "tmp.dat" :direction :output +++ :if-exists :supersede +++ :element-type etype) +++ do (loop repeat 17 do (write-byte e os)) +++ do (finish-output os) +++ unless (= (file-length os) 17) +++ collect (list i (file-length os)) +++ do (close os)) +++ nil) +++ +++(deftest file-length.5 +++ (loop for i from 33 to 100 +++ for etype = `(unsigned-byte ,i) +++ for e = (max 0 (- (ash 1 i) 5)) +++ for os = (open "tmp.dat" :direction :output +++ :if-exists :supersede +++ :element-type etype) +++ for len = 0 +++ do (loop repeat 17 do (write-byte e os)) +++ do (close os) +++ unless (let ((is (open "tmp.dat" :direction :input +++ :element-type etype))) +++ (prog1 +++ (= (file-length is) 17) +++ (close is))) +++ collect i) +++ nil) +++ +++(deftest file-length.6 +++ (with-open-file +++ (*foo* "file-length.lsp" :direction :input) +++ (declare (special *foo*)) +++ (let ((s (make-synonym-stream '*foo*))) +++ (unwind-protect +++ (typep* (file-length s) '(integer 1)) +++ (close s)))) +++ t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/file-namestring.lsp ++@@ -0,0 +1,44 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Sep 11 07:40:47 2004 +++;;;; Contains: Tests for FILE-NAMESTRING +++ +++(in-package :cl-test) +++ +++(deftest file-namestring.1 +++ (let* ((vals (multiple-value-list +++ (file-namestring "file-namestring.lsp"))) +++ (s (first vals))) +++ (if (and (null (cdr vals)) +++ (stringp s) +++ (equal (file-namestring s) s)) +++ :good +++ vals)) +++ :good) +++ +++(deftest file-namestring.2 +++ (do-special-strings +++ (s "file-namestring.lsp" nil) +++ (let ((ns (file-namestring s))) +++ (assert (stringp ns)) +++ (assert (string= (file-namestring ns) ns)))) +++ nil) +++ +++(deftest file-namestring.3 +++ (let* ((name "file-namestring.lsp") +++ (pn (merge-pathnames (pathname name))) +++ (name2 (with-open-file (s pn :direction :input) +++ (file-namestring s))) +++ (name3 (file-namestring pn))) +++ (or (equalt name2 name3) (list name2 name3))) +++ t) +++ +++;;; Error tests +++ +++(deftest file-namestring.error.1 +++ (signals-error (file-namestring) program-error) +++ t) +++ +++(deftest file-namestring.error.2 +++ (signals-error (file-namestring "file-namestring.lsp" nil) program-error) +++ t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/file-position.lsp ++@@ -0,0 +1,170 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Thu Jan 22 03:02:31 2004 +++;;;; Contains: Tests of FILE-POSITION +++ +++(in-package :cl-test) +++ +++(deftest file-position.1 +++ (with-open-file (is "file-position.lsp":direction :input) +++ (file-position is)) +++ 0) +++ +++(deftest file-position.2 +++ (with-open-file (is "file-position.lsp":direction :input) +++ (values +++ (multiple-value-list +++ (notnot-mv (file-position is :start))) +++ (file-position is))) +++ +++ (t) 0) +++ +++(deftest file-position.3 +++ (with-open-file (is "file-position.lsp":direction :input) +++ (values +++ (multiple-value-list +++ (notnot-mv (file-position is :end))) +++ (notnot (> (file-position is) 0)))) +++ (t) t) +++ +++(deftest file-position.4 +++ (with-open-file +++ (is "file-position.lsp":direction :input) +++ (values +++ (file-position is) +++ (read-char is) +++ (notnot (> (file-position is) 0)))) +++ 0 #\; t) +++ +++(deftest file-position.5 +++ (with-open-file +++ (os "tmp.dat":direction :output +++ :if-exists :supersede) +++ (values +++ (file-position os) +++ (write-char #\x os) +++ (notnot (> (file-position os) 0)))) +++ 0 #\x t) +++ +++(deftest file-position.6 +++ (with-open-file +++ (os "tmp.dat":direction :output +++ :if-exists :supersede) +++ (let ((p1 (file-position os)) +++ (delta (file-string-length os #\x))) +++ (write-char #\x os) +++ (let ((p2 (file-position os))) +++ (or (null p1) (null p2) (null delta) +++ (=t (+ p1 delta) p2))))) +++ t) +++ +++;;; Byte streams +++ +++(deftest file-position.7 +++ (loop for len from 1 to 32 +++ for n = (ash 1 len) +++ do (with-open-file +++ (os "tmp.dat" :direction :output +++ :if-exists :supersede +++ :element-type `(unsigned-byte ,len)) +++ (loop for i from 0 below 100 +++ for r = (logand (1- n) i) +++ for pos = (file-position os) +++ do (assert (or (not pos) (eql pos i))) +++ do (write-byte r os))) +++ do (with-open-file +++ (is "tmp.dat" :direction :input +++ :element-type `(unsigned-byte ,len)) +++ (loop for i from 0 below 100 +++ for pos = (file-position is) +++ do (assert (or (not pos) (eql pos i))) +++ do (let ((byte (read-byte is))) +++ (assert (eql byte (logand (1- n) i))))))) +++ nil) +++ +++(deftest file-position.8 +++ (loop for len from 33 to 100 +++ for n = (ash 1 len) +++ do (with-open-file +++ (os "tmp.dat" :direction :output +++ :if-exists :supersede +++ :element-type `(unsigned-byte ,len)) +++ (loop for i from 0 below 100 +++ for r = (logand (1- n) i) +++ for pos = (file-position os) +++ do (assert (or (not pos) (eql pos i))) +++ do (write-byte r os))) +++ do (with-open-file +++ (is "tmp.dat" :direction :input +++ :element-type `(unsigned-byte ,len)) +++ (loop for i from 0 below 100 +++ for pos = (file-position is) +++ do (assert (or (not pos) (eql pos i))) +++ do (let ((byte (read-byte is))) +++ (assert (eql byte (logand (1- n) i))))))) +++ nil) +++ +++(deftest file-position.9 +++ (with-input-from-string +++ (s "abcdefghijklmnopqrstuvwxyz") +++ (loop repeat 26 +++ for p = (file-position s) +++ unless (or (not p) +++ (progn +++ (file-position s p) +++ (eql (file-position s) p))) +++ collect p +++ do (read-char s))) +++ nil) +++ +++(deftest file-position.10 +++ (with-output-to-string +++ (s) +++ (loop repeat 26 +++ for p = (file-position s) +++ unless (or (not p) +++ (progn +++ (file-position s p) +++ (eql (file-position s) p))) +++ collect p +++ do (write-char #\x s))) +++ "xxxxxxxxxxxxxxxxxxxxxxxxxx") +++ +++;;; Error tests +++ +++(deftest file-position.error.1 +++ (signals-error (file-position) program-error) +++ t) +++ +++(deftest file-position.error.2 +++ (signals-error +++ (file-position (make-string-input-stream "abc") :start nil) +++ program-error) +++ t) +++ +++;;; It's not clear what 'too large' means -- can we set the +++;;; file position to a point where the file may later be extended +++;;; by some other writer? +++#| +++(deftest file-position.error.3 +++ (signals-error +++ (with-open-file +++ (is "file-position.lsp" :direction :input) +++ (flet ((%fail () (error 'type-error))) +++ (unless (file-position is :end) (%fail)) +++ (let ((fp (file-position is))) +++ (unless fp (%fail)) +++ (file-position is (+ 1000000 fp))))) +++ error) +++ t) +++ +++(deftest file-position.error.4 +++ (signals-error +++ (with-open-file +++ (is "file-position.lsp" :direction :input) +++ (file-position is 1000000000000000000000)) +++ error) +++ t) +++|# +++ +++ ++\ No newline at end of file ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/file-string-length.lsp ++@@ -0,0 +1,73 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Thu Jan 22 21:34:04 2004 +++;;;; Contains: Tests of FILE-STRING-LENGTH +++ +++(in-package :cl-test) +++ +++(deftest file-string-length.1 +++ (with-open-file +++ (s "tmp.dat" :direction :output +++ :if-exists :supersede) +++ (loop for x across +standard-chars+ +++ for len = (file-string-length s x) +++ do (assert (typep len '(or null (integer 0)))) +++ do (let ((pos1 (file-position s))) +++ (write-char x s) +++ (let ((pos2 (file-position s))) +++ (when (and pos1 pos2 len) +++ (assert (= (+ pos1 len) pos2))))))) +++ nil) +++ +++(deftest file-string-length.2 +++ (with-open-file +++ (s "tmp.dat" :direction :output +++ :if-exists :supersede) +++ (loop for x across +standard-chars+ +++ for len = (file-string-length s (string x)) +++ do (assert (typep len '(or null (integer 0)))) +++ do (let ((pos1 (file-position s))) +++ (write-sequence (string x) s) +++ (let ((pos2 (file-position s))) +++ (when (and pos1 pos2 len) +++ (assert (= (+ pos1 len) pos2))))))) +++ nil) +++ +++(deftest file-string-length.3 +++ (with-open-file +++ (stream "tmp.dat" :direction :output +++ :if-exists :supersede) +++ (let* ((s1 "abcde") +++ (n (file-string-length stream s1))) +++ (do-special-strings +++ (s2 s1 nil) +++ (assert (= (file-string-length stream s2) n))))) +++ nil) +++ +++;;; Error tests +++ +++(deftest file-string-length.error.1 +++ (signals-error (file-string-length) program-error) +++ t) +++ +++(deftest file-string-length.error.2 +++ (signals-error +++ (with-open-file +++ (s "tmp.dat" :direction :output +++ :if-exists :supersede) +++ (file-string-length s)) +++ program-error) +++ t) +++ +++(deftest file-string-length.error.3 +++ (signals-error +++ (with-open-file +++ (s "tmp.dat" :direction :output +++ :if-exists :supersede) +++ (file-string-length s #\x nil)) +++ program-error) +++ t) +++ +++ +++ +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/file-write-date.lsp ++@@ -0,0 +1,89 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Tue Jan 6 06:01:35 2004 +++;;;; Contains: Tests for FILE-WRITE-DATE +++ +++(in-package :cl-test) +++ +++(deftest file-write-date.1 +++ (let* ((pn "file-write-date.lsp") +++ (date (file-write-date pn)) +++ (time (get-universal-time))) +++ (or (null date) +++ (and (integerp date) +++ (<= 0 date time) +++ t))) +++ t) +++ +++(deftest file-write-date.2 +++ (let* ((pn #p"file-write-date.lsp") +++ (date (file-write-date pn)) +++ (time (get-universal-time))) +++ (or (null date) +++ (and (integerp date) +++ (<= 0 date time) +++ t))) +++ t) +++ +++(deftest file-write-date.3 +++ (let* ((pn (truename "file-write-date.lsp")) +++ (date (file-write-date pn)) +++ (time (get-universal-time))) +++ (or (null date) +++ (and (integerp date) +++ (<= 0 date time) +++ t))) +++ t) +++ +++(deftest file-write-date.4 +++ (loop for pn in (directory +++ (make-pathname :name :wild :type :wild +++ :defaults *default-pathname-defaults*)) +++ for date = (file-write-date pn) +++ for time = (get-universal-time) +++ unless (or (null date) +++ (<= 0 date time)) +++ collect (list pn date time)) +++ nil) +++ +++(deftest file-write-date.5 +++ (length (multiple-value-list (file-write-date "file-write-date.lsp"))) +++ 1) +++ +++;;; Specialized string tests +++ +++(deftest file-write-date.6 +++ (let* ((str "file-write-date.lsp") +++ (date (file-write-date str))) +++ (do-special-strings +++ (s str nil) +++ (assert (equal (file-write-date s) date)))) +++ nil) +++ +++;;; FIXME +++;;; Add LPN test +++ +++;;; Error tests +++ +++(deftest file-write-date.error.1 +++ (signals-error (file-write-date) program-error) +++ t) +++ +++(deftest file-write-date.error.2 +++ (signals-error (file-write-date "file-write-date.lsp" nil) +++ program-error) +++ t) +++ +++(deftest file-write-date.error.3 +++ (signals-error-always +++ (file-write-date (make-pathname :name :wild :type "lsp" +++ :defaults *default-pathname-defaults*)) +++ file-error) +++ t t) +++ +++(deftest file-write-date.error.4 +++ (signals-error-always +++ (file-write-date (make-pathname :name "file-write-date" :type :wild +++ :defaults *default-pathname-defaults*)) +++ file-error) +++ t t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/finish-output.lsp ++@@ -0,0 +1,54 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Wed Jan 28 06:38:20 2004 +++;;;; Contains: Tests of FINISH-OUTPUT +++ +++(in-package :cl-test) +++ +++(deftest finish-output.1 +++ (finish-output) +++ nil) +++ +++(deftest finish-output.2 +++ (finish-output t) +++ nil) +++ +++(deftest finish-output.3 +++ (finish-output nil) +++ nil) +++ +++(deftest finish-output.4 +++ (loop for s in (list *debug-io* *error-output* *query-io* +++ *standard-output* *trace-output* *terminal-io*) +++ for results = (multiple-value-list (finish-output s)) +++ unless (equal results '(nil)) +++ collect s) +++ nil) +++ +++(deftest finish-output.5 +++ (let ((os (make-string-output-stream))) +++ (let ((*terminal-io* (make-two-way-stream (make-string-input-stream "") +++ os))) +++ (finish-output t))) +++ nil) +++ +++(deftest finish-output.6 +++ (let ((*standard-output* (make-string-output-stream))) +++ (finish-output nil)) +++ nil) +++ +++;;; Error tests +++ +++(deftest finish-output.error.1 +++ (signals-error (finish-output nil nil) program-error) +++ t) +++ +++(deftest finish-output.error.2 +++ (signals-error (finish-output t nil) program-error) +++ t) +++ +++(deftest finish-output.error.3 +++ (check-type-error #'finish-output +++ #'(lambda (x) (typep x '(or stream (member nil t))))) +++ nil) +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/force-output.lsp ++@@ -0,0 +1,56 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Wed Jan 28 06:41:46 2004 +++;;;; Contains: Tests of FORCE-OUTPUT +++ +++(in-package :cl-test) +++ +++(deftest force-output.1 +++ (force-output) +++ nil) +++ +++(deftest force-output.2 +++ (force-output t) +++ nil) +++ +++(deftest force-output.3 +++ (force-output nil) +++ nil) +++ +++(deftest force-output.4 +++ (loop for s in (list *debug-io* *error-output* *query-io* +++ *standard-output* *trace-output* *terminal-io*) +++ for results = (multiple-value-list (force-output s)) +++ unless (equal results '(nil)) +++ collect s) +++ nil) +++ +++(deftest force-output.5 +++ (let ((os (make-string-output-stream))) +++ (let ((*terminal-io* (make-two-way-stream (make-string-input-stream "") +++ os))) +++ (force-output t))) +++ nil) +++ +++(deftest force-output.6 +++ (let ((*standard-output* (make-string-output-stream))) +++ (force-output nil)) +++ nil) +++ +++ +++;;; Error tests +++ +++(deftest force-output.error.1 +++ (signals-error (force-output nil nil) program-error) +++ t) +++ +++(deftest force-output.error.2 +++ (signals-error (force-output t nil) program-error) +++ t) +++ +++(deftest force-output.error.3 +++ (check-type-error #'force-output +++ #'(lambda (x) (typep x '(or stream (member nil t))))) +++ nil) +++ +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/fresh-line.lsp ++@@ -0,0 +1,87 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sun Jan 18 20:41:18 2004 +++;;;; Contains: Tests of FRESH-LINE +++ +++(in-package :cl-test) +++ +++(deftest fresh-line.1 +++ (let (result) +++ (values +++ (with-output-to-string +++ (*standard-output*) +++ (write-char #\a) +++ (setq result (notnot (fresh-line)))) +++ result)) +++ #.(concatenate 'string "a" (string #\Newline)) +++ t) +++ +++(deftest fresh-line.2 +++ (let (result) +++ (values +++ (with-output-to-string +++ (s) +++ (write-char #\a s) +++ (setq result (notnot (fresh-line s)))) +++ result)) +++ #.(concatenate 'string "a" (string #\Newline)) +++ t) +++ +++(deftest fresh-line.3 +++ (with-output-to-string +++ (s) +++ (write-char #\x s) +++ (fresh-line s) +++ (fresh-line s) +++ (write-char #\y s)) +++ #.(concatenate 'string "x" (string #\Newline) "y")) +++ +++(deftest fresh-line.4 +++ (let (result) +++ (values +++ (with-output-to-string +++ (*standard-output*) +++ (setq result (multiple-value-list (fresh-line)))) +++ result)) +++ "" (nil)) +++ +++(deftest fresh-line.5 +++ (let (result) +++ (values +++ (with-output-to-string +++ (s) +++ (write-char #\Space s) +++ (setq result +++ (list +++ (multiple-value-list (notnot-mv (fresh-line s))) +++ (multiple-value-list (fresh-line s)) +++ (multiple-value-list (fresh-line s))))) +++ result)) +++ " +++" ((t) (nil) (nil))) +++ +++(deftest fresh-line.6 +++ (with-output-to-string +++ (os) +++ (let ((*terminal-io* (make-two-way-stream *standard-input* os))) +++ (write-char #\a t) +++ (fresh-line t) +++ (finish-output t))) +++ #.(concatenate 'string (string #\a) (string #\Newline))) +++ +++(deftest fresh-line.7 +++ (with-output-to-string +++ (*standard-output*) +++ (write-char #\a nil) +++ (terpri nil)) +++ #.(concatenate 'string (string #\a) (string #\Newline))) +++ +++;;; Error tests +++ +++(deftest fresh-line.error.1 +++ (signals-error +++ (with-output-to-string +++ (s) +++ (fresh-line s nil)) +++ program-error) +++ t) ++--- gcl-2.6.12.orig/ansi-tests/gclload2.lsp +++++ gcl-2.6.12/ansi-tests/gclload2.lsp ++@@ -46,6 +46,15 @@ ++ ;;; Tests of strings ++ (load "load-strings.lsp") ++ +++;;; Tests of pathnames +++(load "load-pathnames.lsp") +++ +++;;; Tests of file operations +++(load "load-files.lsp") +++ +++;;; Tests of streams +++(load "load-streams.lsp") +++ ++ ;;; Tests for character functions ++ (compile-and-load "char-aux.lsp") ++ (load "character.lsp") ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/get-output-stream-string.lsp ++@@ -0,0 +1,32 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Feb 14 09:48:46 2004 +++;;;; Contains: Tests of GET-OUTPUT-STREAM-STRING +++ +++(in-package :cl-test) +++ +++;; this function is used extensively elsewhere in the test suite +++ +++(deftest get-output-stream-string.1 +++ (let ((s (make-string-output-stream))) +++ (values +++ (get-output-stream-string s) +++ (write-string "abc" s) +++ (write-string "def" s) +++ (get-output-stream-string s) +++ (get-output-stream-string s))) +++ "" "abc" "def" "abcdef" "") +++ +++;;; Error cases +++ +++(deftest get-output-stream-string.error.1 +++ (signals-error (get-output-stream-string) t) +++ t) +++ +++(deftest get-output-stream-string.error.2 +++ (signals-error (get-output-stream-string (make-string-output-stream) nil) t) +++ t) +++ +++ +++ +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/host-namestring.lsp ++@@ -0,0 +1,49 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sun Sep 12 06:22:40 2004 +++;;;; Contains: Tests of HOST-NAMESTRING +++ +++(in-package :cl-test) +++ +++(deftest host-namestring.1 +++ (let* ((vals (multiple-value-list +++ (host-namestring "host-namestring.lsp"))) +++ (s (first vals))) +++ (if (and (null (cdr vals)) +++ (or (null s) +++ (stringp s) +++ ;; (equal (host-namestring s) s) +++ )) +++ :good +++ vals)) +++ :good) +++ +++(deftest host-namestring.2 +++ (do-special-strings +++ (s "host-namestring.lsp" nil) +++ (let ((ns (host-namestring s))) +++ (when ns +++ (assert (stringp ns)) +++ ;; (assert (string= (host-namestring ns) ns)) +++ ))) +++ nil) +++ +++(deftest host-namestring.3 +++ (let* ((name "host-namestring.lsp") +++ (pn (merge-pathnames (pathname name))) +++ (name2 (with-open-file (s pn :direction :input) +++ (host-namestring s))) +++ (name3 (host-namestring pn))) +++ (or (equalt name2 name3) (list name2 name3))) +++ t) +++ +++;;; Error tests +++ +++(deftest host-namestring.error.1 +++ (signals-error (host-namestring) program-error) +++ t) +++ +++(deftest host-namestring.error.2 +++ (signals-error (host-namestring "host-namestring.lsp" nil) program-error) +++ t) +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/input-stream-p.lsp ++@@ -0,0 +1,40 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Tue Jan 13 19:39:27 2004 +++;;;; Contains: Tests for INPUT-STREAM-P +++ +++(in-package :cl-test) +++ +++(deftest input-stream-p.1 +++ (notnot-mv (input-stream-p *standard-input*)) +++ t) +++ +++(deftest input-stream-p.2 +++ (notnot-mv (input-stream-p *terminal-io*)) +++ t) +++ +++(deftest input-stream-p.3 +++ (with-open-file (s "input-stream-p.lsp" :direction :input) +++ (notnot-mv (input-stream-p s))) +++ t) +++ +++(deftest input-stream-p.4 +++ (with-open-file (s "foo.txt" :direction :output +++ :if-exists :supersede) +++ (input-stream-p s)) +++ nil) +++ +++;;; Error tests +++ +++(deftest input-stream-p.error.1 +++ (signals-error (input-stream-p) program-error) +++ t) +++ +++(deftest input-stream-p.error.2 +++ (signals-error (input-stream-p *standard-input* nil) +++ program-error) +++ t) +++ +++(deftest input-stream-p.error.3 +++ (check-type-error #'input-stream-p #'streamp) +++ nil) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/interactive-stream-p.lsp ++@@ -0,0 +1,28 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Tue Jan 13 19:47:59 2004 +++;;;; Contains: Tests of INTERACTIVE-STREAM-P +++ +++(in-package :cl-test) +++ +++(deftest interactive-stream-p.1 +++ (let ((streams (list *debug-io* *error-output* *query-io* +++ *standard-input* *standard-output* +++ *trace-output* *terminal-io*))) +++ (mapc #'interactive-stream-p streams) +++ ;; no error should occur +++ nil) +++ nil) +++ +++(deftest interactive-stream-p.error.1 +++ (check-type-error #'interactive-stream-p #'streamp) +++ nil) +++ +++(deftest interactive-stream-p.error.2 +++ (signals-error (interactive-stream-p) program-error) +++ t) +++ +++(deftest interactive-stream-p.error.3 +++ (signals-error (interactive-stream-p *terminal-io* nil) +++ program-error) +++ t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/ldtest.lsp ++@@ -0,0 +1 @@ +++(in-package :cl-test) (defun LOAD-TEST-FUN-3 () :foo) ++\ No newline at end of file ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/listen.lsp ++@@ -0,0 +1,73 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Tue Jan 27 21:16:39 2004 +++;;;; Contains: Tests of LISTEN +++ +++(in-package :cl-test) +++ +++(deftest listen.1 +++ (with-input-from-string (s "") (listen s)) +++ nil) +++ +++(deftest listen.2 +++ (with-input-from-string (s "x") (notnot-mv (listen s))) +++ t) +++ +++(deftest listen.3 +++ (with-input-from-string (*standard-input* "") (listen)) +++ nil) +++ +++(deftest listen.4 +++ (with-input-from-string (*standard-input* "A") (notnot-mv (listen))) +++ t) +++ +++;;; (deftest listen.5 +++;;; (when (interactive-stream-p *standard-input*) +++;;; (clear-input) (listen)) +++;;; nil) +++ +++(deftest listen.6 +++ (with-input-from-string +++ (s "x") +++ (values +++ (read-char s) +++ (listen s) +++ (unread-char #\x s) +++ (notnot (listen s)) +++ (read-char s))) +++ #\x nil nil t #\x) +++ +++(deftest listen.7 +++ (with-open-file +++ (s "listen.lsp") +++ (values +++ (notnot (listen s)) +++ (handler-case +++ (locally (declare (optimize safety)) +++ (loop (read-char s))) +++ (end-of-file () (listen s))))) +++ t nil) +++ +++(deftest listen.8 +++ (with-input-from-string +++ (is "abc") +++ (let ((*terminal-io* (make-two-way-stream is (make-broadcast-stream)))) +++ (notnot-mv (listen t)))) +++ t) +++ +++(deftest listen.9 +++ (with-input-from-string +++ (*standard-input* "345") +++ (notnot-mv (listen nil))) +++ t) +++ +++;;; Error tests +++ +++(deftest listen.error.1 +++ :notes (:assume-no-simple-streams) +++ (signals-error (listen *standard-input* nil) program-error) +++ t) +++ +++(deftest listen.error.2 +++ (signals-error (listen *standard-input* nil nil) program-error) +++ t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/load-files.lsp ++@@ -0,0 +1,16 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Thu Jan 1 11:59:35 2004 +++;;;; Contains: Load tests of section 20, 'Files' +++ +++(in-package :cl-test) +++ +++(load "directory.lsp") +++(load "probe-file.lsp") +++(load "ensure-directories-exist.lsp") +++(load "truename.lsp") +++(load "file-author.lsp") +++(load "file-write-date.lsp") +++(load "rename-file.lsp") +++(load "delete-file.lsp") +++(load "file-error.lsp") ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/load-logical-pathname-translations.lsp ++@@ -0,0 +1,34 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Wed Dec 31 09:31:33 2003 +++;;;; Contains: Tests (such as they are) for LOAD-LOGICAL-PATHNAME-TRANSLATIONS +++ +++(in-package :cl-test) +++ +++;;; The function LOAD-LOGICAL-PATHNAME-TRANSLATIONS is almost entirely +++;;; untestable, since the basic behavior is implementation defined. +++ +++(deftest load-logical-pathname-translations.1 +++ (load-logical-pathname-translations "CLTESTROOT") +++ nil) +++ +++;;; Error cases +++ +++(deftest load-logical-pathname-translations.error.1 +++ (handler-case +++ (progn (load-logical-pathname-translations +++ "THEREHADBETTERNOTBEAHOSTCALLEDTHIS") +++ nil) +++ (error () :good)) +++ :good) +++ +++(deftest load-logical-pathname-translations.error.2 +++ (signals-error (load-logical-pathname-translations) +++ program-error) +++ t) +++ +++(deftest load-logical-pathname-translations.error.3 +++ (signals-error (load-logical-pathname-translations "CLTESTROOT" nil) +++ program-error) +++ t) +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/load-pathnames.lsp ++@@ -0,0 +1,36 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Nov 29 04:33:05 2003 +++;;;; Contains: Load tests for pathnames and logical pathnames +++ +++(in-package :cl-test) +++ +++(compile-and-load "pathnames-aux.lsp") +++ +++(load "pathnames.lsp") +++(load "pathname.lsp") +++(load "pathnamep.lsp") +++(load "make-pathname.lsp") +++(load "pathname-host.lsp") +++(load "pathname-device.lsp") +++(load "pathname-directory.lsp") +++(load "pathname-name.lsp") +++(load "pathname-type.lsp") +++(load "pathname-version.lsp") +++ +++(load "load-logical-pathname-translations.lsp") +++(load "logical-pathname.lsp") +++(load "logical-pathname-translations.lsp") +++(load "translate-logical-pathname.lsp") +++ +++(load "namestring.lsp") +++(load "file-namestring.lsp") +++(load "directory-namestring.lsp") +++(load "host-namestring.lsp") +++(load "enough-namestring.lsp") +++ +++(load "wild-pathname-p.lsp") +++(load "merge-pathnames.lsp") +++(load "pathname-match-p.lsp") +++ +++(load "parse-namestring.lsp") ++\ No newline at end of file ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/load-streams.lsp ++@@ -0,0 +1,57 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Tue Jan 13 19:38:10 2004 +++;;;; Contains: Load files containing tests for section 21 (streams) +++ +++(in-package :cl-test) +++ +++(load "input-stream-p.lsp") +++(load "output-stream-p.lsp") +++(load "interactive-stream-p.lsp") +++(load "open-stream-p.lsp") +++(load "stream-element-type.lsp") +++(load "streamp.lsp") +++(load "read-byte.lsp") +++(load "peek-char.lsp") +++(load "read-char.lsp") +++(load "read-char-no-hang.lsp") +++(load "terpri.lsp") +++(load "fresh-line.lsp") +++(load "unread-char.lsp") +++(load "write-char.lsp") +++(load "read-line.lsp") +++(load "write-string.lsp") +++(load "write-line.lsp") +++(load "read-sequence.lsp") +++(load "write-sequence.lsp") +++(load "file-length.lsp") +++(load "file-position.lsp") +++(load "file-string-length.lsp") +++(load "open.lsp") +++(load "stream-external-format.lsp") +++(load "with-open-file.lsp") +++(load "with-open-stream.lsp") +++(load "listen.lsp") +++(load "clear-input.lsp") +++(load "finish-output.lsp") +++(load "force-output.lsp") +++(load "clear-output.lsp") +++(load "make-synonym-stream.lsp") +++(load "synonym-stream-symbol.lsp") +++(load "make-broadcast-stream.lsp") +++(load "broadcast-stream-streams.lsp") +++(load "make-two-way-stream.lsp") +++(load "two-way-stream-input-stream.lsp") +++(load "two-way-stream-output-stream.lsp") +++(load "echo-stream-input-stream.lsp") +++(load "echo-stream-output-stream.lsp") +++(load "make-echo-stream.lsp") +++(load "concatenated-stream-streams.lsp") +++(load "make-concatenated-stream.lsp") +++(load "get-output-stream-string.lsp") +++(load "make-string-input-stream.lsp") +++(load "make-string-output-stream.lsp") +++(load "with-input-from-string.lsp") +++(load "with-output-to-string.lsp") +++(load "stream-error-stream.lsp") +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/load-system-construction.lsp ++@@ -0,0 +1,12 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sun Dec 12 19:44:29 2004 +++;;;; Contains: Load tests for system construction (section 24) +++ +++(in-package :cl-test) +++ +++(load "compile-file.lsp") +++(load "load.lsp") +++(load "with-compilation-unit.lsp") +++(load "features.lsp") +++(load "modules.lsp") ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/load-test-file-2.lsp ++@@ -0,0 +1,7 @@ +++(in-package :cl-test) +++ +++(declaim (special *load-test-var.1* *load-test-var.2*)) +++(eval-when (:load-toplevel) +++ (setq *load-test-var.1* *load-pathname*) +++ (setq *load-test-var.2* *load-truename*)) +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/load-test-file.lsp ++@@ -0,0 +1,9 @@ +++(in-package :cl-test) +++ +++(defun load-file-test-fun.1 () +++ '#.*load-pathname*) +++ +++(defun load-file-test-fun.2 () +++ '#.*load-truename*) +++ +++ ++--- gcl-2.6.12.orig/ansi-tests/load.lsp +++++ gcl-2.6.12/ansi-tests/load.lsp ++@@ -1,15 +1,227 @@ ++-;; Get the MK package ++-;; I've hardwired a path here; fix for your system ++-;; I assume the package is already compiled. ++-(unless (find-package "MK") ++- (load #.(concatenate 'string "../defsys30/defsystem." ++- #+cmu (C::BACKEND-FASL-FILE-TYPE C::*TARGET-BACKEND*) ++- #+allegro "fasl" ++- #+(or akcl gcl) "o"))) ++- ++-(load "rt/rt.system") ++-(mk::load-system "rt") ++-(mk::compile-system "cltest") +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Tue Apr 12 21:51:49 2005 +++;;;; Contains: Tests of LOAD +++ ++ (in-package :cl-test) ++ +++(defun load-file-test (file funname &rest args &key +++ if-does-not-exist +++ (print nil print-p) +++ (verbose nil verbose-p) +++ (*load-print* nil) +++ (*load-verbose* nil) +++ external-format) +++ (declare (ignorable external-format if-does-not-exist +++ print print-p verbose verbose-p)) +++ (fmakunbound funname) +++ (let* ((str (make-array '(0) :element-type 'character :adjustable t +++ :fill-pointer 0)) +++ (vals (multiple-value-list +++ (with-output-to-string +++ (*standard-output* str) +++ (apply #'load file :allow-other-keys t args)))) +++ (print? (if print-p print *load-print*)) +++ (verbose? (if verbose-p verbose *load-verbose*))) +++ (values +++ (let ((v1 (car vals)) +++ (v2 (or (and verbose-p (not verbose)) +++ (and (not verbose-p) (not *load-verbose*)) +++ (position #\; str))) +++ (v3 (or (and print-p (not print)) +++ (and (not print-p) (not *load-print*)) +++ (> (length str) 0))) +++ (v4 (if (or print? verbose?) +++ (> (length str) 0) +++ t))) +++ (if (and (= (length vals) 1) v1 v2 v3 v4) t (list vals v2 v3 v4 str))) +++ (funcall funname)))) +++ +++(deftest load.1 +++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1) +++ t nil) +++ +++(deftest load.2 +++ (load-file-test #p"compile-file-test-file.lsp" 'compile-file-test-fun.1) +++ t nil) +++ +++(deftest load.3 +++ (with-input-from-string +++ (s "(in-package :cl-test) (defun load-file-test-fun.2 () 'good)") +++ (load-file-test s 'load-file-test-fun.2)) +++ t good) +++ +++(deftest load.4 +++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 +++ :external-format :default) +++ t nil) +++ +++(deftest load.5 +++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 +++ :verbose t) +++ t nil) +++ +++(deftest load.6 +++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 +++ :*load-verbose* t) +++ t nil) +++ +++(deftest load.7 +++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 +++ :*load-verbose* t :verbose nil) +++ t nil) +++ +++(deftest load.8 +++ (with-input-from-string +++ (s "(in-package :cl-test) (defun load-file-test-fun.2 () 'good)") +++ (load-file-test s 'load-file-test-fun.2 :verbose t)) +++ t good) +++ +++(deftest load.9 +++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 +++ :print t) +++ t nil) +++ +++(deftest load.10 +++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 +++ :*load-print* t) +++ t nil) +++ +++(deftest load.11 +++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 +++ :*load-print* t :print nil) +++ t nil) +++ +++(deftest load.12 +++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 +++ :*load-print* nil :print t) +++ t nil) +++ +++(deftest load.13 +++ (with-input-from-string +++ (s "(in-package :cl-test) (defun load-file-test-fun.2 () 'good)") +++ (load-file-test s 'load-file-test-fun.2 :print t)) +++ t good) +++ +++(deftest load.14 +++ (load "nonexistent-file.lsp" :if-does-not-exist nil) +++ nil) +++ +++(defpackage LOAD-TEST-PACKAGE (:use "COMMON-LISP")) +++ +++(deftest load.15 +++ (let ((*package* (find-package "LOAD-TEST-PACKAGE"))) +++ (with-input-from-string +++ (s "(defun f () 'good)") +++ (load-file-test s 'load-test-package::f))) +++ t load-test-package::good) +++ +++(deftest load.15a +++ (let ((*package* (find-package "CL-TEST"))) +++ (values +++ (with-input-from-string +++ (s "(eval-when (:load-toplevel :execute) (setq *package* (find-package \"LOAD-TEST-PACKAGE\"))) +++ (defun f () 'good)") +++ (multiple-value-list (load-file-test s 'load-test-package::f))) +++ (read-from-string "GOOD"))) +++ (t load-test-package::good) good) +++ +++(deftest load.16 +++ (let ((*readtable* (copy-readtable nil))) +++ (set-macro-character #\! (get-macro-character #\')) +++ (with-input-from-string +++ (s "(in-package :cl-test) (defun load-file-test-fun.3 () !good)") +++ (load-file-test s 'load-file-test-fun.3))) +++ t good) +++ +++(deftest load.16a +++ (let ((*readtable* *readtable*) +++ (*package* (find-package "CL-TEST"))) +++ (values +++ (with-input-from-string +++ (s "(in-package :cl-test) +++ (eval-when (:load-toplevel :execute) +++ (setq *readtable* (copy-readtable nil)) +++ (set-macro-character #\\! (get-macro-character #\\'))) +++ (defun load-file-test-fun.3 () !good)") +++ (multiple-value-list +++ (load-file-test s 'load-file-test-fun.3))) +++ (read-from-string "!FOO"))) +++ (t good) !FOO) +++ +++(deftest load.17 +++ (let ((file #p"load-test-file.lsp")) +++ (fmakunbound 'load-file-test-fun.1) +++ (fmakunbound 'load-file-test-fun.2) +++ (values +++ (notnot (load file)) +++ (let ((p1 (pathname (merge-pathnames file))) +++ (p2 (funcall 'load-file-test-fun.1))) +++ (equalpt-or-report p1 p2)) +++ (let ((p1 (truename file)) +++ (p2 (funcall 'load-file-test-fun.2))) +++ (equalpt-or-report p1 p2)))) +++ t t t) +++ +++;;; Test that the load pathname/truename variables are bound +++;;; properly when loading compiled files +++ +++(deftest load.18 +++ (let* ((file "load-test-file-2.lsp") +++ (target (enough-namestring (compile-file-pathname file)))) +++ (declare (special *load-test-var.1* *load-test-var.2*)) +++ (compile-file file) +++ (makunbound '*load-test-var.1*) +++ (makunbound '*load-test-var.2*) +++ (load target) +++ (values +++ (let ((p1 (pathname (merge-pathnames target))) +++ (p2 *load-test-var.1*)) +++ (equalpt-or-report p1 p2)) +++ (let ((p1 (truename target)) +++ (p2 *load-test-var.2*)) +++ (equalpt-or-report p1 p2)))) +++ t t) +++ +++(deftest load.19 +++ (let ((file (logical-pathname "CLTEST:LDTEST.LSP")) +++ (fn 'load-test-fun-3) +++ (*package* (find-package "CL-TEST"))) +++ (with-open-file +++ (s file :direction :output :if-exists :supersede +++ :if-does-not-exist :create) +++ (format s "(in-package :cl-test) (defun ~a () :foo)" fn)) +++ (fmakunbound fn) +++ (values +++ (notnot (load file)) +++ (funcall fn))) +++ t :foo) +++ +++;;; Defaults of the load variables +++ +++(deftest load-pathname.1 +++ *load-pathname* +++ nil) +++ +++(deftest load-truename.1 +++ *load-truename* +++ nil) +++ +++(deftest load-print.1 +++ *load-print* +++ nil) +++ +++;;; Error tests +++ +++(deftest load.error.1 +++ (signals-error (load "nonexistent-file.lsp") file-error) +++ t) +++ +++(deftest load.error.2 +++ (signals-error (load) program-error) +++ t) ++ +++(deftest load.error.3 +++ (signals-error (load "compile-file-test-file.lsp" :bad-key-arg t) +++ program-error) +++ t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/logical-pathname-translations.lsp ++@@ -0,0 +1,8 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Wed Dec 31 09:46:08 2003 +++;;;; Contains: Tests of LOGICAL-PATHNAME-TRANSLATIONS +++ +++(in-package :cl-test) +++ +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/logical-pathname.lsp ++@@ -0,0 +1,93 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Tue Dec 30 19:05:01 2003 +++;;;; Contains: Tests of LOGICAL-PATHNAME +++ +++(in-package :cl-test) +++ +++(deftest logical-pathname.1 +++ (loop for x in *logical-pathnames* +++ always (eql x (logical-pathname x))) +++ t) +++ +++(deftest logical-pathname.2 +++ (notnot-mv (typep (logical-pathname "CLTEST:FOO") 'logical-pathname)) +++ t) +++ +++(deftest logical-pathname.3 +++ (let ((name "CLTEST:TEMP.DAT.NEWEST")) +++ (with-open-file +++ (s (logical-pathname name) +++ :direction :output +++ :if-exists :supersede +++ :if-does-not-exist :create) +++ (or (equalt (logical-pathname s) (logical-pathname name)) +++ (list (logical-pathname s) (logical-pathname name))))) +++ t) +++ +++ +++;;; Error tests +++ +++(deftest logical-pathname.error.1 +++ (check-type-error #'logical-pathname +++ (typef '(or string stream logical-pathname))) +++ nil) +++ +++(deftest logical-pathname.error.2 +++ ;; Doesn't specify a host +++ (signals-error (logical-pathname "FOO.TXT") type-error) +++ t) +++ +++(deftest logical-pathname.error.3 +++ (signals-error +++ (with-open-file (s #p"logical-pathname.lsp" :direction :input) +++ (logical-pathname s)) +++ type-error) +++ t) +++ +++(deftest logical-pathname.error.4 +++ (signals-error +++ (with-open-stream +++ (is (make-concatenated-stream)) +++ (with-open-stream +++ (os (make-broadcast-stream)) +++ (with-open-stream +++ (s (make-two-way-stream is os)) +++ (logical-pathname s)))) +++ type-error) +++ t) +++ +++(deftest logical-pathname.error.5 +++ (signals-error +++ (with-open-stream +++ (is (make-concatenated-stream)) +++ (with-open-stream +++ (os (make-broadcast-stream)) +++ (with-open-stream +++ (s (make-echo-stream is os)) +++ (logical-pathname s)))) +++ type-error) +++ t) +++ +++(deftest logical-pathname.error.6 +++ (signals-error (with-open-stream (s (make-broadcast-stream)) (logical-pathname s)) type-error) +++ t) +++ +++(deftest logical-pathname.error.7 +++ (signals-error (with-open-stream (s (make-concatenated-stream)) (logical-pathname s)) type-error) +++ t) +++ +++(deftest logical-pathname.error.8 +++ (signals-error (with-open-stream (s (make-string-input-stream "foo")) +++ (logical-pathname s)) type-error) +++ t) +++ +++(deftest logical-pathname.error.9 +++ (signals-error (with-output-to-string (s) (logical-pathname s)) type-error) +++ t) +++ +++(deftest logical-pathname.error.10 +++ (handler-case +++ (progn (eval '(locally (declare (optimize safety)) (logical-pathname "CLROOT:%"))) t) +++ (type-error () t)) +++ t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/make-broadcast-stream.lsp ++@@ -0,0 +1,99 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Thu Jan 29 21:28:25 2004 +++;;;; Contains: Tests of MAKE-BROADCAST-STREAM +++ +++(in-package :cl-test) +++ +++(deftest make-broadcast-stream.1 +++ (let ((s (make-broadcast-stream))) +++ (assert (typep s 'stream)) +++ (assert (typep s 'broadcast-stream)) +++ (assert (output-stream-p s)) +++ ;; (assert (not (input-stream-p s))) +++ (assert (open-stream-p s)) +++ (assert (streamp s)) +++ ;; (assert (eq (stream-element-type s) t)) +++ (values +++ (notnot (typep s 'stream)) +++ (notnot (typep s 'broadcast-stream)) +++ (notnot (output-stream-p s)) +++ (progn (write-char #\x s) nil) +++ )) +++ t t t nil) +++ +++(deftest make-broadcast-stream.2 +++ (with-output-to-string +++ (s1) +++ (let ((s (make-broadcast-stream s1))) +++ (assert (typep s 'stream)) +++ (assert (typep s 'broadcast-stream)) +++ (assert (output-stream-p s)) +++ ;; (assert (not (input-stream-p s))) +++ (assert (open-stream-p s)) +++ (assert (streamp s)) +++ (assert (eql (stream-element-type s) +++ (stream-element-type s1))) +++ (write-char #\x s))) +++ "x") +++ +++(deftest make-broadcast-stream.3 +++ (let ((s1 (make-string-output-stream)) +++ (s2 (make-string-output-stream))) +++ (let ((s (make-broadcast-stream s1 s2))) +++ (assert (typep s 'stream)) +++ (assert (typep s 'broadcast-stream)) +++ (assert (output-stream-p s)) +++ ;; (assert (not (input-stream-p s))) +++ (assert (open-stream-p s)) +++ (assert (streamp s)) +++ (assert (eql (stream-element-type s) +++ (stream-element-type s2))) +++ (format s "This is a test")) +++ (values +++ (get-output-stream-string s1) +++ (get-output-stream-string s2))) +++ "This is a test" +++ "This is a test") +++ +++(deftest make-broadcast-stream.4 +++ (fresh-line (make-broadcast-stream)) +++ nil) +++ +++(deftest make-broadcast-stream.5 +++ (file-length (make-broadcast-stream)) +++ 0) +++ +++(deftest make-broadcast-stream.6 +++ (file-position (make-broadcast-stream)) +++ 0) +++ +++(deftest make-broadcast-stream.7 +++ (file-string-length (make-broadcast-stream) "antidisestablishmentarianism") +++ 1) +++ +++(deftest make-broadcast-stream.8 +++ (stream-external-format (make-broadcast-stream)) +++ :default) +++ +++ +++ +++;;; FIXME +++;;; Add tests for: close, +++;;; peek-char, read-char-no-hang, terpri, fresh-line, unread-char, +++;;; read-line, write-line, write-string, read-sequence, write-sequence, +++;;; read-byte, write-byte, listen, clear-input, finish-output, force-output, +++;;; clear-output, print, prin1 princ +++ +++;;; Error tests +++ +++(deftest make-broadcast-stream.error.1 +++ (check-type-error #'make-broadcast-stream +++ #'(lambda (x) (and (streamp x) (output-stream-p x)))) +++ nil) +++ +++(deftest make-broadcast-stream.error.2 +++ (check-type-error #'make-broadcast-stream +++ #'(lambda (x) (and (streamp x) (output-stream-p x))) +++ *streams*) +++ nil) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/make-concatenated-stream.lsp ++@@ -0,0 +1,323 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Feb 14 08:41:18 2004 +++;;;; Contains: Tests of MAKE-CONCATENATED-STREAM +++ +++(in-package :cl-test) +++ +++(deftest make-concatenated-stream.1 +++ (let ((s (make-concatenated-stream))) +++ (read s nil :eof)) +++ :eof) +++ +++(deftest make-concatenated-stream.2 +++ (let ((s (make-concatenated-stream))) +++ (notnot-mv (input-stream-p s))) +++ t) +++ +++(deftest make-concatenated-stream.3 +++ (let ((s (make-concatenated-stream))) +++ (output-stream-p s)) +++ nil) +++ +++(deftest make-concatenated-stream.4 +++ (let ((s (make-concatenated-stream))) +++ (notnot-mv (streamp s))) +++ t) +++ +++(deftest make-concatenated-stream.5 +++ (let ((s (make-concatenated-stream))) +++ (notnot-mv (typep s 'stream))) +++ t) +++ +++(deftest make-concatenated-stream.6 +++ (let ((s (make-concatenated-stream))) +++ (notnot-mv (typep s 'concatenated-stream))) +++ t) +++ +++(deftest make-concatenated-stream.7 +++ (let ((s (make-concatenated-stream))) +++ (notnot-mv (open-stream-p s))) +++ t) +++ +++(deftest make-concatenated-stream.8 +++ (let ((s (make-concatenated-stream *standard-input*))) +++ (notnot-mv (stream-element-type s))) +++ t) +++ +++(deftest make-concatenated-stream.9 +++ (let ((pn #p"tmp.dat") +++ (element-type '(unsigned-byte 8))) +++ (with-open-file (s pn :direction :output :element-type element-type +++ :if-exists :supersede) +++ (dolist (b '(1 5 9 13)) (write-byte b s))) +++ (with-open-file +++ (s1 pn :direction :input :element-type element-type) +++ (with-open-file +++ (s2 pn :direction :input :element-type element-type) +++ (let ((s (make-concatenated-stream s1 s2))) +++ (loop repeat 8 collect (read-byte s)))))) +++ (1 5 9 13 1 5 9 13)) +++ +++(deftest make-concatenated-stream.10 +++ (let ((s (make-concatenated-stream))) +++ (read-byte s nil :eof)) +++ :eof) +++ +++(deftest make-concatenated-stream.11 +++ (let ((s (make-concatenated-stream))) +++ (peek-char nil s nil :eof)) +++ :eof) +++ +++(deftest make-concatenated-stream.12 +++ (with-input-from-string +++ (s1 "a") +++ (with-input-from-string +++ (s2 "b") +++ (let ((s (make-concatenated-stream s1 s2))) +++ (values +++ (peek-char nil s) +++ (read-char s) +++ (peek-char nil s) +++ (read-char s) +++ (peek-char nil s nil :eof))))) +++ #\a #\a #\b #\b :eof) +++ +++(deftest make-concatenated-stream.13 +++ (with-input-from-string +++ (s1 " a ") +++ (with-input-from-string +++ (s2 " b ") +++ (let ((s (make-concatenated-stream s1 s2))) +++ (values +++ (peek-char t s) +++ (read-char s) +++ (peek-char t s) +++ (read-char s) +++ (peek-char t s nil :eof))))) +++ #\a #\a #\b #\b :eof) +++ +++(deftest make-concatenated-stream.14 +++ (with-input-from-string +++ (s1 "a") +++ (with-input-from-string +++ (s2 "b") +++ (let ((s (make-concatenated-stream s1 s2))) +++ (values +++ (read-char s) +++ (unread-char #\a s) +++ (read-char s) +++ (read-char s) +++ (unread-char #\b s) +++ (read-char s) +++ (read-char s nil :eof))))) +++ #\a nil #\a #\b nil #\b :eof) +++ +++(deftest make-concatenated-stream.15 +++ (let ((s (make-concatenated-stream))) +++ (read-char-no-hang s nil :eof)) +++ :eof) +++ +++(deftest make-concatenated-stream.16 +++ (with-input-from-string +++ (s1 "a") +++ (with-input-from-string +++ (s2 "b") +++ (let ((s (make-concatenated-stream s1 s2))) +++ (values +++ (read-char-no-hang s) +++ (read-char-no-hang s) +++ (read-char-no-hang s nil :eof))))) +++ #\a #\b :eof) +++ +++(deftest make-concatenated-stream.17 +++ (with-input-from-string +++ (s1 "a") +++ (with-input-from-string +++ (s2 "b") +++ (let ((s (make-concatenated-stream s1 s2))) +++ (multiple-value-bind (str mnp) +++ (read-line s) +++ (values str (notnot mnp)))))) +++ "ab" t) +++ +++(deftest make-concatenated-stream.18 +++ (with-input-from-string +++ (s1 "ab") +++ (with-input-from-string +++ (s2 "") +++ (let ((s (make-concatenated-stream s1 s2))) +++ (multiple-value-bind (str mnp) +++ (read-line s) +++ (values str (notnot mnp)))))) +++ "ab" t) +++ +++(deftest make-concatenated-stream.19 +++ (with-input-from-string +++ (s1 "") +++ (with-input-from-string +++ (s2 "ab") +++ (let ((s (make-concatenated-stream s1 s2))) +++ (multiple-value-bind (str mnp) +++ (read-line s) +++ (values str (notnot mnp)))))) +++ "ab" t) +++ +++(deftest make-concatenated-stream.20 +++ (with-input-from-string +++ (s1 "ab") +++ (with-input-from-string +++ (s2 (concatenate 'string (string #\Newline) "def")) +++ (let ((s (make-concatenated-stream s1 s2))) +++ (read-line s)))) +++ "ab" nil) +++ +++(deftest make-concatenated-stream.21 +++ (with-input-from-string +++ (s1 "") +++ (with-input-from-string +++ (s2 "") +++ (let ((s (make-concatenated-stream s1 s2))) +++ (multiple-value-bind (str mnp) +++ (read-line s nil :eof) +++ (values str (notnot mnp)))))) +++ :eof t) +++ +++(deftest make-concatenated-stream.22 +++ (let ((pn #p"tmp.dat") +++ (element-type '(unsigned-byte 8))) +++ (with-open-file (s pn :direction :output :element-type element-type +++ :if-exists :supersede) +++ (dolist (b '(1 5 9 13)) (write-byte b s))) +++ (with-open-file +++ (s1 pn :direction :input :element-type element-type) +++ (with-open-file +++ (s2 pn :direction :input :element-type element-type) +++ (let ((s (make-concatenated-stream s1 s2)) +++ (x (vector nil nil nil nil nil nil nil nil))) +++ (values +++ (read-sequence x s) +++ x))))) +++ 8 +++ #(1 5 9 13 1 5 9 13)) +++ +++(deftest make-concatenated-stream.23 +++ (let ((pn #p"tmp.dat") +++ (element-type '(unsigned-byte 8))) +++ (with-open-file (s pn :direction :output :element-type element-type +++ :if-exists :supersede) +++ (dolist (b '(1 5 9 13)) (write-byte b s))) +++ (with-open-file +++ (s1 pn :direction :input :element-type element-type) +++ (with-open-file +++ (s2 pn :direction :input :element-type element-type) +++ (let ((s (make-concatenated-stream s1 s2)) +++ (x (vector nil nil nil nil nil nil))) +++ (values +++ (read-sequence x s) +++ x))))) +++ 6 +++ #(1 5 9 13 1 5)) +++ +++(deftest make-concatenated-stream.24 +++ (let ((pn #p"tmp.dat") +++ (element-type '(unsigned-byte 8))) +++ (with-open-file (s pn :direction :output :element-type element-type +++ :if-exists :supersede) +++ (dolist (b '(1 5 9 13)) (write-byte b s))) +++ (with-open-file +++ (s1 pn :direction :input :element-type element-type) +++ (with-open-file +++ (s2 pn :direction :input :element-type element-type) +++ (let ((s (make-concatenated-stream s1 s2)) +++ (x (vector nil nil nil nil nil nil nil nil nil nil))) +++ (values +++ (read-sequence x s) +++ x))))) +++ 8 +++ #(1 5 9 13 1 5 9 13 nil nil)) +++ +++(deftest make-concatenated-stream.25 +++ (close (make-concatenated-stream)) +++ t) +++ +++(deftest make-concatenated-stream.26 +++ (let ((s (make-concatenated-stream))) +++ (values (prog1 (close s) (close s)) +++ (open-stream-p s))) +++ t nil) +++ +++(deftest make-concatenated-stream.27 +++ (with-input-from-string +++ (s1 "abc") +++ (let ((s (make-concatenated-stream s1))) +++ (values +++ (notnot (open-stream-p s1)) +++ (notnot (open-stream-p s)) +++ (close s) +++ (notnot (open-stream-p s1)) +++ (open-stream-p s)))) +++ t t t t nil) +++ +++(deftest make-concatenated-stream.28 +++ (with-input-from-string +++ (s1 "a") +++ (let ((s (make-concatenated-stream s1))) +++ (notnot-mv (listen s)))) +++ t) +++ +++(deftest make-concatenated-stream.28a +++ (listen (make-concatenated-stream)) +++ nil) +++ +++(deftest make-concatenated-stream.29 +++ (with-input-from-string +++ (s1 "") +++ (let ((s (make-concatenated-stream s1))) +++ (listen s))) +++ nil) +++ +++(deftest make-concatenated-stream.30 +++ (with-input-from-string +++ (s1 "") +++ (with-input-from-string +++ (s2 "a") +++ (let ((s (make-concatenated-stream s1 s2))) +++ (notnot-mv (listen s))))) +++ t) +++ +++(deftest make-concatenated-stream.31 +++ (with-input-from-string +++ (s1 "") +++ (with-input-from-string +++ (s2 "") +++ (let ((s (make-concatenated-stream s1 s2))) +++ (listen s)))) +++ nil) +++ +++(deftest make-concatenated-stream.32 +++ (clear-input (make-concatenated-stream)) +++ nil) +++ +++(deftest make-concatenated-stream.33 +++ (with-input-from-string +++ (s1 "abc") +++ (clear-input (make-concatenated-stream s1))) +++ nil) +++ +++;;; Error cases +++ +++(deftest make-concatenated-stream.error.1 +++ (loop for x in *mini-universe* +++ unless (or (and (streamp x) (input-stream-p x)) +++ (eval `(signals-error (make-concatenated-stream ',x) t))) +++ collect x) +++ nil) +++ +++(deftest make-concatenated-stream.error.2 +++ (loop for x in *streams* +++ unless (or (and (streamp x) (input-stream-p x)) +++ (eval `(signals-error (make-concatenated-stream ',x) t))) +++ collect x) +++ nil) +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/make-echo-stream.lsp ++@@ -0,0 +1,332 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Thu Feb 12 04:34:42 2004 +++;;;; Contains: Tests of MAKE-ECHO-STREAM +++ +++(in-package :cl-test) +++ +++(deftest make-echo-stream.1 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-echo-stream is os))) +++ (values +++ (read-char s) +++ (get-output-stream-string os))) +++ #\f "f") +++ +++(deftest make-echo-stream.2 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-echo-stream is os))) +++ (get-output-stream-string os)) +++ "") +++ +++(deftest make-echo-stream.3 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-echo-stream is os))) +++ (values (read-line s nil) +++ (get-output-stream-string os))) +++ "foo" "foo") +++ +++;;; Tests of READ-BYTE on echo streams +++ +++(deftest make-echo-stream.4 +++ (let ((pn #p"tmp.dat") +++ (pn2 #p"tmp2.dat") +++ (element-type '(unsigned-byte 8))) +++ (with-open-file (os pn +++ :direction :output +++ :element-type element-type +++ :if-exists :supersede) +++ (loop for x in '(2 3 5 7 11) +++ do (write-byte x os))) +++ (with-open-file +++ (is pn :direction :input :element-type element-type) +++ (values +++ (with-open-file +++ (os pn2 :direction :output :if-exists :supersede +++ :element-type element-type) +++ (let ((s (make-echo-stream is os))) +++ (loop repeat 6 collect (read-byte s nil :eof1)))) +++ (with-open-file +++ (s pn2 :direction :input :element-type element-type) +++ (loop repeat 6 collect (read-byte s nil :eof2)))))) +++ (2 3 5 7 11 :eof1) +++ (2 3 5 7 11 :eof2)) +++ +++(deftest make-echo-stream.5 +++ (let ((pn #p"tmp.dat") +++ (pn2 #p"tmp2.dat") +++ (element-type '(unsigned-byte 8))) +++ (with-open-file (os pn +++ :direction :output +++ :element-type element-type +++ :if-exists :supersede) +++ (loop for x in '(2 3 5 7 11) +++ do (write-byte x os))) +++ (with-open-file +++ (is pn :direction :input :element-type element-type) +++ (values +++ (with-open-file +++ (os pn2 :direction :output :if-exists :supersede +++ :element-type element-type) +++ (let ((s (make-echo-stream is os))) +++ (loop repeat 6 collect (read-byte s nil 100)))) +++ (with-open-file +++ (s pn2 :direction :input :element-type element-type) +++ (loop repeat 6 collect (read-byte s nil 200)))))) +++ (2 3 5 7 11 100) +++ (2 3 5 7 11 200)) +++ +++(deftest make-echo-stream.6 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-echo-stream is os))) +++ (values (coerce (loop repeat 3 collect (read-char-no-hang s)) 'string) +++ (get-output-stream-string os))) +++ "foo" "foo") +++ +++(deftest make-echo-stream.7 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-echo-stream is os))) +++ (values (coerce (loop repeat 4 collect (read-char-no-hang s nil '#\z)) +++ 'string) +++ (get-output-stream-string os))) +++ "fooz" "foo") +++ +++;;; peek-char + echo streams is tested in peek-char.lsp +++;;; unread-char + echo streams is tested in unread-char.lsp +++ +++(deftest make-echo-stream.8 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-echo-stream is os)) +++ (x (copy-seq "xxxxxx"))) +++ (values +++ (read-sequence x s) +++ x +++ (get-output-stream-string os))) +++ 3 +++ "fooxxx" +++ "foo") +++ +++(deftest make-echo-stream.9 +++ (let ((pn #p"tmp.dat") +++ (pn2 #p"tmp2.dat") +++ (element-type '(unsigned-byte 8))) +++ (with-open-file (os pn +++ :direction :output +++ :element-type element-type +++ :if-exists :supersede) +++ (loop for x in '(2 3 5 7 11) +++ do (write-byte x os))) +++ (with-open-file +++ (is pn :direction :input :element-type element-type) +++ (values +++ (with-open-file +++ (os pn2 :direction :output :if-exists :supersede +++ :element-type element-type) +++ (let ((s (make-echo-stream is os)) +++ (x (vector 0 0 0 0 0 0 0 0))) +++ (list (read-sequence x s) +++ x))) +++ (with-open-file +++ (s pn2 :direction :input :element-type element-type) +++ (loop repeat 8 collect (read-byte s nil nil)))))) +++ (5 #(2 3 5 7 11 0 0 0)) +++ (2 3 5 7 11 nil nil nil)) +++ +++(deftest make-echo-stream.10 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-echo-stream is os))) +++ (values +++ (notnot (open-stream-p s)) +++ (close s) +++ (open-stream-p s) +++ (notnot (open-stream-p is)) +++ (notnot (open-stream-p os)))) +++ t t nil t t) +++ +++(deftest make-echo-stream.11 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-echo-stream is os))) +++ (values +++ (notnot (listen s)) +++ (read-char s) +++ (notnot (listen s)) +++ (read-char s) +++ (notnot (listen s)) +++ (read-char s) +++ (listen s))) +++ t #\f t #\o t #\o nil) +++ +++(deftest make-echo-stream.12 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-echo-stream is os))) +++ (values +++ (notnot (streamp s)) +++ (notnot (typep s 'stream)) +++ (notnot (typep s 'echo-stream)) +++ (notnot (input-stream-p s)) +++ (notnot (output-stream-p s)) +++ (notnot (stream-element-type s)))) +++ t t t t t t) +++ +++;;; FIXME +++;;; Add tests for clear-input, file-position(?) +++;;; Also, add tests for output operations (since echo-streams are +++;;; bidirectional) +++ +++(deftest make-echo-stream.13 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-echo-stream is os))) +++ (values +++ (write-char #\0 s) +++ (close s) +++ (get-output-stream-string os))) +++ #\0 t "0") +++ +++(deftest make-echo-stream.14 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-echo-stream is os))) +++ (values +++ (terpri s) +++ (close s) +++ (get-output-stream-string os))) +++ nil t #.(string #\Newline)) +++ +++(deftest make-echo-stream.15 +++ (let ((pn #p"tmp.dat") +++ (pn2 #p"tmp2.dat") +++ (element-type '(unsigned-byte 8))) +++ (with-open-file (os pn +++ :direction :output +++ :element-type element-type +++ :if-exists :supersede)) +++ (with-open-file +++ (is pn :direction :input :element-type element-type) +++ (values +++ (with-open-file +++ (os pn2 :direction :output :if-exists :supersede +++ :element-type element-type) +++ (let ((s (make-echo-stream is os)) +++ (x (mapcar #'char-code (coerce "abcdefg" 'list)))) +++ (loop for b in x do +++ (assert (equal (list b) +++ (multiple-value-list (write-byte b s))))) +++ (close s))))) +++ (with-open-file +++ (is pn2 :direction :input :element-type element-type) +++ (let ((x (vector 0 0 0 0 0 0 0))) +++ (read-sequence x is) +++ (values +++ (read-byte is nil :done) +++ (map 'string #'code-char x))))) +++ :done +++ "abcdefg") +++ +++(deftest make-echo-stream.16 +++ (let ((pn #p"tmp.dat") +++ (pn2 #p"tmp2.dat") +++ (element-type '(unsigned-byte 8))) +++ (with-open-file (os pn +++ :direction :output +++ :element-type element-type +++ :if-exists :supersede)) +++ (with-open-file +++ (is pn :direction :input :element-type element-type) +++ (values +++ (with-open-file +++ (os pn2 :direction :output :if-exists :supersede +++ :element-type element-type) +++ (let ((s (make-echo-stream is os)) +++ (x (map 'vector #'char-code "abcdefg"))) +++ (assert (equal (multiple-value-list (write-sequence x s)) (list x))) +++ (close s))))) +++ (with-open-file +++ (is pn2 :direction :input :element-type element-type) +++ (let ((x (vector 0 0 0 0 0 0 0))) +++ (read-sequence x is) +++ (values +++ (read-byte is nil :done) +++ (map 'string #'code-char x))))) +++ :done +++ "abcdefg") +++ +++(deftest make-echo-stream.17 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-echo-stream is os))) +++ (values +++ (write-char #\X s) +++ (notnot (fresh-line s)) +++ (finish-output s) +++ (force-output s) +++ (close s) +++ (get-output-stream-string os))) +++ #\X t nil nil t #.(coerce '(#\X #\Newline) 'string)) +++ +++(deftest make-echo-stream.18 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-echo-stream is os))) +++ (values +++ (write-string "159" s) +++ (close s) +++ (get-output-stream-string os))) +++ "159" t "159") +++ +++(deftest make-echo-stream.20 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-echo-stream is os))) +++ (values +++ (write-string "0159X" s :start 1 :end 4) +++ (close s) +++ (get-output-stream-string os))) +++ "0159X" t "159") +++ +++(deftest make-echo-stream.21 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-echo-stream is os))) +++ (values +++ (write-line "159" s) +++ (close s) +++ (get-output-stream-string os))) +++ "159" t #.(concatenate 'string "159" (string #\Newline))) +++ +++(deftest make-echo-stream.22 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-echo-stream is os))) +++ (values +++ (write-char #\0 s) +++ (clear-output s))) +++ #\0 nil) +++ +++;;; Error tests +++ +++(deftest make-echo-stream.error.1 +++ (signals-error (make-echo-stream) program-error) +++ t) +++ +++(deftest make-echo-stream.error.2 +++ (signals-error (make-echo-stream *standard-input*) program-error) +++ t) +++ +++(deftest make-echo-stream.error.3 +++ (signals-error (make-echo-stream *standard-input* *standard-output* nil) +++ program-error) +++ t) +++ +++ +++ +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/make-pathname.lsp ++@@ -0,0 +1,171 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Nov 29 05:54:30 2003 +++;;;; Contains: Tests of MAKE-PATHNAME +++ +++(in-package :cl-test) +++ +++(defvar *null-pathname* +++ (make-pathname)) +++ +++(defun make-pathname-test +++ (&rest args &key (defaults nil) +++ (host (if defaults (pathname-host defaults) +++ (pathname-host *default-pathname-defaults*))) +++ (device (if defaults (pathname-device defaults) +++ (pathname-device *null-pathname*))) +++ (directory (if defaults (pathname-directory defaults) +++ (pathname-directory *null-pathname*))) +++ (name (if defaults (pathname-name defaults) +++ (pathname-name *null-pathname*))) +++ (type (if defaults (pathname-type defaults) +++ (pathname-type *null-pathname*))) +++ (version (if defaults (pathname-version defaults) +++ (pathname-version *null-pathname*))) +++ case) +++ (declare (ignorable case)) +++ (let* ((vals (multiple-value-list (apply #'make-pathname args))) +++ (pn (first vals))) +++ (and (= (length vals) 1) +++ (typep pn 'pathname) +++ (equalp (pathname-host pn) host) +++ (equalp (pathname-device pn) device) +++ ;; (equalp (pathname-directory pn) directory) +++ (let ((pnd (pathname-directory pn))) +++ (if (eq directory :wild) +++ (member pnd '((:absolute :wild-inferiors) +++ (:absolute :wild)) +++ :test #'equal) +++ (equalp pnd directory))) +++ (equalp (pathname-name pn) name) +++ (equalp (pathname-type pn) type) +++ (equalp (pathname-version pn) version) +++ t))) +++ +++ +++ +++(deftest make-pathname.1 +++ (make-pathname-test) +++ t) +++ +++(deftest make-pathname.2 +++ (make-pathname-test :name "foo") +++ t) +++ +++(deftest make-pathname.2a +++ (do-special-strings +++ (s "foo") +++ (assert (make-pathname-test :name s))) +++ nil) +++ +++(deftest make-pathname.3 +++ (make-pathname-test :name "foo" :type "txt") +++ t) +++ +++(deftest make-pathname.3a +++ (do-special-strings +++ (s "txt") +++ (assert (make-pathname-test :name "foo" :type s))) +++ nil) +++ +++(deftest make-pathname.4 +++ (make-pathname-test :type "lsp") +++ t) +++ +++(deftest make-pathname.5 +++ (make-pathname-test :directory :wild) +++ t) +++ +++(deftest make-pathname.6 +++ (make-pathname-test :name :wild) +++ t) +++ +++(deftest make-pathname.7 +++ (make-pathname-test :type :wild) +++ t) +++ +++(deftest make-pathname.8 +++ (make-pathname-test :version :wild) +++ t) +++ +++(deftest make-pathname.9 +++ (make-pathname-test :defaults *default-pathname-defaults*) +++ t) +++ +++(deftest make-pathname.10 +++ (make-pathname-test :defaults (make-pathname :name "foo" :type "bar")) +++ t) +++ +++(deftest make-pathname.11 +++ (make-pathname-test :version :newest) +++ t) +++ +++(deftest make-pathname.12 +++ (make-pathname-test :case :local) +++ t) +++ +++(deftest make-pathname.13 +++ (make-pathname-test :case :common) +++ t) +++ +++(deftest make-pathname.14 +++ (let ((*default-pathname-defaults* +++ (make-pathname :name "foo" :type "lsp" :version :newest))) +++ (make-pathname-test)) +++ t) +++ +++;;; Works on the components of actual pathnames +++(deftest make-pathname.rebuild +++ (loop for p in *pathnames* +++ for host = (pathname-host p) +++ for device = (pathname-device p) +++ for directory = (pathname-directory p) +++ for name = (pathname-name p) +++ for type = (pathname-type p) +++ for version = (pathname-version p) +++ for p2 = (make-pathname +++ :host host +++ :device device +++ :directory directory +++ :name name +++ :type type +++ :version version) +++ unless (equal p p2) +++ collect (list p p2)) +++ nil) +++ +++;;; Various constraints on :directory +++ +++(deftest make-pathname-error-absolute-up +++ (signals-error (directory (make-pathname :directory '(:absolute :up))) +++ file-error) +++ t) +++ +++(deftest make-pathname-error-absolute-back +++ (signals-error (directory (make-pathname :directory '(:absolute :back))) +++ file-error) +++ t) +++ +++;; The next test is correct, but was causing very large amounts of time to be spent +++;; in buggy implementations +++;;#| +++(deftest make-pathname-error-absolute-wild-inferiors-up +++ (signals-error (directory (make-pathname :directory '(:absolute :wild-inferiors :up))) +++ file-error) +++ t) +++;;|# +++ +++(deftest make-pathname-error-relative-wild-inferiors-up +++ (signals-error (length (directory (make-pathname :directory '(:relative :wild-inferiors :up)))) +++ file-error) +++ t) +++ +++(deftest make-pathname-error-absolute-wild-inferiors-back +++ (signals-error (directory (make-pathname :directory '(:absolute :wild-inferiors :back))) +++ file-error) +++ t) +++ +++(deftest make-pathname-error-relative-wild-inferiors-back +++ (signals-error (directory (make-pathname :directory '(:relative :wild-inferiors :back))) +++ file-error) +++ t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/make-string-input-stream.lsp ++@@ -0,0 +1,93 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Feb 14 18:36:48 2004 +++;;;; Contains: Tests for MAKE-STRING-INPUT-STREAM +++ +++(in-package :cl-test) +++ +++(deftest make-string-input-stream.1 +++ (let ((s (make-string-input-stream ""))) +++ (values +++ (notnot (typep s 'stream)) +++ (notnot (streamp s)) +++ (notnot (input-stream-p s)) +++ (output-stream-p s))) +++ t t t nil) +++ +++(deftest make-string-input-stream.2 +++ (let ((s (make-string-input-stream "abcd"))) +++ (values +++ (notnot (typep s 'stream)) +++ (notnot (streamp s)) +++ (notnot (input-stream-p s)) +++ (output-stream-p s))) +++ t t t nil) +++ +++ +++(deftest make-string-input-stream.3 +++ (let ((s (make-string-input-stream "abcd" 1))) +++ (values (read-line s))) +++ "bcd") +++ +++ +++(deftest make-string-input-stream.4 +++ (let ((s (make-string-input-stream "abcd" 0 2))) +++ (values (read-line s))) +++ "ab") +++ +++(deftest make-string-input-stream.5 +++ (let ((s (make-string-input-stream "abcd" 1 nil))) +++ (values (read-line s))) +++ "bcd") +++ +++(deftest make-string-input-stream.6 +++ (let ((str1 (make-array 6 :element-type 'character +++ :initial-contents "abcdef" +++ :fill-pointer 4))) +++ (let ((s (make-string-input-stream str1))) +++ (values (read-line s) (read-char s nil :eof)))) +++ "abcd" :eof) +++ +++(deftest make-string-input-stream.7 +++ (let* ((str1 (make-array 6 :element-type 'character +++ :initial-contents "abcdef")) +++ (str2 (make-array 4 :element-type 'character +++ :displaced-to str1))) +++ (let ((s (make-string-input-stream str2))) +++ (values (read-line s) (read-char s nil :eof)))) +++ "abcd" :eof) +++ +++(deftest make-string-input-stream.8 +++ (let* ((str1 (make-array 6 :element-type 'character +++ :initial-contents "abcdef")) +++ (str2 (make-array 4 :element-type 'character +++ :displaced-to str1 +++ :displaced-index-offset 1))) +++ (let ((s (make-string-input-stream str2))) +++ (values (read-line s) (read-char s nil :eof)))) +++ "bcde" :eof) +++ +++(deftest make-string-input-stream.9 +++ (let ((str1 (make-array 6 :element-type 'character +++ :initial-contents "abcdef" +++ :adjustable t))) +++ (let ((s (make-string-input-stream str1))) +++ (values (read-line s) (read-char s nil :eof)))) +++ "abcdef" :eof) +++ +++(deftest make-string-input-stream.10 +++ :notes (:allow-nil-arrays :nil-vectors-are-strings) +++ (let ((s (make-string-input-stream +++ (make-array 0 :element-type nil)))) +++ (read-char s nil :eof)) +++ :eof) +++ +++;;; Error tests +++ +++(deftest make-string-input-stream.error.1 +++ (signals-error (make-string-input-stream) program-error) +++ t) +++ +++(deftest make-string-input-stream.error.2 +++ (signals-error (make-string-input-stream "abc" 1 2 nil) program-error) +++ t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/make-string-output-stream.lsp ++@@ -0,0 +1,139 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Feb 14 19:42:07 2004 +++;;;; Contains: Tests of MAKE-STRING-OUTPUT-STREAM +++ +++(in-package :cl-test) +++ +++(deftest make-string-output-stream.1 +++ (let ((s (make-string-output-stream))) +++ (values +++ (notnot (typep s 'stream)) +++ (notnot (typep s 'string-stream)) +++ (input-stream-p s) +++ (notnot (output-stream-p s)) +++ (notnot (open-stream-p s)))) +++ t t nil t t) +++ +++(deftest make-string-output-stream.2 +++ (let ((s (make-string-output-stream :element-type 'character))) +++ (values +++ (notnot (typep s 'stream)) +++ (notnot (typep s 'string-stream)) +++ (input-stream-p s) +++ (notnot (output-stream-p s)) +++ (notnot (open-stream-p s)))) +++ t t nil t t) +++ +++(deftest make-string-output-stream.3 +++ (let ((s (make-string-output-stream :element-type 'base-char))) +++ (values +++ (notnot (typep s 'stream)) +++ (notnot (typep s 'string-stream)) +++ (input-stream-p s) +++ (notnot (output-stream-p s)) +++ (notnot (open-stream-p s)))) +++ t t nil t t) +++ +++(deftest make-string-output-stream.4 +++ :notes (:nil-vectors-are-strings) +++ (let ((s (make-string-output-stream :element-type nil))) +++ (values +++ (notnot (typep s 'stream)) +++ (notnot (typep s 'string-stream)) +++ (input-stream-p s) +++ (notnot (output-stream-p s)) +++ (notnot (open-stream-p s)))) +++ t t nil t t) +++ +++(deftest make-string-output-stream.5 +++ (let ((s (make-string-output-stream :allow-other-keys nil))) +++ (values +++ (notnot (typep s 'stream)) +++ (notnot (typep s 'string-stream)) +++ (input-stream-p s) +++ (notnot (output-stream-p s)) +++ (notnot (open-stream-p s)))) +++ t t nil t t) +++ +++(deftest make-string-output-stream.6 +++ (let ((s (make-string-output-stream :allow-other-keys t :foo 'bar))) +++ (values +++ (notnot (typep s 'stream)) +++ (notnot (typep s 'string-stream)) +++ (input-stream-p s) +++ (notnot (output-stream-p s)) +++ (notnot (open-stream-p s)))) +++ t t nil t t) +++ +++(deftest make-string-output-stream.7 +++ (let ((s (make-string-output-stream :foo 'bar :allow-other-keys t +++ :allow-other-keys nil +++ :foo2 'x))) +++ (values +++ (notnot (typep s 'stream)) +++ (notnot (typep s 'string-stream)) +++ (input-stream-p s) +++ (notnot (output-stream-p s)) +++ (notnot (open-stream-p s)))) +++ t t nil t t) +++ +++(deftest make-string-output-stream.8 +++ (let ((s (make-string-output-stream))) +++ (write-string "abc" s) +++ (write-string "def" s) +++ (get-output-stream-string s)) +++ "abcdef") +++ +++(deftest make-string-output-stream.9 +++ (let ((s (make-string-output-stream :element-type 'character))) +++ (write-string "abc" s) +++ (write-string "def" s) +++ (get-output-stream-string s)) +++ "abcdef") +++ +++(deftest make-string-output-stream.10 +++ (let ((s (make-string-output-stream :element-type 'base-char))) +++ (write-string "abc" s) +++ (write-string "def" s) +++ (get-output-stream-string s)) +++ "abcdef") +++ +++(deftest make-string-output-stream.11 +++ :notes (:nil-vectors-are-strings) +++ (let ((s (make-string-output-stream :element-type nil))) +++ (get-output-stream-string s)) +++ "") +++ +++(deftest make-string-output-stream.12 +++ :notes (:nil-vectors-are-strings) +++ (let ((s (make-string-output-stream :element-type nil))) +++ (typep #\a (array-element-type (get-output-stream-string s)))) +++ nil) +++ +++(deftest make-string-output-stream.13 +++ (let ((s (make-string-output-stream))) +++ (values +++ (close s) +++ (open-stream-p s))) +++ t nil) +++ +++;;; Error tests +++ +++(deftest make-string-output-stream.error.1 +++ (signals-error (make-string-output-stream nil) program-error) +++ t) +++ +++(deftest make-string-output-stream.error.2 +++ (signals-error (make-string-output-stream :foo nil) program-error) +++ t) +++ +++(deftest make-string-output-stream.error.3 +++ (signals-error (make-string-output-stream :allow-other-keys nil +++ :foo 'bar) +++ program-error) +++ t) +++ +++ +++ +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/make-synonym-stream.lsp ++@@ -0,0 +1,97 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Wed Jan 28 06:54:33 2004 +++;;;; Contains: Tests of MAKE-SYNONYM-STREAM +++ +++(in-package :cl-test) +++ +++(deftest make-synonym-stream.1 +++ (with-input-from-string +++ (*s* "abcde") +++ (declare (special *s*)) +++ (let ((ss (make-synonym-stream '*s*))) +++ (assert (typep ss 'stream)) +++ (assert (typep ss 'synonym-stream)) +++ (assert (input-stream-p ss)) +++ (assert (not (output-stream-p ss))) +++ (assert (open-stream-p ss)) +++ (assert (streamp ss)) +++ (assert (stream-element-type ss)) +++ (values +++ (read-char *s*) +++ (read-char ss) +++ (read-char *s*) +++ (read-char ss) +++ (read-char ss)))) +++ #\a #\b #\c #\d #\e) +++ +++ +++;;; This test was wrong (section 21.1.4) +++#| +++(deftest make-synonym-stream.2 +++ (let ((ss (make-synonym-stream '*s*))) +++ (with-input-from-string +++ (*s* "z") +++ (declare (special *s*)) +++ (assert (typep ss 'stream)) +++ (assert (typep ss 'synonym-stream)) +++ (assert (input-stream-p ss)) +++ (assert (not (output-stream-p ss))) +++ (assert (open-stream-p ss)) +++ (assert (streamp ss)) +++ (assert (stream-element-type ss)) +++ (read-char ss))) +++ #\z) +++|# +++ +++(deftest make-synonym-stream.3 +++ (with-output-to-string +++ (*s*) +++ (declare (special *s*)) +++ (let ((ss (make-synonym-stream '*s*))) +++ (assert (typep ss 'stream)) +++ (assert (typep ss 'synonym-stream)) +++ (assert (output-stream-p ss)) +++ (assert (not (input-stream-p ss))) +++ (assert (open-stream-p ss)) +++ (assert (streamp ss)) +++ (assert (stream-element-type ss)) +++ (write-char #\a *s*) +++ (write-char #\b ss) +++ (write-char #\x *s*) +++ (write-char #\y ss))) +++ "abxy") +++ +++(deftest make-synonym-stream.4 +++ (let ((ss (make-synonym-stream '*terminal-io*))) +++ (assert (typep ss 'stream)) +++ (assert (typep ss 'synonym-stream)) +++ (assert (output-stream-p ss)) +++ (assert (input-stream-p ss)) +++ (assert (open-stream-p ss)) +++ (assert (streamp ss)) +++ (assert (stream-element-type ss)) +++ nil) +++ nil) +++ +++ +++;;; FIXME +++;;; Add tests for: close, +++;;; peek-char, read-char-no-hang, terpri, fresh-line, unread-char, +++;;; read-line, write-line, write-string, read-sequence, write-sequence, +++;;; read-byte, write-byte, listen, clear-input, finish-output, force-output, +++;;; clear-output, format, print, prin1, princ +++ +++;;; Error cases +++ +++(deftest make-synonym-stream.error.1 +++ (signals-error (make-synonym-stream) program-error) +++ t) +++ +++(deftest make-synonym-stream.error.2 +++ (signals-error (make-synonym-stream '*standard-input* nil) program-error) +++ t) +++ +++(deftest make-synonym-stream.error.3 +++ (check-type-error #'make-synonym-stream #'symbolp) +++ nil) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/make-two-way-stream.lsp ++@@ -0,0 +1,244 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Fri Jan 30 05:39:56 2004 +++;;;; Contains: Tests for MAKE-TWO-WAY-STREAM +++ +++(in-package :cl-test) +++ +++(deftest make-two-way-stream.1 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-two-way-stream is os))) +++ (assert (typep s 'stream)) +++ (assert (typep s 'two-way-stream)) +++ (assert (streamp s)) +++ (assert (open-stream-p s)) +++ (assert (input-stream-p s)) +++ (assert (output-stream-p s)) +++ (assert (stream-element-type s)) +++ (values +++ (read-char s) +++ (write-char #\b s) +++ (read-char s) +++ (write-char #\a s) +++ (read-char s) +++ (write-char #\r s) +++ (get-output-stream-string os))) +++ #\f #\b #\o #\a #\o #\r "bar") +++ +++(deftest make-two-way-stream.2 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-two-way-stream is os))) +++ (values +++ (close s) +++ (open-stream-p s) +++ (notnot (open-stream-p is)) +++ (notnot (open-stream-p os)) +++ (write-char #\8 os) +++ (get-output-stream-string os))) +++ t nil t t #\8 "8") +++ +++(deftest make-two-way-stream.3 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-two-way-stream is os))) +++ (values +++ (peek-char nil s) +++ (read-char s) +++ (get-output-stream-string os))) +++ #\f #\f "") +++ +++(deftest make-two-way-stream.4 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-two-way-stream is os))) +++ (values +++ (read-char-no-hang s) +++ (read-char-no-hang s nil) +++ (read-char-no-hang s t :eof) +++ (read-char-no-hang s nil :eof) +++ (get-output-stream-string os))) +++ #\f #\o #\o :eof "") +++ +++(deftest make-two-way-stream.5 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-two-way-stream is os))) +++ (values +++ (terpri s) +++ (get-output-stream-string os))) +++ nil #.(string #\Newline)) +++ +++(deftest make-two-way-stream.6 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-two-way-stream is os))) +++ (values +++ (write-char #\+ s) +++ (notnot (fresh-line s)) +++ (read-char s) +++ (get-output-stream-string os))) +++ #\+ t #\f #.(coerce (list #\+ #\Newline) 'string)) +++ +++(deftest make-two-way-stream.7 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-two-way-stream is os))) +++ (values +++ (read-char s) +++ (unread-char #\f s) +++ (read-char s) +++ (read-char s) +++ (unread-char #\o s) +++ (get-output-stream-string os))) +++ #\f nil #\f #\o nil "") +++ +++(deftest make-two-way-stream.8 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-two-way-stream is os))) +++ (values +++ (read-line s) +++ (get-output-stream-string os))) +++ "foo" "") +++ +++(deftest make-two-way-stream.9 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-two-way-stream is os))) +++ (values +++ (write-string "bar" s) +++ (get-output-stream-string os))) +++ "bar" "bar") +++ +++(deftest make-two-way-stream.10 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-two-way-stream is os))) +++ (values +++ (write-line "bar" s) +++ (get-output-stream-string os))) +++ "bar" #.(concatenate 'string "bar" '(#\Newline))) +++ +++(deftest make-two-way-stream.11 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-two-way-stream is os))) +++ (let ((x (vector nil nil nil))) +++ (values +++ (read-sequence x s) +++ x +++ (get-output-stream-string os)))) +++ 3 #(#\f #\o #\o) "") +++ +++(deftest make-two-way-stream.12 +++ (let ((pn1 #p"tmp.dat") +++ (pn2 #p"tmp2.dat") +++ (element-type '(unsigned-byte 8))) +++ (with-open-file (s pn1 :direction :output :if-exists :supersede +++ :element-type element-type) +++ (dolist (b '(3 8 19 41)) (write-byte b s))) +++ (with-open-file +++ (is pn1 :direction :input :element-type element-type) +++ (with-open-file +++ (os pn2 :direction :output :element-type element-type +++ :if-exists :supersede) +++ (let ((s (make-two-way-stream is os)) +++ (x (vector nil nil nil nil))) +++ (assert (eql (read-sequence x s) 4)) +++ (assert (equalp x #(3 8 19 41))) +++ (let ((y #(100 5 18 211 0 178))) +++ (assert (eql (write-sequence y s) y)) +++ (close s))))) +++ (with-open-file +++ (s pn2 :direction :input :element-type element-type) +++ (let ((x (vector nil nil nil nil nil nil nil))) +++ (values +++ (read-sequence x s) +++ x)))) +++ 6 +++ #(100 5 18 211 0 178 nil)) +++ +++(deftest make-two-way-stream.13 +++ (let ((pn1 #p"tmp.dat") +++ (pn2 #p"tmp2.dat") +++ (element-type '(unsigned-byte 32))) +++ (with-open-file (s pn1 :direction :output :if-exists :supersede +++ :element-type element-type) +++ (dolist (b '(3 8 19 41)) (write-byte b s))) +++ (with-open-file +++ (is pn1 :direction :input :element-type element-type) +++ (with-open-file +++ (os pn2 :direction :output :element-type element-type +++ :if-exists :supersede) +++ (let ((s (make-two-way-stream is os)) +++ (x (vector nil nil nil nil))) +++ (assert (eql (read-sequence x s) 4)) +++ (assert (equalp x #(3 8 19 41))) +++ (let ((y #(100 5 18 211 0 178))) +++ (assert (eql (write-sequence y s) y)) +++ (close s))))) +++ (with-open-file +++ (s pn2 :direction :input :element-type element-type) +++ (let ((x (vector nil nil nil nil nil nil nil))) +++ (values +++ (read-sequence x s) +++ x)))) +++ 6 +++ #(100 5 18 211 0 178 nil)) +++ +++(deftest make-two-way-stream.14 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-two-way-stream is os))) +++ (values +++ (write-string "abc" s) +++ (clear-input s) +++ (write-string "def" s) +++ (get-output-stream-string os))) +++ "abc" nil "def" "abcdef") +++ +++;;; Error tests +++ +++(deftest make-two-way-stream.error.1 +++ (signals-error (make-two-way-stream) program-error) +++ t) +++ +++(deftest make-two-way-stream.error.2 +++ (signals-error (make-two-way-stream (make-string-input-stream "foo")) +++ program-error) +++ t) +++ +++(deftest make-two-way-stream.error.3 +++ (signals-error (let ((os (make-string-output-stream))) +++ (make-two-way-stream (make-string-input-stream "foo") +++ os nil)) +++ program-error) +++ t) +++ +++(deftest make-two-way-stream.error.4 +++ (check-type-error #'(lambda (x) (make-two-way-stream x (make-string-output-stream))) +++ #'(lambda (x) (and (streamp x) (input-stream-p x)))) +++ nil) +++ +++(deftest make-two-way-stream.error.5 +++ (check-type-error #'(lambda (x) (make-two-way-stream x (make-string-output-stream))) +++ #'(lambda (x) (and (streamp x) (input-stream-p x))) +++ *streams*) +++ nil) +++ +++(deftest make-two-way-stream.error.6 +++ (check-type-error #'(lambda (x) (make-two-way-stream (make-string-input-stream "foo") x)) +++ #'(lambda (x) (and (streamp x) (output-stream-p x)))) +++ nil) +++ +++(deftest make-two-way-stream.error.7 +++ (check-type-error #'(lambda (x) (make-two-way-stream (make-string-input-stream "foo") x)) +++ #'(lambda (x) (and (streamp x) (output-stream-p x))) +++ *streams*) +++ nil) +++ +++ +++ +++ ++\ No newline at end of file ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/merge-pathnames.lsp ++@@ -0,0 +1,124 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Wed Dec 31 11:25:55 2003 +++;;;; Contains: Tests of MERGE-PATHNAMES +++ +++(in-package :cl-test) +++ +++#| +++(defun merge-pathnames-test (&rest args) +++ (assert (<= 1 (length args) 3)) +++ (let* ((p1 (car args)) +++ (p2 (if (cdr args) (cadr args) *default-pathname-defaults*)) +++ (default-version (if (cddr args) (caddr args) :newest)) +++ (results (multiple-value-list (apply #'merge-pathnames args)))) +++ (assert (= (length results) 1)) +++ (let ((p3 (first results))) +++ +++|# +++ +++(deftest merge-pathnames.1 +++ (let* ((p1 (make-pathname :name "foo")) +++ (p2 (merge-pathnames p1 p1 nil))) +++ (values +++ (equalpt (pathname-name p1) "foo") +++ (if (equalpt p1 p2) t +++ (list p1 p2)))) +++ t t) +++ +++(deftest merge-pathnames.2 +++ (let* ((p1 (make-pathname :name "foo")) +++ (p2 (merge-pathnames p1 p1))) +++ (values +++ (equalpt (pathname-host p1) (pathname-host p2)) +++ (equalpt (pathname-device p1) (pathname-device p2)) +++ (equalpt (pathname-directory p1) (pathname-directory p2)) +++ (pathname-name p1) +++ (pathname-name p2) +++ (equalpt (pathname-type p1) (pathname-type p2)) +++ (if (pathname-version p1) +++ (equalpt (pathname-version p1) (pathname-version p2)) +++ (equalpt (pathname-version p2) :newest)))) +++ t t t "foo" "foo" t t) +++ +++(deftest merge-pathnames.3 +++ (let* ((p1 (make-pathname :name "foo")) +++ (p2 (make-pathname :name "bar")) +++ (p3 (merge-pathnames p1 p2))) +++ (values +++ (equalpt (pathname-host p1) (pathname-host p3)) +++ (equalpt (pathname-device p1) (pathname-device p3)) +++ (equalpt (pathname-directory p1) (pathname-directory p3)) +++ (pathname-name p1) +++ (pathname-name p3) +++ (equalpt (pathname-type p1) (pathname-type p3)) +++ (if (pathname-version p1) +++ (equalpt (pathname-version p1) (pathname-version p3)) +++ (equalpt (pathname-version p3) :newest)))) +++ t t t "foo" "foo" t t) +++ +++(deftest merge-pathnames.4 +++ (let* ((p1 (make-pathname :name "foo")) +++ (p2 (make-pathname :type "lsp")) +++ (p3 (merge-pathnames p1 p2))) +++ (values +++ (equalpt (pathname-host p1) (pathname-host p3)) +++ (equalpt (pathname-device p1) (pathname-device p3)) +++ (equalpt (pathname-directory p1) (pathname-directory p3)) +++ (pathname-name p1) +++ (pathname-type p2) +++ (pathname-type p3) +++ (equalpt (pathname-type p2) (pathname-type p3)) +++ (if (pathname-version p1) +++ (equalpt (pathname-version p1) (pathname-version p3)) +++ (equalpt (pathname-version p3) :newest)))) +++ t t t "foo" "lsp" "lsp" t t) +++ +++(deftest merge-pathnames.5 +++ (let* ((p1 (make-pathname :name "foo")) +++ (p2 (make-pathname :type "lsp" :version :newest)) +++ (p3 (merge-pathnames p1 p2 nil))) +++ (values +++ (equalpt (pathname-host p1) (pathname-host p3)) +++ (equalpt (pathname-device p1) (pathname-device p3)) +++ (equalpt (pathname-directory p1) (pathname-directory p3)) +++ (pathname-name p1) +++ (pathname-name p3) +++ (pathname-type p2) +++ (pathname-type p3) +++ (equalpt (pathname-version p1) (pathname-version p3)))) +++ t t t "foo" "foo" "lsp" "lsp" t) +++ +++(deftest merge-pathnames.6 +++ (let* ((p1 (make-pathname)) +++ (p2 (make-pathname :name "foo" :version :newest)) +++ (p3 (merge-pathnames p1 p2 nil))) +++ (values +++ (equalpt (pathname-host p1) (pathname-host p3)) +++ (equalpt (pathname-device p1) (pathname-device p3)) +++ (equalpt (pathname-directory p1) (pathname-directory p3)) +++ (pathname-name p2) +++ (pathname-name p3) +++ (equalpt (pathname-type p2) (pathname-type p3)) +++ (pathname-version p2) +++ (pathname-version p3))) +++ t t t "foo" "foo" t :newest :newest) +++ +++(deftest merge-pathnames.7 +++ (let* ((p1 (make-pathname)) +++ (p2 *default-pathname-defaults*) +++ (p3 (merge-pathnames p1))) +++ (values +++ (equalpt (pathname-host p1) (pathname-host p3)) +++ (equalpt (pathname-host p2) (pathname-host p3)) +++ (equalpt (pathname-device p2) (pathname-device p3)) +++ (equalpt (pathname-directory p2) (pathname-directory p3)) +++ (equalpt (pathname-name p2) (pathname-name p3)) +++ (equalpt (pathname-type p2) (pathname-type p3)) +++ (cond +++ ((pathname-version p1) (equalpt (pathname-version p1) +++ (pathname-version p3))) +++ ((pathname-version p2) (equalpt (pathname-version p2) +++ (pathname-version p3))) +++ (t (equalpt (pathname-version p3) :newest))))) +++ t t t t t t t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/namestring.lsp ++@@ -0,0 +1,64 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Thu Sep 2 07:24:42 2004 +++;;;; Contains: Tests for NAMESTRING +++ +++(in-package :cl-test) +++ +++(deftest namestring.1 +++ (let* ((vals (multiple-value-list (namestring "namestring.lsp"))) +++ (s (first vals))) +++ (if (and (null (cdr vals)) +++ (stringp s) +++ (equal (namestring s) s)) +++ :good +++ vals)) +++ :good) +++ +++(deftest namestring.2 +++ (do-special-strings +++ (s "namestring.lsp" nil) +++ (let ((ns (namestring s))) +++ (assert (stringp ns)) +++ (assert (string= (namestring ns) ns)))) +++ nil) +++ +++;;; I'm not convinced these tested required behavior, so I'm commenting +++;;; them out for now. FIXME: determine if they are bogus +++#| +++(deftest namestring.3 +++ (let* ((name "namestring.lsp") +++ (pn (merge-pathnames (pathname name))) +++ (name2 (namestring pn)) +++ (pn2 (pathname name2))) +++ (or (equalt pn pn2) (list (list pn (pathname-host pn) (pathname-device pn) +++ (pathname-directory pn) (pathname-name pn) +++ (pathname-type pn) (pathname-version pn)) +++ (list pn2 (pathname-host pn2) (pathname-device pn2) +++ (pathname-directory pn2) (pathname-name pn2) +++ (pathname-type pn2) (pathname-version pn2))))) +++ t) +++ +++(deftest namestring.4 +++ (let* ((name "namestring.lsp") +++ (pn (merge-pathnames (pathname name))) +++ (name2 (with-open-file (s pn :direction :input) (namestring s))) +++ (pn2 (pathname name2))) +++ (or (equalt pn pn2) (list (list pn (pathname-host pn) (pathname-device pn) +++ (pathname-directory pn) (pathname-name pn) +++ (pathname-type pn) (pathname-version pn)) +++ (list pn2 (pathname-host pn2) (pathname-device pn2) +++ (pathname-directory pn2) (pathname-name pn2) +++ (pathname-type pn2) (pathname-version pn2))))) +++ t) +++|# +++ +++;;; Error tests +++ +++(deftest namestring.error.1 +++ (signals-error (namestring) program-error) +++ t) +++ +++(deftest namestring.error.2 +++ (signals-error (namestring "namestring.lsp" nil) program-error) +++ t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/open-stream-p.lsp ++@@ -0,0 +1,54 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Tue Jan 13 19:52:30 2004 +++;;;; Contains: Tests of OPEN-STREAM-P +++ +++(in-package :cl-test) +++ +++(deftest open-stream-p.1 +++ (loop for s in (list *debug-io* *error-output* *query-io* +++ *standard-input* *standard-output* +++ *trace-output* *terminal-io*) +++ for results = (multiple-value-list (open-stream-p s)) +++ unless (and (eql (length results) 1) +++ (car results)) +++ collect s) +++ nil) +++ +++(deftest open-stream-p.2 +++ (with-open-file (s "open-stream-p.lsp" :direction :input) +++ (notnot-mv (open-stream-p s))) +++ t) +++ +++(deftest open-stream-p.3 +++ (with-open-file (s "foo.txt" :direction :output +++ :if-exists :supersede) +++ (notnot-mv (open-stream-p s))) +++ t) +++ +++(deftest open-stream-p.4 +++ (let ((s (open "open-stream-p.lsp" :direction :input))) +++ (close s) +++ (open-stream-p s)) +++ nil) +++ +++(deftest open-stream-p.5 +++ (let ((s (open "foo.txt" :direction :output +++ :if-exists :supersede))) +++ (close s) +++ (open-stream-p s)) +++ nil) +++ +++;;; error tests +++ +++(deftest open-stream-p.error.1 +++ (signals-error (open-stream-p) program-error) +++ t) +++ +++(deftest open-stream-p.error.2 +++ (signals-error (open-stream-p *standard-input* nil) program-error) +++ t) +++ +++(deftest open-stream-p.error.3 +++ (check-type-error #'open-stream-p #'streamp) +++ nil) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/open.lsp ++@@ -0,0 +1,1238 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Fri Jan 23 05:36:55 2004 +++;;;; Contains: Tests of OPEN +++ +++(in-package :cl-test) +++ +++;;; Input streams +++ +++(defun generator-for-element-type (type) +++ (etypecase type +++ ((member character base-char) +++ #'(lambda (i) (aref "abcdefghijklmnopqrstuvwxyz" (mod i 26)))) +++ ((member signed-byte unsigned-byte bit) +++ #'(lambda (i) (logand i 1))) +++ (cons +++ (let ((op (car type)) +++ (arg1 (cadr type)) +++ (arg2 (caddr type))) +++ (ecase op +++ (unsigned-byte +++ (let ((mask (1- (ash 1 arg1)))) +++ #'(lambda (i) (logand i mask)))) +++ (signed-byte +++ (let ((mask (1- (ash 1 (1- arg1))))) +++ #'(lambda (i) (logand i mask)))) +++ (integer +++ (let* ((lo arg1) +++ (hi arg2) +++ (lower-bound +++ (etypecase lo +++ (integer lo) +++ (cons (1+ (car lo))))) +++ (upper-bound +++ (etypecase hi +++ (integer hi) +++ (cons (1- (car hi))))) +++ (range (1+ (- upper-bound lower-bound)))) +++ #'(lambda (i) (+ lower-bound (mod i range)))))))))) +++ +++(compile 'generator-for-element-type) +++ +++(defmacro def-open-test (name args form expected +++ &key +++ (notes nil notes-p) +++ (build-form nil build-form-p) +++ (element-type 'character element-type-p) +++ (pathname #p"tmp.dat")) +++ +++ (when element-type-p +++ (setf args (append args (list :element-type `',element-type)))) +++ +++ (unless build-form-p +++ (let ((write-element-form +++ (cond +++ ((subtypep element-type 'integer) +++ `(write-byte +++ (funcall (the function +++ (generator-for-element-type ',element-type)) i) +++ os)) +++ ((subtypep element-type 'character) +++ `(write-char +++ (funcall (the function +++ (generator-for-element-type ',element-type)) i) +++ os))))) +++ (setq build-form +++ `(with-open-file +++ (os pn :direction :output +++ ,@(if element-type-p +++ `(:element-type ',element-type)) +++ :if-exists :supersede) +++ (assert (open-stream-p os)) +++ (dotimes (i 10) ,write-element-form) +++ (finish-output os) +++ )))) +++ +++ `(deftest ,name +++ ,@(when notes-p `(:notes ,notes)) +++ (let ((pn ,pathname)) +++ (delete-all-versions pn) +++ ,build-form +++ (let ((s (open pn ,@args))) +++ (unwind-protect +++ (progn +++ (assert (open-stream-p s)) +++ (assert (typep s 'file-stream)) +++ ,@ +++ (unless (member element-type '(signed-byte unsigned-byte)) +++ #-allegro +++ `((assert (subtypep ',element-type +++ (stream-element-type s)))) +++ #+allegro nil +++ ) +++ ,form) +++ (close s)))) +++ ,@expected)) +++ +++;; (compile 'def-open-test) +++ +++(def-open-test open.1 () (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.2 (:direction :input) +++ (values (read-line s nil)) ("abcdefghij") :element-type character) +++(def-open-test open.3 (:direction :input) +++ (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.4 (:direction :input) +++ (values (read-line s nil)) ("abcdefghij") :element-type base-char) +++(def-open-test open.5 (:if-exists :error) +++ (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.6 (:if-exists :error :direction :input) +++ (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.7 (:if-exists :new-version) +++ (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.8 (:if-exists :new-version :direction :input) +++ (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.9 (:if-exists :rename) +++ (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.10 (:if-exists :rename :direction :input) +++ (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.11 (:if-exists :rename-and-delete) +++ (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.12 (:if-exists :rename-and-delete :direction :input) +++ (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.13 (:if-exists :overwrite) +++ (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.14 (:if-exists :overwrite :direction :input) +++ (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.15 (:if-exists :append) +++ (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.16 (:if-exists :append :direction :input) +++ (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.17 (:if-exists :supersede) +++ (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.18 (:if-exists :supersede :direction :input) +++ (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.19 (:if-exists nil) +++ (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.20 (:if-exists nil :direction :input) +++ (values (read-line s nil)) ("abcdefghij")) +++ +++(def-open-test open.21 (:if-does-not-exist nil) +++ (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.22 (:if-does-not-exist nil :direction :input) +++ (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.23 (:if-does-not-exist :error) +++ (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.24 (:if-does-not-exist :error :direction :input) +++ (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.25 (:if-does-not-exist :create) +++ (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.26 (:if-does-not-exist :create :direction :input) +++ (values (read-line s nil)) ("abcdefghij")) +++ +++(def-open-test open.27 (:external-format :default) +++ (values (read-line s nil)) ("abcdefghij")) +++(def-open-test open.28 (:external-format :default :direction :input) +++ (values (read-line s nil)) ("abcdefghij")) +++ +++(def-open-test open.29 () +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 0 1 0 1 0 1 0 1)) :element-type (unsigned-byte 1)) +++(def-open-test open.30 (:direction :input) +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 0 1 0 1 0 1 0 1)) :element-type (unsigned-byte 1)) +++ +++(def-open-test open.31 () +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 0 1 2 3 0 1)) :element-type (unsigned-byte 2)) +++(def-open-test open.32 (:direction :input) +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 0 1 2 3 0 1)) :element-type (unsigned-byte 2)) +++ +++(def-open-test open.33 () +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 0 1)) :element-type (unsigned-byte 3)) +++(def-open-test open.34 (:direction :input) +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 0 1)) :element-type (unsigned-byte 3)) +++ +++(def-open-test open.35 () +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 4)) +++(def-open-test open.36 (:direction :input) +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 4)) +++ +++(def-open-test open.37 () +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 5)) +++(def-open-test open.38 (:direction :input) +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 5)) +++ +++(def-open-test open.39 () +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 6)) +++(def-open-test open.40 (:direction :input) +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 6)) +++ +++(def-open-test open.41 () +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 7)) +++(def-open-test open.42 (:direction :input) +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 7)) +++ +++(def-open-test open.43 () +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 8)) +++(def-open-test open.44 (:direction :input) +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 8)) +++ +++(def-open-test open.45 () +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 9)) +++(def-open-test open.46 (:direction :input) +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 9)) +++ +++(def-open-test open.47 () +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 10)) +++(def-open-test open.48 (:direction :input) +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 10)) +++ +++(def-open-test open.49 () +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 20)) +++(def-open-test open.50 (:direction :input) +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 20)) +++ +++(def-open-test open.51 () +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 25)) +++(def-open-test open.52 (:direction :input) +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 25)) +++ +++(def-open-test open.53 () +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 30)) +++(def-open-test open.54 (:direction :input) +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 30)) +++ +++(def-open-test open.55 () +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 32)) +++(def-open-test open.56 (:direction :input) +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 32)) +++ +++(def-open-test open.57 () +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 33)) +++(def-open-test open.58 (:direction :input) +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 33)) +++ +++(def-open-test open.59 () +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 0 1 0 1 0 1 0 1)) :element-type unsigned-byte) +++(def-open-test open.60 (:direction :input) +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 0 1 0 1 0 1 0 1)) :element-type unsigned-byte) +++ +++(def-open-test open.61 () +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 0 1 0 1 0 1 0 1)) :element-type signed-byte) +++(def-open-test open.62 (:direction :input) +++ (let ((seq (make-array 10))) (read-sequence seq s) seq) +++ (#(0 1 0 1 0 1 0 1 0 1)) :element-type signed-byte) +++ +++ +++(def-open-test open.63 () +++ (values (read-line s nil)) ("abcdefghij") +++ :pathname "tmp.dat") +++ +++(def-open-test open.64 () +++ (values (read-line s nil)) ("abcdefghij") +++ :pathname (logical-pathname "CLTEST:TMP.DAT")) +++ +++;;; It works on recognizable subtypes. +++(deftest open.65 +++ (let ((type '(or (integer 0 1) (integer 100 200))) +++ (pn #p"tmp.dat") +++ (vals '(0 1 100 120 130 190 200 1 0 150))) +++ (or +++ (not (subtypep type 'integer)) +++ (progn +++ (with-open-file +++ (os pn :direction :output +++ :element-type type +++ :if-exists :supersede) +++ (dolist (e vals) (write-byte e os))) +++ (let ((s (open pn :direction :input +++ :element-type type)) +++ (seq (make-array 10))) +++ (unwind-protect +++ (progn (read-sequence seq s) seq) +++ (close s)) +++ (notnot (every #'eql seq vals)))))) +++ t) +++ +++;;; FIXME: Add -- tests for when the filespec is a stream +++ +++(deftest open.66 +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (with-open-file +++ (s pn :direction :io :if-exists :rename-and-delete +++ :if-does-not-exist :create) +++ (format s "some stuff~%") +++ (finish-output s) +++ (let ((is (open s :direction :input))) +++ (unwind-protect +++ (values +++ (read-char is) +++ (notnot (file-position s :start)) +++ (read-line is) +++ (read-line s)) +++ (close is))))) +++ #\s +++ t +++ "ome stuff" +++ "some stuff") +++ +++(deftest open.67 +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (let ((s (open pn :direction :output))) +++ (unwind-protect +++ (progn +++ (format s "some stuff~%") +++ (finish-output s) +++ (close s) +++ (let ((is (open s :direction :input))) +++ (unwind-protect +++ (values (read-line is)) +++ (close is)))) +++ (when (open-stream-p s) (close s))))) +++ "some stuff") +++ +++;;; FIXME: Add -- tests for when element-type is :default +++ +++;;; Tests of file creation +++ +++(defmacro def-open-output-test +++ (name args form expected +++ &rest keyargs +++ &key +++ (element-type 'character) +++ (build-form +++ `(dotimes (i 10) +++ ,(cond +++ ((subtypep element-type 'integer) +++ `(write-byte +++ (funcall (the function +++ (generator-for-element-type ',element-type)) i) +++ s)) +++ ((subtypep element-type 'character) +++ `(write-char +++ (funcall (the function +++ (generator-for-element-type ',element-type)) i) +++ s))))) +++ &allow-other-keys) +++ `(def-open-test ,name (:direction :output ,@args) +++ (progn +++ ,build-form +++ (assert (output-stream-p s)) +++ ,form) +++ ,expected +++ :build-form nil +++ ,@keyargs)) +++ +++;; (compile 'def-open-output-test) +++ +++(def-open-output-test open.output.1 () +++ (progn (close s) +++ (with-open-file (is #p"tmp.dat") (values (read-line is nil)))) +++ ("abcdefghij")) +++ +++(def-open-output-test open.output.2 () +++ (progn (close s) +++ (with-open-file (is "tmp.dat") (values (read-line is nil)))) +++ ("abcdefghij") +++ :pathname "tmp.dat") +++ +++(def-open-output-test open.output.3 +++ () +++ (progn (close s) +++ (with-open-file (is (logical-pathname "CLTEST:TMP.DAT")) +++ (values (read-line is nil)))) +++ ("abcdefghij") +++ :pathname (logical-pathname "CLTEST:TMP.DAT")) +++ +++(def-open-output-test open.output.4 () +++ (progn (close s) +++ (with-open-file (is #p"tmp.dat" :element-type 'character) +++ (values (read-line is nil)))) +++ ("abcdefghij") +++ :element-type character) +++ +++(def-open-output-test open.output.5 () +++ (progn (close s) (with-open-file (is #p"tmp.dat" +++ :element-type 'base-char) +++ (values (read-line is nil)))) +++ ("abcdefghij") +++ :element-type base-char) +++ +++(def-open-output-test open.output.6 () +++ (progn (close s) (with-open-file (is #p"tmp.dat" +++ :element-type '(integer 0 1)) +++ (let ((seq (make-array 10))) +++ (read-sequence seq is) +++ seq))) +++ (#(0 1 0 1 0 1 0 1 0 1)) +++ :element-type (integer 0 1)) +++ +++(def-open-output-test open.output.7 () +++ (progn (close s) (with-open-file (is #p"tmp.dat" +++ :element-type 'bit) +++ (let ((seq (make-array 10))) +++ (read-sequence seq is) +++ seq))) +++ (#(0 1 0 1 0 1 0 1 0 1)) +++ :element-type bit) +++ +++(def-open-output-test open.output.8 () +++ (progn (close s) (with-open-file (is #p"tmp.dat" +++ :element-type '(unsigned-byte 1)) +++ (let ((seq (make-array 10))) +++ (read-sequence seq is) +++ seq))) +++ (#(0 1 0 1 0 1 0 1 0 1)) +++ :element-type (unsigned-byte 1)) +++ +++(def-open-output-test open.output.9 () +++ (progn (close s) (with-open-file (is #p"tmp.dat" +++ :element-type '(unsigned-byte 2)) +++ (let ((seq (make-array 10))) +++ (read-sequence seq is) +++ seq))) +++ (#(0 1 2 3 0 1 2 3 0 1)) +++ :element-type (unsigned-byte 2)) +++ +++(def-open-output-test open.output.10 () +++ (progn (close s) (with-open-file (is #p"tmp.dat" +++ :element-type '(unsigned-byte 3)) +++ (let ((seq (make-array 10))) +++ (read-sequence seq is) +++ seq))) +++ (#(0 1 2 3 4 5 6 7 0 1)) +++ :element-type (unsigned-byte 3)) +++ +++(def-open-output-test open.output.11 () +++ (progn (close s) (with-open-file (is #p"tmp.dat" +++ :element-type '(unsigned-byte 4)) +++ (let ((seq (make-array 10))) +++ (read-sequence seq is) +++ seq))) +++ (#(0 1 2 3 4 5 6 7 8 9)) +++ :element-type (unsigned-byte 4)) +++ +++ +++(def-open-output-test open.output.12 () +++ (progn (close s) (with-open-file (is #p"tmp.dat" +++ :element-type '(unsigned-byte 6)) +++ (let ((seq (make-array 10))) +++ (read-sequence seq is) +++ seq))) +++ (#(0 1 2 3 4 5 6 7 8 9)) +++ :element-type (unsigned-byte 6)) +++ +++(def-open-output-test open.output.13 () +++ (progn (close s) (with-open-file (is #p"tmp.dat" +++ :element-type '(unsigned-byte 8)) +++ (let ((seq (make-array 10))) +++ (read-sequence seq is) +++ seq))) +++ (#(0 1 2 3 4 5 6 7 8 9)) +++ :element-type (unsigned-byte 8)) +++ +++(def-open-output-test open.output.14 () +++ (progn (close s) (with-open-file (is #p"tmp.dat" +++ :element-type '(unsigned-byte 12)) +++ (let ((seq (make-array 10))) +++ (read-sequence seq is) +++ seq))) +++ (#(0 1 2 3 4 5 6 7 8 9)) +++ :element-type (unsigned-byte 12)) +++ +++(def-open-output-test open.output.15 () +++ (progn (close s) (with-open-file (is #p"tmp.dat" +++ :element-type '(unsigned-byte 16)) +++ (let ((seq (make-array 10))) +++ (read-sequence seq is) +++ seq))) +++ (#(0 1 2 3 4 5 6 7 8 9)) +++ :element-type (unsigned-byte 16)) +++ +++(def-open-output-test open.output.16 () +++ (progn (close s) (with-open-file (is #p"tmp.dat" +++ :element-type '(unsigned-byte 24)) +++ (let ((seq (make-array 10))) +++ (read-sequence seq is) +++ seq))) +++ (#(0 1 2 3 4 5 6 7 8 9)) +++ :element-type (unsigned-byte 24)) +++ +++(def-open-output-test open.output.17 () +++ (progn (close s) (with-open-file (is #p"tmp.dat" +++ :element-type '(unsigned-byte 32)) +++ (let ((seq (make-array 10))) +++ (read-sequence seq is) +++ seq))) +++ (#(0 1 2 3 4 5 6 7 8 9)) +++ :element-type (unsigned-byte 32)) +++ +++(def-open-output-test open.output.18 () +++ (progn (close s) (with-open-file (is #p"tmp.dat" +++ :element-type '(unsigned-byte 64)) +++ (let ((seq (make-array 10))) +++ (read-sequence seq is) +++ seq))) +++ (#(0 1 2 3 4 5 6 7 8 9)) +++ :element-type (unsigned-byte 64)) +++ +++(def-open-output-test open.output.19 () +++ (progn (close s) (with-open-file (is #p"tmp.dat" +++ :element-type '(unsigned-byte 100)) +++ (let ((seq (make-array 10))) +++ (read-sequence seq is) +++ seq))) +++ (#(0 1 2 3 4 5 6 7 8 9)) +++ :element-type (unsigned-byte 100)) +++ +++(deftest open.output.20 +++ (let ((pn #p"tmp.dat")) +++ (with-open-file (s pn :direction :output :if-exists :supersede)) +++ (open pn :direction :output :if-exists nil)) +++ nil) +++ +++(def-open-test open.output.21 (:if-exists :new-version :direction :output) +++ (progn (write-sequence "wxyz" s) +++ (close s) +++ (with-open-file +++ (s pn :direction :input) +++ (values (read-line s nil)))) +++ ("wxyz") +++ :notes (:open-if-exists-new-version-no-error) +++ ) +++ +++(def-open-test open.output.22 (:if-exists :rename :direction :output) +++ (progn (write-sequence "wxyz" s) +++ (close s) +++ (with-open-file +++ (s pn :direction :input) +++ (values (read-line s nil)))) +++ ("wxyz")) +++ +++(def-open-test open.output.23 (:if-exists :rename-and-delete +++ :direction :output) +++ (progn (write-sequence "wxyz" s) +++ (close s) +++ (with-open-file +++ (s pn :direction :input) +++ (values (read-line s nil)))) +++ ("wxyz")) +++ +++(def-open-test open.output.24 (:if-exists :overwrite +++ :direction :output) +++ (progn (write-sequence "wxyz" s) +++ (close s) +++ (with-open-file +++ (s pn :direction :input) +++ (values (read-line s nil)))) +++ ("wxyzefghij")) +++ +++(def-open-test open.output.25 (:if-exists :append +++ :direction :output) +++ (progn (write-sequence "wxyz" s) +++ (close s) +++ (with-open-file +++ (s pn :direction :input) +++ (values (read-line s nil)))) +++ ("abcdefghijwxyz")) +++ +++(def-open-test open.output.26 (:if-exists :supersede +++ :direction :output) +++ (progn (write-sequence "wxyz" s) +++ (close s) +++ (with-open-file +++ (s pn :direction :input) +++ (values (read-line s nil)))) +++ ("wxyz")) +++ +++(def-open-output-test open.output.27 (:if-does-not-exist :create +++ :direction :output) +++ (progn (close s) +++ (with-open-file +++ (is pn :direction :input) +++ (values (read-line is nil)))) +++ ("abcdefghij")) +++ +++(deftest open.output.28 +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (open pn :direction :output :if-does-not-exist nil)) +++ nil) +++ +++(def-open-output-test open.output.28a (:external-format :default) +++ (progn (close s) +++ (with-open-file (is #p"tmp.dat") (values (read-line is nil)))) +++ ("abcdefghij")) +++ +++(def-open-output-test open.output.29 +++ (:external-format (prog1 +++ (with-open-file (s "foo.dat" :direction :output +++ :if-exists :supersede) +++ (stream-external-format s)) +++ (delete-all-versions "foo.dat") +++ )) +++ (progn (close s) +++ (with-open-file (is #p"tmp.dat") (values (read-line is nil)))) +++ ("abcdefghij")) +++ +++;;; Default behavior of open :if-exists is :create when the version +++;;; of the filespec is :newest +++ +++(deftest open.output.30 +++ :notes (:open-if-exists-new-version-no-error) +++ (let ((pn (make-pathname :name "tmp" :type "dat" :version :newest))) +++ (or (not (eql (pathname-version pn) :newest)) +++ (progn +++ ;; Create file +++ (let ((s1 (open pn :direction :output :if-exists :overwrite +++ :if-does-not-exist :create))) +++ (unwind-protect +++ ;; Now try again +++ (let ((s2 (open pn :direction :output))) +++ (unwind-protect +++ (write-line "abcdef" s2) +++ (close s2)) +++ (unwind-protect +++ (progn +++ (setq s2 (open s1 :direction :input)) +++ (equalt (read-line s2 nil) "abcdef")) +++ (close s2))) +++ (close s1) +++ (delete-all-versions pn) +++ ))))) +++ t) +++ +++(def-open-output-test open.output.31 (:if-exists :rename +++ :direction :output) +++ (progn (close s) +++ (with-open-file +++ (is pn :direction :input) +++ (values (read-line is nil)))) +++ ("abcdefghij")) +++ +++(def-open-output-test open.output.32 (:if-exists :rename-and-delete +++ :direction :output) +++ (progn (close s) +++ (with-open-file +++ (is pn :direction :input) +++ (values (read-line is nil)))) +++ ("abcdefghij")) +++ +++(def-open-output-test open.output.33 (:if-exists :new-version +++ :direction :output) +++ (progn (close s) +++ (with-open-file +++ (is pn :direction :input) +++ (values (read-line is nil)))) +++ ("abcdefghij")) +++ +++(def-open-output-test open.output.34 (:if-exists :supersede +++ :direction :output) +++ (progn (close s) +++ (with-open-file +++ (is pn :direction :input) +++ (values (read-line is nil)))) +++ ("abcdefghij")) +++ +++(def-open-output-test open.output.35 (:if-exists nil +++ :direction :output) +++ (progn (close s) +++ (with-open-file +++ (is pn :direction :input) +++ (values (read-line is nil)))) +++ ("abcdefghij")) +++ +++;;; Add -- tests for when the filespec is a stream +++ +++ +++;;; Tests of bidirectional IO +++ +++(defmacro def-open-io-test +++ (name args form expected +++ &rest keyargs +++ &key +++ (element-type 'character) +++ (build-form +++ `(dotimes (i 10) +++ ,(cond +++ ((subtypep element-type 'integer) +++ `(write-byte +++ (funcall (the function +++ (generator-for-element-type ',element-type)) i) +++ s)) +++ ((subtypep element-type 'character) +++ `(write-char +++ (funcall (the function +++ (generator-for-element-type ',element-type)) i) +++ s))))) +++ &allow-other-keys) +++ `(def-open-test ,name (:direction :io ,@args) +++ (progn +++ ,build-form +++ (assert (input-stream-p s)) +++ (assert (output-stream-p s)) +++ ,form) +++ ,expected +++ :build-form nil +++ ,@keyargs)) +++ +++;; (compile 'def-open-io-test) +++ +++(def-open-io-test open.io.1 () +++ (progn (file-position s :start) +++ (values (read-line s nil))) +++ ("abcdefghij")) +++ +++(def-open-io-test open.io.2 () +++ (progn (file-position s :start) +++ (values (read-line s nil))) +++ ("abcdefghij") +++ :pathname "tmp.dat") +++ +++(def-open-io-test open.io.3 +++ () +++ (progn (file-position s :start) +++ (values (read-line s nil))) +++ ("abcdefghij") +++ :pathname (logical-pathname "CLTEST:TMP.DAT")) +++ +++(def-open-io-test open.io.4 () +++ (progn (file-position s :start) +++ (values (read-line s nil))) +++ ("abcdefghij") +++ :element-type character) +++ +++(def-open-io-test open.io.5 () +++ (progn (file-position s :start) +++ (values (read-line s nil))) +++ ("abcdefghij") +++ :element-type base-char) +++ +++(def-open-io-test open.io.6 () +++ (progn (file-position s :start) +++ (let ((seq (make-array 10))) +++ (read-sequence seq s) +++ seq)) +++ (#(0 1 0 1 0 1 0 1 0 1)) +++ :element-type (integer 0 1)) +++ +++(def-open-io-test open.io.7 () +++ (progn (file-position s :start) +++ (let ((seq (make-array 10))) +++ (read-sequence seq s) +++ seq)) +++ (#(0 1 0 1 0 1 0 1 0 1)) +++ :element-type bit) +++ +++(def-open-io-test open.io.8 () +++ (progn (file-position s :start) +++ (let ((seq (make-array 10))) +++ (read-sequence seq s) +++ seq)) +++ (#(0 1 0 1 0 1 0 1 0 1)) +++ :element-type (unsigned-byte 1)) +++ +++(def-open-io-test open.io.9 () +++ (progn (file-position s :start) +++ (let ((seq (make-array 10))) +++ (read-sequence seq s) +++ seq)) +++ (#(0 1 2 3 0 1 2 3 0 1)) +++ :element-type (unsigned-byte 2)) +++ +++(def-open-io-test open.io.10 () +++ (progn (file-position s :start) +++ (let ((seq (make-array 10))) +++ (read-sequence seq s) +++ seq)) +++ (#(0 1 2 3 4 5 6 7 0 1)) +++ :element-type (unsigned-byte 3)) +++ +++(def-open-io-test open.io.11 () +++ (progn (file-position s :start) +++ (let ((seq (make-array 10))) +++ (read-sequence seq s) +++ seq)) +++ (#(0 1 2 3 4 5 6 7 8 9)) +++ :element-type (unsigned-byte 4)) +++ +++ +++(def-open-io-test open.io.12 () +++ (progn (file-position s :start) +++ (let ((seq (make-array 10))) +++ (read-sequence seq s) +++ seq)) +++ (#(0 1 2 3 4 5 6 7 8 9)) +++ :element-type (unsigned-byte 6)) +++ +++(def-open-io-test open.io.13 () +++ (progn (file-position s :start) +++ (let ((seq (make-array 10))) +++ (read-sequence seq s) +++ seq)) +++ (#(0 1 2 3 4 5 6 7 8 9)) +++ :element-type (unsigned-byte 8)) +++ +++(def-open-io-test open.io.14 () +++ (progn (file-position s :start) +++ (let ((seq (make-array 10))) +++ (read-sequence seq s) +++ seq)) +++ (#(0 1 2 3 4 5 6 7 8 9)) +++ :element-type (unsigned-byte 12)) +++ +++(def-open-io-test open.io.15 () +++ (progn (file-position s :start) +++ (let ((seq (make-array 10))) +++ (read-sequence seq s) +++ seq)) +++ (#(0 1 2 3 4 5 6 7 8 9)) +++ :element-type (unsigned-byte 16)) +++ +++(def-open-io-test open.io.16 () +++ (progn (file-position s :start) +++ (let ((seq (make-array 10))) +++ (read-sequence seq s) +++ seq)) +++ (#(0 1 2 3 4 5 6 7 8 9)) +++ :element-type (unsigned-byte 24)) +++ +++(def-open-io-test open.io.17 () +++ (progn (file-position s :start) +++ (let ((seq (make-array 10))) +++ (read-sequence seq s) +++ seq)) +++ (#(0 1 2 3 4 5 6 7 8 9)) +++ :element-type (unsigned-byte 32)) +++ +++(def-open-io-test open.io.18 () +++ (progn (file-position s :start) +++ (let ((seq (make-array 10))) +++ (read-sequence seq s) +++ seq)) +++ (#(0 1 2 3 4 5 6 7 8 9)) +++ :element-type (unsigned-byte 64)) +++ +++(def-open-io-test open.io.19 () +++ (progn (file-position s :start) +++ (let ((seq (make-array 10))) +++ (read-sequence seq s) +++ seq)) +++ (#(0 1 2 3 4 5 6 7 8 9)) +++ :element-type (unsigned-byte 100)) +++ +++(deftest open.io.20 +++ (let ((pn #p"tmp.dat")) +++ (with-open-file (s pn :direction :io :if-exists :supersede)) +++ (open pn :direction :io :if-exists nil)) +++ nil) +++ +++(def-open-test open.io.21 (:if-exists :new-version :direction :io) +++ (progn (write-sequence "wxyz" s) +++ (file-position s :start) +++ (values (read-line s nil))) +++ ("wxyz") +++ :notes (:open-if-exists-new-version-no-error) +++ ) +++ +++(def-open-test open.io.22 (:if-exists :rename :direction :io) +++ (progn (write-sequence "wxyz" s) +++ (file-position s :start) +++ (values (read-line s nil))) +++ ("wxyz")) +++ +++(def-open-test open.io.23 (:if-exists :rename-and-delete +++ :direction :io) +++ (progn (write-sequence "wxyz" s) +++ (file-position s :start) +++ (values (read-line s nil))) +++ ("wxyz")) +++ +++(def-open-test open.io.24 (:if-exists :overwrite +++ :direction :io) +++ (progn (write-sequence "wxyz" s) +++ (file-position s :start) +++ (values (read-line s nil))) +++ ("wxyzefghij")) +++ +++(def-open-test open.io.25 (:if-exists :append +++ :direction :io) +++ (progn (write-sequence "wxyz" s) +++ (file-position s :start) +++ (values (read-line s nil))) +++ ("abcdefghijwxyz")) +++ +++(def-open-test open.io.26 (:if-exists :supersede +++ :direction :io) +++ (progn (write-sequence "wxyz" s) +++ (file-position s :start) +++ (values (read-line s nil))) +++ ("wxyz")) +++ +++(def-open-io-test open.io.27 (:if-does-not-exist :create +++ :direction :io) +++ (progn (file-position s :start) +++ (values (read-line s nil))) +++ ("abcdefghij")) +++ +++(deftest open.io.28 +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (open pn :direction :io :if-does-not-exist nil)) +++ nil) +++ +++(def-open-io-test open.io.28a (:external-format :default) +++ (progn (file-position s :start) +++ (values (read-line s nil))) +++ ("abcdefghij")) +++ +++(def-open-io-test open.io.29 +++ (:external-format (prog1 +++ (with-open-file (s "foo.dat" :direction :io +++ :if-exists :supersede) +++ (stream-external-format s)) +++ (delete-all-versions "foo.dat") +++ )) +++ (progn (file-position s :start) +++ (values (read-line s nil))) +++ ("abcdefghij")) +++ +++;;; Default behavior of open :if-exists is :create when the version +++;;; of the filespec is :newest +++ +++(deftest open.io.30 +++ :notes (:open-if-exists-new-version-no-error) +++ (let ((pn (make-pathname :name "tmp" :type "dat" :version :newest))) +++ (or (not (eql (pathname-version pn) :newest)) +++ (progn +++ ;; Create file +++ (let ((s1 (open pn :direction :io :if-exists :overwrite +++ :if-does-not-exist :create))) +++ (unwind-protect +++ ;; Now try again +++ (let ((s2 (open pn :direction :io))) +++ (unwind-protect +++ (write-line "abcdef" s2) +++ (close s2)) +++ (unwind-protect +++ (progn +++ (setq s2 (open s1 :direction :input)) +++ (equalt (read-line s2 nil) "abcdef")) +++ (close s2))) +++ (close s1) +++ (delete-all-versions pn) +++ ))))) +++ t) +++ +++(def-open-io-test open.io.31 (:if-exists :rename +++ :direction :io) +++ (progn (file-position s :start) +++ (values (read-line s nil))) +++ ("abcdefghij")) +++ +++(def-open-io-test open.io.32 (:if-exists :rename-and-delete +++ :direction :io) +++ (progn (file-position s :start) +++ (values (read-line s nil))) +++ ("abcdefghij")) +++ +++(def-open-io-test open.io.33 (:if-exists :new-version +++ :direction :io) +++ (progn (file-position s :start) +++ (values (read-line s nil))) +++ ("abcdefghij")) +++ +++(def-open-io-test open.io.34 (:if-exists :supersede +++ :direction :io) +++ (progn (file-position s :start) +++ (values (read-line s nil))) +++ ("abcdefghij")) +++ +++(def-open-io-test open.io.35 (:if-exists nil +++ :direction :io) +++ (progn (file-position s :start) +++ (values (read-line s nil))) +++ ("abcdefghij")) +++ +++;;;; :PROBE tests +++ +++(defmacro def-open-probe-test +++ (name args form +++ &key (build-form nil build-form-p) +++ (pathname #p"tmp.dat")) +++ (unless build-form-p +++ (setf build-form +++ `(with-open-file (s pn :direction :output +++ :if-exists :supersede)))) +++ `(deftest ,name +++ (let ((pn ,pathname)) +++ (delete-all-versions pn) +++ ,build-form +++ (let ((s (open pn :direction :probe ,@args))) +++ (values +++ ,(if build-form +++ `(and +++ (typep s 'file-stream) +++ (not (open-stream-p s)) +++ ) +++ `(not s)) +++ ,form))) +++ t t)) +++ +++(def-open-probe-test open.probe.1 () t) +++(def-open-probe-test open.probe.2 (:if-exists :error) t) +++(def-open-probe-test open.probe.3 (:if-exists :new-version) t) +++(def-open-probe-test open.probe.4 (:if-exists :rename) t) +++(def-open-probe-test open.probe.5 (:if-exists :rename-and-delete) t) +++(def-open-probe-test open.probe.6 (:if-exists :overwrite) t) +++(def-open-probe-test open.probe.7 (:if-exists :append) t) +++(def-open-probe-test open.probe.8 (:if-exists :supersede) t) +++ +++(def-open-probe-test open.probe.9 (:if-does-not-exist :error) t) +++(def-open-probe-test open.probe.10 (:if-does-not-exist nil) t) +++(def-open-probe-test open.probe.11 (:if-does-not-exist :create) t) +++ +++(def-open-probe-test open.probe.12 () t :build-form nil) +++(def-open-probe-test open.probe.13 (:if-exists :error) t :build-form nil) +++(def-open-probe-test open.probe.14 (:if-exists :new-version) t :build-form nil) +++(def-open-probe-test open.probe.15 (:if-exists :rename) t :build-form nil) +++(def-open-probe-test open.probe.16 (:if-exists :rename-and-delete) t +++ :build-form nil) +++(def-open-probe-test open.probe.17 (:if-exists :overwrite) t +++ :build-form nil) +++(def-open-probe-test open.probe.18 (:if-exists :append) t +++ :build-form nil) +++(def-open-probe-test open.probe.19 (:if-exists :supersede) t +++ :build-form nil) +++ +++(def-open-probe-test open.probe.20 (:if-does-not-exist nil) t +++ :build-form nil) +++ +++(deftest open.probe.21 +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (let ((s (open pn :direction :probe :if-does-not-exist :create))) +++ (values +++ (notnot s) +++ (notnot (probe-file pn))))) +++ t t) +++ +++(deftest open.probe.22 +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (let ((s (open pn :direction :probe :if-does-not-exist :create +++ :if-exists :error))) +++ (values +++ (notnot s) +++ (notnot (probe-file pn))))) +++ t t) +++ +++(def-open-probe-test open.probe.23 (:external-format :default) t) +++(def-open-probe-test open.probe.24 (:element-type 'character) t) +++(def-open-probe-test open.probe.25 (:element-type 'bit) t) +++(def-open-probe-test open.probe.26 (:element-type '(unsigned-byte 2)) t) +++(def-open-probe-test open.probe.27 (:element-type '(unsigned-byte 4)) t) +++(def-open-probe-test open.probe.28 (:element-type '(unsigned-byte 8)) t) +++(def-open-probe-test open.probe.29 (:element-type '(unsigned-byte 9)) t) +++(def-open-probe-test open.probe.30 (:element-type '(unsigned-byte 15)) t) +++(def-open-probe-test open.probe.31 (:element-type '(unsigned-byte 16)) t) +++(def-open-probe-test open.probe.32 (:element-type '(unsigned-byte 17)) t) +++(def-open-probe-test open.probe.33 (:element-type '(unsigned-byte 31)) t) +++(def-open-probe-test open.probe.34 (:element-type '(unsigned-byte 32)) t) +++(def-open-probe-test open.probe.35 (:element-type '(unsigned-byte 33)) t) +++(def-open-probe-test open.probe.36 (:element-type '(integer -1002 13112)) t) +++ +++;;;; Error tests +++ +++(deftest open.error.1 +++ (signals-error (open) program-error) +++ t) +++ +++(deftest open.error.2 +++ (signals-error-always +++ (let ((pn #p"tmp.dat")) +++ (close (open pn :direction :output :if-does-not-exist :create)) +++ (open pn :if-exists :error :direction :output)) +++ file-error) +++ t t) +++ +++(deftest open.error.3 +++ (signals-error-always +++ (let ((pn #p"tmp.dat")) +++ (close (open pn :direction :output :if-does-not-exist :create)) +++ (open pn :if-exists :error :direction :io)) +++ file-error) +++ t t) +++ +++(deftest open.error.4 +++ (signals-error-always +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (open pn)) +++ file-error) +++ t t) +++ +++(deftest open.error.5 +++ (signals-error-always +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (open pn :if-does-not-exist :error)) +++ file-error) +++ t t) +++ +++(deftest open.error.6 +++ (signals-error-always +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (open pn :direction :input)) +++ file-error) +++ t t) +++ +++(deftest open.error.7 +++ (signals-error-always +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (open pn :if-does-not-exist :error :direction :input)) +++ file-error) +++ t t) +++ +++(deftest open.error.8 +++ (signals-error-always +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (open pn :direction :output :if-does-not-exist :error)) +++ file-error) +++ t t) +++ +++(deftest open.error.9 +++ (signals-error-always +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (open pn :direction :io :if-does-not-exist :error)) +++ file-error) +++ t t) +++ +++(deftest open.error.10 +++ (signals-error-always +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (open pn :direction :probe :if-does-not-exist :error)) +++ file-error) +++ t t) +++ +++(deftest open.error.11 +++ (signals-error-always +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (open pn :direction :output :if-exists :overwrite)) +++ file-error) +++ t t) +++ +++(deftest open.error.12 +++ (signals-error-always +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (open pn :direction :output :if-exists :append)) +++ file-error) +++ t t) +++ +++(deftest open.error.13 +++ (signals-error-always +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (open pn :direction :io :if-exists :overwrite)) +++ file-error) +++ t t) +++ +++(deftest open.error.14 +++ (signals-error-always +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (open pn :direction :io :if-exists :append)) +++ file-error) +++ t t) +++ +++(deftest open.error.15 +++ (signals-error-always +++ (open (make-pathname :name :wild :type "lsp")) +++ file-error) +++ t t) +++ +++(deftest open.error.16 +++ (signals-error-always +++ (open (make-pathname :name "open" :type :wild)) +++ file-error) +++ t t) +++ +++(deftest open.error.17 +++ (signals-error-always +++ (let ((pn (make-pathname :name "open" :type "lsp" :version :wild))) +++ (if (wild-pathname-p pn) (open pn) +++ (error 'file-error))) +++ file-error) +++ t t) +++ +++(deftest open.error.18 +++ (signals-error-always +++ (open #p"tmp.dat" :direction :output :if-exists :supersede +++ :external-form (gensym)) +++ error) +++ t t) +++ +++ +++;;; FIXME -- add tests for :element-type :default +++ +++;;; FIXME -- add tests for filespec being a specialized string ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/output-stream-p.lsp ++@@ -0,0 +1,39 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Tue Jan 13 19:46:12 2004 +++;;;; Contains: Tests of OUTPUT-STREAM-P +++ +++(in-package :cl-test) +++ +++(deftest output-stream-p.1 +++ (notnot-mv (output-stream-p *standard-output*)) +++ t) +++ +++(deftest output-stream-p.2 +++ (notnot-mv (output-stream-p *terminal-io*)) +++ t) +++ +++(deftest output-stream-p.3 +++ (with-open-file (s "output-stream-p.lsp" :direction :input) +++ (output-stream-p s)) +++ nil) +++ +++(deftest output-stream-p.4 +++ (with-open-file (s "foo.txt" :direction :output +++ :if-exists :supersede) +++ (notnot-mv (output-stream-p s))) +++ t) +++ +++;;; Error tests +++ +++(deftest output-stream-p.error.1 +++ (signals-error (output-stream-p) program-error) +++ t) +++ +++(deftest output-stream-p.error.2 +++ (signals-error (output-stream-p *standard-output* nil) program-error) +++ t) +++ +++(deftest output-stream-p.error.3 +++ (check-type-error #'output-stream-p #'streamp) +++ nil) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/parse-namestring.lsp ++@@ -0,0 +1,89 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Aug 14 13:59:18 2004 +++;;;; Contains: Tests of PARSE-NAMESTRING +++ +++(in-package :cl-test) +++ +++;;; "Parsing a null string always succeeds, producing a pathname +++;;; with all components (except the host) equal to nil." +++ +++(deftest parse-namestring.1 +++ (let ((vals (multiple-value-list (parse-namestring "")))) +++ (assert (= (length vals) 2)) +++ (let ((pn (first vals)) +++ (pos (second vals))) +++ (values +++ (pathname-directory pn) +++ (pathname-device pn) +++ (pathname-name pn) +++ (pathname-type pn) +++ (pathname-version pn) +++ pos))) +++ nil nil nil nil nil 0) +++ +++(deftest parse-namestring.2 +++ (let ((vals (multiple-value-list (parse-namestring (make-array 0 :element-type 'base-char))))) +++ (assert (= (length vals) 2)) +++ (let ((pn (first vals)) +++ (pos (second vals))) +++ (values +++ (pathname-directory pn) +++ (pathname-device pn) +++ (pathname-name pn) +++ (pathname-type pn) +++ (pathname-version pn) +++ pos))) +++ nil nil nil nil nil 0) +++ +++(deftest parse-namestring.3 +++ (let ((vals (multiple-value-list (parse-namestring (make-array 4 :element-type 'base-char +++ :initial-element #\X +++ :fill-pointer 0))))) +++ (assert (= (length vals) 2)) +++ (let ((pn (first vals)) +++ (pos (second vals))) +++ (values +++ (pathname-directory pn) +++ (pathname-device pn) +++ (pathname-name pn) +++ (pathname-type pn) +++ (pathname-version pn) +++ pos))) +++ nil nil nil nil nil 0) +++ +++(deftest parse-namestring.4 +++ (loop for etype in '(standard-char base-char character) +++ for s0 = (make-array 4 :element-type etype :initial-element #\X) +++ for s = (make-array 0 :element-type etype :displaced-to s0 +++ :displaced-index-offset 1) +++ for vals = (multiple-value-list (parse-namestring s)) +++ for pn = (first vals) +++ for pos = (second vals) +++ do (assert (= (length vals) 2)) +++ nconc +++ (let ((result (list (pathname-directory pn) +++ (pathname-device pn) +++ (pathname-name pn) +++ (pathname-type pn) +++ (pathname-version pn) +++ pos))) +++ (unless (equal result '(nil nil nil nil nil 0)) +++ (list (list etype result))))) +++ nil) +++ +++;;; Error tests +++ +++(deftest parse-namestring.error.1 +++ (signals-error (parse-namestring) program-error) +++ t) +++ +++(deftest parse-name-string.error.2 +++ (signals-error (parse-namestring "" nil *default-pathname-defaults* :foo nil) program-error) +++ t) +++ +++(deftest parse-name-string.error.3 +++ (signals-error (parse-namestring "" nil *default-pathname-defaults* :start) program-error) +++ t) +++ +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/pathname-device.lsp ++@@ -0,0 +1,74 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Dec 6 14:23:54 2003 +++;;;; Contains: Tests for PATHNAME-DEVICE +++ +++(in-package :cl-test) +++ +++(compile-and-load "pathnames-aux.lsp") +++ +++(deftest pathname-device.1 +++ (loop for p in *pathnames* +++ for device = (pathname-device p) +++ unless (or (stringp device) +++ (member device '(nil :wild :unspecific))) +++ collect (list p device)) +++ nil) +++ +++(deftest pathname-device.2 +++ (loop for p in *pathnames* +++ for device = (pathname-device p :case :local) +++ unless (or (stringp device) +++ (member device '(nil :wild :unspecific))) +++ collect (list p device)) +++ nil) +++ +++(deftest pathname-device.3 +++ (loop for p in *pathnames* +++ for device = (pathname-device p :case :common) +++ unless (or (stringp device) +++ (member device '(nil :wild :unspecific))) +++ collect (list p device)) +++ nil) +++ +++(deftest pathname-device.4 +++ (loop for p in *pathnames* +++ for device = (pathname-device p :allow-other-keys nil) +++ unless (or (stringp device) +++ (member device '(nil :wild :unspecific))) +++ collect (list p device)) +++ nil) +++ +++(deftest pathname-device.5 +++ (loop for p in *pathnames* +++ for device = (pathname-device p :foo 'bar :allow-other-keys t) +++ unless (or (stringp device) +++ (member device '(nil :wild :unspecific))) +++ collect (list p device)) +++ nil) +++ +++(deftest pathname-device.6 +++ (loop for p in *pathnames* +++ for device = (pathname-device p :allow-other-keys t :allow-other-keys nil :foo 'bar) +++ unless (or (stringp device) +++ (member device '(nil :wild :unspecific))) +++ collect (list p device)) +++ nil) +++ +++;;; section 19.3.2.1 +++(deftest pathname-device.7 +++ (loop for p in *logical-pathnames* +++ always (eq (pathname-device p) :unspecific)) +++ t) +++ +++(deftest pathname-device.8 +++ (do-special-strings (s "" nil) (pathname-device s)) +++ nil) +++ +++(deftest pathname-device.error.1 +++ (signals-error (pathname-device) program-error) +++ t) +++ +++(deftest pathname-device.error.2 +++ (check-type-error #'pathname-device #'could-be-pathname-designator) +++ nil) ++\ No newline at end of file ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/pathname-directory.lsp ++@@ -0,0 +1,89 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Dec 6 14:24:39 2003 +++;;;; Contains: Tests for PATHNAME-DIRECTORY +++ +++(in-package :cl-test) +++ +++(compile-and-load "pathnames-aux.lsp") +++ +++(deftest pathname-directory.1 +++ (loop for p in *pathnames* +++ for directory = (pathname-directory p) +++ unless (or (stringp directory) +++ (member directory '(nil :wild :unspecific)) +++ (and (consp directory) +++ (member (car directory) '(:absolute :relative)))) +++ collect (list p directory)) +++ nil) +++ +++(deftest pathname-directory.2 +++ (loop for p in *pathnames* +++ for directory = (pathname-directory p :case :local) +++ unless (or (stringp directory) +++ (member directory '(nil :wild :unspecific)) +++ (and (consp directory) +++ (member (car directory) '(:absolute :relative)))) +++ collect (list p directory)) +++ nil) +++ +++(deftest pathname-directory.3 +++ (loop for p in *pathnames* +++ for directory = (pathname-directory p :case :common) +++ unless (or (stringp directory) +++ (member directory '(nil :wild :unspecific)) +++ (and (consp directory) +++ (member (car directory) '(:absolute :relative)))) +++ collect (list p directory)) +++ nil) +++ +++(deftest pathname-directory.4 +++ (loop for p in *pathnames* +++ for directory = (pathname-directory p :allow-other-keys nil) +++ unless (or (stringp directory) +++ (member directory '(nil :wild :unspecific)) +++ (and (consp directory) +++ (member (car directory) '(:absolute :relative)))) +++ collect (list p directory)) +++ nil) +++ +++(deftest pathname-directory.5 +++ (loop for p in *pathnames* +++ for directory = (pathname-directory p :foo 'bar :allow-other-keys t) +++ unless (or (stringp directory) +++ (member directory '(nil :wild :unspecific)) +++ (and (consp directory) +++ (member (car directory) '(:absolute :relative)))) +++ collect (list p directory)) +++ nil) +++ +++(deftest pathname-directory.6 +++ (loop for p in *pathnames* +++ for directory = (pathname-directory p :allow-other-keys t +++ :allow-other-keys nil +++ 'foo 'bar) +++ unless (or (stringp directory) +++ (member directory '(nil :wild :unspecific)) +++ (and (consp directory) +++ (member (car directory) '(:absolute :relative)))) +++ collect (list p directory)) +++ nil) +++ +++;;; section 19.3.2.1 +++(deftest pathname-directory.7 +++ (loop for p in *logical-pathnames* +++ when (eq (pathname-directory p) :unspecific) +++ collect p) +++ nil) +++ +++(deftest pathname-directory.8 +++ (do-special-strings (s "" nil) (pathname-directory s)) +++ nil) +++ +++(deftest pathname-directory.error.1 +++ (signals-error (pathname-directory) program-error) +++ t) +++ +++(deftest pathname-directory.error.2 +++ (check-type-error #'pathname-directory #'could-be-pathname-designator) +++ nil) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/pathname-host.lsp ++@@ -0,0 +1,79 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Dec 6 14:23:22 2003 +++;;;; Contains: Tests for PATHNAME-HOST +++ +++(in-package :cl-test) +++ +++(compile-and-load "pathnames-aux.lsp") +++ +++(deftest pathname-host.1 +++ (loop for p in *pathnames* +++ always (eql (length (multiple-value-list (pathname-host p))) 1)) +++ t) +++ +++(deftest pathname-host.2 +++ (loop for p in *pathnames* +++ always (eql (length (multiple-value-list (pathname-host p :case :local))) 1)) +++ t) +++ +++(deftest pathname-host.3 +++ (loop for p in *pathnames* +++ always (eql (length (multiple-value-list (pathname-host p :case :common))) 1)) +++ t) +++ +++(deftest pathname-host.4 +++ (loop for p in *pathnames* +++ always (eql (length (multiple-value-list (pathname-host p :allow-other-keys nil))) 1)) +++ t) +++ +++(deftest pathname-host.5 +++ (loop for p in *pathnames* +++ always (eql (length (multiple-value-list +++ (pathname-host p :foo t :allow-other-keys t))) 1)) +++ t) +++ +++(deftest pathname-host.6 +++ (loop for p in *pathnames* +++ always (eql (length (multiple-value-list +++ (pathname-host p :allow-other-keys t +++ :allow-other-keys nil +++ 'foo t))) 1)) +++ t) +++ +++;;; section 19.3.2.1 +++(deftest pathname-host.7 +++ (loop for p in *logical-pathnames* +++ when (eq (pathname-host p) :unspecific) +++ collect p) +++ nil) +++ +++(deftest pathname-host.8 +++ (do-special-strings (s "" nil) (pathname-host s)) +++ nil) +++ +++#| +++(deftest pathname-host.9 +++ (loop for p in *pathnames* +++ for host = (pathname-host p) +++ unless (or (stringp host) +++ (and (listp host) (every #'stringp host)) +++ (eql host :unspecific)) +++ collect (list p host)) +++ nil) +++|# +++ +++;;; Error cases +++ +++(deftest pathname-host.error.1 +++ (signals-error (pathname-host) program-error) +++ t) +++ +++(deftest pathname-host.error.2 +++ (check-type-error #'pathname-host #'could-be-pathname-designator) +++ nil) +++ +++(deftest pathname-host.error.3 +++ (signals-error (pathname-host *default-pathname-defaults* '#:bogus t) +++ program-error) +++ t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/pathname-match-p.lsp ++@@ -0,0 +1,103 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sun Aug 15 07:46:22 2004 +++;;;; Contains: Tests for PATHNAME-MATCH-P +++ +++(in-package :cl-test) +++ +++(compile-and-load "pathnames-aux.lsp") +++ +++;;; Much of the behavior cannot be tested portably. +++ +++(deftest pathname-match-p.1 +++ (let ((pn1 (make-pathname :name :wild)) +++ (pn2 (make-pathname :name "foo"))) +++ (pathname-match-p pn1 pn2)) +++ nil) +++ +++(deftest pathname-match-p.2 +++ (let ((pn1 (make-pathname :type :wild)) +++ (pn2 (make-pathname :type "txt"))) +++ (pathname-match-p pn1 pn2)) +++ nil) +++ +++(deftest pathname-match-p.3 +++ (let ((pn1 (make-pathname :directory '(:absolute :wild))) +++ (pn2 (make-pathname :directory '(:absolute)))) +++ (pathname-match-p pn1 pn2)) +++ nil) +++ +++(deftest pathname-match-p.4 +++ (let ((pn1 (make-pathname :directory '(:relative :wild))) +++ (pn2 (make-pathname :directory '(:relative)))) +++ (pathname-match-p pn1 pn2)) +++ nil) +++ +++(deftest pathname-match-p.5 +++ (let ((pn1 (make-pathname :directory '(:relative :wild))) +++ (pn2 (make-pathname :directory nil))) +++ (and (wild-pathname-p pn1) +++ (not (pathname-directory pn2)) +++ (not (pathname-match-p pn1 pn2)))) +++ nil) +++ +++(deftest pathname-match-p.6 +++ (let ((pn1 (make-pathname :version :wild)) +++ (pn2 (make-pathname))) +++ (and (wild-pathname-p pn1) +++ (not (pathname-version pn2)) +++ (not (pathname-match-p pn1 pn2)))) +++ nil) +++ +++;;; Specialized string tests +++ +++(deftest pathname-match-p.7 +++ (let ((wpn (parse-namestring "CLTEST:*.LSP"))) +++ (assert (wild-pathname-p wpn)) +++ (do-special-strings +++ (s "CLTEST:FOO.LSP" nil) +++ (assert (pathname-match-p s wpn)))) +++ nil) +++ +++(deftest pathname-match-p.8 +++ (do-special-strings +++ (s "CLTEST:*.LSP" nil) +++ (assert (pathname-match-p "CLTEST:FOO.LSP" s))) +++ nil) +++ +++ +++;;; Add more tests here +++ +++;;; Here are error tests +++ +++(deftest pathname-match-p.error.1 +++ (signals-error (pathname-match-p) program-error) +++ t) +++ +++(deftest pathname-match-p.error.2 +++ (signals-error (pathname-match-p #p"") program-error) +++ t) +++ +++(deftest pathname-match-p.error.3 +++ (signals-error (pathname-match-p #p"" #p"" nil) program-error) +++ t) +++ +++(deftest pathname-match-p.error.4 +++ (check-type-error #'(lambda (x) (pathname-match-p x #p"")) +++ #'could-be-pathname-designator) +++ nil) +++ +++(deftest pathname-match-p.error.5 +++ (check-type-error #'(lambda (x) (declare (optimize (safety 0))) (pathname-match-p x #p"")) +++ #'could-be-pathname-designator) +++ nil) +++ +++(deftest pathname-match-p.error.6 +++ (check-type-error #'(lambda (x) (pathname-match-p #p"" x)) +++ #'could-be-pathname-designator) +++ nil) +++ +++(deftest pathname-match-p.error.7 +++ (check-type-error #'(lambda (x) (declare (optimize (safety 0))) (pathname-match-p #p"" x)) +++ #'could-be-pathname-designator) +++ nil) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/pathname-name.lsp ++@@ -0,0 +1,75 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Dec 6 14:45:16 2003 +++;;;; Contains: Tests for PATHNAME-NAME +++ +++(in-package :cl-test) +++ +++(compile-and-load "pathnames-aux.lsp") +++ +++(deftest pathname-name.1 +++ (loop for p in *pathnames* +++ for name = (pathname-name p) +++ unless (or (stringp name) +++ (member name '(nil :wild :unspecific))) +++ collect (list p name)) +++ nil) +++ +++(deftest pathname-name.2 +++ (loop for p in *pathnames* +++ for name = (pathname-name p :case :local) +++ unless (or (stringp name) +++ (member name '(nil :wild :unspecific))) +++ collect (list p name)) +++ nil) +++ +++(deftest pathname-name.3 +++ (loop for p in *pathnames* +++ for name = (pathname-name p :case :common) +++ unless (or (stringp name) +++ (member name '(nil :wild :unspecific))) +++ collect (list p name)) +++ nil) +++ +++(deftest pathname-name.4 +++ (loop for p in *pathnames* +++ for name = (pathname-name p :allow-other-keys nil) +++ unless (or (stringp name) +++ (member name '(nil :wild :unspecific))) +++ collect (list p name)) +++ nil) +++ +++(deftest pathname-name.5 +++ (loop for p in *pathnames* +++ for name = (pathname-name p :foo 'bar :allow-other-keys t) +++ unless (or (stringp name) +++ (member name '(nil :wild :unspecific))) +++ collect (list p name)) +++ nil) +++ +++(deftest pathname-name.6 +++ (loop for p in *pathnames* +++ for name = (pathname-name p :allow-other-keys t :allow-other-keys nil :foo 'bar) +++ unless (or (stringp name) +++ (member name '(nil :wild :unspecific))) +++ collect (list p name)) +++ nil) +++ +++;;; section 19.3.2.1 +++(deftest pathname-name.7 +++ (loop for p in *logical-pathnames* +++ when (eq (pathname-name p) :unspecific) +++ collect p) +++ nil) +++ +++(deftest pathname-name.8 +++ (do-special-strings (s "" nil) (pathname-name s)) +++ nil) +++ +++(deftest pathname-name.error.1 +++ (signals-error (pathname-name) program-error) +++ t) +++ +++(deftest pathname-name.error.2 +++ (check-type-error #'pathname-name #'could-be-pathname-designator) +++ nil) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/pathname-type.lsp ++@@ -0,0 +1,75 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Dec 6 14:45:16 2003 +++;;;; Contains: Tests for PATHNAME-TYPE +++ +++(in-package :cl-test) +++ +++(compile-and-load "pathnames-aux.lsp") +++ +++(deftest pathname-type.1 +++ (loop for p in *pathnames* +++ for type = (pathname-type p) +++ unless (or (stringp type) +++ (member type '(nil :wild :unspecific))) +++ collect (list p type)) +++ nil) +++ +++(deftest pathname-type.2 +++ (loop for p in *pathnames* +++ for type = (pathname-type p :case :local) +++ unless (or (stringp type) +++ (member type '(nil :wild :unspecific))) +++ collect (list p type)) +++ nil) +++ +++(deftest pathname-type.3 +++ (loop for p in *pathnames* +++ for type = (pathname-type p :case :common) +++ unless (or (stringp type) +++ (member type '(nil :wild :unspecific))) +++ collect (list p type)) +++ nil) +++ +++(deftest pathname-type.4 +++ (loop for p in *pathnames* +++ for type = (pathname-type p :allow-other-keys nil) +++ unless (or (stringp type) +++ (member type '(nil :wild :unspecific))) +++ collect (list p type)) +++ nil) +++ +++(deftest pathname-type.5 +++ (loop for p in *pathnames* +++ for type = (pathname-type p :foo 'bar :allow-other-keys t) +++ unless (or (stringp type) +++ (member type '(nil :wild :unspecific))) +++ collect (list p type)) +++ nil) +++ +++(deftest pathname-type.6 +++ (loop for p in *pathnames* +++ for type = (pathname-type p :allow-other-keys t :allow-other-keys nil :foo 'bar) +++ unless (or (stringp type) +++ (member type '(nil :wild :unspecific))) +++ collect (list p type)) +++ nil) +++ +++;;; section 19.3.2.1 +++(deftest pathname-type.7 +++ (loop for p in *logical-pathnames* +++ when (eq (pathname-type p) :unspecific) +++ collect p) +++ nil) +++ +++(deftest pathname-type.8 +++ (do-special-strings (s "" nil) (pathname-type s)) +++ nil) +++ +++(deftest pathname-type.error.1 +++ (signals-error (pathname-type) program-error) +++ t) +++ +++(deftest pathname-type.error.2 +++ (check-type-error #'pathname-type #'could-be-pathname-designator) +++ nil) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/pathname-version.lsp ++@@ -0,0 +1,40 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Dec 6 14:45:16 2003 +++;;;; Contains: Tests for PATHNAME-VERSION +++ +++(in-package :cl-test) +++ +++(compile-and-load "pathnames-aux.lsp") +++ +++(deftest pathname-version.1 +++ (loop for p in *pathnames* +++ for version = (pathname-version p) +++ unless (or (integerp version) (symbolp version)) +++ collect (list p version)) +++ nil) +++ +++;;; section 19.3.2.1 +++(deftest pathname-version.2 +++ (loop for p in *logical-pathnames* +++ when (eq (pathname-version p) :unspecific) +++ collect p) +++ nil) +++ +++(deftest pathname-version.3 +++ (do-special-strings (s "" nil) (pathname-version s)) +++ nil) +++ +++(deftest pathname-version.error.1 +++ (signals-error (pathname-version) program-error) +++ t) +++ +++(deftest pathname-version.error.2 +++ (signals-error (pathname-version *default-pathname-defaults* nil) +++ program-error) +++ t) +++ +++(deftest pathname-version.error.3 +++ (check-type-error #'pathname-version #'could-be-pathname-designator) +++ nil) +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/pathname.lsp ++@@ -0,0 +1,88 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Nov 29 05:06:57 2003 +++;;;; Contains: Tests of the function PATHNAME +++ +++(in-package :cl-test) +++ +++(deftest pathname.1 +++ (loop for x in *pathnames* +++ always (eq x (pathname x))) +++ t) +++ +++(deftest pathname.2 +++ (equalt #p"ansi-aux.lsp" (pathname "ansi-aux.lsp")) +++ t) +++ +++(deftest pathname.3 +++ (let ((s (open "ansi-aux.lsp" :direction :input))) +++ (prog1 (equalt (truename (pathname s)) (truename #p"ansi-aux.lsp")) +++ (close s))) +++ t) +++ +++(deftest pathname.4 +++ (let ((s (open "ansi-aux.lsp" :direction :input))) +++ (close s) +++ (equalt (truename (pathname s)) (truename #p"ansi-aux.lsp"))) +++ t) +++ +++(deftest pathname.5 +++ (loop for x in *logical-pathnames* +++ always (eq x (pathname x))) +++ t) +++ +++(deftest pathname.6 +++ (equalt #p"ansi-aux.lsp" +++ (pathname (make-array 12 :initial-contents "ansi-aux.lsp" +++ :element-type 'base-char))) +++ t) +++ +++(deftest pathname.7 +++ (equalt #p"ansi-aux.lsp" +++ (pathname (make-array 15 :initial-contents "ansi-aux.lspXXX" +++ :element-type 'base-char +++ :fill-pointer 12))) +++ t) +++ +++(deftest pathname.8 +++ (equalt #p"ansi-aux.lsp" +++ (pathname (make-array 12 :initial-contents "ansi-aux.lsp" +++ :element-type 'base-char +++ :adjustable t))) +++ t) +++ +++(deftest pathname.9 +++ (equalt #p"ansi-aux.lsp" +++ (pathname (make-array 15 :initial-contents "ansi-aux.lspXXX" +++ :element-type 'character +++ :fill-pointer 12))) +++ t) +++ +++(deftest pathname.10 +++ (equalt #p"ansi-aux.lsp" +++ (pathname (make-array 12 :initial-contents "ansi-aux.lsp" +++ :element-type 'character +++ :adjustable t))) +++ t) +++ +++(deftest pathname.11 +++ (loop for etype in '(standard-char base-char character) +++ collect +++ (equalt #p"ansi-aux.lsp" +++ (pathname +++ (let* ((s (make-array 15 :initial-contents "XXansi-aux.lspX" +++ :element-type etype))) +++ (make-array 12 :element-type etype +++ :displaced-to s +++ :displaced-index-offset 2))))) +++ (t t t)) +++ +++;;; Error tests +++ +++(deftest pathname.error.1 +++ (signals-error (pathname) program-error) +++ t) +++ +++(deftest pathname.error.2 +++ (signals-error (pathname (first *pathnames*) nil) program-error) +++ t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/pathnamep.lsp ++@@ -0,0 +1,31 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Dec 6 10:26:45 2003 +++;;;; Contains: Tests of PATHNAMEP +++ +++(in-package :cl-test) +++ +++(deftest pathnamep.1 +++ (check-type-predicate #'pathnamep 'pathname) +++ 0) +++ +++(deftest pathnamep.2 +++ (check-predicate #'(lambda (x) (eql (length (multiple-value-list (pathnamep x))) 1))) +++ nil) +++ +++(deftest pathnamep.3 +++ (check-predicate (typef '(not logical-pathname)) #'pathnamep) +++ nil) +++ +++(deftest pathnamep.error.1 +++ (signals-error (pathnamep) program-error) +++ t) +++ +++(deftest pathnamep.error.2 +++ (signals-error (pathnamep nil nil) program-error) +++ t) +++ +++(deftest pathnamep.error.3 +++ (signals-error (pathnamep *default-pathname-defaults* nil) +++ program-error) +++ t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/pathnames-aux.lsp ++@@ -0,0 +1,25 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Dec 6 15:05:05 2003 +++;;;; Contains: Functions associated with pathname tests +++ +++(in-package :cl-test) +++ +++(defun could-be-pathname-designator (x) +++ (or (stringp x) +++ (pathnamep x) +++ (typep x 'file-stream) +++ (and (typep x 'synonym-stream) +++ (could-be-pathname-designator +++ (symbol-value +++ (synonym-stream-symbol x)))))) +++ +++(defun explode-pathname (pn) +++ (list +++ :host (pathname-host pn) +++ :device (pathname-device pn) +++ :directory (pathname-directory pn) +++ :name (pathname-name pn) +++ :type (pathname-type pn) +++ :version (pathname-version pn))) +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/pathnames.lsp ++@@ -0,0 +1,19 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Nov 29 04:21:53 2003 +++;;;; Contains: Various tests on pathnames +++ +++(in-package :cl-test) +++ +++(deftest pathnames-print-and-read-properly +++ (with-standard-io-syntax +++ (loop +++ for p1 in *pathnames* +++ for s = (handler-case (write-to-string p1 :readably t) +++ (print-not-readable () :unreadable-error)) +++ unless (eql s :unreadable-error) +++ append +++ (let ((p2 (read-from-string s))) +++ (unless (equal p1 p2) +++ (list (list p1 s p2)))))) +++ nil) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/peek-char.lsp ++@@ -0,0 +1,329 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Jan 17 21:02:13 2004 +++;;;; Contains: Tests of PEEK-CHAR +++ +++(in-package :cl-test) +++ +++(deftest peek-char.1 +++ (with-input-from-string +++ (*standard-input* "abc") +++ (values +++ (peek-char) +++ (read-char) +++ (read-char) +++ (peek-char) +++ (read-char))) +++ #\a #\a #\b #\c #\c) +++ +++(deftest peek-char.2 +++ (with-input-from-string +++ (*standard-input* " ab") +++ (values +++ (peek-char) +++ (read-char) +++ (peek-char t) +++ (read-char) +++ (peek-char t) +++ (read-char))) +++ #\Space #\Space #\a #\a #\b #\b) +++ +++(deftest peek-char.3 +++ (with-input-from-string +++ (*standard-input* (concatenate 'string +++ (string #\Newline) +++ (string #\Newline) +++ " " +++ (string #\Newline) +++ "ab")) +++ (values +++ (peek-char) +++ (read-char) +++ (peek-char t) +++ (read-char) +++ (peek-char t) +++ (read-char))) +++ #\Newline #\Newline #\a #\a #\b #\b) +++ +++(when (name-char "Linefeed") +++ (deftest peek-char.4 +++ (with-input-from-string +++ (*standard-input* (concatenate 'string +++ (string (name-char "Linefeed")) +++ (string (name-char "Linefeed")) +++ "abc")) +++ (values +++ (peek-char) +++ (read-char) +++ (peek-char t) +++ (read-char))) +++ #.(name-char "Linefeed") +++ #.(name-char "Linefeed") +++ #\a #\a)) +++ +++(when (name-char "Page") +++ (deftest peek-char.5 +++ (with-input-from-string +++ (*standard-input* (concatenate 'string +++ (string (name-char "Page")) +++ (string (name-char "Page")) +++ "abc")) +++ (values +++ (peek-char) +++ (read-char) +++ (peek-char t) +++ (read-char))) +++ #.(name-char "Page") +++ #.(name-char "Page") +++ #\a #\a)) +++ +++(when (name-char "Tab") +++ (deftest peek-char.6 +++ (with-input-from-string +++ (*standard-input* (concatenate 'string +++ (string (name-char "Tab")) +++ (string (name-char "Tab")) +++ "abc")) +++ (values +++ (peek-char) +++ (read-char) +++ (peek-char t) +++ (read-char))) +++ #.(name-char "Tab") +++ #.(name-char "Tab") +++ #\a #\a)) +++ +++(when (name-char "Return") +++ (deftest peek-char.7 +++ (with-input-from-string +++ (*standard-input* (concatenate 'string +++ (string (name-char "Return")) +++ (string (name-char "Return")) +++ "abc")) +++ (values +++ (peek-char) +++ (read-char) +++ (peek-char t) +++ (read-char))) +++ #.(name-char "Return") +++ #.(name-char "Return") +++ #\a #\a)) +++ +++(deftest peek-char.8 +++ (with-input-from-string +++ (s "a bcd") +++ (values +++ (peek-char nil s) +++ (read-char s) +++ (peek-char t s) +++ (read-char s) +++ (peek-char t s) +++ (read-char s))) +++ #\a #\a #\b #\b #\c #\c) +++ +++(deftest peek-char.9 +++ (with-input-from-string +++ (*standard-input* " a bCcde") +++ (values +++ (peek-char #\c) +++ (read-char) +++ (read-char))) +++ #\c #\c #\d) +++ +++(deftest peek-char.10 +++ (with-input-from-string +++ (*standard-input* " ; foo") +++ (values +++ (peek-char t) +++ (read-char))) +++ #\; #\;) +++ +++(deftest peek-char.11 +++ (with-input-from-string +++ (s "") +++ (peek-char nil s nil)) +++ nil) +++ +++(deftest peek-char.12 +++ (with-input-from-string +++ (s "") +++ (peek-char nil s nil 'foo)) +++ foo) +++ +++(deftest peek-char.13 +++ (with-input-from-string +++ (s " ") +++ (peek-char t s nil)) +++ nil) +++ +++(deftest peek-char.14 +++ (with-input-from-string +++ (s " ") +++ (peek-char t s nil 'foo)) +++ foo) +++ +++(deftest peek-char.15 +++ (with-input-from-string +++ (s "ab c d") +++ (peek-char #\z s nil)) +++ nil) +++ +++(deftest peek-char.16 +++ (with-input-from-string +++ (s "ab c d") +++ (peek-char #\z s nil 'foo)) +++ foo) +++ +++;;; Interaction with echo streams +++ +++(deftest peek-char.17 +++ (block done +++ (with-input-from-string +++ (is "ab") +++ (with-output-to-string +++ (os) +++ (let ((es (make-echo-stream is os))) +++ (let ((pos1 (file-position os))) +++ (unless (zerop pos1) (return-from done :good)) +++ (peek-char nil es nil) +++ (let ((pos2 (file-position os))) +++ (return-from done +++ (if (eql pos1 pos2) +++ :good +++ (list pos1 pos2))))))))) +++ :good) +++ +++(deftest peek-char.18 +++ (block done +++ (with-input-from-string +++ (is " ab") +++ (with-output-to-string +++ (os) +++ (let ((es (make-echo-stream is os))) +++ (let ((pos1 (file-position os))) +++ (unless (zerop pos1) (return-from done :good)) +++ (peek-char t es nil) +++ (let ((pos2 (file-position os))) +++ (return-from done +++ (if (eql pos1 pos2) +++ pos1 +++ :good)))))))) +++ :good) +++ +++(deftest peek-char.19 +++ (block done +++ (with-input-from-string +++ (is "abcde") +++ (with-output-to-string +++ (os) +++ (let ((es (make-echo-stream is os))) +++ (let ((pos1 (file-position os))) +++ (unless (zerop pos1) (return-from done :good)) +++ (peek-char #\c es nil) +++ (let ((pos2 (file-position os))) +++ (return-from done +++ (if (eql pos1 pos2) +++ pos1 +++ :good)))))))) +++ :good) +++ +++;;; Interactions with the readtable +++ +++(deftest peek-char.20 +++ (let ((*readtable* (copy-readtable))) +++ (set-syntax-from-char #\Space #\a) +++ (with-input-from-string +++ (*standard-input* " x") +++ (values +++ (peek-char) +++ (read-char) +++ (peek-char t) +++ (read-char)))) +++ #\Space #\Space +++ #\Space #\Space ; *not* #\x #\x +++ ) +++ +++(deftest peek-char.21 +++ (let ((*readtable* (copy-readtable))) +++ (set-syntax-from-char #\x #\Space) +++ (with-input-from-string +++ (*standard-input* "xxa") +++ (values +++ (peek-char) +++ (read-char) +++ (peek-char t) +++ (read-char)))) +++ #\x #\x +++ #\a #\a ; *not* #\x #\x +++ ) +++ +++;;; Stream designators are accepted for the stream argument +++ +++(deftest peek-char.22 +++ (with-input-from-string +++ (is "!?*") +++ (let ((*terminal-io* (make-two-way-stream is (make-string-output-stream)))) +++ (peek-char nil t))) +++ #\!) +++ +++(deftest peek-char.23 +++ (with-input-from-string +++ (*standard-input* "345") +++ (peek-char nil nil)) +++ #\3) +++ +++;;; Error tests +++ +++(deftest peek-char.error.1 +++ (signals-error +++ (with-input-from-string +++ (s "abc") +++ (peek-char s nil nil nil nil 'nonsense)) +++ program-error) +++ t) +++ +++ +++(deftest peek-char.error.2 +++ (signals-error-always +++ (with-input-from-string +++ (*standard-input* "") +++ (peek-char)) +++ end-of-file) +++ t t) +++ +++(deftest peek-char.error.3 +++ (signals-error-always +++ (with-input-from-string +++ (s "") +++ (peek-char nil s)) +++ end-of-file) +++ t t) +++ +++(deftest peek-char.error.4 +++ (signals-error-always +++ (with-input-from-string +++ (s " ") +++ (peek-char t s)) +++ end-of-file) +++ t t) +++ +++(deftest peek-char.error.5 +++ (signals-error-always +++ (with-input-from-string +++ (s "abcd") +++ (peek-char #\z s)) +++ end-of-file) +++ t t) +++ +++;;; There was a consensus on comp.lang.lisp that the requirement +++;;; that an end-of-file error be thrown in the following case +++;;; is a spec bug +++#| +++(deftest peek-char.error.6 +++ (signals-error +++ (with-input-from-string +++ (s "") +++ (peek-char nil s nil nil t)) +++ end-of-file) +++ t) +++|# ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/probe-file.lsp ++@@ -0,0 +1,58 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Mon Jan 5 20:46:29 2004 +++;;;; Contains: Tests of PROBE-FILE +++ +++(in-package :cl-test) +++ +++(deftest probe-file.1 +++ (probe-file #p"nonexistent") +++ nil) +++ +++(deftest probe-file.2 +++ (let ((s (open #p"probe-file.lsp" :direction :input))) +++ (prog1 +++ (equalpt (truename #p"probe-file.lsp") +++ (probe-file s)) +++ (close s))) +++ t) +++ +++(deftest probe-file.3 +++ (let ((s (open #p"probe-file.lsp" :direction :input))) +++ (close s) +++ (equalpt (truename #p"probe-file.lsp") +++ (probe-file s))) +++ t) +++ +++(deftest probe-file.4 +++ (equalpt (truename #p"probe-file.lsp") +++ (probe-file "CLTEST:PROBE-FILE.LSP")) +++ t) +++ +++;;; Specialized string tests +++ +++(deftest probe-file.5 +++ (do-special-strings +++ (str "probe-file.lsp" nil) +++ (let ((s (open str :direction :input))) +++ (assert (equalpt (truename #p"probe-file.lsp") (probe-file s))) +++ (close s))) +++ nil) +++ +++;;; Error tests +++ +++(deftest probe-file.error.1 +++ (signals-error (probe-file) program-error) +++ t) +++ +++(deftest probe-file.error.2 +++ (signals-error (probe-file #p"probe-file.lsp" nil) program-error) +++ t) +++ +++(deftest probe-file.error.3 +++ (signals-error-always (probe-file (make-pathname :name :wild)) file-error) +++ t t) +++ +++(deftest probe-file.error.4 +++ (signals-error-always (probe-file "CLTEST:*.FOO") file-error) +++ t t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/read-byte.lsp ++@@ -0,0 +1,194 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Jan 17 17:30:49 2004 +++;;;; Contains: Tests of READ-BYTE, WRITE-BYTE +++ +++(in-package :cl-test) +++ +++(deftest read-byte.1 +++ (let ((s (open "foo.txt" +++ :direction :output +++ :if-exists :supersede +++ :element-type '(unsigned-byte 8)))) +++ (values +++ (write-byte 17 s) +++ (close s) +++ (progn +++ (setq s (open "foo.txt" +++ :direction :input +++ :element-type '(unsigned-byte 8))) +++ (read-byte s)) +++ (close s))) +++ 17 t 17 t) +++ +++(deftest read-byte.2 +++ (let ((s (open "foo.txt" +++ :direction :output +++ :if-exists :supersede +++ :element-type '(unsigned-byte 8)))) +++ (values +++ (close s) +++ (progn +++ (setq s (open "foo.txt" +++ :direction :input +++ :element-type '(unsigned-byte 8))) +++ (read-byte s nil 'foo)) +++ (read-byte s nil) +++ (close s))) +++ t foo nil t) +++ +++(deftest read-byte.3 +++ (loop with b1 = 0 +++ and b2 = 0 +++ for i from 1 to 32 +++ do (let ((s (open "foo.txt" +++ :direction :output +++ :if-exists :supersede +++ :element-type `(unsigned-byte ,i)))) +++ (write-byte (1- (ash 1 i)) s) +++ (write-byte 1 s) +++ (close s)) +++ unless (let ((s (open "foo.txt" +++ :direction :input +++ :element-type `(unsigned-byte ,i)))) +++ (prog1 +++ (and (eql (setq b1 (read-byte s)) (1- (ash 1 i))) +++ (eql (setq b2 (read-byte s)) 1)) +++ (close s))) +++ collect (list i b1 b2)) +++ nil) +++ +++(deftest read-byte.4 +++ (loop with b1 = 0 +++ and b2 = 0 +++ for i from 33 to 200 by 7 +++ do (let ((s (open "foo.txt" +++ :direction :output +++ :if-exists :supersede +++ :element-type `(unsigned-byte ,i)))) +++ (write-byte (1- (ash 1 i)) s) +++ (write-byte 1 s) +++ (close s)) +++ unless (let ((s (open "foo.txt" +++ :direction :input +++ :element-type `(unsigned-byte ,i)))) +++ (prog1 +++ (and (eql (setq b1 (read-byte s)) (1- (ash 1 i))) +++ (eql (setq b2 (read-byte s)) 1)) +++ (close s))) +++ collect (list i b1 b2)) +++ nil) +++ +++;;; Error tests +++ +++(deftest read-byte.error.1 +++ (signals-error (read-byte) program-error) +++ t) +++ +++(deftest read-byte.error.2 +++ (progn +++ (let ((s (open "foo.txt" +++ :direction :output +++ :if-exists :supersede +++ :element-type `(unsigned-byte 8)))) +++ (close s)) +++ (signals-error +++ (let ((s (open "foo.txt" +++ :direction :input +++ :element-type '(unsigned-byte 8)))) +++ (read-byte s)) +++ end-of-file)) +++ t) +++ +++(deftest read-byte.error.3 +++ (progn +++ (let ((s (open "foo.txt" +++ :direction :output +++ :if-exists :supersede))) +++ (close s)) +++ (signals-error +++ (let ((s (open "foo.txt" :direction :input))) +++ (unwind-protect +++ (read-byte s) +++ (close s))) +++ error)) +++ t) +++ +++(deftest read-byte.error.4 +++ (signals-error-always +++ (progn +++ (let ((s (open "foo.txt" +++ :direction :output +++ :if-exists :supersede +++ :element-type '(unsigned-byte 8)))) +++ (close s)) +++ (let ((s (open "foo.txt" +++ :direction :input +++ :element-type '(unsigned-byte 8)))) +++ (unwind-protect +++ (read-byte s t) +++ (close s)))) +++ end-of-file) +++ t t) +++ +++(deftest read-byte.error.5 +++ (check-type-error #'read-byte #'streamp) +++ nil) +++ +++(deftest read-byte.error.6 +++ (progn +++ (let ((s (open "foo.txt" +++ :direction :output +++ :if-exists :supersede +++ :element-type '(unsigned-byte 8)))) +++ (close s)) +++ (signals-error +++ (let ((s (open "foo.txt" +++ :direction :input +++ :element-type '(unsigned-byte 8)))) +++ (unwind-protect +++ (read-byte s t t nil) +++ (close s))) +++ program-error)) +++ t) +++ +++ +++(deftest write-byte.error.1 +++ (signals-error (write-byte) program-error) +++ t) +++ +++(deftest write-byte.error.2 +++ (signals-error (write-byte 0) program-error) +++ t) +++ +++(deftest write-byte.error.3 +++ (signals-error +++ (let ((s (open "foo.txt" +++ :direction :output +++ :if-exists :supersede +++ :element-type '(unsigned-byte 8)))) +++ (unwind-protect +++ (write 1 s nil) +++ (close s))) +++ program-error) +++ t) +++ +++(deftest write-byte.error.4 +++ (check-type-error #'(lambda (x) (write-byte 0 x)) #'streamp) +++ nil) +++ +++(deftest write-byte.error.5 +++ (signals-error +++ (let ((s (open "foo.txt" +++ :direction :output +++ :if-exists :supersede))) +++ (unwind-protect +++ (write 1 s) +++ (close s))) +++ error) +++ t) +++ +++ +++ +++ +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/read-char-no-hang.lsp ++@@ -0,0 +1,123 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sun Jan 18 20:32:38 2004 +++;;;; Contains: Tests of READ-CHAR-NO-HANG +++ +++(in-package :cl-test) +++ +++(deftest read-char-no-hang.1 +++ (with-input-from-string +++ (*standard-input* "a") +++ (read-char-no-hang)) +++ #\a) +++ +++(deftest read-char-no-hang.2 +++ (with-input-from-string +++ (*standard-input* "abc") +++ (values +++ (read-char-no-hang) +++ (read-char-no-hang) +++ (read-char-no-hang))) +++ #\a #\b #\c) +++ +++(when (code-char 0) +++ (deftest read-char-no-hang.3 +++ (with-input-from-string +++ (*standard-input* (concatenate 'string +++ "a" +++ (string (code-char 0)) +++ "b")) +++ (values +++ (read-char-no-hang) +++ (read-char-no-hang) +++ (read-char-no-hang))) +++ #\a #.(code-char 0) #\b)) +++ +++(deftest read-char-no-hang.4 +++ (with-input-from-string +++ (s "abc") +++ (values +++ (read-char-no-hang s) +++ (read-char-no-hang s) +++ (read-char-no-hang s))) +++ #\a #\b #\c) +++ +++(deftest read-char-no-hang.5 +++ (with-input-from-string +++ (s "") +++ (read-char-no-hang s nil)) +++ nil) +++ +++(deftest read-char-no-hang.6 +++ (with-input-from-string +++ (s "") +++ (read-char-no-hang s nil 'foo)) +++ foo) +++ +++(deftest read-char-no-hang.7 +++ (with-input-from-string +++ (s "abc") +++ (values +++ (read-char-no-hang s nil nil) +++ (read-char-no-hang s nil nil) +++ (read-char-no-hang s nil nil))) +++ #\a #\b #\c) +++ +++(deftest read-char-no-hang.8 +++ (with-input-from-string +++ (s "abc") +++ (values +++ (read-char-no-hang s nil t) +++ (read-char-no-hang s nil t) +++ (read-char-no-hang s nil t))) +++ #\a #\b #\c) +++ +++(deftest read-char-no-hang.9 +++ (with-input-from-string +++ (is "!?*") +++ (let ((*terminal-io* (make-two-way-stream is (make-string-output-stream)))) +++ (read-char-no-hang t))) +++ #\!) +++ +++(deftest read-char-no-hang.10 +++ (with-input-from-string +++ (*standard-input* "345") +++ (read-char-no-hang nil)) +++ #\3) +++ +++;;; Need a test of the non-hanging. +++;;; This is hard to do portably. +++ +++;;; Error tests +++ +++(deftest read-char-no-hang.error.1 +++ (signals-error +++ (with-input-from-string +++ (s "abc") +++ (read-char-no-hang s nil nil nil nil)) +++ program-error) +++ t) +++ +++(deftest read-char-no-hang.error.2 +++ (signals-error-always +++ (with-input-from-string +++ (s "") +++ (read-char-no-hang s)) +++ end-of-file) +++ t t) +++ +++(deftest read-char-no-hang.error.3 +++ (signals-error-always +++ (with-input-from-string +++ (s "") +++ (read-char-no-hang s t)) +++ end-of-file) +++ t t) +++ +++(deftest read-char-no-hang.error.4 +++ (signals-error-always +++ (with-input-from-string +++ (s "") +++ (read-char-no-hang s t t)) +++ end-of-file) +++ t t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/read-char.lsp ++@@ -0,0 +1,121 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sun Jan 18 08:53:56 2004 +++;;;; Contains: Tests of READ-CHAR +++ +++(in-package :cl-test) +++ +++(deftest read-char.1 +++ (with-input-from-string +++ (*standard-input* "a") +++ (read-char)) +++ #\a) +++ +++(deftest read-char.2 +++ (with-input-from-string +++ (*standard-input* "abc") +++ (values +++ (read-char) +++ (read-char) +++ (read-char))) +++ #\a #\b #\c) +++ +++(when (code-char 0) +++ (deftest read-char.3 +++ (with-input-from-string +++ (*standard-input* (concatenate 'string +++ "a" +++ (string (code-char 0)) +++ "b")) +++ (values +++ (read-char) +++ (read-char) +++ (read-char))) +++ #\a #.(code-char 0) #\b)) +++ +++(deftest read-char.4 +++ (with-input-from-string +++ (s "abc") +++ (values +++ (read-char s) +++ (read-char s) +++ (read-char s))) +++ #\a #\b #\c) +++ +++(deftest read-char.5 +++ (with-input-from-string +++ (s "") +++ (read-char s nil)) +++ nil) +++ +++(deftest read-char.6 +++ (with-input-from-string +++ (s "") +++ (read-char s nil 'foo)) +++ foo) +++ +++(deftest read-char.7 +++ (with-input-from-string +++ (s "abc") +++ (values +++ (read-char s nil nil) +++ (read-char s nil nil) +++ (read-char s nil nil))) +++ #\a #\b #\c) +++ +++(deftest read-char.8 +++ (with-input-from-string +++ (s "abc") +++ (values +++ (read-char s nil t) +++ (read-char s nil t) +++ (read-char s nil t))) +++ #\a #\b #\c) +++ +++(deftest read-char.9 +++ (with-input-from-string +++ (is "!?*") +++ (let ((*terminal-io* (make-two-way-stream is (make-string-output-stream)))) +++ (read-char t))) +++ #\!) +++ +++(deftest read-char.10 +++ (with-input-from-string +++ (*standard-input* "345") +++ (read-char nil)) +++ #\3) +++ +++ +++;;; Error tests +++ +++(deftest read-char.error.1 +++ (signals-error +++ (with-input-from-string +++ (s "abc") +++ (read-char s nil nil nil nil)) +++ program-error) +++ t) +++ +++(deftest read-char.error.2 +++ (signals-error-always +++ (with-input-from-string +++ (s "") +++ (read-char s)) +++ end-of-file) +++ t t) +++ +++(deftest read-char.error.3 +++ (signals-error-always +++ (with-input-from-string +++ (s "") +++ (read-char s t)) +++ end-of-file) +++ t t) +++ +++(deftest read-char.error.4 +++ (signals-error-always +++ (with-input-from-string +++ (s "") +++ (read-char s t t)) +++ end-of-file) +++ t t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/read-line.lsp ++@@ -0,0 +1,104 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sun Jan 18 20:53:59 2004 +++;;;; Contains: Tests of READ-LINE +++ +++(in-package :cl-test) +++ +++(deftest read-line.1 +++ (with-input-from-string +++ (*standard-input* " abcd ") +++ (let ((vals (multiple-value-list (read-line)))) +++ (assert (= (length vals) 2)) +++ (values (first vals) (notnot (second vals))))) +++ " abcd " t) +++ +++(deftest read-line.2 +++ (with-input-from-string +++ (*standard-input* (string #\Newline)) +++ (read-line)) +++ "" nil) +++ +++(deftest read-line.3 +++ (with-input-from-string +++ (s (concatenate 'string "abc" (string #\Newline))) +++ (read-line s)) +++ "abc" nil) +++ +++(deftest read-line.4 +++ (with-input-from-string +++ (s "") +++ (let ((vals (multiple-value-list (read-line s nil)))) +++ (assert (= (length vals) 2)) +++ (values (first vals) (notnot (second vals))))) +++ nil t) +++ +++(deftest read-line.5 +++ (with-input-from-string +++ (s "") +++ (let ((vals (multiple-value-list (read-line s nil 'foo)))) +++ (assert (= (length vals) 2)) +++ (values (first vals) (notnot (second vals))))) +++ foo t) +++ +++(deftest read-line.6 +++ (with-input-from-string +++ (s " abcd ") +++ (let ((vals (multiple-value-list (read-line s t nil t)))) +++ (assert (= (length vals) 2)) +++ (values (first vals) (notnot (second vals))))) +++ " abcd " t) +++ +++(deftest read-line.7 +++ (with-input-from-string +++ (is "abc") +++ (let ((*terminal-io* (make-two-way-stream is *standard-output*))) +++ (let ((vals (multiple-value-list (read-line t)))) +++ (assert (= (length vals) 2)) +++ (assert (second vals)) +++ (first vals)))) +++ "abc") +++ +++(deftest read-line.8 +++ (with-input-from-string +++ (*standard-input* "abc") +++ (let ((vals (multiple-value-list (read-line nil)))) +++ (assert (= (length vals) 2)) +++ (assert (second vals)) +++ (first vals))) +++ "abc") +++ +++;;; Error tests +++ +++(deftest read-line.error.1 +++ (signals-error +++ (with-input-from-string +++ (s (concatenate 'string "abc" (string #\Newline))) +++ (read-line s t nil nil nil)) +++ program-error) +++ t) +++ +++(deftest read-line.error.2 +++ (signals-error-always +++ (with-input-from-string +++ (s "") +++ (read-line s)) +++ end-of-file) +++ t t) +++ +++(deftest read-line.error.3 +++ (signals-error-always +++ (with-input-from-string +++ (*standard-input* "") +++ (read-line)) +++ end-of-file) +++ t t) +++ +++(deftest read-line.error.4 +++ (signals-error-always +++ (with-input-from-string +++ (s "") +++ (read-line s t)) +++ end-of-file) +++ t t) +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/read-sequence.lsp ++@@ -0,0 +1,300 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Mon Jan 19 06:55:04 2004 +++;;;; Contains: Tests of READ-SEQUENCE +++ +++(in-package :cl-test) +++ +++;;; Read into a string +++ +++(defmacro def-read-sequence-test (name init args input &rest expected) +++ `(deftest ,name +++ (let ((s ,init)) +++ (with-input-from-string +++ (is ,input) +++ (values +++ (read-sequence s is ,@args) +++ s))) +++ ,@expected)) +++ +++(def-read-sequence-test read-sequence.string.1 (copy-seq " ") +++ () "abcdefghijk" 5 "abcde") +++ +++(def-read-sequence-test read-sequence.string.2 (copy-seq " ") +++ () "abc" 3 "abc ") +++ +++(def-read-sequence-test read-sequence.string.3 (copy-seq " ") +++ (:start 1) "abcdefghijk" 5 " abcd") +++ +++(def-read-sequence-test read-sequence.string.4 (copy-seq " ") +++ (:end 3) "abcdefghijk" 3 "abc ") +++ +++(def-read-sequence-test read-sequence.string.5 (copy-seq " ") +++ (:start 1 :end 4) "abcdefghijk" 4 " abc ") +++ +++(def-read-sequence-test read-sequence.string.6 (copy-seq " ") +++ (:start 0 :end 0) "abcdefghijk" 0 " ") +++ +++(def-read-sequence-test read-sequence.string.7 (copy-seq " ") +++ (:end nil) "abcdefghijk" 5 "abcde") +++ +++(def-read-sequence-test read-sequence.string.8 (copy-seq " ") +++ (:allow-other-keys nil) "abcdefghijk" 5 "abcde") +++ +++(def-read-sequence-test read-sequence.string.9 (copy-seq " ") +++ (:allow-other-keys t :foo 'bar) "abcdefghijk" 5 "abcde") +++ +++(def-read-sequence-test read-sequence.string.10 (copy-seq " ") +++ (:foo 'bar :allow-other-keys 'x) "abcdefghijk" 5 "abcde") +++ +++(def-read-sequence-test read-sequence.string.11 (copy-seq " ") +++ (:foo 'bar :allow-other-keys 'x :allow-other-keys nil) +++ "abcdefghijk" 5 "abcde") +++ +++(def-read-sequence-test read-sequence.string.12 (copy-seq " ") +++ (:end 5 :end 3 :start 0 :start 1) "abcdefghijk" 5 "abcde") +++ +++;;; Read into a base string +++ +++(def-read-sequence-test read-sequence.base-string.1 +++ (make-array 5 :element-type 'base-char) +++ () "abcdefghijk" 5 "abcde") +++ +++(def-read-sequence-test read-sequence.base-string.2 +++ (make-array 5 :element-type 'base-char :initial-element #\Space) +++ () "abc" 3 "abc ") +++ +++(def-read-sequence-test read-sequence.base-string.3 +++ (make-array 5 :element-type 'base-char :initial-element #\Space) +++ (:start 1) "abcdefghijk" 5 " abcd") +++ +++(def-read-sequence-test read-sequence.base-string.4 +++ (make-array 5 :element-type 'base-char :initial-element #\Space) +++ (:end 3) "abcdefghijk" 3 "abc ") +++ +++(def-read-sequence-test read-sequence.base-string.5 +++ (make-array 5 :element-type 'base-char :initial-element #\Space) +++ (:start 1 :end 4) "abcdefghijk" 4 " abc ") +++ +++(def-read-sequence-test read-sequence.base-string.6 +++ (make-array 5 :element-type 'base-char :initial-element #\Space) +++ (:start 0 :end 0) "abcdefghijk" 0 " ") +++ +++(def-read-sequence-test read-sequence.base-string.7 +++ (make-array 5 :element-type 'base-char :initial-element #\Space) +++ (:end nil) "abcdefghijk" 5 "abcde") +++ +++;;; Read into a list +++ +++(def-read-sequence-test read-sequence.list.1 (make-list 5) +++ () "abcdefghijk" 5 (#\a #\b #\c #\d #\e)) +++ +++(def-read-sequence-test read-sequence.list.2 (make-list 5) +++ () "abc" 3 (#\a #\b #\c nil nil)) +++ +++(def-read-sequence-test read-sequence.list.3 (make-list 5) +++ (:start 1) "abcdefghijk" 5 (nil #\a #\b #\c #\d)) +++ +++(def-read-sequence-test read-sequence.list.4 (make-list 5) +++ (:end 3) "abcdefghijk" 3 (#\a #\b #\c nil nil)) +++ +++(def-read-sequence-test read-sequence.list.5 (make-list 5) +++ (:end 4 :start 1) "abcdefghijk" 4 (nil #\a #\b #\c nil)) +++ +++(def-read-sequence-test read-sequence.list.6 (make-list 5) +++ (:start 0 :end 0) "abcdefghijk" 0 (nil nil nil nil nil)) +++ +++(def-read-sequence-test read-sequence.list.7 (make-list 5) +++ (:end nil) "abcdefghijk" 5 (#\a #\b #\c #\d #\e)) +++ +++;;; Read into a vector +++ +++(def-read-sequence-test read-sequence.vector.1 +++ (vector nil nil nil nil nil) +++ () "abcdefghijk" 5 #(#\a #\b #\c #\d #\e)) +++ +++(def-read-sequence-test read-sequence.vector.2 +++ (vector nil nil nil nil nil) +++ () "abc" 3 #(#\a #\b #\c nil nil)) +++ +++(def-read-sequence-test read-sequence.vector.3 +++ (vector nil nil nil nil nil) +++ (:start 2) "abcdefghijk" 5 #(nil nil #\a #\b #\c)) +++ +++(def-read-sequence-test read-sequence.vector.4 +++ (vector nil nil nil nil nil) +++ (:start 1 :end 4) "abcdefghijk" 4 #(nil #\a #\b #\c nil)) +++ +++(def-read-sequence-test read-sequence.vector.5 +++ (vector nil nil nil nil nil) +++ (:end 2) "abcdefghijk" 2 #(#\a #\b nil nil nil)) +++ +++(def-read-sequence-test read-sequence.vector.6 +++ (vector nil nil nil nil nil) +++ (:end 0 :start 0) "abcdefghijk" 0 #(nil nil nil nil nil)) +++ +++(def-read-sequence-test read-sequence.vector.7 +++ (vector nil nil nil nil nil) +++ (:end nil) "abcdefghijk" 5 #(#\a #\b #\c #\d #\e)) +++ +++;;; Read into a vector with a fill pointer +++ +++(def-read-sequence-test read-sequence.fill-vector.1 +++ (make-array 10 :initial-element nil :fill-pointer 5) +++ () "abcdefghijk" 5 #(#\a #\b #\c #\d #\e)) +++ +++(def-read-sequence-test read-sequence.fill-vector.2 +++ (make-array 10 :initial-element nil :fill-pointer 5) +++ () "ab" 2 #(#\a #\b nil nil nil)) +++ +++(def-read-sequence-test read-sequence.fill-vector.3 +++ (make-array 10 :initial-element nil :fill-pointer 5) +++ () "" 0 #(nil nil nil nil nil)) +++ +++(def-read-sequence-test read-sequence.fill-vector.4 +++ (make-array 10 :initial-element nil :fill-pointer 5) +++ (:start 2) "abcdefghijk" 5 #(nil nil #\a #\b #\c)) +++ +++(def-read-sequence-test read-sequence.fill-vector.5 +++ (make-array 10 :initial-element nil :fill-pointer 5) +++ (:start 1 :end 4) "abcdefghijk" 4 #(nil #\a #\b #\c nil)) +++ +++(def-read-sequence-test read-sequence.fill-vector.6 +++ (make-array 10 :initial-element nil :fill-pointer 5) +++ (:end 2) "abcdefghijk" 2 #(#\a #\b nil nil nil)) +++ +++(def-read-sequence-test read-sequence.fill-vector.7 +++ (make-array 10 :initial-element nil :fill-pointer 5) +++ (:end 0 :start 0) "abcdefghijk" 0 #(nil nil nil nil nil)) +++ +++(def-read-sequence-test read-sequence.fill-vector.8 +++ (make-array 10 :initial-element nil :fill-pointer 5) +++ (:end nil) "abcdefghijk" 5 #(#\a #\b #\c #\d #\e)) +++ +++;;; Nil vectors +++ +++(deftest read-sequence.nil-vector.1 +++ :notes (:nil-vectors-are-strings) +++ (let ((s (make-array 0 :element-type nil))) +++ (with-input-from-string +++ (is "abcde") +++ (values +++ (read-sequence s is) +++ s))) +++ 0 "") +++ +++;;; Read into a bit vector +++ +++(defmacro def-read-sequence-bv-test (name init args &rest expected) +++ `(deftest ,name +++ ;; Create output file +++ (progn +++ (let (os) +++ (unwind-protect +++ (progn +++ (setq os (open "temp.dat" :direction :output +++ :element-type '(unsigned-byte 8) +++ :if-exists :supersede)) +++ (loop for i in '(0 1 1 0 0 1 1 0 1 0 1 1 1 0) +++ do (write-byte i os))) +++ (when os (close os)))) +++ (let (is (bv (copy-seq ,init))) +++ (unwind-protect +++ (progn +++ (setq is (open "temp.dat" :direction :input +++ :element-type '(unsigned-byte 8))) +++ (values +++ (read-sequence bv is ,@args) +++ bv)) +++ (when is (close is))))) +++ ,@expected)) +++ +++(def-read-sequence-bv-test read-sequence.bv.1 #*00000000000000 () +++ 14 #*01100110101110) +++ +++(def-read-sequence-bv-test read-sequence.bv.2 #*00000000000000 (:start 0) +++ 14 #*01100110101110) +++ +++(def-read-sequence-bv-test read-sequence.bv.3 #*00000000000000 (:end 14) +++ 14 #*01100110101110) +++ +++(def-read-sequence-bv-test read-sequence.bv.4 #*00000000000000 (:end nil) +++ 14 #*01100110101110) +++ +++(def-read-sequence-bv-test read-sequence.bv.5 #*00000000000000 (:start 2) +++ 14 #*00011001101011) +++ +++(def-read-sequence-bv-test read-sequence.bv.6 #*00000000000000 +++ (:start 2 :end 13) +++ 13 #*00011001101010) +++ +++(def-read-sequence-bv-test read-sequence.bv.7 #*00000000000000 (:end 6) +++ 6 #*01100100000000) +++ +++;;; Error cases +++ +++(deftest read-sequence.error.1 +++ (signals-error (read-sequence) program-error) +++ t) +++ +++(deftest read-sequence.error.2 +++ (signals-error (read-sequence (make-string 10)) program-error) +++ t) +++ +++(deftest read-sequence.error.3 +++ (signals-error +++ (read-sequence (make-string 5) (make-string-input-stream "abc") :start) +++ program-error) +++ t) +++ +++(deftest read-sequence.error.4 +++ (signals-error +++ (read-sequence (make-string 5) (make-string-input-stream "abc") :foo 1) +++ program-error) +++ t) +++ +++(deftest read-sequence.error.5 +++ (signals-error +++ (read-sequence (make-string 5) (make-string-input-stream "abc") +++ :allow-other-keys nil :bar 2) +++ program-error) +++ t) +++ +++(deftest read-sequence.error.6 +++ (check-type-error #'(lambda (x) (read-sequence x (make-string-input-stream "abc"))) +++ #'sequencep) +++ nil) +++ +++(deftest read-sequence.error.7 +++ (signals-error +++ (read-sequence (cons 'a 'b) (make-string-input-stream "abc")) +++ type-error) +++ t) +++ +++;;; This test appears to cause Allegro CL to crash +++(deftest read-sequence.error.8 +++ (signals-type-error x -1 +++ (read-sequence (make-string 3) +++ (make-string-input-stream "abc") +++ :start x)) +++ t) +++ +++(deftest read-sequence.error.9 +++ (check-type-error #'(lambda (s) +++ (read-sequence (make-string 3) (make-string-input-stream "abc") +++ :start s)) +++ (typef 'unsigned-byte)) +++ nil) +++ +++(deftest read-sequence.error.10 +++ (signals-type-error x -1 +++ (read-sequence (make-string 3) (make-string-input-stream "abc") +++ :end x)) +++ t) +++ +++(deftest read-sequence.error.11 +++ (check-type-error #'(lambda (e) +++ (read-sequence (make-string 3) (make-string-input-stream "abc") +++ :end e)) +++ (typef '(or unsigned-byte null))) +++ nil) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/rename-file.lsp ++@@ -0,0 +1,199 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Thu Jan 8 06:22:53 2004 +++;;;; Contains: Tests for RENAME-FILE +++ +++(in-package :cl-test) +++ +++(deftest rename-file.1 +++ (let ((pn1 #p"file-to-be-renamed.txt") +++ (pn2 #p"file-that-was-renamed.txt")) +++ (delete-all-versions pn1) +++ (delete-all-versions pn2) +++ (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) +++ (let ((results (multiple-value-list (rename-file pn1 pn2)))) +++ (destructuring-bind (defaulted-new-name old-truename new-truename) +++ results +++ (values +++ (=t (length results) 3) +++ (probe-file pn1) +++ (notnot (probe-file pn2)) +++ (list (notnot (pathnamep defaulted-new-name)) +++ (notnot (pathnamep old-truename)) +++ (notnot (pathnamep new-truename)) +++ (typep old-truename 'logical-pathname) +++ (typep new-truename 'logical-pathname)) +++ (notnot (probe-file defaulted-new-name)) +++ (probe-file old-truename) +++ (notnot (probe-file new-truename)))))) +++ t nil t (t t t nil nil) t nil t) +++ +++(deftest rename-file.2 +++ (let ((pn1 "file-to-be-renamed.txt") +++ (pn2 "file-that-was-renamed.txt")) +++ (delete-all-versions pn1) +++ (delete-all-versions pn2) +++ (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) +++ (let ((results (multiple-value-list (rename-file pn1 pn2)))) +++ (destructuring-bind (defaulted-new-name old-truename new-truename) +++ results +++ (values +++ (=t (length results) 3) +++ (probe-file pn1) +++ (notnot (probe-file pn2)) +++ (list (notnot (pathnamep defaulted-new-name)) +++ (notnot (pathnamep old-truename)) +++ (notnot (pathnamep new-truename)) +++ (typep old-truename 'logical-pathname) +++ (typep new-truename 'logical-pathname)) +++ (notnot (probe-file defaulted-new-name)) +++ (probe-file old-truename) +++ (notnot (probe-file new-truename)))))) +++ t nil t (t t t nil nil) t nil t) +++ +++ (deftest rename-file.3 +++ (let* ((pn1 (make-pathname :name "file-to-be-renamed" +++ :type "txt" +++ :version :newest +++ :defaults *default-pathname-defaults*)) +++ (pn2 (make-pathname :name "file-that-was-renamed")) +++ (pn3 (make-pathname :name "file-that-was-renamed" +++ :defaults pn1))) +++ (delete-all-versions pn1) +++ (delete-all-versions pn3) +++ (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) +++ (let ((results (multiple-value-list (rename-file pn1 pn2)))) +++ (destructuring-bind (defaulted-new-name old-truename new-truename) +++ results +++ (values +++ (equalpt (pathname-type pn1) +++ (pathname-type defaulted-new-name)) +++ (=t (length results) 3) +++ (probe-file pn1) +++ (notnot (probe-file pn3)) +++ (list (notnot (pathnamep defaulted-new-name)) +++ (notnot (pathnamep old-truename)) +++ (notnot (pathnamep new-truename)) +++ (typep old-truename 'logical-pathname) +++ (typep new-truename 'logical-pathname)) +++ (notnot (probe-file defaulted-new-name)) +++ (probe-file old-truename) +++ (notnot (probe-file new-truename)))))) +++ t t nil t (t t t nil nil) t nil t) +++ +++(deftest rename-file.4 +++ (let ((pn1 "file-to-be-renamed.txt") +++ (pn2 "file-that-was-renamed.txt")) +++ (delete-all-versions pn1) +++ (delete-all-versions pn2) +++ (let ((s (open pn1 :direction :output))) +++ (format s "Whatever~%") +++ (close s) +++ (let ((results (multiple-value-list (rename-file s pn2)))) +++ (destructuring-bind (defaulted-new-name old-truename new-truename) +++ results +++ (values +++ (=t (length results) 3) +++ (probe-file pn1) +++ (notnot (probe-file pn2)) +++ (list (notnot (pathnamep defaulted-new-name)) +++ (notnot (pathnamep old-truename)) +++ (notnot (pathnamep new-truename)) +++ (typep old-truename 'logical-pathname) +++ (typep new-truename 'logical-pathname)) +++ (notnot (probe-file defaulted-new-name)) +++ (probe-file old-truename) +++ (notnot (probe-file new-truename))))))) +++ t nil t (t t t nil nil) t nil t) +++ +++(deftest rename-file.5 +++ (let ((pn1 "CLTEST:FILE-TO-BE-RENAMED.TXT") +++ (pn2 "CLTEST:FILE-THAT-WAS-RENAMED.TXT")) +++ (delete-all-versions pn1) +++ (delete-all-versions pn2) +++ (assert (typep (pathname pn1) 'logical-pathname)) +++ (assert (typep (pathname pn2) 'logical-pathname)) +++ (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) +++ (let ((results (multiple-value-list (rename-file pn1 pn2)))) +++ (destructuring-bind (defaulted-new-name old-truename new-truename) +++ results +++ (values +++ (=t (length results) 3) +++ (probe-file pn1) +++ (notnot (probe-file pn2)) +++ (list (notnot (pathnamep defaulted-new-name)) +++ (notnot (pathnamep old-truename)) +++ (notnot (pathnamep new-truename)) +++ (typep old-truename 'logical-pathname) +++ (typep new-truename 'logical-pathname)) +++ (notnot (probe-file defaulted-new-name)) +++ (probe-file old-truename) +++ (notnot (probe-file new-truename)) +++ (notnot (typep defaulted-new-name 'logical-pathname)) +++ )))) +++ t nil t (t t t nil nil) t nil t t) +++ +++;;; Specialized string tests +++ +++(deftest rename-file.6 +++ (do-special-strings +++ (s "file-to-be-renamed.txt" nil) +++ (let ((pn1 s) +++ (pn2 "file-that-was-renamed.txt")) +++ (delete-all-versions pn1) +++ (delete-all-versions pn2) +++ (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) +++ (let ((results (multiple-value-list (rename-file pn1 pn2)))) +++ (destructuring-bind (defaulted-new-name old-truename new-truename) +++ results +++ (assert +++ (equal +++ (list +++ (=t (length results) 3) +++ (probe-file pn1) +++ (notnot (probe-file pn2)) +++ (list (notnot (pathnamep defaulted-new-name)) +++ (notnot (pathnamep old-truename)) +++ (notnot (pathnamep new-truename)) +++ (typep old-truename 'logical-pathname) +++ (typep new-truename 'logical-pathname)) +++ (notnot (probe-file defaulted-new-name)) +++ (probe-file old-truename) +++ (notnot (probe-file new-truename))) +++ '(t nil t (t t t nil nil) t nil t))))))) +++ nil) +++ +++(deftest rename-file.7 +++ (do-special-strings +++ (s "file-that-was-renamed.txt" nil) +++ (let ((pn1 "file-to-be-renamed.txt") +++ (pn2 s)) +++ (delete-all-versions pn1) +++ (delete-all-versions pn2) +++ (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) +++ (let ((results (multiple-value-list (rename-file pn1 pn2)))) +++ (destructuring-bind (defaulted-new-name old-truename new-truename) +++ results +++ (assert +++ (equal +++ (list +++ (=t (length results) 3) +++ (probe-file pn1) +++ (notnot (probe-file pn2)) +++ (list (notnot (pathnamep defaulted-new-name)) +++ (notnot (pathnamep old-truename)) +++ (notnot (pathnamep new-truename)) +++ (typep old-truename 'logical-pathname) +++ (typep new-truename 'logical-pathname)) +++ (notnot (probe-file defaulted-new-name)) +++ (probe-file old-truename) +++ (notnot (probe-file new-truename))) +++ '(t nil t (t t t nil nil) t nil t))))))) +++ nil) +++ +++;;; Error tests +++ +++(deftest rename-file.error.1 +++ (signals-error (rename-file) program-error) +++ t) +++ ++--- gcl-2.6.12.orig/ansi-tests/rt.lsp +++++ gcl-2.6.12/ansi-tests/rt.lsp ++@@ -21,81 +21,147 @@ ++ | SOFTWARE. | ++ |----------------------------------------------------------------------------|# ++ ++-;This is the December 19, 1990 version of the regression tester. +++;This was the December 19, 1990 version of the regression tester, but +++;has since been modified. ++ ++ (in-package :regression-test) ++ +++(declaim (ftype (function (t) t) get-entry expanded-eval do-entries)) +++(declaim (type list *entries*)) +++(declaim (ftype (function (t &rest t) t) report-error)) +++(declaim (ftype (function (t &optional t) t) do-entry)) +++ ++ (defvar *test* nil "Current test name") ++ (defvar *do-tests-when-defined* nil) ++-(defvar *entries* '(nil) "Test database") +++(defvar *entries* (list nil) "Test database. Has a leading dummy cell that does not contain an entry.") +++(defvar *entries-tail* *entries* "Tail of the *entries* list") +++(defvar *entries-table* (make-hash-table :test #'equal) +++ "Map the names of entries to the cons cell in *entries* that precedes the one whose car is the entry.") ++ (defvar *in-test* nil "Used by TEST") ++ (defvar *debug* nil "For debugging") ++ (defvar *catch-errors* t "When true, causes errors in a test to be caught.") ++ (defvar *print-circle-on-failure* nil ++ "Failure reports are printed with *PRINT-CIRCLE* bound to this value.") ++ ++-(defvar *compile-tests* nil "When true, compile the tests before running ++-them.") +++(defvar *compile-tests* nil "When true, compile the tests before running them.") +++(defvar *expanded-eval* nil "When true, convert the tests into a form that is less likely to have compiler optimizations.") ++ (defvar *optimization-settings* '((safety 3))) ++ +++(defvar *failed-tests* nil "After DO-TESTS, becomes the list of names of tests that have failed") +++(defvar *passed-tests* nil "After DO-TESTS, becomes the list of names of tests that have passed") +++ ++ (defvar *expected-failures* nil ++ "A list of test names that are expected to fail.") ++ ++-(defstruct (entry (:conc-name nil) ++- (:type list)) ++- pend name form) ++- ++-(defmacro vals (entry) `(cdddr ,entry)) ++- ++-(defmacro defn (entry) `(cdr ,entry)) +++(defvar *notes* (make-hash-table :test 'equal) +++ "A mapping from names of notes to note objects.") +++ +++(defstruct (entry (:conc-name nil)) +++ pend name props form vals) +++ +++;;; Note objects are used to attach information to tests. +++;;; A typical use is to mark tests that depend on a particular +++;;; part of a set of requirements, or a particular interpretation +++;;; of the requirements. +++ +++(defstruct note +++ name +++ contents +++ disabled ;; When true, tests with this note are considered inactive +++ ) +++ +++;; (defmacro vals (entry) `(cdddr ,entry)) +++ +++(defmacro defn (entry) +++ (let ((var (gensym))) +++ `(let ((,var ,entry)) +++ (list* (name ,var) (form ,var) (vals ,var))))) +++ +++(defun entry-notes (entry) +++ (let* ((props (props entry)) +++ (notes (getf props :notes))) +++ (if (listp notes) +++ notes +++ (list notes)))) +++ +++(defun has-disabled-note (entry) +++ (let ((notes (entry-notes entry))) +++ (loop for n in notes +++ for note = (if (note-p n) n +++ (gethash n *notes*)) +++ thereis (and note (note-disabled note))))) +++ +++(defun has-note (entry note) +++ (unless (note-p note) +++ (let ((new-note (gethash note *notes*))) +++ (setf note new-note))) +++ (and note (not (not (member note (entry-notes entry)))))) ++ ++ (defun pending-tests () ++- (do ((l (cdr *entries*) (cdr l)) ++- (r nil)) ++- ((null l) (nreverse r)) ++- (when (pend (car l)) ++- (push (name (car l)) r)))) +++ (loop for entry in (cdr *entries*) +++ when (and (pend entry) (not (has-disabled-note entry))) +++ collect (name entry))) ++ ++ (defun rem-all-tests () ++ (setq *entries* (list nil)) +++ (setq *entries-tail* *entries*) +++ (clrhash *entries-table*) ++ nil) ++ ++ (defun rem-test (&optional (name *test*)) ++- (do ((l *entries* (cdr l))) ++- ((null (cdr l)) nil) ++- (when (equal (name (cadr l)) name) ++- (setf (cdr l) (cddr l)) ++- (return name)))) +++ (let ((pred (gethash name *entries-table*))) +++ (when pred +++ (if (null (cddr pred)) +++ (setq *entries-tail* pred) +++ (setf (gethash (name (caddr pred)) *entries-table*) pred)) +++ (setf (cdr pred) (cddr pred)) +++ (remhash name *entries-table*) +++ name))) ++ ++ (defun get-test (&optional (name *test*)) ++ (defn (get-entry name))) ++ ++ (defun get-entry (name) ++- (let ((entry (find name (cdr *entries*) ++- :key #'name ++- :test #'equal))) +++ (let ((entry ;; (find name (the list (cdr *entries*)) +++ ;; :key #'name :test #'equal) +++ (cadr (gethash name *entries-table*)) +++ )) ++ (when (null entry) ++ (report-error t ++ "~%No test with name ~:@(~S~)." ++ name)) ++ entry)) ++ ++-(defmacro deftest (name form &rest values) ++- `(add-entry '(t ,name ,form .,values))) +++(defmacro deftest (name &rest body) +++ (let* ((p body) +++ (properties +++ (loop while (keywordp (first p)) +++ unless (cadr p) +++ do (error "Poorly formed deftest: ~A~%" +++ (list* 'deftest name body)) +++ append (list (pop p) (pop p)))) +++ (form (pop p)) +++ (vals p)) +++ `(add-entry (make-entry :pend t +++ :name ',name +++ :props ',properties +++ :form ',form +++ :vals ',vals)))) ++ ++ (defun add-entry (entry) ++- (setq entry (copy-list entry)) ++- (do ((l *entries* (cdr l))) (nil) ++- (when (null (cdr l)) ++- (setf (cdr l) (list entry)) ++- (return nil)) ++- (when (equal (name (cadr l)) ++- (name entry)) ++- (setf (cadr l) entry) +++ (setq entry (copy-entry entry)) +++ (let* ((pred (gethash (name entry) *entries-table*))) +++ (cond +++ (pred +++ (setf (cadr pred) entry) ++ (report-error nil ++ "Redefining test ~:@(~S~)" ++- (name entry)) ++- (return nil))) +++ (name entry))) +++ (t +++ (setf (gethash (name entry) *entries-table*) *entries-tail*) +++ (setf (cdr *entries-tail*) (cons entry nil)) +++ (setf *entries-tail* (cdr *entries-tail*)) +++ ))) ++ (when *do-tests-when-defined* ++ (do-entry entry)) ++ (setq *test* (name entry))) ++@@ -105,53 +171,59 @@ them.") ++ (apply #'format t args) ++ (if error? (throw '*debug* nil))) ++ (error? (apply #'error args)) ++- (t (apply #'warn args)))) +++ (t (apply #'warn args))) +++ nil) ++ ++-(defun do-test (&optional (name *test*)) ++- (do-entry (get-entry name))) +++(defun do-test (&optional (name *test*) &rest key-args) +++ (flet ((%parse-key-args +++ (&key +++ ((:catch-errors *catch-errors*) *catch-errors*) +++ ((:compile *compile-tests*) *compile-tests*)) +++ (do-entry (get-entry name)))) +++ (apply #'%parse-key-args key-args))) +++ +++(defun my-aref (a &rest args) +++ (apply #'aref a args)) +++ +++(defun my-row-major-aref (a index) +++ (row-major-aref a index)) ++ ++ (defun equalp-with-case (x y) ++ "Like EQUALP, but doesn't do case conversion of characters. ++ Currently doesn't work on arrays of dimension > 2." ++ (cond +++ ((eq x y) t) ++ ((consp x) ++ (and (consp y) ++ (equalp-with-case (car x) (car y)) ++ (equalp-with-case (cdr x) (cdr y)))) ++ ((and (typep x 'array) ++ (= (array-rank x) 0)) ++- (equalp-with-case (aref x) (aref y))) +++ (equalp-with-case (my-aref x) (my-aref y))) ++ ((typep x 'vector) ++ (and (typep y 'vector) ++ (let ((x-len (length x)) ++ (y-len (length y))) ++ (and (eql x-len y-len) ++ (loop ++- for e1 across x ++- for e2 across y +++ for i from 0 below x-len +++ for e1 = (my-aref x i) +++ for e2 = (my-aref y i) ++ always (equalp-with-case e1 e2)))))) ++ ((and (typep x 'array) ++ (typep y 'array) ++ (not (equal (array-dimensions x) ++ (array-dimensions y)))) ++ nil) ++- #| ++- ((and (typep x 'array) ++- (= (array-rank x) 2)) ++- (let ((dim (array-dimensions x))) ++- (loop for i from 0 below (first dim) ++- always (loop for j from 0 below (second dim) ++- always (equalp-with-case (aref x i j) ++- (aref y i j)))))) ++- |# ++ ++ ((typep x 'array) ++ (and (typep y 'array) ++ (let ((size (array-total-size x))) ++ (loop for i from 0 below size ++- always (equalp-with-case (row-major-aref x i) ++- (row-major-aref y i)))))) ++- +++ always (equalp-with-case (my-row-major-aref x i) +++ (my-row-major-aref y i)))))) +++ ((typep x 'pathname) +++ (equal x y)) ++ (t (eql x y)))) ++ ++ (defun do-entry (entry &optional ++@@ -165,49 +237,110 @@ them.") ++ r) ++ ;; (declare (special *break-on-warnings*)) ++ ++- (flet ((%do ++- () ++- (setf r ++- (multiple-value-list ++- (if *compile-tests* ++- (funcall (compile ++- nil ++- `(lambda () ++- (declare ++- (optimize ,@*optimization-settings*)) ++- ,(form entry)))) ++- (eval (form entry))))))) ++- (block aborted ++- (if *catch-errors* ++- (handler-bind (#-ecl (style-warning #'muffle-warning) ++- (error #'(lambda (c) ++- (setf aborted t) ++- (setf r (list c)) ++- (return-from aborted nil)))) ++- (%do)) ++- (%do)))) ++- +++ (block aborted +++ (setf r +++ (flet ((%do () +++ (handler-bind +++ #-sbcl nil +++ #+sbcl ((sb-ext:code-deletion-note #'(lambda (c) +++ (if (has-note entry :do-not-muffle) +++ nil +++ (muffle-warning c))))) +++ (cond +++ (*compile-tests* +++ (multiple-value-list +++ (funcall (compile +++ nil +++ `(lambda () +++ (declare +++ (optimize ,@*optimization-settings*)) +++ ,(form entry)))))) +++ (*expanded-eval* +++ (multiple-value-list +++ (expanded-eval (form entry)))) +++ (t +++ (multiple-value-list +++ (eval (form entry)))))))) +++ (if *catch-errors* +++ (handler-bind +++ (#-ecl (style-warning #'(lambda (c) (if (has-note entry :do-not-muffle-warnings) +++ c +++ (muffle-warning c)))) +++ (error #'(lambda (c) +++ (setf aborted t) +++ (setf r (list c)) +++ (return-from aborted nil)))) +++ (%do)) +++ (%do))))) +++ ++ (setf (pend entry) ++ (or aborted ++ (not (equalp-with-case r (vals entry))))) +++ ++ (when (pend entry) ++ (let ((*print-circle* *print-circle-on-failure*)) ++- (format s "~&Test ~:@(~S~) failed~%Form: ~S~%Expected value~P:~%" ++- *test* (form entry) (length (vals entry))) ++- (dolist (v (vals entry)) (format s "~10t~S~%" v)) ++- (format s "Actual value~P:~%" (length r)) ++- (dolist (v r) ++- (format s "~10t~S~:[~; [~2:*~A]~]~%" ++- v (typep v 'condition))))))) +++ (format s "~&Test ~:@(~S~) failed~ +++ ~%Form: ~S~ +++ ~%Expected value~P: ~ +++ ~{~S~^~%~17t~}~%" +++ *test* (form entry) +++ (length (vals entry)) +++ (vals entry)) +++ (handler-case +++ (let ((st (format nil "Actual value~P: ~ +++ ~{~S~^~%~15t~}.~%" +++ (length r) r))) +++ (format s "~A" st)) +++ (error () (format s "Actual value: #~%"))) +++ (finish-output s))))) ++ (when (not (pend entry)) *test*)) ++ +++(defun expanded-eval (form) +++ "Split off top level of a form and eval separately. This reduces the chance that +++ compiler optimizations will fold away runtime computation." +++ (if (not (consp form)) +++ (eval form) +++ (let ((op (car form))) +++ (cond +++ ((eq op 'let) +++ (let* ((bindings (loop for b in (cadr form) +++ collect (if (consp b) b (list b nil)))) +++ (vars (mapcar #'car bindings)) +++ (binding-forms (mapcar #'cadr bindings))) +++ (apply +++ (the function +++ (eval `(lambda ,vars ,@(cddr form)))) +++ (mapcar #'eval binding-forms)))) +++ ((and (eq op 'let*) (cadr form)) +++ (let* ((bindings (loop for b in (cadr form) +++ collect (if (consp b) b (list b nil)))) +++ (vars (mapcar #'car bindings)) +++ (binding-forms (mapcar #'cadr bindings))) +++ (funcall +++ (the function +++ (eval `(lambda (,(car vars) &aux ,@(cdr bindings)) ,@(cddr form)))) +++ (eval (car binding-forms))))) +++ ((eq op 'progn) +++ (loop for e on (cdr form) +++ do (if (null (cdr e)) (return (eval (car e))) +++ (eval (car e))))) +++ ((and (symbolp op) (fboundp op) +++ (not (macro-function op)) +++ (not (special-operator-p op))) +++ (apply (symbol-function op) +++ (mapcar #'eval (cdr form)))) +++ (t (eval form)))))) +++ ++ (defun continue-testing () ++ (if *in-test* ++ (throw '*in-test* nil) ++ (do-entries *standard-output*))) ++ ++-(defun do-tests (&optional ++- (out *standard-output*)) +++(defun do-tests (&key (out *standard-output*) +++ ((:catch-errors *catch-errors*) *catch-errors*) +++ ((:compile *compile-tests*) *compile-tests*)) +++ (setq *failed-tests* nil +++ *passed-tests* nil) ++ (dolist (entry (cdr *entries*)) ++ (setf (pend entry) t)) ++ (if (streamp out) ++@@ -219,13 +352,19 @@ them.") ++ (defun do-entries (s) ++ (format s "~&Doing ~A pending test~:P ~ ++ of ~A tests total.~%" ++- (count t (cdr *entries*) ++- :key #'pend) +++ (count t (the list (cdr *entries*)) :key #'pend) ++ (length (cdr *entries*))) +++ (finish-output s) ++ (dolist (entry (cdr *entries*)) ++- (when (pend entry) ++- (format s "~@[~<~%~:; ~:@(~S~)~>~]" ++- (do-entry entry s)))) +++ (when (and (pend entry) +++ (not (has-disabled-note entry))) +++ (let ((success? (do-entry entry s))) +++ (if success? +++ (push (name entry) *passed-tests*) +++ (push (name entry) *failed-tests*)) +++ (format s "~@[~<~%~:; ~:@(~S~)~>~]" success?)) +++ (finish-output s) +++ )) ++ (let ((pending (pending-tests)) ++ (expected-table (make-hash-table :test #'equal))) ++ (dolist (ex *expected-failures*) ++@@ -252,19 +391,46 @@ them.") ++ ~^, ~}~)." ++ (length new-failures) ++ new-failures))) ++- (when *expected-failures* ++- (let ((pending-table (make-hash-table :test #'equal))) ++- (dolist (ex pending) ++- (setf (gethash ex pending-table) t)) ++- (let ((unexpected-successes ++- (loop :for ex :in *expected-failures* ++- :unless (gethash ex pending-table) :collect ex))) ++- (if unexpected-successes ++- (format t "~&~:D unexpected successes: ~ ++- ~:@(~{~<~% ~1:;~S~>~ ++- ~^, ~}~)." ++- (length unexpected-successes) ++- unexpected-successes) ++- (format t "~&No unexpected successes."))))) ++ )) +++ (finish-output s) ++ (null pending)))) +++ +++;;; Note handling functions and macros +++ +++(defmacro defnote (name contents &optional disabled) +++ `(eval-when (:load-toplevel :execute) +++ (let ((note (make-note :name ',name +++ :contents ',contents +++ :disabled ',disabled))) +++ (setf (gethash (note-name note) *notes*) note) +++ note))) +++ +++(defun disable-note (n) +++ (let ((note (if (note-p n) n +++ (setf n (gethash n *notes*))))) +++ (unless note (error "~A is not a note or note name." n)) +++ (setf (note-disabled note) t) +++ note)) +++ +++(defun enable-note (n) +++ (let ((note (if (note-p n) n +++ (setf n (gethash n *notes*))))) +++ (unless note (error "~A is not a note or note name." n)) +++ (setf (note-disabled note) nil) +++ note)) +++ +++;;; Extended random regression +++ +++(defun do-extended-tests (&key (tests *passed-tests*) (count nil) +++ ((:catch-errors *catch-errors*) *catch-errors*) +++ ((:compile *compile-tests*) *compile-tests*)) +++ "Execute randomly chosen tests from TESTS until one fails or until +++ COUNT is an integer and that many tests have been executed." +++ (let ((test-vector (coerce tests 'simple-vector))) +++ (let ((n (length test-vector))) +++ (when (= n 0) (error "Must provide at least one test.")) +++ (loop for i from 0 +++ for name = (svref test-vector (random n)) +++ until (eql i count) +++ do (print name) +++ unless (do-test name) return (values name (1+ i)))))) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/stream-element-type.lsp ++@@ -0,0 +1,102 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Tue Jan 13 20:09:50 2004 +++;;;; Contains: Tests for STREAM-ELEMENT-TYPE +++ +++(in-package :cl-test) +++ +++(deftest stream-element-type.1 +++ (loop for s in (list *debug-io* *error-output* *query-io* +++ *standard-input* *standard-output* +++ *trace-output* *terminal-io*) +++ for results = (multiple-value-list (stream-element-type s)) +++ unless (and (eql (length results) 1) +++ (car results)) +++ collect s) +++ nil) +++ +++(deftest stream-element-type.2 +++ (let ((pn "foo.txt")) +++ (loop for i from 1 to 100 +++ for etype = `(unsigned-byte ,i) +++ for s = (progn (delete-all-versions pn) +++ (open pn :direction :output +++ :element-type etype)) +++ unless +++ (multiple-value-bind (sub good) +++ (subtypep etype (stream-element-type s)) +++ (close s) +++ (or sub (not good))) +++ collect i)) +++ nil) +++ +++(deftest stream-element-type.3 +++ (let ((pn "foo.txt")) +++ (loop for i from 1 to 100 +++ for etype = `(signed-byte ,i) +++ for s = (progn (delete-all-versions pn) +++ (open pn :direction :output +++ :element-type etype)) +++ unless +++ (multiple-value-bind (sub good) +++ (subtypep etype (stream-element-type s)) +++ (close s) +++ (or sub (not good))) +++ collect i)) +++ nil) +++ +++(deftest stream-element-type.4 +++ (let ((pn "foo.txt")) +++ (loop for i from 1 to 100 +++ for etype = `(integer 0 ,i) +++ for s = (progn (delete-all-versions pn) +++ (open pn :direction :output +++ :element-type etype)) +++ unless +++ (multiple-value-bind (sub good) +++ (subtypep etype (stream-element-type s)) +++ (close s) +++ (or sub (not good))) +++ collect i)) +++ nil) +++ +++ +++(deftest stream-element-type.5 +++ :notes (:assume-no-simple-streams) +++ (let ((pn "foo.txt")) +++ (delete-all-versions pn) +++ (let ((s (open pn :direction :output))) +++ (let ((etype (stream-element-type s))) +++ (unwind-protect +++ (equalt (multiple-value-list (subtypep* 'character etype)) +++ '(nil t)) +++ (close s))))) +++ nil) +++ +++(deftest stream-element-type.6 +++ :notes (:assume-no-simple-streams) +++ (let ((pn "foo.txt")) +++ (delete-all-versions pn) +++ (let ((s (open pn :direction :output +++ :element-type :default))) +++ (let ((etype (stream-element-type s))) +++ (unwind-protect +++ (multiple-value-bind (sub1 good1) (subtypep* etype 'integer) +++ (multiple-value-bind (sub2 good2) (subtypep* etype 'character) +++ (or (not good1) +++ (not good2) +++ sub1 sub2))) +++ (close s))))) +++ t) +++ +++(deftest stream-element-type.error.1 +++ (signals-error (stream-element-type) program-error) +++ t) +++ +++(deftest stream-element-type.error.2 +++ (signals-error (stream-element-type *standard-input* nil) program-error) +++ t) +++ +++(deftest stream-element-type.error.3 +++ (check-type-error #'stream-element-type #'streamp) +++ nil) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/stream-error-stream.lsp ++@@ -0,0 +1,34 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Feb 14 20:51:33 2004 +++;;;; Contains: Tests of STREAM-ERROR-STREAM +++ +++(in-package :cl-test) +++ +++(deftest stream-error-stream.1 +++ (with-input-from-string +++ (s "") +++ (handler-case +++ (read-char s) +++ (stream-error (c) (eqlt (stream-error-stream c) s)))) +++ t) +++ +++;;; Error tests +++ +++(deftest stream-error-stream.error.1 +++ (signals-error (stream-error-stream) program-error) +++ t) +++ +++ +++(deftest stream-error-stream.error.2 +++ (signals-error +++ (with-input-from-string +++ (s "") +++ (handler-case +++ (read-char s) +++ (stream-error (c) (stream-error-stream c nil)))) +++ program-error) +++ t) +++ +++ +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/stream-external-format.lsp ++@@ -0,0 +1,24 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Tue Jan 27 20:53:21 2004 +++;;;; Contains: Tests of STREAM-EXTERNAL-FORMAT +++ +++(in-package :cl-test) +++ +++;;; This is tested in open.lsp +++ +++;;; Error tests +++ +++(deftest stream-external-format.error.1 +++ (signals-error (stream-external-format) program-error) +++ t) +++ +++(deftest stream-external-format.error.2 +++ (signals-error +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (with-open-file +++ (s pn :direction :output :if-exists :supersede) +++ (stream-external-format s nil))) +++ program-error) +++ t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/streamp.lsp ++@@ -0,0 +1,44 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Jan 17 17:12:38 2004 +++;;;; Contains: Tests for STREAMP +++ +++(in-package :cl-test) +++ +++(deftest streamp.1 +++ (loop for s in (list *debug-io* *error-output* *query-io* +++ *standard-input* *standard-output* +++ *trace-output* *terminal-io*) +++ unless (equal (multiple-value-list (notnot-mv (streamp s))) +++ '(t)) +++ collect s) +++ nil) +++ +++(deftest streamp.2 +++ (check-type-predicate #'streamp 'stream) +++ 0) +++ +++(deftest streamp.3 +++ (let ((s (open "foo.txt" :direction :output +++ :if-exists :supersede))) +++ (close s) +++ (notnot-mv (streamp s))) +++ t) +++ +++(deftest streamp.4 +++ (let ((s (open "foo.txt" :direction :output +++ :if-exists :supersede))) +++ (unwind-protect +++ (notnot-mv (streamp s)) +++ (close s))) +++ t) +++ +++;;; Error tests +++ +++(deftest streamp.error.1 +++ (signals-error (streamp) program-error) +++ t) +++ +++(deftest streamp.error.2 +++ (signals-error (streamp *standard-input* nil) program-error) +++ t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/synonym-stream-symbol.lsp ++@@ -0,0 +1,23 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Thu Jan 29 21:21:06 2004 +++;;;; Contains: Tests of SYNONYM-STREAM-SYMBOL +++ +++(in-package :cl-test) +++ +++(deftest synonym-stream-symbol.1 +++ (synonym-stream-symbol (make-synonym-stream '*standard-input*)) +++ *standard-input*) +++ +++(deftest synonym-stream-symbol.error.1 +++ (signals-error (synonym-stream-symbol) program-error) +++ t) +++ +++(deftest synonym-stream-symbol.error.2 +++ (signals-error (synonym-stream-symbol +++ (make-synonym-stream '*terminal-io*) +++ nil) +++ program-error) +++ t) +++ +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/terpri.lsp ++@@ -0,0 +1,62 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sun Jan 18 20:35:57 2004 +++;;;; Contains: Tests of TERPRI +++ +++(in-package :cl-test) +++ +++(deftest terpri.1 +++ (let (result) +++ (values +++ (with-output-to-string +++ (*standard-output*) +++ (write-char #\a) +++ (setq result (terpri))) +++ result)) +++ #.(concatenate 'string "a" (string #\Newline)) +++ nil) +++ +++(deftest terpri.2 +++ (let (result) +++ (values +++ (with-output-to-string +++ (s) +++ (write-char #\a s) +++ (setq result (terpri s))) +++ result)) +++ #.(concatenate 'string "a" (string #\Newline)) +++ nil) +++ +++(deftest terpri.3 +++ (with-output-to-string +++ (s) +++ (write-char #\x s) +++ (terpri s) +++ (terpri s) +++ (write-char #\y s)) +++ #.(concatenate 'string "x" (string #\Newline) (string #\Newline) "y")) +++ +++(deftest terpri.4 +++ (with-output-to-string +++ (os) +++ (let ((*terminal-io* (make-two-way-stream *standard-input* os))) +++ (terpri t) +++ (finish-output t))) +++ #.(string #\Newline)) +++ +++(deftest terpri.5 +++ (with-output-to-string +++ (*standard-output*) +++ (terpri nil)) +++ #.(string #\Newline)) +++ +++;;; Error tests +++ +++(deftest terpri.error.1 +++ (signals-error +++ (with-output-to-string +++ (s) +++ (terpri s nil)) +++ program-error) +++ t) +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/translate-logical-pathname.lsp ++@@ -0,0 +1,48 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Mon Dec 29 14:45:50 2003 +++;;;; Contains: Tests for TRANSLATE-LOGICAL-PATHNAME +++ +++(in-package :cl-test) +++ +++;; On physical pathnames, t-l-p returns the pathname itself +++ +++;;; Every physical pathname is converted to itself +++(deftest translate-logical-pathname.1 +++ (loop for p in *pathnames* +++ unless (or (typep p 'logical-pathname) +++ (eq p (translate-logical-pathname p))) +++ collect p) +++ nil) +++ +++;;; &key arguments are allowed +++(deftest translate-logical-pathname.2 +++ (loop for p in *pathnames* +++ unless (or (typep p 'logical-pathname) +++ (eq p (translate-logical-pathname +++ p :allow-other-keys t))) +++ collect p) +++ nil) +++ +++(deftest translate-logical-pathname.3 +++ (loop for p in *pathnames* +++ unless (or (typep p 'logical-pathname) +++ (eq p (translate-logical-pathname +++ p :allow-other-keys nil))) +++ collect p) +++ nil) +++ +++(deftest translate-logical-pathname.4 +++ (loop for p in *pathnames* +++ unless (or (typep p 'logical-pathname) +++ (eq p (translate-logical-pathname +++ p :foo 1 :allow-other-keys t :bar 2))) +++ collect p) +++ nil) +++ +++ +++;;; errors +++ +++(deftest translate-logical-pathname.error.1 +++ (signals-error (translate-logical-pathname) program-error) +++ t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/translate-pathname.lsp ++@@ -0,0 +1,50 @@ +++;-*- Mode: Lisp -*- +++ +++(in-package :cl-test) +++ +++(deftest translate-pathname.1 (translate-pathname "foobar" "foobar" "foobar") #P"foobar") +++(deftest translate-pathname.2 (translate-pathname "foobar" "foobar" "foo*") #P"foo") +++(deftest translate-pathname.3 (translate-pathname "foobar" "foobar" "*") #P"foobar") +++(deftest translate-pathname.4 (translate-pathname "foobar" "foobar" "") #P"foobar") +++ +++(deftest translate-pathname.5 (translate-pathname "foobar" "foo*r" "foobar") #P"foobar") +++(deftest translate-pathname.6 (translate-pathname "foobar" "foo*r" "foo*") #P"fooba") +++(deftest translate-pathname.7 (translate-pathname "foobar" "foo*r" "*") #P"foobar") +++(deftest translate-pathname.8 (translate-pathname "foobar" "foo*r" "") #P"foobar") +++ +++(deftest translate-pathname.9 (translate-pathname "foobar" "*" "foobar") #P"foobar") +++(deftest translate-pathname.10 (translate-pathname "foobar" "*" "foo*") #P"foofoobar") +++(deftest translate-pathname.11 (translate-pathname "foobar" "*" "*") #P"foobar") +++(deftest translate-pathname.12 (translate-pathname "foobar" "*" "") #P"foobar") +++ +++(deftest translate-pathname.13 (translate-pathname "foobar" "" "foobar") #P"foobar") +++(deftest translate-pathname.14 (translate-pathname "foobar" "" "foo*") #P"foofoobar") +++(deftest translate-pathname.15 (translate-pathname "foobar" "" "*") #P"foobar") +++(deftest translate-pathname.16 (translate-pathname "foobar" "" "") #P"foobar") +++ +++(deftest translate-pathname.17 (translate-pathname "/a/bbfb/c/d/" "/a/bbfb/c/d/" "/a/qc/c/d/") #P"/a/qc/c/d/") +++(deftest translate-pathname.18 (translate-pathname "/a/bbfb/c/d/" "/a/bbfb/c/d/" "/a/q*c*/c/d/") #P"/a/qc/c/d/") +++(deftest translate-pathname.19 (translate-pathname "/a/bbfb/c/d/" "/a/bbfb/c/d/" "/a/*/c/d/") #P"/a/c/d/") +++(deftest translate-pathname.20 (translate-pathname "/a/bbfb/c/d/" "/a/bbfb/c/d/" "/a/**/d/") #P"/a/d/") +++ +++(deftest translate-pathname.21 (translate-pathname "/a/bbfb/c/d/" "/a/b*f*/c/d/" "/a/qc/c/d/") #P"/a/qc/c/d/") +++(deftest translate-pathname.22 (translate-pathname "/a/bbfb/c/d/" "/a/b*f*/c/d/" "/a/q*c*/c/d/") #P"/a/qbcb/c/d/") +++(deftest translate-pathname.23 (translate-pathname "/a/bbfb/c/d/" "/a/b*f*/c/d/" "/a/*/c/d/") #P"/a/bbfb/c/d/") +++(deftest translate-pathname.24 (translate-pathname "/a/bbfb/c/d/" "/a/b*f*/c/d/" "/a/**/d/") #P"/a/bbfb/d/") +++ +++(deftest translate-pathname.25 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "/a/qc/c/d/") #P"/a/qc/c/d/") +++(deftest translate-pathname.26 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "/a/q*c*/c/d/") #P"/a/qc/c/d/") +++(deftest translate-pathname.27 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "/a/*/d/") #P"/a/bbfb/d/") +++(deftest translate-pathname.28 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "/a/**/d/") #P"/a/bbfb/c/d/") +++ +++(deftest translate-pathname.29 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "a/qc/c/d/") #P"a/qc/c/d/") +++(deftest translate-pathname.30 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "a/q*c*/c/d/") #P"a/qc/c/d/") +++(deftest translate-pathname.31 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "a/*/d/") #P"a/bbfb/d/") +++(deftest translate-pathname.32 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "a/**/d/") #P"a/bbfb/c/d/") +++ +++(deftest translate-pathname.33 (translate-pathname "/a/bbfb/c/d/" "/a/bbfb/c/d/" "a") #P"/a/bbfb/c/d/a") +++(deftest translate-pathname.34 (translate-pathname "/a/bbfb/c/d/" "/a/b*f*/c/d/" "a") #P"/a/bbfb/c/d/a") +++(deftest translate-pathname.35 (translate-pathname "/a/bbfb/c/d/" "/a/*/c/d/" "a") #P"/a/bbfb/c/d/a") +++(deftest translate-pathname.36 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "a") #P"/a/bbfb/c/d/a") +++ +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/truename.lsp ++@@ -0,0 +1,108 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Tue Jan 6 05:32:37 2004 +++;;;; Contains: Tests of TRUENAME +++ +++(in-package :cl-test) +++ +++(deftest truename.1 +++ (let* ((pn #p"truename.lsp") +++ (tn (truename pn))) +++ (values +++ (notnot (pathnamep pn)) +++ (typep pn 'logical-pathname) +++ (equalt (pathname-name pn) (pathname-name tn)) +++ (equalt (pathname-type pn) (pathname-type tn)) +++ )) +++ t nil t t) +++ +++(deftest truename.2 +++ (let* ((name "truename.lsp") +++ (pn (pathname name)) +++ (tn (truename name))) +++ (values +++ (notnot (pathnamep pn)) +++ (typep pn 'logical-pathname) +++ (equalt (pathname-name pn) (pathname-name tn)) +++ (equalt (pathname-type pn) (pathname-type tn)) +++ )) +++ t nil t t) +++ +++(deftest truename.3 +++ (let* ((pn #p"truename.lsp")) +++ (with-open-file +++ (s pn :direction :input) +++ (let ((tn (truename s))) +++ (values +++ (notnot (pathnamep pn)) +++ (typep pn 'logical-pathname) +++ (equalt (pathname-name pn) (pathname-name tn)) +++ (equalt (pathname-type pn) (pathname-type tn)) +++ )))) +++ t nil t t) +++ +++(deftest truename.4 +++ (let* ((pn #p"truename.lsp")) +++ (let ((s (open pn :direction :input))) +++ (close s) +++ (let ((tn (truename s))) +++ (values +++ (notnot (pathnamep pn)) +++ (typep pn 'logical-pathname) +++ (equalt (pathname-name pn) (pathname-name tn)) +++ (equalt (pathname-type pn) (pathname-type tn)) +++ )))) +++ t nil t t) +++ +++(deftest truename.5 +++ (let* ((lpn "CLTEST:foo.txt") +++ (pn (translate-logical-pathname lpn))) +++ (unless (probe-file lpn) +++ (with-open-file (s lpn :direction :output) (format s "Stuff~%"))) +++ (let ((tn (truename lpn))) +++ (values +++ (notnot (pathnamep pn)) +++ (if (equalt (pathname-name pn) (pathname-name tn)) +++ t (list (pathname-name pn) (pathname-name tn))) +++ (if (equalt (pathname-type pn) (pathname-type tn)) +++ t (list (pathname-type pn) (pathname-type tn))) +++ ))) +++ t t t) +++ +++;;; Specialized string tests +++ +++(deftest truename.6 +++ (do-special-strings +++ (s "truename.lsp" nil) +++ (assert (equalp (truename s) (truename "truename.lsp")))) +++ nil) +++ +++;;; Error tests +++ +++(deftest truename.error.1 +++ (signals-error (truename) program-error) +++ t) +++ +++(deftest truename.error.2 +++ (signals-error (truename "truename.lsp" nil) program-error) +++ t) +++ +++(deftest truename.error.3 +++ (signals-error-always (truename "nonexistent") file-error) +++ t t) +++ +++(deftest truename.error.4 +++ (signals-error-always (truename #p"nonexistent") file-error) +++ t t) +++ +++(deftest truename.error.5 +++ (signals-error-always (truename (logical-pathname "CLTESTROOT:NONEXISTENT")) file-error) +++ t t) +++ +++(deftest truename.error.6 +++ (signals-error-always +++ (let ((pn (make-pathname :name :wild +++ :defaults *default-pathname-defaults*))) +++ (truename pn)) +++ file-error) +++ t t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/two-way-stream-input-stream.lsp ++@@ -0,0 +1,26 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Thu Feb 12 04:22:50 2004 +++;;;; Contains: Tests of TWO-WAY-STREAM-INPUT-STREAM +++ +++(in-package :cl-test) +++ +++(deftest two-way-stream-input-stream.1 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-two-way-stream is os))) +++ (equalt (multiple-value-list (two-way-stream-input-stream s)) +++ (list is))) +++ t) +++ +++(deftest two-way-stream-input-stream.error.1 +++ (signals-error (two-way-stream-input-stream) program-error) +++ t) +++ +++(deftest two-way-stream-input-stream.error.2 +++ (signals-error (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-two-way-stream is os))) +++ (two-way-stream-input-stream s nil)) +++ program-error) +++ t) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/two-way-stream-output-stream.lsp ++@@ -0,0 +1,26 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Thu Feb 12 04:25:59 2004 +++;;;; Contains: Tests off TWO-WAY-STREAM-OUTPUT-STREAM +++ +++(in-package :cl-test) +++ +++(deftest two-way-stream-output-stream.1 +++ (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-two-way-stream is os))) +++ (equalt (multiple-value-list (two-way-stream-output-stream s)) +++ (list os))) +++ t) +++ +++(deftest two-way-stream-output-stream.error.1 +++ (signals-error (two-way-stream-output-stream) program-error) +++ t) +++ +++(deftest two-way-stream-output-stream.error.2 +++ (signals-error (let* ((is (make-string-input-stream "foo")) +++ (os (make-string-output-stream)) +++ (s (make-two-way-stream is os))) +++ (two-way-stream-output-stream s nil)) +++ program-error) +++ t) ++--- gcl-2.6.12.orig/ansi-tests/universe.lsp +++++ gcl-2.6.12/ansi-tests/universe.lsp ++@@ -307,15 +307,50 @@ ++ #-(or GCL CMU ECL) (make-hash-table :test #'equalp) ++ )) ++ ++-(defvar *pathnames* ++- (list ++- (make-pathname :name "foo") ++- (make-pathname :name "bar") ++- (make-pathname :name "foo" :type "txt") ++- (make-pathname :name "bar" :type "txt") ++- (make-pathname :name :wild) ++- (make-pathname :name :wild :type "txt") ++- )) +++(defparameter *pathnames* +++ (locally +++ (declare (optimize safety)) +++ (loop for form in '((make-pathname :name "foo") +++ (make-pathname :name "FOO" :case :common) +++ (make-pathname :name "bar") +++ (make-pathname :name "foo" :type "txt") +++ (make-pathname :name "bar" :type "txt") +++ (make-pathname :name "XYZ" :type "TXT" :case :common) +++ (make-pathname :name nil) +++ (make-pathname :name :wild) +++ (make-pathname :name nil :type "txt") +++ (make-pathname :name :wild :type "txt") +++ (make-pathname :name :wild :type "TXT" :case :common) +++ (make-pathname :name :wild :type "abc" :case :common) +++ (make-pathname :directory :wild) +++ (make-pathname :type :wild) +++ (make-pathname :version :wild) +++ (make-pathname :version :newest)) +++ append (ignore-errors (eval `(list ,form)))))) +++ +++(eval-when (:compile-toplevel :load-toplevel :execute) +++ (locally +++ (declare (optimize safety)) +++ (ignore-errors +++ (setf (logical-pathname-translations "CLTESTROOT") +++ `(("**;*.*.*" ,(make-pathname :directory '(:absolute :wild-inferiors) +++ :name :wild :type :wild))))) +++ (ignore-errors +++ (setf (logical-pathname-translations "CLTEST") +++ `(("**;*.*.*" ,(make-pathname +++ :directory (append +++ (pathname-directory +++ (truename (make-pathname))) +++ '(:wild-inferiors)) +++ :name :wild :type :wild))))) +++ )) +++ +++(defparameter *logical-pathnames* +++ (locally +++ (declare (optimize safety)) +++ (append +++ (ignore-errors (list (logical-pathname "CLTESTROOT:"))) +++ ))) ++ ++ (defvar *streams* ++ (remove-duplicates ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/unread-char.lsp ++@@ -0,0 +1,92 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sun Jan 18 20:05:36 2004 +++;;;; Contains: Tests of UNREAD-CHAR +++ +++(in-package :cl-test) +++ +++(deftest unread-char.1 +++ (with-input-from-string +++ (*standard-input* "abc") +++ (values +++ (read-char) +++ (unread-char #\a) +++ (read-char) +++ (read-char) +++ (unread-char #\b) +++ (read-char) +++ (read-char))) +++ #\a nil #\a #\b nil #\b #\c) +++ +++(deftest unread-char.2 +++ (with-input-from-string +++ (s "abc") +++ (values +++ (read-char s) +++ (unread-char #\a s) +++ (read-char s) +++ (read-char s) +++ (unread-char #\b s) +++ (read-char s) +++ (read-char s))) +++ #\a nil #\a #\b nil #\b #\c) +++ +++(deftest unread-char.3 +++ (with-input-from-string +++ (is "abc") +++ (with-output-to-string +++ (os) +++ (let ((s (make-echo-stream is os))) +++ (read-char s) +++ (unread-char #\a s) +++ (read-char s) +++ (read-char s) +++ (read-char s) +++ (unread-char #\c s) +++ (read-char s)))) +++ "abc") +++ +++(deftest unread-char.4 +++ (with-input-from-string +++ (*standard-input* "abc") +++ (values +++ (read-char) +++ (unread-char #\a nil) +++ (read-char) +++ (read-char) +++ (unread-char #\b nil) +++ (read-char) +++ (read-char))) +++ #\a nil #\a #\b nil #\b #\c) +++ +++(deftest unread-char.5 +++ (with-input-from-string +++ (is "abc") +++ (let ((*terminal-io* (make-two-way-stream +++ is (make-string-output-stream)))) +++ (values +++ (read-char t) +++ (unread-char #\a t) +++ (read-char t) +++ (read-char t) +++ (unread-char #\b t) +++ (read-char t) +++ (read-char t)))) +++ #\a nil #\a #\b nil #\b #\c) +++ +++;;; Error tests +++ +++(deftest unread-char.error.1 +++ (signals-error (unread-char) program-error) +++ t) +++ +++(deftest unread-char.error.2 +++ (signals-error +++ (with-input-from-string +++ (s "abc") +++ (read-char s) +++ (unread-char #\a s nil)) +++ program-error) +++ t) +++ +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/wild-pathname-p.lsp ++@@ -0,0 +1,234 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Wed Dec 31 16:54:55 2003 +++;;;; Contains: Tests of WILD-PATHNAME-P +++ +++(in-package :cl-test) +++ +++(compile-and-load "pathnames-aux.lsp") +++ +++(deftest wild-pathname-p.1 +++ (wild-pathname-p (make-pathname)) +++ nil) +++ +++(deftest wild-pathname-p.2 +++ (loop for key in '(:host :device :directory :name :type :version nil) +++ when (wild-pathname-p (make-pathname) key) +++ collect key) +++ nil) +++ +++(deftest wild-pathname-p.3 +++ (let ((p (make-pathname :directory :wild))) +++ (notnot-mv (wild-pathname-p p))) +++ t) +++ +++(deftest wild-pathname-p.4 +++ (let ((p (make-pathname :directory :wild))) +++ (notnot-mv (wild-pathname-p p nil))) +++ t) +++ +++(deftest wild-pathname-p.5 +++ (let ((p (make-pathname :directory :wild))) +++ (notnot-mv (wild-pathname-p p :directory))) +++ t) +++ +++(deftest wild-pathname-p.6 +++ (let ((p (make-pathname :directory :wild))) +++ (loop for key in '(:host :device :name :type :version) +++ when (wild-pathname-p p key) +++ collect key)) +++ nil) +++ +++ +++(deftest wild-pathname-p.7 +++ (let ((p (make-pathname :directory '(:absolute :wild)))) +++ (notnot-mv (wild-pathname-p p))) +++ t) +++ +++(deftest wild-pathname-p.8 +++ (let ((p (make-pathname :directory '(:absolute :wild)))) +++ (notnot-mv (wild-pathname-p p nil))) +++ t) +++ +++(deftest wild-pathname-p.9 +++ (let ((p (make-pathname :directory '(:absolute :wild)))) +++ (notnot-mv (wild-pathname-p p :directory))) +++ t) +++ +++(deftest wild-pathname-p.10 +++ (let ((p (make-pathname :directory '(:absolute :wild)))) +++ (loop for key in '(:host :device :name :type :version) +++ when (wild-pathname-p p key) +++ collect key)) +++ nil) +++ +++ +++(deftest wild-pathname-p.11 +++ (let ((p (make-pathname :directory '(:relative :wild)))) +++ (notnot-mv (wild-pathname-p p))) +++ t) +++ +++(deftest wild-pathname-p.12 +++ (let ((p (make-pathname :directory '(:relative :wild)))) +++ (notnot-mv (wild-pathname-p p nil))) +++ t) +++ +++(deftest wild-pathname-p.13 +++ (let ((p (make-pathname :directory '(:relative :wild)))) +++ (notnot-mv (wild-pathname-p p :directory))) +++ t) +++ +++(deftest wild-pathname-p.14 +++ (let ((p (make-pathname :directory '(:relative :wild)))) +++ (loop for key in '(:host :device :name :type :version) +++ when (wild-pathname-p p key) +++ collect key)) +++ nil) +++ +++;;; +++ +++(deftest wild-pathname-p.15 +++ (let ((p (make-pathname :name :wild))) +++ (notnot-mv (wild-pathname-p p))) +++ t) +++ +++(deftest wild-pathname-p.16 +++ (let ((p (make-pathname :name :wild))) +++ (notnot-mv (wild-pathname-p p nil))) +++ t) +++ +++(deftest wild-pathname-p.17 +++ (let ((p (make-pathname :name :wild))) +++ (notnot-mv (wild-pathname-p p :name))) +++ t) +++ +++(deftest wild-pathname-p.18 +++ (let ((p (make-pathname :name :wild))) +++ (loop for key in '(:host :device :directory :type :version) +++ when (wild-pathname-p p key) +++ collect key)) +++ nil) +++ +++;;; +++ +++(deftest wild-pathname-p.19 +++ (let ((p (make-pathname :type :wild))) +++ (notnot-mv (wild-pathname-p p))) +++ t) +++ +++(deftest wild-pathname-p.20 +++ (let ((p (make-pathname :type :wild))) +++ (notnot-mv (wild-pathname-p p nil))) +++ t) +++ +++(deftest wild-pathname-p.21 +++ (let ((p (make-pathname :type :wild))) +++ (notnot-mv (wild-pathname-p p :type))) +++ t) +++ +++(deftest wild-pathname-p.22 +++ (let ((p (make-pathname :type :wild))) +++ (loop for key in '(:host :device :directory :name :version) +++ when (wild-pathname-p p key) +++ collect key)) +++ nil) +++ +++;;; +++ +++ (deftest wild-pathname-p.23 +++ (let ((p (make-pathname :version :wild))) +++ (notnot-mv (wild-pathname-p p))) +++ t) +++ +++(deftest wild-pathname-p.24 +++ (let ((p (make-pathname :version :wild))) +++ (notnot-mv (wild-pathname-p p nil))) +++ t) +++ +++(deftest wild-pathname-p.25 +++ (let ((p (make-pathname :version :wild))) +++ (notnot-mv (wild-pathname-p p :version))) +++ t) +++ +++(deftest wild-pathname-p.26 +++ (let ((p (make-pathname :version :wild))) +++ (loop for key in '(:host :device :directory :name :type) +++ when (wild-pathname-p p key) +++ collect key)) +++ nil) +++ +++;;; +++ +++(deftest wild-pathname-p.27 +++ (loop for p in (append *pathnames* *logical-pathnames*) +++ unless (if (wild-pathname-p p) (wild-pathname-p p nil) +++ (not (wild-pathname-p p nil))) +++ collect p) +++ nil) +++ +++(deftest wild-pathname-p.28 +++ (loop for p in (append *pathnames* *logical-pathnames*) +++ when (and (loop for key in '(:host :device :directory +++ :name :type :version) +++ thereis (wild-pathname-p p key)) +++ (not (wild-pathname-p p))) +++ collect p) +++ nil) +++ +++;;; On streams associated with files +++ +++(deftest wild-pathname-p.29 +++ (with-open-file (s "foo.lsp" +++ :direction :output +++ :if-exists :append +++ :if-does-not-exist :create) +++ (wild-pathname-p s)) +++ nil) +++ +++(deftest wild-pathname-p.30 +++ (let ((s (open "foo.lsp" +++ :direction :output +++ :if-exists :append +++ :if-does-not-exist :create))) +++ (close s) +++ (wild-pathname-p s)) +++ nil) +++ +++;;; logical pathname designators +++ +++(deftest wild-pathname-p.31 +++ (wild-pathname-p "CLTEST:FOO.LISP") +++ nil) +++ +++;;; Odd strings +++ +++(deftest wild-pathname-p.32 +++ (do-special-strings +++ (s "CLTEST:FOO.LISP" nil) +++ (let ((vals (multiple-value-list (wild-pathname-p s)))) +++ (assert (equal vals '(nil))))) +++ nil) +++ +++;;; +++ +++(deftest wild-pathname-p.error.1 +++ (signals-error (wild-pathname-p) program-error) +++ t) +++ +++(deftest wild-pathname-p.error.2 +++ (signals-error (wild-pathname-p *default-pathname-defaults* nil nil) +++ program-error) +++ t) +++ +++(deftest wild-pathname-p.error.3 +++ (check-type-error #'wild-pathname-p +++ (typef '(or pathname string file-stream +++ synonym-stream))) +++ nil) +++ +++(deftest wild-pathname-p.error.4 +++ (check-type-error #'(lambda (x) (declare (optimize (safety 0))) +++ (wild-pathname-p x)) +++ (typef '(or pathname string file-stream +++ synonym-stream))) +++ nil) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/with-input-from-string.lsp ++@@ -0,0 +1,245 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Feb 14 20:13:02 2004 +++;;;; Contains: Tests of WITH-INPUT-FROM-STRING +++ +++(in-package :cl-test) +++ +++(deftest with-input-from-string.1 +++ (with-input-from-string +++ (s "abc") +++ (values (read-char s) (read-char s) (read-char s) (read-char s nil :eof))) +++ #\a #\b #\c :eof) +++ +++(deftest with-input-from-string.2 +++ (with-input-from-string (s "abc")) +++ nil) +++ +++(deftest with-input-from-string.3 +++ (with-input-from-string (s "abc") (declare (optimize speed))) +++ nil) +++ +++(deftest with-input-from-string.3a +++ (with-input-from-string (s "abc") +++ (declare (optimize speed)) +++ (declare (optimize space))) +++ nil) +++ +++(deftest with-input-from-string.4 +++ (with-input-from-string +++ (s "abc") +++ (declare (optimize safety)) +++ (read-char s) +++ (read-char s)) +++ #\b) +++ +++(deftest with-input-from-string.5 +++ (let ((i nil)) +++ (values +++ (with-input-from-string +++ (s "abc" :index i)) +++ i)) +++ nil 0) +++ +++(deftest with-input-from-string.6 +++ (let ((i (list nil))) +++ (values +++ (with-input-from-string +++ (s "abc" :index (car i))) +++ i)) +++ nil (0)) +++ +++(deftest with-input-from-string.7 +++ (let ((i nil)) +++ (values +++ (with-input-from-string +++ (s "abc" :index i) +++ (list i (read-char s) i (read-char s) i)) +++ i)) +++ (nil #\a nil #\b nil) 2) +++ +++(deftest with-input-from-string.9 +++ (with-input-from-string +++ (s "abc") +++ (values +++ (notnot (typep s 'stream)) +++ (notnot (typep s 'string-stream)) +++ (notnot (open-stream-p s)) +++ (notnot (input-stream-p s)) +++ (output-stream-p s))) +++ t t t t nil) +++ +++(deftest with-input-from-string.10 +++ :notes (:nil-vectors-are-strings) +++ (with-input-from-string +++ (s (make-array 0 :element-type nil)) +++ (values +++ (notnot (typep s 'stream)) +++ (notnot (typep s 'string-stream)) +++ (notnot (open-stream-p s)) +++ (notnot (input-stream-p s)) +++ (output-stream-p s))) +++ t t t t nil) +++ +++(deftest with-input-from-string.11 +++ (with-input-from-string +++ (s (make-array 3 :element-type 'character :initial-contents "abc")) +++ (values +++ (notnot (typep s 'stream)) +++ (notnot (typep s 'string-stream)) +++ (notnot (open-stream-p s)) +++ (notnot (input-stream-p s)) +++ (output-stream-p s) +++ (read-line s))) +++ t t t t nil "abc") +++ +++(deftest with-input-from-string.12 +++ (with-input-from-string +++ (s (make-array 3 :element-type 'base-char :initial-contents "abc")) +++ (values +++ (notnot (typep s 'stream)) +++ (notnot (typep s 'string-stream)) +++ (notnot (open-stream-p s)) +++ (notnot (input-stream-p s)) +++ (output-stream-p s) +++ (read-line s))) +++ t t t t nil "abc") +++ +++(deftest with-input-from-string.13 +++ (with-input-from-string +++ (s "abcdef" :start 2) +++ (values +++ (notnot (typep s 'stream)) +++ (notnot (typep s 'string-stream)) +++ (notnot (open-stream-p s)) +++ (notnot (input-stream-p s)) +++ (output-stream-p s) +++ (read-line s))) +++ t t t t nil "cdef") +++ +++(deftest with-input-from-string.14 +++ (with-input-from-string +++ (s "abcdef" :end 3) +++ (values +++ (notnot (typep s 'stream)) +++ (notnot (typep s 'string-stream)) +++ (notnot (open-stream-p s)) +++ (notnot (input-stream-p s)) +++ (output-stream-p s) +++ (read-line s))) +++ t t t t nil "abc") +++ +++(deftest with-input-from-string.15 +++ (with-input-from-string +++ (s "abcdef" :start 1 :end 5) +++ (values +++ (notnot (typep s 'stream)) +++ (notnot (typep s 'string-stream)) +++ (notnot (open-stream-p s)) +++ (notnot (input-stream-p s)) +++ (output-stream-p s) +++ (read-line s))) +++ t t t t nil "bcde") +++ +++(deftest with-input-from-string.16 +++ (with-input-from-string +++ (s "abcdef" :start 1 :end nil) +++ (values +++ (notnot (typep s 'stream)) +++ (notnot (typep s 'string-stream)) +++ (notnot (open-stream-p s)) +++ (notnot (input-stream-p s)) +++ (output-stream-p s) +++ (read-line s))) +++ t t t t nil "bcdef") +++ +++(deftest with-input-from-string.17 +++ (let ((i 2)) +++ (values +++ (with-input-from-string +++ (s "abcdef" :index i :start i) +++ (read-char s)) +++ i)) +++ #\c 3) +++ +++;;; Test that there is no implicit tagbody +++ +++(deftest with-input-from-string.18 +++ (block done +++ (tagbody +++ (with-input-from-string +++ (s "abc") +++ (go 1) +++ 1 +++ (return-from done :bad)) +++ 1 +++ (return-from done :good))) +++ :good) +++ +++;;; Free declaration scope +++ +++(deftest with-input-from-string.19 +++ (block done +++ (let ((x :bad)) +++ (declare (special x)) +++ (let ((x :good)) +++ (with-input-from-string (s (return-from done x)) +++ (declare (special x)))))) +++ :good) +++ +++(deftest with-input-from-string.20 +++ (block done +++ (let ((x :bad)) +++ (declare (special x)) +++ (let ((x :good)) +++ (with-input-from-string (s "abc" :start (return-from done x)) +++ (declare (special x)))))) +++ :good) +++ +++(deftest with-input-from-string.21 +++ (block done +++ (let ((x :bad)) +++ (declare (special x)) +++ (let ((x :good)) +++ (with-input-from-string (s "abc" :end (return-from done x)) +++ (declare (special x)))))) +++ :good) +++ +++;;; index is not updated if the form exits abnormally +++ +++(deftest with-input-from-string.22 +++ (let ((i nil)) +++ (values +++ (block done +++ (with-input-from-string (s "abcde" :index i) (return-from done (read-char s)))) +++ i)) +++ #\a nil) +++ +++;;; Test that explicit calls to macroexpand in subforms +++;;; are done in the correct environment +++ +++(deftest with-input-from-string.23 +++ (macrolet +++ ((%m (z) z)) +++ (with-input-from-string (s (expand-in-current-env (%m "123"))) +++ (read-char s))) +++ #\1) +++ +++(deftest with-input-from-string.24 +++ (macrolet +++ ((%m (z) z)) +++ (with-input-from-string (s "123" :start (expand-in-current-env (%m 1))) +++ (read-char s))) +++ #\2) +++ +++(deftest with-input-from-string.25 +++ (macrolet +++ ((%m (z) z)) +++ (with-input-from-string (s "123" :start 0 +++ :end (expand-in-current-env (%m 0))) +++ (read-char s nil nil))) +++ nil) +++ +++ +++;;; FIXME: Add more tests on specialized strings. +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/with-open-file.lsp ++@@ -0,0 +1,98 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Tue Jan 27 20:57:05 2004 +++;;;; Contains: Tests of WITH-OPEN-FILE +++ +++(in-package :cl-test) +++ +++;;; For now, omit most of the options combinations, assuming they will +++;;; be tested in OPEN. The tests of OPEN should be ported to here at some +++;;; point. +++ +++(deftest with-open-file.1 +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (with-open-file (s pn :direction :output))) +++ nil) +++ +++(deftest with-open-file.2 +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (with-open-file +++ (s pn :direction :output) +++ (notnot-mv (output-stream-p s)))) +++ t) +++ +++(deftest with-open-file.3 +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (with-open-file +++ (s pn :direction :output) +++ (values)))) +++ +++(deftest with-open-file.4 +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (with-open-file +++ (s pn :direction :output) +++ (values 1 2 3 4 5 6 7 8))) +++ 1 2 3 4 5 6 7 8) +++ +++(deftest with-open-file.5 +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (with-open-file +++ (s pn :direction :output) +++ (declare (ignore s)) +++ (declare (optimize)))) +++ nil) +++ +++(deftest with-open-file.6 +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (with-open-file +++ (s pn (cdr '(nil . :direction)) (car '(:output))) +++ (format s "foo!~%")) +++ (with-open-file (s pn) (read-line s))) +++ "foo!" nil) +++ +++;;; Free declaration scope tests +++ +++(deftest with-open-file.7 +++ (block done +++ (let ((x :bad)) +++ (declare (special x)) +++ (let ((x :good)) +++ (with-open-file (s (return-from done x)) +++ (declare (special x)))))) +++ :good) +++ +++(deftest with-open-file.8 +++ (block done +++ (let ((x :bad)) +++ (declare (special x)) +++ (let ((x :good)) +++ (with-open-file (s "with-open-file.lsp" (return-from done x) :input) +++ (declare (special x)))))) +++ :good) +++ +++(deftest with-open-file.9 +++ (block done +++ (let ((x :bad)) +++ (declare (special x)) +++ (let ((x :good)) +++ (with-open-file (s "with-open-file.lsp" :direction (return-from done x)) +++ (declare (special x)))))) +++ :good) +++ +++;;; Test that explicit calls to macroexpand in subforms +++;;; are done in the correct environment +++ +++(deftest with-open-file.10 +++ (macrolet +++ ((%m (z) z)) +++ (let ((pn #p"tmp.dat")) +++ (delete-all-versions pn) +++ (with-open-file (s (expand-in-current-env (%m pn)) +++ :direction :output)))) +++ nil) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/with-open-stream.lsp ++@@ -0,0 +1,77 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Mon Dec 13 01:42:59 2004 +++;;;; Contains: Tests of WITH-OPEN-STREAM +++ +++(in-package :cl-test) +++ +++(deftest with-open-stream.1 +++ (with-open-stream (os (make-string-output-stream))) +++ nil) +++ +++(deftest with-open-stream.2 +++ (with-open-stream (os (make-string-output-stream)) +++ (declare (ignore os))) +++ nil) +++ +++(deftest with-open-stream.3 +++ (with-open-stream (os (make-string-output-stream)) +++ (declare (ignore os)) +++ (declare (type string-stream os))) +++ nil) +++ +++(deftest with-open-stream.4 +++ (with-open-stream (os (make-string-output-stream)) +++ (declare (ignore os)) +++ (values))) +++ +++(deftest with-open-stream.5 +++ (with-open-stream (os (make-string-output-stream)) +++ (declare (ignore os)) +++ (values 'a 'b)) +++ a b) +++ +++(deftest with-open-stream.6 +++ (let ((s (make-string-output-stream))) +++ (values +++ (with-open-stream (os s)) +++ (notnot (typep s 'string-stream)) +++ (open-stream-p s))) +++ nil t nil) +++ +++(deftest with-open-stream.7 +++ (let ((s (make-string-input-stream "123"))) +++ (values +++ (with-open-stream (is s) (read-char s)) +++ (notnot (typep s 'string-stream)) +++ (open-stream-p s))) +++ #\1 t nil) +++ +++(deftest with-open-stream.8 +++ (let ((s (make-string-output-stream))) +++ (values +++ (block done +++ (with-open-stream (os s) (return-from done nil))) +++ (notnot (typep s 'string-stream)) +++ (open-stream-p s))) +++ nil t nil) +++ +++(deftest with-open-stream.9 +++ (let ((s (make-string-output-stream))) +++ (values +++ (catch 'done +++ (with-open-stream (os s) (throw 'done nil))) +++ (notnot (typep s 'string-stream)) +++ (open-stream-p s))) +++ nil t nil) +++ +++;;; Free declaration scope +++ +++(deftest with-open-stream.10 +++ (block done +++ (let ((x :bad)) +++ (declare (special x)) +++ (let ((x :good)) +++ (with-open-stream (s (return-from done x)) +++ (declare (special x)))))) +++ :good) ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/with-output-to-string.lsp ++@@ -0,0 +1,129 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sat Feb 14 20:33:51 2004 +++;;;; Contains: Tests of WITH-OUTPUT-TO-STRING +++ +++(in-package :cl-test) +++ +++ +++(deftest with-output-to-string.1 +++ (with-output-to-string (s)) +++ "") +++ +++(deftest with-output-to-string.2 +++ (with-output-to-string (s) (write-char #\3 s)) +++ "3") +++ +++(deftest with-output-to-string.3 +++ (with-output-to-string (s (make-array 10 :fill-pointer 0 +++ :element-type 'character))) +++ nil) +++ +++(deftest with-output-to-string.4 +++ :notes (:allow-nil-arrays :nil-vectors-are-strings) +++ (let ((str (make-array 10 :fill-pointer 0 :element-type 'character))) +++ (values +++ (with-output-to-string +++ (s str :element-type nil) +++ (write-string "abcdef" s)) +++ str)) +++ "abcdef" "abcdef") +++ +++(deftest with-output-to-string.5 +++ (with-output-to-string (s (make-array 10 :fill-pointer 0 +++ :element-type 'character)) +++ (values))) +++ +++(deftest with-output-to-string.6 +++ (with-output-to-string (s (make-array 10 :fill-pointer 0 +++ :element-type 'character)) +++ (values 'a 'b 'c 'd)) +++ a b c d) +++ +++(deftest with-output-to-string.7 +++ (with-output-to-string (s nil :element-type 'character) +++ (write-char #\& s)) +++ "&") +++ +++(deftest with-output-to-string.8 +++ (let ((str (with-output-to-string (s nil :element-type 'base-char) +++ (write-char #\8 s)))) +++ (assert (typep str 'simple-base-string)) +++ str) +++ "8") +++ +++(deftest with-output-to-string.9 +++ :notes (:allow-nil-arrays :nil-vectors-are-strings) +++ (with-output-to-string (s nil :element-type nil)) +++ "") +++ +++(deftest with-output-to-string.10 +++ (let* ((s1 (make-array 20 :element-type 'character +++ :initial-element #\.)) +++ (s2 (make-array 10 :element-type 'character +++ :displaced-to s1 +++ :displaced-index-offset 5 +++ :fill-pointer 0))) +++ +++ (values +++ (with-output-to-string +++ (s s2) +++ (write-string "0123456789" s)) +++ s1 +++ s2)) +++ "0123456789" +++ ".....0123456789....." +++ "0123456789") +++ +++(deftest with-output-to-string.11 +++ (with-output-to-string (s) (declare (optimize safety))) +++ "") +++ +++(deftest with-output-to-string.12 +++ (with-output-to-string (s) (declare (optimize safety)) +++ (declare (optimize (speed 0)))) +++ "") +++ +++(deftest with-output-to-string.13 +++ (with-output-to-string +++ (s) +++ (write-char #\0 s) +++ (write-char #\4 s) +++ (write-char #\9 s)) +++ "049") +++ +++(deftest with-output-to-string.14 +++ (let* ((str1 (make-array '(256) :element-type 'base-char :fill-pointer 0)) +++ (str2 (with-output-to-string +++ (s nil :element-type 'base-char) +++ (loop for i below 256 +++ for c = (code-char i) +++ when (typep c 'base-char) +++ do (progn (write-char c s) +++ (vector-push c str1)))))) +++ (if (string= str1 str2) :good +++ (list str1 str2))) +++ :good) +++ +++;;; Free declaration scope +++ +++(deftest with-output-to-string.15 +++ (block done +++ (let ((x :bad)) +++ (declare (special x)) +++ (let ((x :good)) +++ (with-output-to-string (s (return-from done x)) +++ (declare (special x)))))) +++ :good) +++ +++(deftest with-output-to-string.16 +++ (block done +++ (let ((x :bad)) +++ (declare (special x)) +++ (let ((x :good) +++ (str (make-array '(10) :element-type 'character +++ :fill-pointer 0))) +++ (with-output-to-string (s str :element-type (return-from done x)) +++ (declare (special x)))))) +++ :good) +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/write-char.lsp ++@@ -0,0 +1,51 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sun Jan 18 20:50:31 2004 +++;;;; Contains: Tests of WRITE-CHAR +++ +++(in-package :cl-test) +++ +++(deftest write-char.1 +++ (loop for i from 0 to 255 +++ for c = (code-char i) +++ when c +++ unless (string= (with-output-to-string +++ (*standard-output*) +++ (write-char c)) +++ (string c)) +++ collect c) +++ nil) +++ +++(deftest write-char.2 +++ (with-input-from-string +++ (is "abcd") +++ (with-output-to-string +++ (os) +++ (let ((*terminal-io* (make-two-way-stream is os))) +++ (write-char #\$ t) +++ (close *terminal-io*)))) +++ "$") +++ +++(deftest write-char.3 +++ (with-output-to-string +++ (*standard-output*) +++ (write-char #\: nil)) +++ ":") +++ +++;;; Error tests +++ +++(deftest write-char.error.1 +++ (signals-error (write-char) program-error) +++ t) +++ +++(deftest write-char.error.2 +++ (signals-error +++ (with-output-to-string +++ (s) +++ (write-char #\a s nil)) +++ program-error) +++ t) +++ +++;;; More tests in other files +++ +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/write-line.lsp ++@@ -0,0 +1,165 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Mon Jan 19 06:49:26 2004 +++;;;; Contains: Tests of WRITE-LINE +++ +++(in-package :cl-test) +++ +++(deftest write-line.1 +++ (let (result) +++ (values +++ (with-output-to-string +++ (*standard-output*) +++ (setq result (multiple-value-list (write-line "")))) +++ result)) +++ #.(string #\Newline) +++ ("")) +++ +++(deftest write-line.2 +++ :notes (:nil-vectors-are-strings) +++ (let (result) +++ (values +++ (with-output-to-string +++ (*standard-output*) +++ (setq result +++ (multiple-value-list +++ (write-line (make-array '(0) :element-type nil))))) +++ result)) +++ #.(string #\Newline) +++ ("")) +++ +++(deftest write-line.3 +++ (let (result) +++ (values +++ (with-output-to-string +++ (*standard-output*) +++ (setq result (multiple-value-list (write-line "abcde")))) +++ result)) +++ #.(concatenate 'string "abcde" (string #\Newline)) +++ ("abcde")) +++ +++(deftest write-line.4 +++ (let (result) +++ (values +++ (with-output-to-string +++ (s) +++ (setq result (multiple-value-list (write-line "abcde" s :start 1)))) +++ result)) +++ #.(concatenate 'string "bcde" (string #\Newline)) +++ ("abcde")) +++ +++(deftest write-line.5 +++ (let (result) +++ (values +++ (with-output-to-string +++ (s) +++ (setq result (multiple-value-list +++ (write-line "abcde" s :start 1 :end 3)))) +++ result)) +++ #.(concatenate 'string "bc" (string #\Newline)) +++ ("abcde")) +++ +++(deftest write-line.6 +++ (let (result) +++ (values +++ (with-output-to-string +++ (s) +++ (setq result (multiple-value-list +++ (write-line "abcde" s :start 1 :end nil)))) +++ result)) +++ #.(concatenate 'string "bcde" (string #\Newline)) +++ ("abcde")) +++ +++(deftest write-line.7 +++ (let (result) +++ (values +++ (with-output-to-string +++ (s) +++ (setq result (multiple-value-list (write-line "abcde" s :end 3)))) +++ result)) +++ #.(concatenate 'string "abc" (string #\Newline)) +++ ("abcde")) +++ +++(deftest write-line.8 +++ (let (result) +++ (values +++ (with-output-to-string +++ (s) +++ (setq result (multiple-value-list +++ (write-line "abcde" s :end 3 :allow-other-keys nil)))) +++ result)) +++ #.(concatenate 'string "abc" (string #\Newline)) +++ ("abcde")) +++ +++(deftest write-line.9 +++ (let (result) +++ (values +++ (with-output-to-string +++ (s) +++ (setq result +++ (multiple-value-list +++ (write-line "abcde" s :end 3 :allow-other-keys t :foo 'bar)))) +++ result)) +++ #.(concatenate 'string "abc" (string #\Newline)) +++ ("abcde")) +++ +++(deftest write-line.10 +++ (let (result) +++ (values +++ (with-output-to-string +++ (s) +++ (setq result (multiple-value-list +++ (write-line "abcde" s :end 3 :end 2)))) +++ result)) +++ #.(concatenate 'string "abc" (string #\Newline)) +++ ("abcde")) +++ +++(deftest write-line.11 +++ (with-input-from-string +++ (is "abcd") +++ (with-output-to-string +++ (os) +++ (let ((*terminal-io* (make-two-way-stream is os))) +++ (write-line "951" t) +++ (close *terminal-io*)))) +++ #.(concatenate 'string "951" (string #\Newline))) +++ +++(deftest write-line.12 +++ (with-output-to-string +++ (*standard-output*) +++ (write-line "-=|!" nil)) +++ #.(concatenate 'string "-=|!" (string #\Newline))) +++ +++;;; Specialized string tests +++ +++(deftest write-line.13 +++ (do-special-strings +++ (s "abcde" nil) +++ (assert (equal +++ (with-output-to-string +++ (*standard-output*) +++ (multiple-value-list (write-line "abcde"))) +++ #.(concatenate 'string "abcde" (string #\Newline))))) +++ nil) +++ +++;;; Error tests +++ +++(deftest write-line.error.1 +++ (signals-error (write-line) program-error) +++ t) +++ +++(deftest write-line.error.2 +++ (signals-error (write-line "" *standard-output* :start) program-error) +++ t) +++ +++(deftest write-line.error.3 +++ (signals-error (write-line "" *standard-output* :foo nil) program-error) +++ t) +++ +++(deftest write-line.error.4 +++ (signals-error (write-line "" *standard-output* +++ :allow-other-keys nil +++ :foo nil) +++ program-error) +++ t) +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/write-sequence.lsp ++@@ -0,0 +1,225 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Wed Jan 21 04:07:58 2004 +++;;;; Contains: Tests of WRITE-SEQUENCE +++ +++(in-package :cl-test) +++ +++(defmacro def-write-sequence-test (name input args &rest expected) +++ `(deftest ,name +++ (let ((s ,input)) +++ (with-output-to-string +++ (os) +++ (assert (eq (write-sequence s os ,@args) s)))) +++ ,@expected)) +++ +++;;; on strings +++ +++(def-write-sequence-test write-sequence.string.1 "abcde" () "abcde") +++(def-write-sequence-test write-sequence.string.2 "abcde" (:start 1) "bcde") +++(def-write-sequence-test write-sequence.string.3 "abcde" (:end 3) "abc") +++(def-write-sequence-test write-sequence.string.4 "abcde" +++ (:start 1 :end 4) "bcd") +++(def-write-sequence-test write-sequence.string.5 "abcde" (:end nil) "abcde") +++(def-write-sequence-test write-sequence.string.6 "abcde" (:start 3 :end 3) "") +++(def-write-sequence-test write-sequence.string.7 "abcde" +++ (:end nil :start 1) "bcde") +++(def-write-sequence-test write-sequence.string.8 "abcde" +++ (:allow-other-keys nil) "abcde") +++(def-write-sequence-test write-sequence.string.9 "abcde" +++ (:allow-other-keys t :foo nil) "abcde") +++(def-write-sequence-test write-sequence.string.10 "abcde" +++ (:allow-other-keys t :allow-other-keys nil :foo nil) "abcde") +++(def-write-sequence-test write-sequence.string.11 "abcde" +++ (:bar 'x :allow-other-keys t) "abcde") +++(def-write-sequence-test write-sequence.string.12 "abcde" +++ (:start 1 :end 4 :start 2 :end 3) "bcd") +++(def-write-sequence-test write-sequence.string.13 "" () "") +++ +++(defmacro def-write-sequence-special-test (name string args expected) +++ `(deftest ,name +++ (let ((str ,string) +++ (expected ,expected)) +++ (do-special-strings +++ (s str nil) +++ (let ((out (with-output-to-string +++ (os) +++ (assert (eq (write-sequence s os ,@args) s))))) +++ (assert (equal out expected))))) +++ nil)) +++ +++(def-write-sequence-special-test write-sequence.string.14 "12345" () "12345") +++(def-write-sequence-special-test write-sequence.string.15 "12345" (:start 1 :end 3) "23") +++ +++;;; on lists +++ +++(def-write-sequence-test write-sequence.list.1 (coerce "abcde" 'list) +++ () "abcde") +++(def-write-sequence-test write-sequence.list.2 (coerce "abcde" 'list) +++ (:start 1) "bcde") +++(def-write-sequence-test write-sequence.list.3 (coerce "abcde" 'list) +++ (:end 3) "abc") +++(def-write-sequence-test write-sequence.list.4 (coerce "abcde" 'list) +++ (:start 1 :end 4) "bcd") +++(def-write-sequence-test write-sequence.list.5 (coerce "abcde" 'list) +++ (:end nil) "abcde") +++(def-write-sequence-test write-sequence.list.6 (coerce "abcde" 'list) +++ (:start 3 :end 3) "") +++(def-write-sequence-test write-sequence.list.7 (coerce "abcde" 'list) +++ (:end nil :start 1) "bcde") +++(def-write-sequence-test write-sequence.list.8 () () "") +++ +++ +++;;; on vectors +++ +++(def-write-sequence-test write-sequence.simple-vector.1 +++ (coerce "abcde" 'simple-vector) () "abcde") +++(def-write-sequence-test write-sequence.simple-vector.2 +++ (coerce "abcde" 'simple-vector) (:start 1) "bcde") +++(def-write-sequence-test write-sequence.simple-vector.3 +++ (coerce "abcde" 'simple-vector) (:end 3) "abc") +++(def-write-sequence-test write-sequence.simple-vector.4 +++ (coerce "abcde" 'simple-vector) (:start 1 :end 4) "bcd") +++(def-write-sequence-test write-sequence.simple-vector.5 +++ (coerce "abcde" 'simple-vector) (:end nil) "abcde") +++(def-write-sequence-test write-sequence.simple-vector.6 +++ (coerce "abcde" 'simple-vector) (:start 3 :end 3) "") +++(def-write-sequence-test write-sequence.simple-vector.7 +++ (coerce "abcde" 'simple-vector) (:end nil :start 1) "bcde") +++(def-write-sequence-test write-sequence.simple-vector.8 #() () "") +++ +++;;; on vectors with fill pointers +++ +++(def-write-sequence-test write-sequence.fill-vector.1 +++ (make-array 10 :initial-contents "abcde " :fill-pointer 5) () "abcde") +++(def-write-sequence-test write-sequence.fill-vector.2 +++ (make-array 10 :initial-contents "abcde " :fill-pointer 5) +++ (:start 1) "bcde") +++(def-write-sequence-test write-sequence.fill-vector.3 +++ (make-array 10 :initial-contents "abcde " :fill-pointer 5) +++ (:end 3) "abc") +++(def-write-sequence-test write-sequence.fill-vector.4 +++ (make-array 10 :initial-contents "abcde " :fill-pointer 5) +++ (:start 1 :end 4) "bcd") +++(def-write-sequence-test write-sequence.fill-vector.5 +++ (make-array 10 :initial-contents "abcde " :fill-pointer 5) +++ (:end nil) "abcde") +++(def-write-sequence-test write-sequence.fill-vector.6 +++ (make-array 10 :initial-contents "abcde " :fill-pointer 5) +++ (:start 3 :end 3) "") +++(def-write-sequence-test write-sequence.fill-vector.7 +++ (make-array 10 :initial-contents "abcde " :fill-pointer 5) +++ (:end nil :start 1) "bcde") +++ +++;;; on bit vectors +++ +++(defmacro def-write-sequence-bv-test (name input args expected) +++ `(deftest ,name +++ (let ((s ,input) +++ (expected ,expected)) +++ (with-open-file +++ (os "tmp.dat" :direction :output +++ :element-type '(unsigned-byte 8) +++ :if-exists :supersede) +++ (assert (eq (write-sequence s os ,@args) s))) +++ (with-open-file +++ (is "tmp.dat" :direction :input +++ :element-type '(unsigned-byte 8)) +++ (loop for i from 0 below (length expected) +++ for e = (elt expected i) +++ always (eql (read-byte is) e)))) +++ t)) +++ +++(def-write-sequence-bv-test write-sequence.bv.1 #*00111010 +++ () #*00111010) +++(def-write-sequence-bv-test write-sequence.bv.2 #*00111010 +++ (:start 1) #*0111010) +++(def-write-sequence-bv-test write-sequence.bv.3 #*00111010 +++ (:end 5) #*00111) +++(def-write-sequence-bv-test write-sequence.bv.4 #*00111010 +++ (:start 1 :end 6) #*01110) +++(def-write-sequence-bv-test write-sequence.bv.5 #*00111010 +++ (:start 1 :end nil) #*0111010) +++(def-write-sequence-bv-test write-sequence.bv.6 #*00111010 +++ (:start 1 :end nil :end 4) #*0111010) +++ +++ +++;;; Error tests +++ +++(deftest write-sequence.error.1 +++ (signals-error (write-sequence) program-error) +++ t) +++ +++(deftest write-sequence.error.2 +++ (signals-error (write-sequence "abcde") program-error) +++ t) +++ +++(deftest write-sequence.error.3 +++ (signals-error (write-sequence '(#\a . #\b) *standard-output*) type-error) +++ t) +++ +++(deftest write-sequence.error.4 +++ (signals-error (write-sequence #\a *standard-output*) type-error) +++ t) +++ +++(deftest write-sequence.error.5 +++ (signals-error (write-sequence "ABC" *standard-output* :start -1) type-error) +++ t) +++ +++(deftest write-sequence.error.6 +++ (signals-error (write-sequence "ABC" *standard-output* :start 'x) type-error) +++ t) +++ +++(deftest write-sequence.error.7 +++ (signals-error (write-sequence "ABC" *standard-output* :start 0.0) +++ type-error) +++ t) +++ +++(deftest write-sequence.error.8 +++ (signals-error (write-sequence "ABC" *standard-output* :end -1) +++ type-error) +++ t) +++ +++(deftest write-sequence.error.9 +++ (signals-error (write-sequence "ABC" *standard-output* :end 'x) +++ type-error) +++ t) +++ +++(deftest write-sequence.error.10 +++ (signals-error (write-sequence "ABC" *standard-output* :end 2.0) +++ type-error) +++ t) +++ +++(deftest write-sequence.error.11 +++ (signals-error (write-sequence "abcde" *standard-output* +++ :foo nil) program-error) +++ t) +++ +++(deftest write-sequence.error.12 +++ (signals-error (write-sequence "abcde" *standard-output* +++ :allow-other-keys nil :foo t) +++ program-error) +++ t) +++ +++(deftest write-sequence.error.13 +++ (signals-error (write-sequence "abcde" *standard-output* :start) +++ program-error) +++ t) +++ +++(deftest write-sequence.error.14 +++ (check-type-error #'(lambda (x) (write-sequence x *standard-output*)) +++ #'sequencep) +++ nil) +++ +++(deftest write-sequence.error.15 +++ (check-type-error #'(lambda (x) (write-sequence "abcde" *standard-output* +++ :start x)) +++ (typef 'unsigned-byte)) +++ nil) +++ +++(deftest write-sequence.error.16 +++ (check-type-error #'(lambda (x) (write-sequence "abcde" *standard-output* +++ :end x)) +++ (typef '(or null unsigned-byte))) +++ nil) +++ ++--- /dev/null +++++ gcl-2.6.12/ansi-tests/write-string.lsp ++@@ -0,0 +1,156 @@ +++;-*- Mode: Lisp -*- +++;;;; Author: Paul Dietz +++;;;; Created: Sun Jan 18 21:13:32 2004 +++;;;; Contains: Tests of WRITE-STRING +++ +++(in-package :cl-test) +++ +++(deftest write-string.1 +++ (let (result) +++ (values +++ (with-output-to-string +++ (*standard-output*) +++ (setq result (multiple-value-list (write-string "")))) +++ result)) +++ "" ("")) +++ +++(deftest write-string.2 +++ :notes (:nil-vectors-are-strings) +++ (let (result) +++ (values +++ (with-output-to-string +++ (*standard-output*) +++ (setq result +++ (multiple-value-list +++ (write-string (make-array '(0) :element-type nil))))) +++ result)) +++ "" ("")) +++ +++(deftest write-string.3 +++ (let (result) +++ (values +++ (with-output-to-string +++ (*standard-output*) +++ (setq result (multiple-value-list (write-string "abcde")))) +++ result)) +++ "abcde" ("abcde")) +++ +++(deftest write-string.4 +++ (let (result) +++ (values +++ (with-output-to-string +++ (s) +++ (setq result (multiple-value-list (write-string "abcde" s :start 1)))) +++ result)) +++ "bcde" ("abcde")) +++ +++(deftest write-string.5 +++ (let (result) +++ (values +++ (with-output-to-string +++ (s) +++ (setq result (multiple-value-list +++ (write-string "abcde" s :start 1 :end 3)))) +++ result)) +++ "bc" ("abcde")) +++ +++(deftest write-string.6 +++ (let (result) +++ (values +++ (with-output-to-string +++ (s) +++ (setq result (multiple-value-list +++ (write-string "abcde" s :start 1 :end nil)))) +++ result)) +++ "bcde" ("abcde")) +++ +++(deftest write-string.7 +++ (let (result) +++ (values +++ (with-output-to-string +++ (s) +++ (setq result (multiple-value-list (write-string "abcde" s :end 3)))) +++ result)) +++ "abc" ("abcde")) +++ +++(deftest write-string.8 +++ (let (result) +++ (values +++ (with-output-to-string +++ (s) +++ (setq result (multiple-value-list +++ (write-string "abcde" s :end 3 :allow-other-keys nil)))) +++ result)) +++ "abc" ("abcde")) +++ +++(deftest write-string.9 +++ (let (result) +++ (values +++ (with-output-to-string +++ (s) +++ (setq result +++ (multiple-value-list +++ (write-string "abcde" s :end 3 :allow-other-keys t :foo 'bar)))) +++ result)) +++ "abc" ("abcde")) +++ +++(deftest write-string.10 +++ (let (result) +++ (values +++ (with-output-to-string +++ (s) +++ (setq result (multiple-value-list +++ (write-string "abcde" s :end 3 :end 2)))) +++ result)) +++ "abc" ("abcde")) +++ +++(deftest write-string.11 +++ (with-input-from-string +++ (is "abcd") +++ (with-output-to-string +++ (os) +++ (let ((*terminal-io* (make-two-way-stream is os))) +++ (write-string "951" t) +++ (close *terminal-io*)))) +++ "951") +++ +++(deftest write-string.12 +++ (with-output-to-string +++ (*standard-output*) +++ (write-string "-=|!" nil)) +++ "-=|!") +++ +++;;; Specialized string tests +++ +++(deftest write-string.13 +++ (let (result) +++ (do-special-strings +++ (s "abcde" nil) +++ (assert (equal +++ (with-output-to-string +++ (*standard-output*) +++ (setq result (multiple-value-list (write-string "abcde")))) +++ "abcde")) +++ (assert (equal result '("abcde"))))) +++ nil) +++ +++;;; Error tests +++ +++(deftest write-string.error.1 +++ (signals-error (write-string) program-error) +++ t) +++ +++(deftest write-string.error.2 +++ (signals-error (write-string "" *standard-output* :start) program-error) +++ t) +++ +++(deftest write-string.error.3 +++ (signals-error (write-string "" *standard-output* :foo nil) program-error) +++ t) +++ +++(deftest write-string.error.4 +++ (signals-error (write-string "" *standard-output* +++ :allow-other-keys nil +++ :foo nil) +++ program-error) +++ t) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpfun.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpfun.lsp ++@@ -556,6 +556,14 @@ ++ ((null type) nil) ++ ((setq f (assoc type *type-alist* :test 'equal)) ++ (list (cdr f) x)) +++ ((setq f (when (symbolp type) (get type 'si::type-predicate))) +++ (list f x)) +++ ((and (consp type) (eq (car type) 'or)) +++ `(or ,@(mapcar (lambda (y) `(typep ,x ',y)) (cdr type)))) +++ ((and (consp type) (eq (car type) 'member)) +++ `(or ,@(mapcar (lambda (y) `(eql ,x ',y)) (cdr type)))) +++ ((and (consp type) (eq (car type) 'eql)) +++ `(eql ,x ',(cadr type))) ++ ((and (consp type) ++ (or (and (eq (car type) 'vector) ++ (null (cddr type))) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmplabel.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmplabel.lsp ++@@ -44,7 +44,7 @@ ++ `(when (cdr ,label) (wt-nl "goto T" (car ,label) ";")(wt-nl1 "T" (car ,label) ":;"))) ++ ++ (defmacro wt-go (label) ++- `(progn (rplacd ,label t) (wt "goto T" (car ,label) ";"))) +++ `(progn (rplacd ,label t) (wt "goto T" (car ,label) ";")(wt-nl))) ++ ++ ++ (defvar *restore-avma* nil) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmplam.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmplam.lsp ++@@ -407,6 +407,12 @@ ++ (c2lambda-expr-without-key lambda-list body))) ++ )) ++ +++(defun decl-body-safety (body) +++ (case (car body) +++ (decl-body (or (cadr (assoc 'safety (caddr body))) 0)) +++ ((let let*) (decl-body-safety (car (last body)))) +++ (otherwise 0))) +++ ++ (defun c2lambda-expr-without-key ++ (lambda-list body ++ &aux (requireds (car lambda-list)) ++@@ -439,7 +445,7 @@ ++ (when rest (do-decl rest)) ++ ) ++ ;;; check arguments ++- (when (or *safe-compile* *compiler-check-args*) +++ (when (or *safe-compile* *compiler-check-args* (plusp (decl-body-safety body)));FIXME ++ (cond ((or rest optionals) ++ (when requireds ++ (wt-nl "if(vs_top-vs_base<" (length requireds) ++@@ -448,7 +454,7 @@ ++ (wt-nl "if(vs_top-vs_base>" ++ (+ (length requireds) (length optionals)) ++ ") too_many_arguments();"))) ++- (t (wt-nl "check_arg(" (length requireds) ");")))) +++ (t (when requireds (wt-nl "check_arg(" (length requireds) ");"))))) ++ ++ ;;; Allocate the parameters. ++ (dolist** (var requireds) (setf (var-ref var) (vs-push))) ++@@ -562,7 +568,7 @@ ++ (when (cadddr kwd) (do-decl (cadddr kwd)))) ++ ) ++ ;;; Check arguments. ++- (when (and (or *safe-compile* *compiler-check-args*) requireds) +++ (when (and (or *safe-compile* *compiler-check-args* (plusp (decl-body-safety body))) requireds);FIXME ++ (when requireds ++ (wt-nl "if(vs_top-vs_base<" (length requireds) ++ ") too_few_arguments();"))) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp ++@@ -52,7 +52,7 @@ ++ (defvar *cmpinclude-string* ++ (si::file-to-string ++ (namestring ++- (make-pathname :directory (append (pathname-directory si::*system-directory*) (list :parent "h")) +++ (make-pathname :directory (append (pathname-directory si::*system-directory*) (list :back "h")) ++ :name "cmpinclude" :type "h")))) ++ ++ ++@@ -160,7 +160,7 @@ ++ ++ ++ (defun compile-file1 (input-pathname ++- &key (output-file (truename input-pathname)) +++ &key (output-file (merge-pathnames ".o" (truename input-pathname))) ++ (o-file t) ++ (c-file *default-c-file*) ++ (h-file *default-h-file*) ++@@ -175,7 +175,7 @@ ++ (*c-debug* c-debug) ++ (*compile-print* (or print *compile-print*)) ++ (*package* *package*) ++- (*DEFAULT-PATHNAME-DEFAULTS* #"") +++ (*DEFAULT-PATHNAME-DEFAULTS* #p"") ++ (*data* (list (make-array 50 :fill-pointer 0 :adjustable t) nil nil)) ++ *init-name* ++ (*fasd-data* *fasd-data*) ++@@ -186,25 +186,25 @@ ++ (cond (*compiler-in-use* ++ (format t "~&The compiler was called recursively.~%~ ++ Cannot compile ~a.~%" ++- (namestring (merge-pathnames input-pathname #".lsp"))) +++ (namestring (merge-pathnames input-pathname #p".lsp"))) ++ (setq *error-p* t) ++ (return-from compile-file1 (values))) ++ (t (setq *error-p* nil) ++ (setq *compiler-in-use* t))) ++ ++- (unless (probe-file (merge-pathnames input-pathname #".lsp")) +++ (unless (probe-file (merge-pathnames input-pathname #p".lsp")) ++ (format t "~&The source file ~a is not found.~%" ++- (namestring (merge-pathnames input-pathname #".lsp"))) +++ (namestring (merge-pathnames input-pathname #p".lsp"))) ++ (setq *error-p* t) ++ (return-from compile-file1 (values))) ++ ++ (when *compile-verbose* ++- (format t "~&Compiling ~a.~%" (namestring (merge-pathnames input-pathname #".lsp")))) +++ (format t "~&Compiling ~a.~%" (namestring (merge-pathnames input-pathname #p".lsp")))) ++ ++ (and *record-call-info* (clear-call-table)) ++ ++ (with-open-file ++- (*compiler-input* (merge-pathnames input-pathname #".lsp")) +++ (*compiler-input* (merge-pathnames input-pathname #p".lsp")) ++ ++ ++ (cond ((numberp *split-files*) ++@@ -232,8 +232,11 @@ Cannot compile ~a.~%" ++ (device (or (and (not (null output-file)) ++ (pathname-device output-file)) ++ (pathname-device input-pathname))) +++ (typ (or (and (not (null output-file)) +++ (pathname-type output-file)) +++ "o")) ++ ++- (o-pathname (get-output-pathname o-file "o" name dir device)) +++ (o-pathname (get-output-pathname o-file typ name dir device)) ++ (c-pathname (get-output-pathname c-file "c" name dir device)) ++ (h-pathname (get-output-pathname h-file "h" name dir device)) ++ (data-pathname (get-output-pathname data-file "data" name dir device))) ++@@ -351,7 +354,7 @@ Cannot compile ~a.~%" ++ (wt-data1 form) ;; this binds all the print stuff ++ )) ++ ++-(defun compile (name &optional def &aux tem gaz (*default-pathname-defaults* #".")) +++(defun compile (name &optional def &aux tem gaz (*default-pathname-defaults* #p".")) ++ ++ (cond ((not(symbolp name)) (error "Must be a name")) ++ ((and (consp def) ++@@ -797,7 +800,7 @@ Cannot compile ~a.~%" ++ ++ (with-open-file (st (namestring map) :direction :output)) ++ (safe-system ++- (let* ((par (namestring (make-pathname :directory '(:parent)))) +++ (let* ((par (namestring (make-pathname :directory '(:back)))) ++ (i (concatenate 'string " " par)) ++ (j (concatenate 'string " " si::*system-directory* par))) ++ (format nil "~a ~a ~a ~a -L~a ~a ~a ~a" ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpopt.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpopt.lsp ++@@ -1170,6 +1170,14 @@ type_of(#0)==t_complex") ++ (push '((t) t #.(flags ans)"coerce_to_string(#0)") ++ (get 'string 'inline-always)) ++ +++;;PATHNAME-DESIGNATORP +++(push '((t) boolean #.(flags)"pathname_designatorp(#0)") +++ (get 'si::pathname-designatorp 'inline-always)) +++ +++;;PATHNAMEP +++(push '((t) boolean #.(flags)"pathnamep(#0)") +++ (get 'pathnamep 'inline-always)) +++ ++ ;;STRINGP ++ (push '((t) boolean #.(flags)"type_of(#0)==t_string") ++ (get 'stringp 'inline-always)) ++--- gcl-2.6.12.orig/cmpnew/gcl_cmptop.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmptop.lsp ++@@ -209,7 +209,7 @@ ++ ++ (cond ((not sp) "code") ++ ((not (pathnamep p)) (init-name (pathname p) sp gp dc nt)) ++- (gp (init-name (truename (merge-pathnames p #".lsp")) sp nil dc nt)) +++ (gp (init-name (truename (merge-pathnames p #p".lsp")) sp nil dc nt)) ++ ((pathname-type p) ++ (init-name (make-pathname ++ :host (pathname-host p) ++--- gcl-2.6.12.orig/cmpnew/gcl_collectfn.lsp +++++ gcl-2.6.12/cmpnew/gcl_collectfn.lsp ++@@ -240,22 +240,20 @@ ++ ++ (defvar *warn-on-multiple-fn-definitions* t) ++ ++-(defun add-fn-data (lis &aux tem file) ++- (let ((file (and (setq file (si::fp-input-stream *standard-input*)) ++- (truename file)))) +++(defun add-fn-data (lis &aux tem (file *load-truename*)) ++ (dolist (v lis) ++- (cond ((eql (fn-name v) 'other-form) ++- (setf (fn-name v) (intern ++- (concatenate 'string "OTHER-FORM-" ++- (namestring file)))) ++- (setf (get (fn-name v) 'other-form) t))) ++- (setf (gethash (fn-name v) *call-table*) v) ++- (when *warn-on-multiple-fn-definitions* ++- (when (setq tem (gethash (fn-name v) *file-table*)) ++- (unless (equal tem file) ++- (warn 'simple-warning :format-control "~% ~a redefined in ~a. Originally in ~a." ++- :format-arguments (list (fn-name v) file tem))))) ++- (setf (gethash (fn-name v) *file-table*) file)))) +++ (cond ((eql (fn-name v) 'other-form) +++ (setf (fn-name v) (intern +++ (concatenate 'string "OTHER-FORM-" +++ (namestring file)))) +++ (setf (get (fn-name v) 'other-form) t))) +++ (setf (gethash (fn-name v) *call-table*) v) +++ (when *warn-on-multiple-fn-definitions* +++ (when (setq tem (gethash (fn-name v) *file-table*)) +++ (unless (equal tem file) +++ (warn 'simple-warning :format-control "~% ~a redefined in ~a. Originally in ~a." +++ :format-arguments (list (fn-name v) file tem))))) +++ (setf (gethash (fn-name v) *file-table*) file))) ++ ++ (defun dump-fn-data (&optional (file "fn-data.lsp") ++ &aux (*package* (find-package "COMPILER")) ++--- gcl-2.6.12.orig/cmpnew/gcl_lfun_list.lsp +++++ gcl-2.6.12/cmpnew/gcl_lfun_list.lsp ++@@ -20,7 +20,6 @@ ++ (DEFSYSFUN 'CHAR-NAME "Lchar_name" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'RASSOC-IF "Lrassoc_if" '(T T) 'T NIL NIL) ++ (DEFSYSFUN 'MAKE-LIST "Lmake_list" '(T *) 'T NIL NIL) ++-(DEFSYSFUN 'HOST-NAMESTRING "Lhost_namestring" '(T) 'STRING NIL NIL) ++ (DEFSYSFUN 'MAKE-ECHO-STREAM "Lmake_echo_stream" '(T T) 'T NIL NIL) ++ ;(DEFSYSFUN 'NTH "Lnth" '(T T) 'T NIL NIL) ++ (DEFSYSFUN 'SIN "Lsin" '(T) 'T NIL NIL) ++@@ -31,8 +30,6 @@ ++ ;#-clcs (DEFSYSFUN 'OPEN "Lopen" '(T *) 'T NIL NIL) ++ (DEFSYSFUN 'BOTH-CASE-P "Lboth_case_p" '(T) 'T NIL T) ++ (DEFSYSFUN 'NULL "Lnull" '(T) 'T NIL T) ++-(DEFSYSFUN 'RENAME-FILE "Lrename_file" '(T T) 'T NIL NIL) ++-(DEFSYSFUN 'FILE-AUTHOR "Lfile_author" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'STRING-CAPITALIZE "Lstring_capitalize" '(T *) 'STRING NIL ++ NIL) ++ (DEFSYSFUN 'MACROEXPAND "Lmacroexpand" '(T *) '(VALUES T T) NIL NIL) ++@@ -45,7 +42,6 @@ ++ (DEFSYSFUN 'LENGTH "Llength" '(T) 'FIXNUM T NIL) ++ (DEFSYSFUN 'RASSOC "Lrassoc" '(T T *) 'T NIL NIL) ++ (DEFSYSFUN 'PPRINT "Lpprint" '(T *) 'T NIL NIL) ++-(DEFSYSFUN 'PATHNAME-HOST "Lpathname_host" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'NSUBST-IF-NOT "Lnsubst_if_not" '(T T T *) 'T NIL NIL) ++ (DEFSYSFUN 'FILE-POSITION "Lfile_position" '(T *) 'T NIL NIL) ++ (DEFSYSFUN 'STRING< "Lstring_l" '(T T *) 'T NIL NIL) ++@@ -58,14 +54,11 @@ ++ (DEFSYSFUN 'STRING>= "Lstring_ge" '(T T *) 'T NIL NIL) ++ (DEFSYSFUN 'REALPART "Lrealpart" '(T) 'T NIL NIL) ++ ;;broken on suns.. ++-;(DEFSYSFUN 'USER-HOMEDIR-PATHNAME "Luser_homedir_pathname" '(*) 'T NIL ++-; NIL) ++ (DEFSYSFUN 'NBUTLAST "Lnbutlast" '(T *) 'T NIL NIL) ++ (DEFSYSFUN 'ARRAY-DIMENSION "Larray_dimension" '(T T) 'FIXNUM NIL NIL) ++ (DEFSYSFUN 'CDR "Lcdr" '(T) 'T NIL NIL) ++ ;(DEFSYSFUN 'EQL "Leql" '(T T) 'T NIL T) ++ (DEFSYSFUN 'LOG "Llog" '(T *) 'T NIL NIL) ++-(DEFSYSFUN 'DIRECTORY "Ldirectory" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'STRING-NOT-EQUAL "Lstring_not_equal" '(T T *) 'T NIL NIL) ++ (DEFSYSFUN 'SHADOWING-IMPORT "Lshadowing_import" '(T *) 'T NIL NIL) ++ (DEFSYSFUN 'MAPC "Lmapc" '(T T *) 'T NIL NIL) ++@@ -78,8 +71,6 @@ ++ (DEFSYSFUN 'MAKE-SYMBOL "Lmake_symbol" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'STRING-RIGHT-TRIM "Lstring_right_trim" '(T T) 'STRING NIL ++ NIL) ++-(DEFSYSFUN 'ENOUGH-NAMESTRING "Lenough_namestring" '(T *) 'STRING NIL ++- NIL) ++ (DEFSYSFUN 'PRINT "Lprint" '(T *) 'T NIL NIL) ++ (DEFSYSFUN 'CDDAAR "Lcddaar" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'CDADAR "Lcdadar" '(T) 'T NIL NIL) ++@@ -187,7 +178,6 @@ ++ NIL) ++ (DEFSYSFUN 'COPY-ALIST "Lcopy_alist" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'ATAN "Latan" '(T *) 'T NIL NIL) ++-(DEFSYSFUN 'DELETE-FILE "Ldelete_file" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'FLOAT-RADIX "Lfloat_radix" '(T) 'FIXNUM NIL NIL) ++ (DEFSYSFUN 'SYMBOL-NAME "Lsymbol_name" '(T) 'STRING NIL NIL) ++ (DEFSYSFUN 'CLEAR-INPUT "Lclear_input" '(*) 'T NIL NIL) ++@@ -215,8 +205,6 @@ ++ (DEFSYSFUN 'SXHASH "Lsxhash" '(T) 'FIXNUM NIL NIL) ++ (DEFSYSFUN 'LISTEN "Llisten" '(*) 'T NIL NIL) ++ (DEFSYSFUN 'ARRAYP "Larrayp" '(T) 'T NIL T) ++-(DEFSYSFUN 'MAKE-PATHNAME "Lmake_pathname" '(*) 'T NIL NIL) ++-(DEFSYSFUN 'PATHNAME-TYPE "Lpathname_type" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'FUNCALL "Lfuncall" '(T *) 'T NIL NIL) ++ (DEFSYSFUN 'CLRHASH "Lclrhash" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'GRAPHIC-CHAR-P "Lgraphic_char_p" '(T) 'T NIL T) ++@@ -227,14 +215,12 @@ ++ (DEFSYSFUN 'SUBST-IF "Lsubst_if" '(T T T *) 'T NIL NIL) ++ (DEFSYSFUN 'COMPLEXP "Lcomplexp" '(T) 'T NIL T) ++ (DEFSYSFUN 'READ-LINE "Lread_line" '(*) '(VALUES T T) NIL NIL) ++-(DEFSYSFUN 'PATHNAMEP "Lpathnamep" '(T) 'T NIL T) ++ (DEFSYSFUN 'MAX "Lmax" '(T *) 'T NIL NIL) ++ (DEFSYSFUN 'IN-PACKAGE "Lin_package" '(T *) 'T NIL NIL) ++ (DEFSYSFUN 'READTABLEP "Lreadtablep" '(T) 'T NIL T) ++ (DEFSYSFUN 'FLOAT-SIGN "Lfloat_sign" '(T *) 'T NIL NIL) ++ (DEFSYSFUN 'CHARACTERP "Lcharacterp" '(T) 'T NIL T) ++ (DEFSYSFUN 'READ "Lread" '(*) 'T NIL NIL) ++-(DEFSYSFUN 'NAMESTRING "Lnamestring" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'UNREAD-CHAR "Lunread_char" '(T *) 'T NIL NIL) ++ (DEFSYSFUN 'CDAAR "Lcdaar" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'CADAR "Lcadar" '(T) 'T NIL NIL) ++@@ -267,10 +253,8 @@ ++ (DEFSYSFUN 'PACKAGEP "Lpackagep" '(T) 'T NIL T) ++ (DEFSYSFUN 'INPUT-STREAM-P "Linput_stream_p" '(T) 'T NIL T) ++ (DEFSYSFUN '>= "Lmonotonically_nonincreasing" '(T *) 'T NIL T) ++-(DEFSYSFUN 'PATHNAME "Lpathname" '(T) 'T NIL NIL) ++ ;(DEFSYSFUN 'EQ "Leq" '(T T) 'T NIL T) ++ (DEFSYSFUN 'MAKE-CHAR "Lmake_char" '(T *) 'CHARACTER NIL NIL) ++-(DEFSYSFUN 'FILE-NAMESTRING "Lfile_namestring" '(T) 'STRING NIL NIL) ++ (DEFSYSFUN 'CHARACTER "Lcharacter" '(T) 'CHARACTER NIL NIL) ++ (DEFSYSFUN 'SYMBOL-FUNCTION "Lsymbol_function" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'CONSTANTP "Lconstantp" '(T) 'T NIL T) ++@@ -307,13 +291,9 @@ ++ (DEFSYSFUN 'NUMBERP "Lnumberp" '(T) 'T NIL T) ++ (DEFSYSFUN 'COPY-READTABLE "Lcopy_readtable" '(*) 'T NIL NIL) ++ (DEFSYSFUN 'RANDOM-STATE-P "Lrandom_state_p" '(T) 'T NIL T) ++-(DEFSYSFUN 'DIRECTORY-NAMESTRING "Ldirectory_namestring" '(T) 'STRING ++- NIL NIL) ++ (DEFSYSFUN 'STANDARD-CHAR-P "Lstandard_char_p" '(T) 'T NIL T) ++-(DEFSYSFUN 'TRUENAME "Ltruename" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'IDENTITY "Lidentity" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'NREVERSE "Lnreverse" '(T) 'T NIL NIL) ++-(DEFSYSFUN 'PATHNAME-DEVICE "Lpathname_device" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'UNINTERN "Lunintern" '(T *) 'T NIL NIL) ++ (DEFSYSFUN 'UNEXPORT "Lunexport" '(T *) 'T NIL NIL) ++ (DEFSYSFUN 'FLOAT-PRECISION "Lfloat_precision" '(T) 'FIXNUM NIL NIL) ++@@ -324,7 +304,7 @@ ++ (DEFSYSFUN 'READ-CHAR-NO-HANG "Lread_char_no_hang" '(*) 'T NIL NIL) ++ (DEFSYSFUN 'FRESH-LINE "Lfresh_line" '(*) 'T NIL NIL) ++ (DEFSYSFUN 'WRITE-CHAR "Lwrite_char" '(T *) 'T NIL NIL) ++-(DEFSYSFUN 'PARSE-NAMESTRING "Lparse_namestring" '(T *) 'T NIL NIL) +++;(DEFSYSFUN 'PARSE-NAMESTRING "Lparse_namestring" '(T *) 'T NIL NIL) ++ (DEFSYSFUN 'STRING-NOT-LESSP "Lstring_not_lessp" '(T T *) 'T NIL NIL) ++ (DEFSYSFUN 'CHAR "Lchar" '(T T) 'CHARACTER NIL NIL) ++ (DEFSYSFUN 'AREF "Laref" '(T *) 'T NIL NIL) ++@@ -338,7 +318,6 @@ ++ (DEFSYSFUN 'DIGIT-CHAR-P "Ldigit_char_p" '(T *) 'T NIL NIL) ++ ;; #-clcs (DEFSYSFUN 'ERROR "Lerror" '(T *) 'T NIL NIL) ++ (DEFSYSFUN 'CHAR/= "Lchar_neq" '(T *) 'T NIL T) ++-(DEFSYSFUN 'PATHNAME-DIRECTORY "Lpathname_directory" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'CDAAAR "Lcdaaar" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'CADAAR "Lcadaar" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'CAADAR "Lcaadar" '(T) 'T NIL NIL) ++@@ -349,7 +328,6 @@ ++ (DEFSYSFUN 'FORMAT "Lformat" '(T T *) 'T NIL NIL) ++ (DEFSYSFUN 'COMPILED-FUNCTION-P "Lcompiled_function_p" '(T) 'T NIL T) ++ (DEFSYSFUN 'SUBLIS "Lsublis" '(T T *) 'T NIL NIL) ++-(DEFSYSFUN 'PATHNAME-NAME "Lpathname_name" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'IMPORT "Limport" '(T *) 'T NIL NIL) ++ (DEFSYSFUN 'LOGXOR "Llogxor" '(*) 'T NIL NIL) ++ (DEFSYSFUN 'RASSOC-IF-NOT "Lrassoc_if_not" '(T T) 'T NIL NIL) ++@@ -366,9 +344,7 @@ ++ (DEFSYSFUN 'GET-PROPERTIES "Lget_properties" '(T T) '* NIL NIL) ++ (DEFSYSFUN 'STRING<= "Lstring_le" '(T T *) 'T NIL NIL) ++ (DEFSYSFUN 'EVALHOOK "siLevalhook" '(T T T *) 'T NIL NIL) ++-(DEFSYSFUN 'FILE-WRITE-DATE "Lfile_write_date" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'LOGCOUNT "Llogcount" '(T) 'T NIL NIL) ++-(DEFSYSFUN 'MERGE-PATHNAMES "Lmerge_pathnames" '(T *) 'T NIL NIL) ++ (DEFSYSFUN 'MEMBER-IF "Lmember_if" '(T T *) 'T NIL NIL) ++ (DEFSYSFUN 'READ-BYTE "Lread_byte" '(T *) 'T NIL NIL) ++ (DEFSYSFUN 'SIMPLE-VECTOR-P "Lsimple_vector_p" '(T) 'T NIL T) ++@@ -381,10 +357,8 @@ ++ (DEFSYSFUN 'GET "Lget" '(T T *) 'T NIL NIL) ++ (DEFSYSFUN 'MOD "Lmod" '(T T) 'T NIL NIL) ++ (DEFSYSFUN 'DIGIT-CHAR "Ldigit_char" '(T *) 'CHARACTER NIL NIL) ++-(DEFSYSFUN 'PROBE-FILE "Lprobe_file" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'STRING-LEFT-TRIM "Lstring_left_trim" '(T T) 'STRING NIL ++ NIL) ++-(DEFSYSFUN 'PATHNAME-VERSION "Lpathname_version" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'WRITE-LINE "Lwrite_line" '(T *) 'T NIL NIL) ++ (DEFSYSFUN 'EVAL "Leval" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'ATOM "Latom" '(T) 'T NIL T) ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -4183,7 +4183,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu ++ #fi ++ # subst GCC not only under 386-linux, but where available -- CM ++ ++-TCFLAGS="-fsigned-char" +++TCFLAGS="-fsigned-char -fno-builtin-malloc -fno-builtin-free" ++ ++ if test "$GCC" = "yes" ; then ++ ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -483,7 +483,7 @@ AC_SUBST(CC) ++ #fi ++ # subst GCC not only under 386-linux, but where available -- CM ++ ++-TCFLAGS="-fsigned-char" +++TCFLAGS="-fsigned-char -fno-builtin-malloc -fno-builtin-free" ++ ++ if test "$GCC" = "yes" ; then ++ ++--- gcl-2.6.12.orig/h/att_ext.h +++++ gcl-2.6.12/h/att_ext.h ++@@ -116,25 +116,14 @@ float object_to_float(); ++ double object_to_double(); ++ ++ /* error.c */ ++-EXTER object sKerror; ++-EXTER object sKwrong_type_argument; ++ EXTER object sKcatch; ++ EXTER object sKprotect; ++ EXTER object sKcatchall; ++-EXTER object sKtoo_few_arguments; ++-EXTER object sKtoo_many_arguments; ++-EXTER object sKunexpected_keyword; ++-EXTER object sKinvalid_form; ++-EXTER object sKunbound_variable; ++-EXTER object sKinvalid_variable; ++-EXTER object sKundefined_function; ++-EXTER object sKinvalid_function; ++ EXTER object sKdatum; ++ EXTER object sKexpected_type; ++ EXTER object sKpackage; ++ EXTER object sKformat_control; ++ EXTER object sKformat_arguments; ++-EXTER object sKpackage_error; ++ object wrong_type_argument(); ++ EXTER object sSuniversal_error_handler; ++ ++@@ -394,10 +383,11 @@ EXTER object sKname; ++ EXTER object sKtype; ++ EXTER object sKversion; ++ EXTER object sKdefaults; ++-EXTER object sKroot; ++-EXTER object sKcurrent; ++-EXTER object sKparent; ++-EXTER object sKper; +++ +++EXTER object sKabsolute; +++EXTER object sKrelative; +++EXTER object sKup; +++ ++ /* object parse_namestring(); */ ++ object coerce_to_pathname(); ++ /* object default_device(); */ ++--- gcl-2.6.12.orig/h/compdefs.h +++++ gcl-2.6.12/h/compdefs.h ++@@ -115,3 +115,5 @@ SIGNED_CHAR(x) ++ FEerror(x,y...) ++ FEwrong_type_argument(x,y) ++ BIT_ENDIAN(x) +++pathname_designatorp(x) +++pathnamep(x) ++--- gcl-2.6.12.orig/h/error.h +++++ gcl-2.6.12/h/error.h ++@@ -22,6 +22,7 @@ PFN(numberp) ++ PFN(characterp) ++ PFN(symbolp) ++ PFN(stringp) +++PFN(pathnamep) ++ PFN(string_symbolp) ++ PFN(packagep) ++ PFN(consp) ++@@ -52,6 +53,7 @@ PFN(functionp) ++ #define check_type_character(a_) TPE(a_,characterp_fn,sLcharacter) ++ #define check_type_sym(a_) TPE(a_,symbolp_fn,sLsymbol) ++ #define check_type_string(a_) TPE(a_,stringp_fn,sLstring) +++#define check_type_pathname(a_) TPE(a_,pathnamep_fn,sLpathname) ++ #define check_type_or_string_symbol(a_) TPE(a_,string_symbolp_fn,TSor_symbol_string) ++ #define check_type_or_symbol_string(a_) TPE(a_,string_symbolp_fn,TSor_symbol_string) ++ #define check_type_or_pathname_string_symbol_stream(a_) TPE(a_,pathname_string_symbol_streamp_fn,TSor_pathname_string_symbol_stream) ++@@ -79,12 +81,6 @@ PFN(functionp) ++ set_type_of((a_),t_fixnum);\ ++ (a_)->FIX.FIXVAL=(b_);} ++ ++-/*FIXME the stack stuff is dangerous It works for error handling, but ++- simple errors may evan pass the format tring up the stack as a slot ++- in ansi*/ ++-/* #define TYPE_ERROR(a_,b_) {stack_string(tp_err,"~S is not of type ~S.");\ */ ++-/* Icall_error_handler(sKwrong_type_argument,tp_err,2,(a_),(b_));} */ ++- ++ object ihs_top_function_name(ihs_ptr h); ++ #define FEerror(a_,b_...) Icall_error_handler(sLerror,null_string,\ ++ 4,sKformat_control,make_simple_string(a_),sKformat_arguments,list(b_)) ++--- gcl-2.6.12.orig/h/lu.h +++++ gcl-2.6.12/h/lu.h ++@@ -301,7 +301,7 @@ struct pathname { ++ object pn_name; ++ object pn_type; ++ object pn_version; ++- SPAD; +++ object pn_namestring; ++ }; ++ ++ struct cfun { ++--- gcl-2.6.12.orig/h/notcomp.h +++++ gcl-2.6.12/h/notcomp.h ++@@ -47,12 +47,6 @@ EXTER object user_package; ++ else *__p++ = va_arg(ap,object);} \ ++ va_end(ap) ++ ++-/* #undef endp */ ++- ++-/* #define endp(obje) ((enum type)((endp_temp = (obje))->d.t) == t_cons ? \ */ ++-/* FALSE : endp_temp == Cnil ? TRUE : \ */ ++-/* endp1(endp_temp)) */ ++- ++ #ifndef NO_DEFUN ++ #undef DEFUN ++ #define DEFUN(string,ret,fname,pack,min,max, flags, ret0a0,a12,a34,a56,doc) ret fname ++@@ -234,7 +228,7 @@ EXTER bool left_trim; ++ EXTER bool right_trim; ++ int (*casefun)(); ++ ++-#define Q_SIZE 128 +++#define Q_SIZE 256 ++ #define IS_SIZE 256 ++ ++ struct printStruct { ++@@ -300,6 +294,8 @@ gcl_init_cmp_anon(void); ++ ++ #include "gmp_wrappers.h" ++ +++char FN1[PATH_MAX],FN2[PATH_MAX],FN3[PATH_MAX],FN4[PATH_MAX],FN5[PATH_MAX]; +++ ++ #include ++ #define massert(a_) ({errno=0;if (!(a_)||errno) assert_error(#a_,__LINE__,__FILE__,__FUNCTION__);}) ++ ++--- gcl-2.6.12.orig/h/object.h +++++ gcl-2.6.12/h/object.h ++@@ -163,24 +163,6 @@ enum aelttype { /* array element type ++ #define STREF(type,x,i) (*((type *)(((char *)((x)->str.str_self))+(i)))) ++ #define STSET(type,x,i,val) do{SGC_TOUCH(x);STREF(type,x,i) = (val);} while(0) ++ ++- ++- ++-enum smmode { /* stream mode */ ++- smm_input, /* input */ ++- smm_output, /* output */ ++- smm_io, /* input-output */ ++- smm_probe, /* probe */ ++- smm_synonym, /* synonym */ ++- smm_broadcast, /* broadcast */ ++- smm_concatenated, /* concatenated */ ++- smm_two_way, /* two way */ ++- smm_echo, /* echo */ ++- smm_string_input, /* string input */ ++- smm_string_output, /* string output */ ++- smm_user_defined, /* for user defined */ ++- smm_socket /* Socket stream */ ++-}; ++- ++ /* for any stream that takes writec_char, directly (not two_way or echo) ++ ie. smm_output,smm_io, smm_string_output, smm_socket ++ */ ++@@ -217,9 +199,9 @@ enum gcl_sm_flags { ++ gcl_sm_tcp_async, ++ gcl_sm_input, ++ gcl_sm_output, +++ gcl_sm_closed, ++ gcl_sm_had_error ++ ++- ++ }; ++ ++ enum chattrib { /* character attribute */ ++@@ -496,8 +478,11 @@ object make_si_sfun(); ++ Used by the C function to set optionals */ ++ ++ #define VFUN_NARGS fcall.argd +++#define RETURN4(x,y,z,w) do{/* object _x = (void *) x; */ \ +++ fcall.values[1]=y;fcall.values[2]=z;fcall.values[3]=w;fcall.nvalues=4; \ +++ return (x) ;} while(0) ++ #define RETURN2(x,y) do{/* object _x = (void *) x; */\ ++- fcall.values[2]=y;fcall.nvalues=2; \ +++ fcall.values[1]=y;fcall.nvalues=2; \ ++ return (x) ;} while(0) ++ #define RETURN1(x) do{fcall.nvalues=1; return (x) ;} while(0) ++ #define RETURN0 do{fcall.nvalues=0; return Cnil ;} while(0) ++--- gcl-2.6.12.orig/h/protoize.h +++++ gcl-2.6.12/h/protoize.h ++@@ -88,7 +88,7 @@ ++ /* big.c:85:OF */ extern void zero_big (object x); /* (x) object x; */ ++ /* bind.c:74:OF */ extern void lambda_bind (object *arg_top); /* (arg_top) object *arg_top; */ ++ /* bind.c:564:OF */ extern void bind_var (object var, object val, object spp); /* (var, val, spp) object var; object val; object spp; */ ++-/* bind.c:610:OF */ extern object find_special (object body, struct bind_temp *start, struct bind_temp *end); /* (body, start, end) object body; struct bind_temp *start; struct bind_temp *end; */ +++/* bind.c:610:OF */ extern object find_special (object body, struct bind_temp *start, struct bind_temp *end,object *s); /* (body, start, end) object body; struct bind_temp *start; struct bind_temp *end; */ ++ /* bind.c:670:OF */ extern object let_bind (object body, struct bind_temp *start, struct bind_temp *end); /* (body, start, end) object body; struct bind_temp *start; struct bind_temp *end; */ ++ /* bind.c:688:OF */ extern object letA_bind (object body, struct bind_temp *start, struct bind_temp *end); /* (body, start, end) object body; struct bind_temp *start; struct bind_temp *end; */ ++ /* bind.c:712:OF */ extern void parse_key (object *base, bool rest, bool allow_other_keys, register int n, ... ); ++--- gcl-2.6.12.orig/h/type.h +++++ gcl-2.6.12/h/type.h ++@@ -7,6 +7,7 @@ enum type { ++ t_shortfloat, ++ t_longfloat, ++ t_complex, +++ t_stream, ++ t_pathname, ++ t_string, ++ t_bitvector, ++@@ -17,7 +18,6 @@ enum type { ++ t_character, ++ t_symbol, ++ t_package, ++- t_stream, ++ t_random, ++ t_readtable, ++ t_cfun, ++@@ -36,6 +36,23 @@ enum type { ++ }; ++ ++ +++enum smmode { /* stream mode */ +++ smm_input, /* input */ +++ smm_output, /* output */ +++ smm_io, /* input-output */ +++ smm_probe, /* probe */ +++ smm_file_synonym, /* synonym stream to file_stream */ +++ smm_synonym, /* synonym */ +++ smm_broadcast, /* broadcast */ +++ smm_concatenated, /* concatenated */ +++ smm_two_way, /* two way */ +++ smm_echo, /* echo */ +++ smm_string_input, /* string input */ +++ smm_string_output, /* string output */ +++ smm_user_defined, /* for user defined */ +++ smm_socket /* Socket stream */ +++}; +++ ++ #define Zcdr(a_) (*(object *)(a_))/* ((a_)->c.c_cdr) */ /*FIXME*/ ++ ++ #ifndef WIDE_CONS ++@@ -82,7 +99,7 @@ enum type { ++ #else ++ #define TYPEWORD_TYPE_P(y_) (y_!=t_cons) ++ #endif ++- +++ ++ /*Note preserve sgc flag here VVV*/ ++ #define set_type_of(x,y) ({object _x=(object)(x);enum type _y=(y);_x->d.f=0;\ ++ if (TYPEWORD_TYPE_P(_y)) {_x->d.e=1;_x->d.t=_y;_x->fw|=(fixnum)OBJNULL;}}) ++@@ -113,6 +130,7 @@ enum type { ++ #define randomp(a_) SPP(a_,random) ++ #define characterp(a_) SPP(a_,character) ++ #define symbolp(a_) SPP(a_,symbol) +++#define pathnamep(a_) SPP(a_,pathname) ++ #define stringp(a_) SPP(a_,string) ++ #define fixnump(a_) SPP(a_,fixnum) ++ #define readtablep(a_) SPP(a_,readtable) ++@@ -133,3 +151,6 @@ enum type { ++ || _tp == t_symbol;}) ++ #define pathname_string_symbol_streamp(a_) ({enum type _tp=type_of(a_); _tp==t_pathname || _tp == t_string\ ++ || _tp == t_symbol || _tp==t_stream;}) +++ +++#define pathname_designatorp(a_) ({object _a=(a_);enum type _tp=type_of(a_);\ +++ _tp==t_pathname||_tp==t_string||(_tp==t_stream && _a->sm.sm_mode>=smm_input && _a->sm.sm_mode<=smm_file_synonym);}) ++--- gcl-2.6.12.orig/lsp/gcl_autoload.lsp +++++ gcl-2.6.12/lsp/gcl_autoload.lsp ++@@ -410,10 +410,3 @@ Good luck! The GCL Development Team" ++ (setf (get 'with-open-file 'si:pretty-print-format) 1) ++ (setf (get 'with-open-stream 'si:pretty-print-format) 1) ++ (setf (get 'with-output-to-string 'si:pretty-print-format) 1) ++- ++- ++-(in-package :si) ++- ++-(defvar *lib-directory* (namestring (truename "../"))) ++- ++-(import '(*lib-directory* *load-path* *system-directory*) :user) ++--- /dev/null +++++ gcl-2.6.12/lsp/gcl_directory.lsp ++@@ -0,0 +1,67 @@ +++(in-package :si) +++ +++(defconstant +d-type-alist+ (d-type-list)) +++ +++(defun ?push (x tp) +++ (when (and x (eq tp :directory)) (vector-push-extend #\/ x)) +++ x) +++ +++(defun wreaddir (x s &optional y (ls (length s) lsp) &aux (y (if (rassoc y +d-type-alist+) y :unknown))) +++ (when lsp (setf (fill-pointer s) ls)) +++ (let ((r (readdir x (car (rassoc y +d-type-alist+)) s))) +++ (typecase r +++ (fixnum (wreaddir x (adjust-array s (+ 100 (ash (array-dimension s 0) 1))) y)) +++ (cons (let ((tp (cdr (assoc (cdr r) +d-type-alist+)))) (cons (?push (car r) tp) tp))) +++ (otherwise (?push r y))))) +++ +++(defun dot-dir-p (r l) (member-if (lambda (x) (string= x r :start2 l)) '("./" "../"))) +++ +++(defun vector-push-string (x s &optional (ss 0) (lx (length x)) &aux (ls (- (length s) ss))) +++ (let ((x (if (> ls (- (array-dimension x 0) lx)) (adjust-array x (+ ls (ash lx 1))) x))) +++ (setf (fill-pointer x) (+ lx ls)) +++ (replace x s :start1 lx :start2 ss))) +++ +++(defun walk-dir (s e f &optional (y :unknown) (d (opendir s)) (l (length s)) (le (length e)) +++ &aux (r (wreaddir d s y l))) +++ (cond (r (unless (dot-dir-p r l) (funcall f r (vector-push-string e r l le) l)) +++ (walk-dir s e f y d l le)) +++ ((setf (fill-pointer s) l (fill-pointer e) le) (closedir d)))) +++ +++(defun recurse-dir (x y f) +++ (funcall f x y) +++ (walk-dir x y (lambda (x y l) (declare (ignore l)) (recurse-dir x y f)) :directory)) +++ +++(defun make-frame (s &aux (l (length s))) +++ (replace (make-array l :element-type 'character :adjustable t :fill-pointer l) s)) +++ +++(defun expand-wild-directory (l f zz &optional (yy (make-frame zz))) +++ (let* ((x (member-if 'wild-dir-element-p l)) +++ (s (namestring (make-pathname :directory (ldiff l x)))) +++ (z (vector-push-string zz s)) +++ (l (length yy)) +++ (y (link-expand (vector-push-string yy s) l)) +++ (y (if (eq y yy) y (make-frame y)))) +++ (when (or (eq (stat z) :directory) (zerop (length z))) +++ (cond ((eq (car x) :wild-inferiors) (recurse-dir z y f)) +++ (x (walk-dir z y (lambda (q e l) +++ (declare (ignore l)) +++ (expand-wild-directory (cons :relative (cdr x)) f q e)) :directory));FIXME +++ ((funcall f z y)))))) +++ +++(defun directory (p &key &aux (p (translate-logical-pathname p))(d (pathname-directory p)) +++ (c (unless (eq (car d) :absolute) (make-frame (concatenate 'string (getcwd) "/")))) +++ (lc (when c (length c))) +++ (filesp (or (pathname-name p) (pathname-type p))) +++ (v (compile-regexp (to-regexp p)))(*up-key* :back) r) +++ (expand-wild-directory d +++ (lambda (dir exp &aux (pexp (pathname (if c (vector-push-string c exp 0 lc) exp)))) +++ (if filesp +++ (walk-dir dir exp +++ (lambda (dir exp pos) +++ (declare (ignore exp)) +++ (when (pathname-match-p dir v) +++ (push (merge-pathnames (parse-namestring dir nil *default-pathname-defaults* :start pos) pexp nil) r))) +++ :file) +++ (when (pathname-match-p dir v) (push pexp r)))) +++ (make-frame (if c "./" ""))) +++ r) ++--- gcl-2.6.12.orig/lsp/gcl_fpe.lsp +++++ gcl-2.6.12/lsp/gcl_fpe.lsp ++@@ -60,7 +60,7 @@ ++ ++ ++ (defun rf (addr w) ++- (ecase w (4 (*float addr)) (8 (*double addr)))) +++ (ecase w (4 (*float addr 0 nil nil)) (8 (*double addr 0 nil nil)))) ++ ++ (defun ref (addr p w &aux (i -1)) ++ (if p ++@@ -71,7 +71,7 @@ ++ (f (eql #\F (aref z 0)))) ++ (ref addr (unless f (eql (aref z (- lz 2)) #\P)) (if (or f (eql (aref z (1- lz)) #\D)) 8 4))) ++ ++-(defun reg-lookup (x) (*fixnum (+ (car *context*) (symbol-value x)))) +++(defun reg-lookup (x) (*fixnum (+ (car *context*) (symbol-value x)) 0 nil nil)) ++ ++ (defun st-lookup (x) (fld (+ (cadr *context*) (symbol-value x)))) ++ (defun xmm-lookup (x) (gref (+ (caddr *context*) (symbol-value x)))) ++--- gcl-2.6.12.orig/lsp/gcl_fpe_test.lsp +++++ gcl-2.6.12/lsp/gcl_fpe_test.lsp ++@@ -1,6 +1,6 @@ ++-#.`(defun test-fpe (f a r &optional chk &aux cc (o (mapcan (lambda (x) (list x t)) (si::break-on-floating-point-exceptions)))) +++#.`(defun test-fpe (f a r &optional chk &aux cc (o (mapcan (lambda (x) (list x t)) (break-on-floating-point-exceptions)))) ++ (flet ((set-break (x) (when (keywordp r) ++- (apply 'si::break-on-floating-point-exceptions (append (unless x o) (list r x)))))) +++ (apply 'break-on-floating-point-exceptions (append (unless x o) (list r x)))))) ++ (let* ((rr (handler-case (unwind-protect (progn (set-break t) (apply f a)) (set-break nil)) ++ ,@(mapcar (lambda (x &aux (x (car x))) `(,x (c) (setq cc c) ,(intern (symbol-name x) :keyword))) ++ (append si::+fe-list+ '((arithmetic-error)(error))))))) ++--- gcl-2.6.12.orig/lsp/gcl_info.lsp +++++ gcl-2.6.12/lsp/gcl_info.lsp ++@@ -8,28 +8,6 @@ ++ (,op (the fixnum ,x) (the fixnum ,y)))) ++ (defmacro fcr (x) `(load-time-value (compile-regexp ,x)))) ++ ++-(eval-when (compile eval load) ++-(defun sharp-u-reader (stream subchar arg) ++- subchar arg ++- (let ((tem (make-array 10 :element-type 'character :fill-pointer 0))) ++- (or (eql (read-char stream) #\") ++- (error "sharp-u-reader reader needs a \" right after it")) ++- (loop ++- (let ((ch (read-char stream))) ++- (cond ((eql ch #\") (return tem)) ++- ((eql ch #\\) ++- (setq ch (read-char stream)) ++- (setq ch (or (cdr (assoc ch '((#\n . #\newline) ++- (#\t . #\tab) ++- (#\r . #\return)))) ++- ch)))) ++- (vector-push-extend ch tem))) ++- tem)) ++- ++-(set-dispatch-macro-character #\# #\u 'sharp-u-reader) ++- ++-) ++- ++ (defconstant +crlu+ (compile-regexp #u"")) ++ (defconstant +crnp+ (compile-regexp #u"[ ]")) ++ ++--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp +++++ gcl-2.6.12/lsp/gcl_iolib.lsp ++@@ -1,3 +1,4 @@ +++;; -*-Lisp-*- ++ ;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa ++ ++ ;; This file is part of GNU Common Lisp, herein referred to as GCL ++@@ -24,130 +25,229 @@ ++ ++ (in-package :si) ++ ++-(proclaim '(optimize (safety 2) (space 3))) +++(defun concatenated-stream-streams (stream) +++ (declare (optimize (safety 2))) +++ (check-type stream concatenated-stream) +++ (c-stream-object0 stream)) +++(defun broadcast-stream-streams (stream) +++ (declare (optimize (safety 2))) +++ (check-type stream broadcast-stream) +++ (c-stream-object0 stream)) +++(defun two-way-stream-input-stream (stream) +++ (declare (optimize (safety 2))) +++ (check-type stream two-way-stream) +++ (c-stream-object0 stream)) +++(defun echo-stream-input-stream (stream) +++ (declare (optimize (safety 2))) +++ (check-type stream echo-stream) +++ (c-stream-object0 stream)) +++(defun two-way-stream-output-stream (stream) +++ (declare (optimize (safety 2))) +++ (check-type stream two-way-stream) +++ (c-stream-object1 stream)) +++(defun echo-stream-output-stream (stream) +++ (declare (optimize (safety 2))) +++ (check-type stream echo-stream) +++ (c-stream-object1 stream)) +++(defun synonym-stream-symbol (stream) +++ (declare (optimize (safety 2))) +++ (check-type stream synonym-stream) +++ (c-stream-object0 stream)) ++ +++(defun maybe-clear-input (&optional (x *standard-input*)) +++ (typecase x +++ (synonym-stream (maybe-clear-input (symbol-value (synonym-stream-symbol x)))) +++ (two-way-stream (maybe-clear-input (two-way-stream-input-stream x))) +++ (stream (when (terminal-input-stream-p x) (clear-input t))))) ++ ++ (defmacro with-open-stream ((var stream) . body) ++- (multiple-value-bind (ds b) ++- (find-declarations body) +++ (declare (optimize (safety 1))) +++ (multiple-value-bind (ds b) (find-declarations body) ++ `(let ((,var ,stream)) ++ ,@ds ++ (unwind-protect ++- (progn ,@b) +++ (progn ,@b) ++ (close ,var))))) ++ ++- ++ (defmacro with-input-from-string ((var string &key index start end) . body) ++- (let ((x (sgen "X"))) ++- (multiple-value-bind (ds b) ++- (find-declarations body) ++- `(let ((,var (make-string-input-stream ,string ,start ,end))) ++- ,@ds ++- (unwind-protect ++- ,(let ((f `(progn ,@b))) ++- (if index ++- `(let ((,x (multiple-value-list ,f))) (setf ,index (get-string-input-stream-index ,var)) (values-list ,x)) ++- f)) ++- (close ,var)))))) +++ (declare (optimize (safety 1))) +++ (multiple-value-bind (ds b) (find-declarations body) +++ `(let ((,var (make-string-input-stream ,string ,start ,end))) +++ ,@ds +++ (unwind-protect +++ (multiple-value-prog1 +++ (progn ,@b) +++ ,@(when index `((setf ,index (get-string-input-stream-index ,var))))) +++ (close ,var))))) ++ ++ (defmacro with-output-to-string ((var &optional string &key element-type) . body) ++- (let ((s (sgen "STRING"))(bl (sgen "BLOCK"))(e (sgen "ELEMENT-TYPE"))(x (sgen "X"))) ++- (multiple-value-bind (ds b) ++- (find-declarations body) ++- `(let* ((,s ,string)(,e ,element-type) ++- (,var (if ,s (make-string-output-stream-from-string ,s) (make-string-output-stream :element-type ,e)))) +++ (declare (optimize (safety 1))) +++ (let ((s (sgen "STRING"))) +++ (multiple-value-bind (ds b) (find-declarations body) +++ `(let* ((,s ,string) +++ (,var (if ,s (make-string-output-stream-from-string ,s) (make-string-output-stream :element-type ,element-type)))) ++ ,@ds ++ (unwind-protect ++- (let ((,x (multiple-value-list (progn ,@b)))) (if ,s (values-list ,x) (get-output-stream-string ,var))) +++ (block nil +++ (multiple-value-prog1 +++ (progn ,@b) +++ (unless ,s (return (get-output-stream-string ,var))))) ++ (close ,var)))))) ++ ++ ++-(defun read-from-string (string ++- &optional (eof-error-p t) eof-value ++- &key (start 0) (end (length string)) ++- preserve-whitespace) ++- (let ((stream (make-string-input-stream string start end))) ++- (if preserve-whitespace ++- (values (read-preserving-whitespace stream eof-error-p eof-value) ++- (si:get-string-input-stream-index stream)) ++- (values (read stream eof-error-p eof-value) ++- (si:get-string-input-stream-index stream))))) ++- +++(defun read-from-string (string &optional (eof-error-p t) eof-value +++ &key (start 0) end preserve-whitespace) +++ (declare (optimize (safety 1))) +++ (check-type string string) +++ (check-type start seqind) +++ (check-type end (or null seqind)) +++ (let ((stream (make-string-input-stream string start (or end (length string))))) +++ (values (if preserve-whitespace +++ (read-preserving-whitespace stream eof-error-p eof-value) +++ (read stream eof-error-p eof-value)) +++ (get-string-input-stream-index stream)))) +++ +++;; (defun write (x &key stream +++;; (array *print-array*) +++;; (base *print-base*) +++;; (case *print-case*) +++;; (circle *print-circle*) +++;; (escape *print-escape*) +++;; (gensym *print-gensym*) +++;; (length *print-length*) +++;; (level *print-level*) +++;; (lines *print-lines*) +++;; (miser-width *print-miser-width*) +++;; (pprint-dispatch *print-pprint-dispatch*) +++;; (pretty *print-pretty*) +++;; (radix *print-radix*) +++;; (readably *print-readably*) +++;; (right-margin *print-right-margin*)) +++;; (write-int x stream array base case circle escape gensym +++;; length level lines miser-width pprint-dispatch +++;; pretty radix readably right-margin)) ++ ++ (defun write-to-string (object &rest rest ++- &key escape radix base ++- circle pretty level length ++- case gensym array ++- &aux (stream (make-string-output-stream))) ++- (declare (ignore escape radix base ++- circle pretty level length ++- case gensym array)) +++ &key (escape *print-escape*)(radix *print-radix*)(base *print-base*) +++ (circle *print-circle*)(pretty *print-pretty*)(level *print-level*) +++ (length *print-length*)(case *print-case*)(gensym *print-gensym*) +++ (array *print-array*)(lines *print-lines*)(miser-width *print-miser-width*) +++ (pprint-dispatch *print-pprint-dispatch*)(readably *print-readably*) +++ (right-margin *print-right-margin*) +++ &aux (stream (make-string-output-stream)) +++ (*print-escape* escape)(*print-radix* radix)(*print-base* base) +++ (*print-circle* circle)(*print-pretty* pretty)(*print-level* level) +++ (*print-length* length)(*print-case* case)(*print-gensym* gensym) +++ (*print-array* array)(*print-lines* lines)(*print-miser-width* miser-width) +++ (*print-pprint-dispatch* pprint-dispatch)(*print-readably* readably ) +++ (*print-right-margin* right-margin)) +++ (declare (optimize (safety 1))(dynamic-extent rest)) ++ (apply #'write object :stream stream rest) ++ (get-output-stream-string stream)) ++ +++(defun prin1-to-string (object &aux (stream (make-string-output-stream))) +++ (declare (optimize (safety 1))) +++ (prin1 object stream) +++ (get-output-stream-string stream)) ++ ++-(defun prin1-to-string (object ++- &aux (stream (make-string-output-stream))) ++- (prin1 object stream) ++- (get-output-stream-string stream)) ++- ++- ++-(defun princ-to-string (object ++- &aux (stream (make-string-output-stream))) +++(defun princ-to-string (object &aux (stream (make-string-output-stream))) +++ (declare (optimize (safety 1))) ++ (princ object stream) ++ (get-output-stream-string stream)) ++ +++;; (defun file-string-length (ostream object) +++;; (declare (optimize (safety 2))) +++;; (let ((ostream (if (typep ostream 'broadcast-stream) +++;; (car (last (broadcast-stream-streams ostream))) +++;; ostream))) +++;; (cond ((not ostream) 1) +++;; ((subtypep1 (stream-element-type ostream) 'character) +++;; (length (let ((*print-escape* nil)) (write-to-string object))))))) +++ +++;; (defmacro with-temp-file ((s pn) (tmp ext) &rest body) +++;; (multiple-value-bind +++;; (doc decls ctps body) +++;; (parse-body-header body) +++;; (declare (ignore doc)) +++;; `(let* ((,s (temp-stream ,tmp ,ext)) +++;; (,pn (stream-object1 ,s))) +++;; ,@decls +++;; ,@ctps +++;; (unwind-protect (progn ,@body) (progn (close ,s) (delete-file ,s)))))) +++ ++ ++ (defmacro with-open-file ((stream . filespec) . body) ++- (multiple-value-bind (ds b) ++- (find-declarations body) +++ (declare (optimize (safety 1))) +++ (multiple-value-bind (ds b) (find-declarations body) ++ `(let ((,stream (open ,@filespec))) ++ ,@ds ++ (unwind-protect ++- (progn ,@b) ++- (if ,stream (close ,stream)))))) +++ (progn ,@b) +++ (when ,stream (close ,stream)))))) ++ +++;; (defun pprint-dispatch (obj &optional (table *print-pprint-dispatch*)) +++;; (declare (optimize (safety 2))) +++;; (let ((fun (si:get-pprint-dispatch obj table))) +++;; (if fun (values fun t) (values 'si:default-pprint-object nil)))) +++ +++;; (setq *print-pprint-dispatch* '(pprint-dispatch . nil)) +++ +++;; (defun set-pprint-dispatch (type-spec function &optional +++;; (priority 0) +++;; (table *print-pprint-dispatch*)) +++;; (declare (optimize (safety 2))) +++;; (unless (typep priority 'real) +++;; (error 'type-error :datum priority :expected-type 'real)) +++;; (let ((a (assoc type-spec (cdr table) :test 'equal))) +++;; (if a (setf (cdr a) (list function priority)) +++;; (rplacd (last table) `((,type-spec ,function ,priority))))) +++;; nil) +++ +++;; (defun copy-pprint-dispatch (&optional table) +++;; (declare (optimize (safety 2))) +++;; (unless table +++;; (setq table *print-pprint-dispatch*)) +++;; (unless (and (eq (type-of table) 'cons) +++;; (eq (car table) 'pprint-dispatch)) +++;; (error 'type-error :datum table :expected-type 'pprint-dispatch)) +++;; (copy-seq table )) ++ ++-(defun y-or-n-p (&optional string &rest args) ++- (do ((reply)) ++- (nil) ++- (when string (format *query-io* "~&~? (Y or N) " string args)) ++- (setq reply (read *query-io*)) ++- (cond ((string-equal (symbol-name reply) "Y") ++- (return-from y-or-n-p t)) ++- ((string-equal (symbol-name reply) "N") ++- (return-from y-or-n-p nil))))) ++ +++(defun y-or-n-p (&optional string &rest args) +++ (declare (optimize (safety 1))) +++ (when string (format *query-io* "~&~? (Y or N) " string args)) +++ (let ((reply (symbol-name (read *query-io*)))) +++ (cond ((string-equal reply "Y") t) +++ ((string-equal reply "N") nil) +++ ((apply 'y-or-n-p string args))))) ++ ++ (defun yes-or-no-p (&optional string &rest args) ++- (do ((reply)) ++- (nil) ++- (when string (format *query-io* "~&~? (Yes or No) " string args)) ++- (setq reply (read *query-io*)) ++- (cond ((string-equal (symbol-name reply) "YES") ++- (return-from yes-or-no-p t)) ++- ((string-equal (symbol-name reply) "NO") ++- (return-from yes-or-no-p nil))))) ++- +++ (declare (optimize (safety 1))) +++ (when string (format *query-io* "~&~? (Yes or No) " string args)) +++ (let ((reply (symbol-name (read *query-io*)))) +++ (cond ((string-equal reply "YES") t) +++ ((string-equal reply "NO") nil) +++ ((apply 'yes-or-no-p string args))))) ++ ++ (defun sharp-a-reader (stream subchar arg) ++ (declare (ignore subchar)) ++ (let ((initial-contents (read stream nil nil t))) ++- (if *read-suppress* ++- nil ++- (do ((i 0 (1+ i)) ++- (d nil (cons (length ic) d)) ++- (ic initial-contents (if (zerop (length ic)) ic (elt ic 0)))) ++- ((>= i arg) ++- (make-array (nreverse d) ++- :initial-contents initial-contents)))))) +++ (unless *read-suppress* +++ (do ((i 0 (1+ i)) +++ (d nil (cons (length ic) d)) +++ (ic initial-contents (if (zerop (length ic)) ic (elt ic 0)))) +++ ((>= i arg) (make-array (nreverse d) :initial-contents initial-contents)))))) ++ ++ (set-dispatch-macro-character #\# #\a 'sharp-a-reader) +++(set-dispatch-macro-character #\# #\a 'sharp-a-reader (standard-readtable)) ++ (set-dispatch-macro-character #\# #\A 'sharp-a-reader) +++(set-dispatch-macro-character #\# #\A 'sharp-a-reader (standard-readtable)) ++ ++ ;; defined in defstruct.lsp ++ (set-dispatch-macro-character #\# #\s 'sharp-s-reader) +++(set-dispatch-macro-character #\# #\s 'sharp-s-reader (standard-readtable)) ++ (set-dispatch-macro-character #\# #\S 'sharp-s-reader) +++(set-dispatch-macro-character #\# #\S 'sharp-s-reader (standard-readtable)) ++ ++ (defvar *dribble-stream* nil) ++ (defvar *dribble-io* nil) ++@@ -155,6 +255,7 @@ ++ (defvar *dribble-saved-terminal-io* nil) ++ ++ (defun dribble (&optional (pathname "DRIBBLE.LOG" psp) (f :supersede)) +++ (declare (optimize (safety 1))) ++ (cond ((not psp) ++ (when (null *dribble-stream*) (error "Not in dribble.")) ++ (if (eq *dribble-io* *terminal-io*) ++@@ -183,73 +284,18 @@ ++ (format t "~&Starts dribbling to ~A (~d/~d/~d, ~d:~d:~d)." ++ namestring year month day hour min sec)))))) ++ ++-(defconstant char-length 8) ++- ++-(defun get-byte-stream-nchars (s) ++- (check-type s stream) ++- (let* ((tp (stream-element-type s)) ++- (tp (if (consp tp) (cadr tp) char-length)) ++- (nc (ceiling tp char-length))) ++- nc)) ++- ++-(defun write-byte (j s) ++- (declare (optimize (safety 1))) ++- (let ((nc (get-byte-stream-nchars s)) ++- (ff (1- (expt 2 char-length)))) ++- (do ((k 0 (1+ k))(i j (ash i (- char-length)))) ((>= k nc) j) ++- (write-char (code-char (logand i ff)) s)))) ++- ++-(defun read-byte (s &optional (eof-error-p t) eof-value) ++- (declare (optimize (safety 1))) ++- (let ((nc (get-byte-stream-nchars s))) ++- (do ((j 0 (1+ j)) ++- (i 0 (logior i ++- (ash (char-code (let ((ch (read-char s eof-error-p eof-value))) ++- (if (and (not eof-error-p) (eq ch eof-value)) ++- (return-from read-byte ch) ++- ch))) (* j char-length))))) ++- ((>= j nc) i)))) ++- ++- ++-(defun read-sequence (seq strm &key (start 0) end) ++- (declare (optimize (safety 1))) ++- (check-type seq sequence) ++- (check-type start (integer 0)) ++- (check-type end (or null (integer 0))) ++- (let* ((start (min start array-dimension-limit)) ++- (end (if end (min end array-dimension-limit) (length seq))) ++- (l (listp seq)) ++- (seq (if (and l (> start 0)) (nthcdr start seq) seq)) ++- (tp (subtypep (stream-element-type strm) 'character))) ++- (do ((i start (1+ i))(seq seq (if l (cdr seq) seq))) ++- ((or (>= i end) (when l (endp seq))) i) ++- (declare (fixnum i)) ++- (let ((el (if tp (read-char strm nil 'eof) (read-byte strm nil 'eof)))) ++- (when (eq el 'eof) (return i)) ++- (if l (setf (car seq) el) (setf (aref seq i) el)))))) ++- +++;; (defmacro formatter ( control-string ) +++;; (declare (optimize (safety 2))) +++;; `(progn +++;; (lambda (*standard-output* &rest arguments) +++;; (let ((*format-unused-args* nil)) +++;; (apply 'format t ,control-string arguments) +++;; *format-unused-args*)))) ++ ++-(defun write-sequence (seq strm &key (start 0) end) +++(defun stream-external-format (s) ++ (declare (optimize (safety 1))) ++- (check-type seq sequence) ++- (check-type start (integer 0)) ++- (check-type end (or null (integer 0))) ++- (let* ((start (min start array-dimension-limit)) ++- (end (if end (min end array-dimension-limit) (length seq))) ++- (l (listp seq)) ++- (tp (subtypep (stream-element-type strm) 'character))) ++- (do ((i start (1+ i)) ++- (seq (if (and l (> start 0)) (nthcdr start seq) seq) (if l (cdr seq) seq))) ++- ((or (>= i end) (when l (endp seq)))) ++- (declare (fixnum i)) ++- (let ((el (if l (car seq) (aref seq i)))) ++- (if tp (write-char el strm) (write-byte el strm)))) ++- seq)) ++- ++-(defmacro with-compilation-unit (opt &rest body) ++- (declare (optimize (safety 2))) ++- (declare (ignore opt)) ++- `(progn ,@body)) +++ (check-type s stream) +++ :default) ++ ++ (defvar *print-lines* nil) ++ (defvar *print-miser-width* nil) ++@@ -257,7 +303,7 @@ ++ (defvar *print-right-margin* nil) ++ ++ (defmacro with-standard-io-syntax (&body body) ++- (declare (optimize (safety 2))) +++ (declare (optimize (safety 1))) ++ `(let* ((*package* (find-package :cl-user)) ++ (*print-array* t) ++ (*print-base* 10) ++@@ -269,7 +315,7 @@ ++ (*print-level* nil) ++ (*print-lines* nil) ++ (*print-miser-width* nil) ++- (*print-pprint-dispatch* *print-pprint-dispatch*) +++ (*print-pprint-dispatch* *print-pprint-dispatch*);FIXME ++ (*print-pretty* nil) ++ (*print-radix* nil) ++ (*print-readably* t) ++@@ -278,37 +324,163 @@ ++ (*read-default-float-format* 'single-float) ++ (*read-eval* t) ++ (*read-suppress* nil) ++- (*readtable* (copy-readtable (si::standard-readtable))));FIXME copy? +++ (*readtable* (copy-readtable (standard-readtable)))) ++ ,@body)) ++ +++;; (defmacro print-unreadable-object +++;; ((object stream &key type identity) &body body) +++;; (declare (optimize (safety 2))) +++;; (let ((q `(princ " " ,stream))) +++;; `(if *print-readably* +++;; (error 'print-not-readable :object ,object) +++;; (progn +++;; (princ "#<" ,stream) +++;; ,@(when type `((prin1 (type-of ,object) ,stream) ,q)) +++;; ,@body +++;; ,@(when identity +++;; (let ((z `(princ (address ,object) ,stream))) +++;; (if (and (not body) type) (list z) (list q z)))) +++;; (princ ">" ,stream) +++;; nil)))) +++ +++;; (defmacro with-compile-file-syntax (&body body) +++;; `(let ((*print-radix* nil) +++;; (*print-base* 10) +++;; (*print-circle* t) +++;; (*print-pretty* nil) +++;; (*print-level* nil) +++;; (*print-length* nil) +++;; (*print-case* :downcase) +++;; (*print-gensym* t) +++;; (*print-array* t) +++;; (*print-package* t) +++;; (*print-structure* t)) +++;; ,@body)) +++ +++(defmacro with-compilation-unit (opt &rest body) +++ (declare (optimize (safety 1))) +++ (declare (ignore opt)) +++ `(progn ,@body)) +++ +++(defconstant char-length 8) +++ +++(defun get-byte-stream-nchars (s) +++ (let* ((tp (stream-element-type s))) +++ (ceiling (if (consp tp) (cadr tp) char-length) char-length))) +++ +++;; (defun parse-integer (s &key start end (radix 10) junk-allowed) +++;; (declare (optimize (safety 1))) +++;; (parse-integer-int s start end radix junk-allowed)) +++ +++(defun write-byte (j s &aux (i j)) +++ (declare (optimize (safety 1))) +++ (check-type j integer) +++ (check-type s stream) +++ (dotimes (k (get-byte-stream-nchars s) j) +++ (write-char (code-char (logand i #.(1- (ash 1 char-length)))) s) +++ (setq i (ash i #.(- char-length))))) +++ +++ +++(defun read-byte (s &optional (eof-error-p t) eof-value &aux (i 0)) +++ (declare (optimize (safety 1))) +++ (check-type s stream) +++ (dotimes (k (get-byte-stream-nchars s) i) +++ (setq i (logior i (ash (let ((ch (read-char s eof-error-p eof-value))) +++ (if (eq ch eof-value) (return ch) (char-code ch))) +++ (* k char-length)))))) +++ +++ +++(defun read-sequence (seq strm &rest r &key (start 0) end +++ &aux (l (listp seq))(seqp (when l (nthcdr start seq))) +++ (cp (eq (stream-element-type strm) 'character))) +++ (declare (optimize (safety 1))(dynamic-extent r)) +++ (check-type seq sequence) +++ (check-type strm stream) +++ (check-type start (integer 0)) +++ (check-type end (or null (integer 0))) +++ (apply 'reduce (lambda (y x &aux (z (if cp (read-char strm nil 'eof) (read-byte strm nil 'eof)))) +++ (declare (seqind y)(ignorable x)) +++ (when (eq z 'eof) (return-from read-sequence y)) +++ (if l (setf (car seqp) z seqp (cdr seqp)) (setf (aref seq y) z)) +++ (1+ y)) seq :initial-value start r)) +++ +++ +++(defun write-sequence (seq strm &rest r &key (start 0) end +++ &aux (l (listp seq))(cp (eq (stream-element-type strm) 'character))) +++ (declare (optimize (safety 1))(dynamic-extent r)) +++ (check-type seq sequence) +++ (check-type strm stream) +++ (check-type start (integer 0)) +++ (check-type end (or null (integer 0))) +++ (apply 'reduce (lambda (y x) +++ (declare (seqind y)) +++ (if cp (write-char x strm) (write-byte x strm)) +++ (1+ y)) seq :initial-value start r) +++ seq) +++ +++(defun restrict-stream-element-type (tp) +++ (cond ((or (member tp '(character :default)) (subtypep tp 'character)) 'character) +++ ((subtypep tp 'integer) +++ (let* ((ntp (car (expand-ranges (normalize-type tp)))) +++ (min (or (cadr ntp) '*))(max (or (caddr ntp) '*)) +++ (s (if (or (eq min '*) (< min 0)) 'signed-byte 'unsigned-byte)) +++ (lim (unless (or (eq min '*) (eq max '*)) (max (integer-length min) (integer-length max)))) +++ (lim (if (and lim (eq s 'signed-byte)) (1+ lim) lim))) +++ (if lim `(,s ,lim) s))) +++ ((check-type tp (member character integer))))) +++ +++(defun open (f &key (direction :input) +++ (element-type 'character) +++ (if-exists nil iesp) +++ (if-does-not-exist nil idnesp) +++ (external-format :default) &aux (pf (pathname f))) +++ (declare (optimize (safety 1))) +++ (check-type f pathname-designator) +++ (when (wild-pathname-p pf) +++ (error 'file-error :pathname pf :format-control "Pathname is wild.")) +++ (let* ((s (open-int (namestring (translate-logical-pathname pf)) direction +++ (restrict-stream-element-type element-type) +++ if-exists iesp if-does-not-exist idnesp external-format))) +++ (when (typep s 'stream) (c-set-stream-object1 s pf) s))) +++ +++(defun load-pathname (p print if-does-not-exist external-format +++ &aux (pp (merge-pathnames p)) +++ (epp (reduce (lambda (y x) (or y (probe-file (translate-pathname x "" p)))) +++ '(#P".o" #P".lsp" #P".lisp" #P"") :initial-value nil)));FIXME newest? +++ (if epp +++ (let* ((*load-pathname* pp)(*load-truename* epp)) +++ (with-open-file +++ (s epp :external-format external-format) +++ (if (member (peek-char nil s nil 'eof) '#.(mapcar 'code-char (list 127 #xfe #xff #x4c))) +++ (load-fasl s print) +++ (let ((*standard-input* s)) (load-stream s print))))) +++ (when if-does-not-exist +++ (error 'file-error :pathname pp :format-control "File does not exist.")))) +++ +++(defun load (p &key (verbose *load-verbose*) (print *load-print*) (if-does-not-exist :error) +++ (external-format :default) &aux (*readtable* *readtable*)(*package* *package*)) +++ (declare (optimize (safety 1))) +++ (check-type p (or stream pathname-designator)) +++ (when verbose (format t ";; Loading ~s~%" p)) +++ (prog1 +++ (typecase p +++ (pathname-designator (load-pathname (pathname p) print if-does-not-exist external-format)) +++ (stream (load-stream p print))) +++ (when verbose (format t ";; Finished loading ~s~%" p)))) +++ ++ (defun ensure-directories-exist (ps &key verbose &aux created) +++ (declare (optimize (safety 1))) +++ (check-type ps pathname-designator) ++ (when (wild-pathname-p ps) ++ (error 'file-error :pathname ps :format-control "Pathname is wild")) ++- (labels ((d (x y &aux (z (ldiff x y)) (p (make-pathname :directory z))) +++ (labels ((d (x y &aux (z (ldiff x y)) (n (namestring (make-pathname :directory z)))) ++ (when (when z (stringp (car (last z)))) ++- (unless (eq :directory (car (stat p))) ++- (mkdir (namestring p)) +++ (unless (eq :directory (stat n)) +++ (mkdir n) ++ (setq created t) ++- (when verbose (format *standard-output* "Creating directory ~s~%" p)))) +++ (when verbose (format *standard-output* "Creating directory ~s~%" n)))) ++ (when y (d x (cdr y))))) ++ (let ((pd (pathname-directory ps))) ++ (d pd (cdr pd))) ++ (values ps created))) ++ ++-#.(let ((g '(:host :device :directory :name :type :version))) ++- `(defun wild-pathname-p (pd &optional f &aux (p (pathname pd))) ++- (declare (optimize (safety 1))) ++- (check-type f (or null (member ,@g))) ++- (labels ((w-f (x) ++- (case x ++- ,@(mapcar (lambda (x &aux (f (intern (string-concatenate "PATHNAME-" (string-upcase x))))) ++- `(,x ,(if (eq x :directory) `(when (member :wild (,f p)) t) `(eq :wild (,f p))))) g)))) ++- (if f ++- (w-f f) ++- (reduce (lambda (z x) (or z (w-f x))) ',g :initial-value nil))))) ++- ++-(defun maybe-clear-input (&optional (x *standard-input*)) ++- (cond ((not (typep x 'stream)) nil) ++- ((typep x 'synonym-stream) (maybe-clear-input (symbol-value (synonym-stream-symbol x)))) ++- ((typep x 'two-way-stream) (maybe-clear-input (two-way-stream-input-stream x))) ++- ((terminal-input-stream-p x) (clear-input t)))) ++--- /dev/null +++++ gcl-2.6.12/lsp/gcl_logical_pathname_translations.lsp ++@@ -0,0 +1,28 @@ +++(in-package :si) +++ +++(defvar *pathname-logical* nil) +++ +++(defun setf-logical-pathname-translations (v k) +++ (declare (optimize (safety 1))) +++ (check-type v list) +++ (check-type k string) +++ (setf (cdr (or (assoc k *pathname-logical* :test 'string-equal) (car (push (cons k t) *pathname-logical*)))) ;(cons k nil) +++ (mapcar (lambda (x) (list (parse-namestring (car x) k) (parse-namestring (cadr x)))) v))) +++ +++(defsetf logical-pathname-translations (x) (y) `(setf-logical-pathname-translations ,y ,x)) +++(remprop 'logical-pathname-translations 'si::setf-update-fn) +++ +++(defun logical-pathname-translations (k) +++ (declare (optimize (safety 1))) +++ (check-type k string) +++ (cdr (assoc k *pathname-logical* :test 'string-equal))) +++ +++ +++(defun load-logical-pathname-translations (k) +++ (declare (optimize (safety 1))) +++ (unless (logical-pathname-translations k) +++ (error "No translations found for ~s" k))) +++ +++(defun logical-pathname-host-p (host) +++ (when host +++ (logical-pathname-translations host))) ++--- /dev/null +++++ gcl-2.6.12/lsp/gcl_make_pathname.lsp ++@@ -0,0 +1,155 @@ +++(in-package :si) +++ +++;; (defun pathnamep (x) +++;; (declare (optimize (safety 1))) +++;; (when (typep x 'pathname) t)) +++ +++(defun msub (a x) (if a (msub (cdr a) (substitute (caar a) (cdar a) x)) x)) +++ +++(defvar *glob-to-regexp-alist* (list (cons #v"{[^}]*}" (lambda (x) (msub '((#\| . #\,)(#\( . #\{)(#\) . #\})) x))) +++ (cons #v"\\[[^\\]*\\]" (lambda (x) +++ (concatenate 'string "(" +++ (substitute #\^ #\! (subseq x 0 2)) +++ (subseq x 2) ")"))) +++ (cons #v"\\*" (lambda (x) "([^/.]*)")) +++ (cons #v"\\?" (lambda (x) "([^/.])")) +++ (cons #v"\\." (lambda (x) "\\.")))) +++ +++(defun mglist (x &optional (b 0)) +++ (let* ((y (mapcan (lambda (z &aux (w (string-match (car z) x b))) +++ (unless (eql w -1) +++ (list (list w (match-end 0) z)))) +++ *glob-to-regexp-alist*)) +++ (z (when y (reduce (lambda (y x) (if (< (car x) (car y)) x y)) y)))) +++ (when z +++ (cons z (mglist x (cadr z)))))) +++ +++(defun mgsub (x &optional (l (mglist x)) (b 0) &aux (w (pop l))) +++ (if w +++ (concatenate 'string +++ (subseq x b (car w)) +++ (funcall (cdaddr w) (subseq x (car w) (cadr w))) +++ (mgsub x l (cadr w))) +++ (subseq x b))) +++ +++ +++(defun elsub (el x rp lp &aux (y x) (pref (pop y))(dflt (pop y))(post (pop y))) +++; (destructuring-bind (pref dflt post &rest y) x +++ (etypecase el +++ (string (let ((x (list pref el post))) (unless (zerop (length dflt)) (if rp (mapcar 'mgsub x) x)))) +++ (integer (elsub (write-to-string el) x rp lp)) +++ ((eql :wild-inferiors) (if rp (list "(" dflt "*)") (elsub "**" x rp lp))) +++ ((eql :wild) (if rp (list dflt) (elsub "*" x rp lp))) +++ ((eql :newest) (elsub (if rp "(newest|NEWEST)" "NEWEST") x rp lp)) +++ ((member :up :back) (elsub ".." x rp lp)) +++ ((member nil :unspecific) (when rp (list dflt))) +++ (cons (cons +++ (if (eq (car el) :absolute) (if lp "" "/") (if lp ";" "")) +++ (mapcan (lambda (z) (elsub z y rp lp)) (cdr el))))) +++; ) +++) +++ +++(defconstant +physical-pathname-defaults+ '(("" "" "") +++ ("" "" "") +++ ("" "(/?([^/]+/)*)" "" "" "([^/]+/)" "/") +++ ("" "([^/.]*)" "") +++ ("." "(\\.[^/]*)?" "") +++ ("" "" ""))) +++(defconstant +logical-pathname-defaults+ '(("" "([-0-9A-Z]+:)?" ":") +++ ("" "" "") +++ ("" "(;?((\\*?([-0-9A-Z]+\\*?)+|\\*|\\*\\*);)*)" "" "" "((\\*?([-0-9A-Z]+\\*?)+|\\*);)" ";") +++ ("" "(\\*?([-0-9A-Z]+\\*?)+|\\*)?" "") +++ ("." "(\\.(\\*?([-0-9A-Z]+\\*?)+|\\*))?" "") +++ ("." "(\\.([1-9][0-9]*|newest|NEWEST|\\*))?" ""))) +++ +++(defun to-regexp-or-namestring (x rp lp) +++ (apply 'concatenate 'string +++ (mapcan (lambda (x y) (elsub x y rp lp)) +++ x (if lp +logical-pathname-defaults+ +physical-pathname-defaults+)))) +++ +++(defun directory-list-check (l) +++ (when (listp l) +++ (when (member (car l) '(:absolute :relative)) +++ (mapl (lambda (x &aux (c (car x))(d (cadr x))) +++ (when (and (member d '(:up :back)) (member c '(:absolute :wild-inferiors))) +++ (return-from directory-list-check nil))) l)))) +++ +++(defun canonicalize-pathname-directory (l) +++ (cond ((eq l :wild) (canonicalize-pathname-directory '(:absolute :wild-inferiors))) +++ ((stringp l) (canonicalize-pathname-directory (list :absolute l))) +++ ((mapl (lambda (x &aux (c (car x))) +++ (when (and (or (stringp c) (eq c :wild)) (eq (cadr x) :back)) +++ (return-from canonicalize-pathname-directory +++ (canonicalize-pathname-directory (nconc (ldiff l x) (cddr x)))))) l)))) +++ +++(defvar *default-pathname-defaults* (init-pathname nil nil nil nil nil nil "")) +++(declaim (type pathname *default-pathname-defaults*)) +++ +++(defun toggle-case (x) +++ (cond ((symbolp x) x) +++ ((listp x) (mapcar 'toggle-case x)) +++ ((find-if 'upper-case-p x) (if (find-if 'lower-case-p x) x (string-downcase x))) +++ ((find-if 'lower-case-p x) (string-upcase x)) +++ (x))) +++ +++(defun logical-pathname (spec &aux (p (pathname spec))) +++ (declare (optimize (safety 1))) +++ (check-type spec pathname-designator) +++ (check-type p logical-pathname) +++ p) +++ +++(eval-when (compile eval) +++ (defun strsym (p &rest r) +++ (declare (:dynamic-extent r)) +++ (intern (apply 'concatenate 'string (mapcar 'string-upcase r)) p))) +++ +++#.`(defun make-pathname (&key (host nil hostp) (device nil devicep) (directory nil directoryp) +++ (name nil namep) (type nil typep) (version nil versionp) +++ defaults (case :local) namestring &aux defaulted (def (when defaults (pathname defaults)))) +++ (declare (optimize (safety 1))) +++ (check-type host (or (member nil :unspecific) string)) +++ (check-type device (member nil :unspecific)) +++ (check-type directory (or (member nil :unspecific :wild) string list)) +++ (check-type name (or string (member nil :unspecific :wild))) +++ (check-type type (or string (member nil :unspecific :wild))) +++ (check-type version (or (integer 1) (member nil :unspecific :wild :newest))) +++ (check-type defaults (or null pathname-designator)) +++ (check-type case (member :common :local)) +++ ,(flet ((def? (k) `(let* (,@(when (eq k 'host) `((def (or def *default-pathname-defaults*)))) +++ (nk (if ,(strsym :si k "P") ,k (progn (setq defaulted t) (when def (,(strsym :si "C-PATHNAME-" k) def))))) +++ (nk (if (eq case :local) nk (progn (setq defaulted t) (toggle-case nk))))) +++ nk))) +++ `(let* ((h ,(def? 'host)) +++ (h (let ((h1 (when (logical-pathname-host-p h) h))) (unless (eq h h1) (setq defaulted t)) h1)) +++ (dev ,(def? 'device)) +++ (d ,(def? 'directory)) +++ (d (let ((d1 (canonicalize-pathname-directory d))) (unless (eq d d1) (setq defaulted t)) d1)) +++ (n ,(def? 'name)) +++ (typ ,(def? 'type)) +++ (v ,(def? 'version)) +++ (p (init-pathname h dev d n typ v +++ (or (unless defaulted namestring) (to-regexp-or-namestring (list h dev d n typ v) nil h))))) +++ (when h (c-set-t-tt p 1)) +++ (unless (eq d (directory-list-check d)) +++ (error 'file-error :pathname p :format-control "Bad directory list")) +++ p))) +++ +++(macrolet ((pn-accessor (k &aux (f (strsym :si "PATHNAME-" k)) (c (strsym :si "C-PATHNAME-" k))) +++ `(defun ,f (p &key (case :local) &aux (pn (pathname p))) +++ (declare (optimize (safety 1))) +++ (check-type p pathname-designator) +++ (let ((x (,c pn))) (if (eq case :local) x (toggle-case x)))))) +++ (pn-accessor host) +++ (pn-accessor device) +++ (pn-accessor directory) +++ (pn-accessor name) +++ (pn-accessor type) +++ (pn-accessor version)) +++ +++(defconstant +pathname-keys+ '(:host :device :directory :name :type :version)) +++ +++#.`(defun mlp (p) +++ (list ,@(mapcar (lambda (x) `(,(strsym :si "C-PATHNAME-" x) p)) +pathname-keys+))) +++ +++(defun pnl1 (x) (list* (pop x) (pop x) (append (pop x) x))) +++(defun lnp (x) (list* (pop x) (pop x) (let ((q (last x 3))) (cons (ldiff x q) q)))) ++--- /dev/null +++++ gcl-2.6.12/lsp/gcl_merge_pathnames.lsp ++@@ -0,0 +1,18 @@ +++(in-package :si) +++ +++(defun merge-pathnames (p &optional (def *default-pathname-defaults*) (def-v :newest) +++ &aux dflt (pn (pathname p))(def-pn (pathname def))) +++ (declare (optimize (safety 1))) +++ (check-type p pathname-designator) +++ (check-type def pathname-designator) +++ (check-type def-v (or null (eql :newest) seqind)) +++ (labels ((def (x) (when x (setq dflt t) x))) +++ (make-pathname +++ :host (or (pathname-host pn) (def (pathname-host def-pn))) +++ :device (or (pathname-device pn) (def (pathname-device def-pn))) +++ :directory (let ((d (pathname-directory pn))(defd (pathname-directory def-pn))) +++ (or (def (when (and defd (eq (car d) :relative)) (append defd (cdr d)))) d (def defd))) +++ :name (or (pathname-name pn) (def (pathname-name def-pn))) +++ :type (or (pathname-type pn) (def (pathname-type def-pn))) +++ :version (or (pathname-version pn) (def (unless (pathname-name pn) (pathname-version def-pn))) (def def-v)) +++ :version (unless dflt (return-from merge-pathnames pn))))) ++--- gcl-2.6.12.orig/lsp/gcl_mislib.lsp +++++ gcl-2.6.12/lsp/gcl_mislib.lsp ++@@ -114,13 +114,15 @@ ++ (* (+ h tz) 3600) (* min 60) sec)) ++ ++ (defun compile-file-pathname (pathname) ++-(make-pathname :defaults pathname :type "o")) +++ (make-pathname :defaults pathname :type "o")) +++ ++ (defun constantly (x) ++-#'(lambda (&rest args) +++ (lambda (&rest args) ++ (declare (ignore args) (:dynamic-extent args)) ++-x)) +++ x)) +++ ++ (defun complement (fn) ++-#'(lambda (&rest args) (not (apply fn args)))) +++ (lambda (&rest args) (not (apply fn args)))) ++ ++ (defun default-system-banner () ++ (let (gpled-modules) ++--- gcl-2.6.12.orig/lsp/gcl_module.lsp +++++ gcl-2.6.12/lsp/gcl_module.lsp ++@@ -40,13 +40,13 @@ ++ ++ (defun require (module-name ++ &optional (pathname (string-downcase (string module-name)))) ++- (let ((*default-pathname-defaults* #"")) +++ (let ((*default-pathname-defaults* (make-pathname))) ++ (unless (member (string module-name) ++ *modules* ++ :test #'string=) ++ (if (atom pathname) ++ (load pathname) ++- (do ((p pathname (cdr p))) +++ (do ((p pathname (cdr p))) ++ ((endp p)) ++ (load (car p))))))) ++ ++--- /dev/null +++++ gcl-2.6.12/lsp/gcl_namestring.lsp ++@@ -0,0 +1,39 @@ +++(in-package :si) +++ +++(defun namestring (x) +++ (declare (optimize (safety 1))) +++ (check-type x pathname-designator) +++ (typecase x +++ (string x) +++ (pathname (c-pathname-namestring x)) +++ (stream (namestring (c-stream-object1 x))))) +++ +++(defun file-namestring (x &aux (px (pathname x))) +++ (declare (optimize (safety 1))) +++ (check-type x pathname-designator) +++ (namestring (make-pathname :name (pathname-name px) :type (pathname-type px) :version (pathname-version px)))) +++ +++(defun directory-namestring (x &aux (px (pathname x))) +++ (declare (optimize (safety 1))) +++ (check-type x pathname-designator) +++ (namestring (make-pathname :directory (pathname-directory px)))) +++ +++(defun host-namestring (x &aux (px (pathname x))) +++ (declare (optimize (safety 1))) +++ (check-type x pathname-designator) +++ (or (pathname-host px) "")) +++ +++#.`(defun enough-namestring (x &optional (def *default-pathname-defaults*) &aux (px (pathname x))(pdef (pathname def))) +++ (declare (optimize (safety 1))) +++ (check-type x pathname-designator) +++ (check-type def pathname-designator) +++ ,(labels ((new? (k &aux (f (intern (concatenate 'string "PATHNAME-" (string k)) :si))) +++ `(let ((k (,f px))) (unless (equal k (,f pdef)) k)))) +++ `(namestring (make-pathname +++ ,@(mapcan (lambda (x) (list x (new? x))) +pathname-keys+))))) +++ +++(defun faslink (file name &aux (pfile (namestring (merge-pathnames (make-pathname :type "o") (pathname file))))(*package* *package*));FIXME +++ (declare (optimize (safety 1))) +++ (check-type file pathname-designator) +++ (check-type name string) +++ (faslink-int pfile name)) ++--- /dev/null +++++ gcl-2.6.12/lsp/gcl_parse_namestring.lsp ++@@ -0,0 +1,139 @@ +++(in-package :si) +++ +++(deftype seqind nil `fixnum) +++ +++(defun match-beginning (i &aux (v *match-data*)) +++ (declare ((vector fixnum) v)(seqind i)) +++ (the (or (integer -1 -1 ) seqind) (aref v i))) +++(defun match-end (i &aux (v *match-data*)) +++ (declare ((vector fixnum) v)(seqind i)) +++ (the (or (integer -1 -1 ) seqind) (aref v (+ i (ash (length v) -1))))) +++ +++(declaim (inline match-beginning match-end)) +++ +++(defun dir-conj (x) (if (eq x :relative) :absolute :relative)) +++ +++(defvar *up-key* :up) +++ +++(defun mfr (x b i) (subseq x b i)); (make-array (- i b) :element-type 'character :displaced-to x :displaced-index-offset b) +++ +++(defvar *sym-sub-alist* '((:host . nil) +++ (:device . nil) +++ (:directory . (("." . nil)(".." . :up)("*" . :wild)("**" . :wild-inferiors))) +++ (:name . (("*" . :wild))) +++ (:type . (("*" . :wild))) +++ (:version . (("*" . :wild)("NEWEST" . :newest))))) +++ +++(defun element (x b i key) +++ (let* ((z (when (> i b) (mfr x b i))) +++ (w (assoc z (cdr (assoc key *sym-sub-alist*)) :test 'string-equal)) +++ (z (if w (cdr w) z))) +++ (if (eq z :up) *up-key* z))) +++ +++(defun dir-parse (x sep sepfirst &optional (b 0)) +++ (when (stringp x) +++ (let ((i (search sep x :start2 b)));string-match spoils outer match results +++ (when i +++ (let* ((y (dir-parse x sep sepfirst (1+ i))) +++ (z (element x b i :directory)) +++ (y (if z (cons z y) y))) +++ (if (zerop b) +++ (cons (if (zerop i) sepfirst (dir-conj sepfirst)) y) +++ y)))))) +++ +++(defun match-component (x i k &optional (boff 0) (eoff 0)) +++ (element x (+ (match-beginning i) boff) (+ (match-end i) eoff) k)) +++ +++(defun version-parse (x) +++ (typecase x +++ (string (version-parse (parse-integer x))) +++; (integer (locally (check-type x (integer 1)) x)) +++ (otherwise x))) +++ +++(defconstant +generic-logical-pathname-regexp+ (compile-regexp (to-regexp-or-namestring (make-list (length +logical-pathname-defaults+)) t t))) +++ +++(defun expand-home-dir (dir) +++ (cond ((and (eq (car dir) :relative) (stringp (cadr dir)) (eql #\~ (aref (cadr dir) 0))) +++ (append (dir-parse (home-namestring (cadr dir)) "/" :absolute) (cddr dir))) +++ (dir))) +++ +++(defun logical-pathname-parse (x &optional host def (b 0) (e (length x))) +++ (when (and (eql b (string-match +generic-logical-pathname-regexp+ x b e)) (eql (match-end 0) e)) +++ (let ((mhost (match-component x 1 :host 0 -1))) +++ (when (and host mhost) +++ (unless (string-equal host mhost) +++ (error 'error :format-control "Host part of ~s does not match ~s" :format-arguments (list x host)))) +++ (let ((host (or host mhost (pathname-host def)))) +++ (when (logical-pathname-host-p host) +++ (let* ((dir (dir-parse (match-component x 2 :none) ";" :relative)) +++ (edir (expand-home-dir dir))) +++ (make-pathname :host host +++ :device :unspecific +++ :directory edir +++ :name (match-component x 6 :name) +++ :type (match-component x 8 :type 1) +++ :version (version-parse (match-component x 11 :version 1)) +++ :namestring (when (and mhost (eql b 0) (eql e (length x)) (eq dir edir)) x)))))))) +++ +++(defconstant +generic-physical-pathname-regexp+ (compile-regexp (to-regexp-or-namestring (make-list (length +physical-pathname-defaults+)) t nil))) +++ +++(defun pathname-parse (x b e) +++ (when (and (eql b (string-match +generic-physical-pathname-regexp+ x b e)) (eql (match-end 0) e)) +++ (let* ((dir (dir-parse (match-component x 1 :none) "/" :absolute)) +++ (edir (expand-home-dir dir))) +++ (make-pathname :directory edir +++ :name (match-component x 3 :name) +++ :type (match-component x 4 :type 1) +++ :namestring (when (and (eql b 0) (eql e (length x)) (eq dir edir)) x))))) +++ +++ +++(defun path-stream-name (x) +++ (check-type x pathname-designator) +++ (typecase x +++ (synonym-stream (path-stream-name (symbol-value (synonym-stream-symbol x)))) +++ (stream (path-stream-name (c-stream-object1 x))) +++ (otherwise x))) +++ +++(defun parse-namestring (thing &optional host (default-pathname *default-pathname-defaults*) &rest r &key (start 0) end junk-allowed) +++ (declare (optimize (safety 1))(dynamic-extent r)) +++ (check-type thing pathname-designator) +++ (check-type host (or null (satisfies logical-pathname-translations))) +++ (check-type default-pathname pathname-designator) +++ (check-type start seqind) +++ (check-type end (or null seqind)) +++ +++ (typecase thing +++ (string (let* ((e (or end (length thing))) +++ (l (logical-pathname-parse thing host default-pathname start e)) +++ (l (or l (unless host (pathname-parse thing start e))))) +++ (cond (junk-allowed (values l (max 0 (match-end 0)))) +++ (l (values l e)) +++ ((error 'parse-error :format-control "~s is not a valid pathname on host ~s" :format-arguments (list thing host)))))) +++ (stream (apply 'parse-namestring (path-stream-name thing) host default-pathname r)) +++ (pathname +++ (when host +++ (unless (string-equal host (pathname-host thing)) +++ (error 'file-error :pathname thing :format-control "Host does not match ~s" :format-arguments (list host)))) +++ (values thing start)))) +++ +++(defun pathname (spec) +++ (declare (optimize (safety 1))) +++ (check-type spec pathname-designator) +++ (if (typep spec 'pathname) spec (values (parse-namestring spec)))) +++ +++(defun sharp-p-reader (stream subchar arg) +++ (declare (ignore subchar arg)) +++ (let ((x (parse-namestring (read stream)))) x)) +++ +++(defun sharp-dq-reader (stream subchar arg);FIXME arg && read-suppress +++ (declare (ignore subchar arg)) +++ (unread-char #\" stream) +++ (let ((x (parse-namestring (read stream)))) x)) +++ +++(set-dispatch-macro-character #\# #\p 'sharp-p-reader) +++(set-dispatch-macro-character #\# #\p 'sharp-p-reader (standard-readtable)) +++(set-dispatch-macro-character #\# #\P 'sharp-p-reader) +++(set-dispatch-macro-character #\# #\P 'sharp-p-reader (standard-readtable)) +++(set-dispatch-macro-character #\# #\" 'sharp-dq-reader) +++(set-dispatch-macro-character #\# #\" 'sharp-dq-reader (standard-readtable)) +++ ++--- /dev/null +++++ gcl-2.6.12/lsp/gcl_pathname_match_p.lsp ++@@ -0,0 +1,14 @@ +++(in-package :si) +++ +++(defun to-regexp (x &optional (rp t) &aux (px (pathname x))(lp (typep px 'logical-pathname))) +++ (to-regexp-or-namestring (mlp px) rp lp)) +++ +++(deftype compiled-regexp nil `(vector unsigned-char)) +++ +++(defun pathname-match-p (p w &aux (s (namestring p))) +++ (declare (optimize (safety 1))) +++ (check-type p pathname-designator) +++ (check-type w (or compiled-regexp pathname-designator)) +++ (and (zerop (string-match (if (typep w 'compiled-regexp) w (to-regexp w)) s)) +++ (eql (match-end 0) (length s)))) +++ ++--- gcl-2.6.12.orig/lsp/gcl_predlib.lsp +++++ gcl-2.6.12/lsp/gcl_predlib.lsp ++@@ -110,6 +110,7 @@ ++ (not (array-has-fill-pointer-p x)) ++ (not (si:displaced-array-p x)))) ++ +++(defun logical-pathnamep (x) (when (pathnamep x) (eql (c-t-tt x) 1))) ++ ++ (do ((l '((null . null) ++ (symbol . symbolp) ++@@ -124,7 +125,15 @@ ++ (character . characterp) ++ (package . packagep) ++ (stream . streamp) +++ (file-stream . file-stream-p) +++ (synonym-stream . synonym-stream-p) +++ (broadcast-stream . broadcast-stream-p) +++ (concatenated-stream . concatenated-stream-p) +++ (two-way-stream . two-way-stream-p) +++ (echo-stream . echo-stream-p) ++ (pathname . pathnamep) +++ (pathname-designator . pathname-designatorp) +++ (logical-pathname . logical-pathnamep) ++ (readtable . readtablep) ++ (hash-table . hash-table-p) ++ (random-state . random-state-p) ++@@ -196,6 +205,8 @@ ++ ((null l) t) ++ (unless (typep object (car l)) (return nil)))) ++ (satisfies (funcall (car i) object)) +++ (eql (eql (car i) object)) +++ (member (member object i)) ++ ((t) t) ++ ((nil) nil) ++ (boolean (or (eq object 't) (eq object 'nil))) ++@@ -280,6 +291,40 @@ ++ (typep object (apply tem i))))))) ++ ++ +++ +++(defun minmax (i1 i2 low-p e &aux (fn (if low-p (if e '< '>) (if e '> '<)))) +++ (cond ((eq i1 '*) (if e i1 i2)) +++ ((eq i2 '*) (if e i2 i1)) +++ ((funcall fn i1 i2) i1) +++ (i2))) +++ +++(defun expand-range (low high bottom top) +++ (let ((low (minmax low bottom t t))(high (minmax high top nil t))) +++ (when (or (eq low '*) (eq high '*) (<= low high)) (list low high)))) +++ +++(defun nc (tp) +++ (when (consp tp) +++ (case (car tp) +++ ;; (immfix (let ((m (cadr tp))(x (caddr tp)) +++ ;; (list (list 'integer (if (eq m '*) most-negative-immfix m) (if (eq x '*) most-positive-immfix x))))) +++ ;; (bfix (let* ((m (cadr tp))(x (caddr tp))(m (if (eq m '*) most-negative-fixnum m))(x (if (eq x '*) most-positive-fixnum x))) +++ ;; (if (< (* m x) 0) +++ ;; `((integer ,m ,(1- most-negative-immfix))(integer ,(1+ most-positive-immfix) ,x)) +++ ;; `((integer ,m ,x))))) +++ ;; (bignum (let* ((m (cadr tp))(x (caddr tp))(sm (or (eq m '*) (< m 0)))(sx (or (eq x '*) (>= x 0)))) +++ ;; (if (and sm sx) +++ ;; `((integer ,m ,(1- most-negative-fixnum))(integer ,(1+ most-positive-fixnum) ,x)) +++ ;; `((integer ,m ,x))))) +++ ((integer ratio short-float long-float) (list tp)) +++ (otherwise (append (nc (car tp)) (nc (cdr tp))))))) +++ +++ +++(defun expand-ranges (type) +++ (reduce (lambda (y x &aux (z (assoc (car x) y))) +++ (if z (subst (cons (car z) (apply 'expand-range (cadr x) (caddr x) (cdr z))) z y) +++ (cons x y))) (nc type) :initial-value nil)) +++ +++ ++ ;;; NORMALIZE-TYPE normalizes the type using the DEFTYPE definitions. ++ ;;; The result is always a list. ++ (defun normalize-type (type &aux tp i ) ++--- /dev/null +++++ gcl-2.6.12/lsp/gcl_rename_file.lsp ++@@ -0,0 +1,47 @@ +++(in-package :si) +++ +++(defun set-path-stream-name (x y) +++ (check-type x pathname-designator) +++ (typecase x +++ (synonym-stream (set-path-stream-name (symbol-value (synonym-stream-symbol x)) y)) +++ (stream (c-set-stream-object1 x y)))) +++ +++(defun rename-file (f n &aux (pf (pathname f))(pn (merge-pathnames n pf nil)) +++ (tpf (truename pf))(nf (namestring tpf)) +++ (tpn (translate-logical-pathname pn))(nn (namestring tpn))) +++ (declare (optimize (safety 1))) +++ (check-type f pathname-designator) +++ (check-type n (and pathname-designator (not stream))) +++ (unless (rename nf nn) +++ (error 'file-error :pathname pf :format-control "Cannot rename ~s to ~s." :format-arguments (list nf nn))) +++ (set-path-stream-name f pn) +++ (values pn tpf (truename tpn))) +++ +++(defun user-homedir-pathname (&optional (host :unspecific hostp)) +++ (declare (optimize (safety 1))) +++ (check-type host (or string list (eql :unspecific))) +++ (unless hostp +++ (pathname (home-namestring "~")))) +++ +++(defun delete-file (f &aux (pf (truename f))(nf (namestring pf))) +++ (declare (optimize (safety 1))) +++ (check-type f pathname-designator) +++ (unless (if (eq :directory (stat nf)) (rmdir nf) (unlink nf)) +++ (error 'file-error :pathname (pathname nf) :format-control "Cannot delete pathname.")) +++ t) +++ +++(defun file-write-date (spec) +++ (declare (optimize (safety 1))) +++ (check-type spec pathname-designator) +++ (multiple-value-bind +++ (tp sz tm) (stat (namestring (truename spec))) +++ (+ tm (* (+ 17 (* 70 365)) (* 24 60 60))))) +++ +++ +++(defun file-author (spec) +++ (declare (optimize (safety 1))) +++ (check-type spec pathname-designator) +++ (multiple-value-bind +++ (tp sz tm uid) (stat (namestring (truename spec))) +++ (uid-to-name uid))) +++ ++--- gcl-2.6.12.orig/lsp/gcl_sharp.lsp +++++ gcl-2.6.12/lsp/gcl_sharp.lsp ++@@ -61,4 +61,6 @@ ++ (otherwise x))) ++ ++ (set-dispatch-macro-character #\# #\= #'sharp-eq-reader) +++(set-dispatch-macro-character #\# #\= #'sharp-eq-reader (standard-readtable)) ++ (set-dispatch-macro-character #\# #\# #'sharp-sharp-reader) +++(set-dispatch-macro-character #\# #\# #'sharp-sharp-reader (standard-readtable)) ++--- /dev/null +++++ gcl-2.6.12/lsp/gcl_sharp_uv.lsp ++@@ -0,0 +1,29 @@ +++(in-package :si) +++ +++(defun regexp-conv (stream) +++ +++ (let ((tem (make-array 10 :element-type 'character :fill-pointer 0))) +++ (or (eql (read-char stream) #\") +++ (error "sharp-u-reader reader needs a \" right after it")) +++ (loop +++ (let ((ch (read-char stream))) +++ (cond ((eql ch #\") (return tem)) +++ ((eql ch #\\) +++ (setq ch (read-char stream)) +++ (setq ch (or (cdr (assoc ch '((#\n . #\newline) +++ (#\t . #\tab) +++ (#\r . #\return)))) +++ ch)))) +++ (vector-push-extend ch tem))) +++ tem)) +++ +++(defun sharp-u-reader (stream subchar arg) +++ (declare (ignore subchar arg)) +++ (regexp-conv stream)) +++ +++(defun sharp-v-reader (stream subchar arg) +++ (declare (ignore subchar arg)) +++ `(load-time-value (compile-regexp ,(regexp-conv stream)))) +++ +++(set-dispatch-macro-character #\# #\u 'sharp-u-reader) +++(set-dispatch-macro-character #\# #\v 'sharp-v-reader) ++--- gcl-2.6.12.orig/lsp/gcl_top.lsp +++++ gcl-2.6.12/lsp/gcl_top.lsp ++@@ -83,7 +83,7 @@ ++ (progn ++ (cond ++ (*multiply-stacks* (setq *multiply-stacks* nil)) ++- ((probe-file "init.lsp") (load "init.lsp")))) +++ ((when (fboundp 'probe-file) (probe-file "init.lsp")) (load "init.lsp")))) ++ (when (if (symbolp *top-level-hook*) (fboundp *top-level-hook*) (functionp *top-level-hook*)) ++ (funcall *top-level-hook*))) ++ ++@@ -122,6 +122,8 @@ ++ ++ (defvar *error-p* nil) ++ +++(defvar *lib-directory* nil) +++ ++ (defun process-some-args (args &optional compile &aux *load-verbose*) ++ (when args ++ (let ((x (pop args))) ++@@ -148,7 +150,7 @@ ++ (file (cdr (assoc :compile compile))) ++ (o (cdr (assoc :o compile))) ++ (compile (remove :o (remove :compile compile :key 'car) :key 'car)) ++- (compile (cons (cons :output-file (or o file)) compile)) ++++ (compile (cons (cons :output-file (or o (merge-pathnames ".o" file))) compile)) ++ (result (system:error-set `(apply 'compile-file ,file ',(mapcan (lambda (x) (list (car x) (cdr x))) compile))))) ++ (bye (if (or *error-p* (equal result '(nil))) 1 0))))) ++ ++@@ -520,15 +522,12 @@ add a new one, add a 'si::break-command ++ ++ ;;make sure '/' terminated ++ ++-(defun coerce-slash-terminated (v ) ++- (declare (string v)) ++- (or (stringp v) (error "not a string ~a" v)) +++(defun coerce-slash-terminated (v) ++ (let ((n (length v))) ++- (declare (fixnum n)) ++- (unless (and (> n 0) (eql ++- (the character(aref v (the fixnum (- n 1)))) #\/)) ++- (setf v (format nil "~a/" v)))) ++- v) +++ (if (and (> n 0) (eql (aref v (1- n)) #\/)) +++ v +++ (string-concatenate v "/")))) +++ ++ (defun fix-load-path (l) ++ (when (not (equal l *fixed-load-path*)) ++ (do ((x l (cdr x)) ) ++@@ -587,19 +586,17 @@ First directory is checked for first nam ++ (when (and s (symbol-value s)) ++ (list *system-directory*)))) ++ ++- ++-(defun get-temp-dir nil ++- (dolist (x `(,@(wine-tmp-redirect) ,@(mapcar 'getenv '("TMPDIR" "TMP" "TEMP")) "/tmp" "")) ++- (when (or (stringp x) (pathnamep x)) ++- (let* ((x (truename (pathname x))) ++- (y (namestring (make-pathname :name (pathname-name x) :type (pathname-type x) :version (pathname-version x)))) ++- (y (unless (zerop (length y)) (list y)))) ++- (when (eq :directory (car (stat x))) ++- (return-from get-temp-dir ++- (namestring ++- (make-pathname ++- :device (pathname-device x) ++- :directory (append (pathname-directory x) y))))))))) +++(defun ensure-dir-string (str) +++ (if (eq (stat str) :directory) +++ (coerce-slash-terminated str) +++ str)) +++ +++(defun get-temp-dir () +++ (dolist (x `(,@(wine-tmp-redirect) ,@(mapcar 'si::getenv '("TMPDIR" "TMP" "TEMP")) "/tmp" "")) +++ (when x +++ (let ((x (coerce-slash-terminated x))) +++ (when (eq (stat x) :directory) +++ (return-from get-temp-dir x)))))) ++ ++ (defun get-path (s &aux (m (string-match "([^/ ]*)( |$)" s))(b (match-beginning 1))(e (match-end 1)) ++ (r (with-open-file (s (concatenate 'string "|which " (subseq s b e))) (read s nil 'eof)))) ++--- /dev/null +++++ gcl-2.6.12/lsp/gcl_translate_pathname.lsp ++@@ -0,0 +1,90 @@ +++(in-package :si) +++ +++(defun lenel (x lp) +++ (case x (:wild 1)(:wild-inferiors 2)(:absolute (if lp -1 0))(:relative (if lp 0 -1)) +++ ((:unspecific nil :newest) -1)(otherwise (length x)))) +++ +++(defun next-match (&optional (i 1) (k -1) (m (1- (ash (length *match-data*) -1)))) +++ (cond ((< k (match-beginning i) (match-end i)) i) +++ ((< i m) (next-match (1+ i) k m)) +++ (i))) +++ +++(defun mme2 (s lel lp &optional (b 0) (i (next-match)) r el +++ &aux (e (+ b (lenel (car lel) lp)))(j (match-beginning i))(k (match-end i))) +++ (cond +++ ((< (- b 2) j k (+ e 2)) +++ (let* ((z (car lel))(b1 (max b j))(e1 (min k e)) +++ (z (if (or (< b b1) (< e1 e)) (subseq z (- b1 b) (- e1 b)) z)) +++ (r (if el r (cons nil r)))) +++ (mme2 s lel lp b (next-match i k) (cons (cons z (car r)) (cdr r)) (or el (car lel))))) +++ ((< (1- j) b e (1+ k)) +++ (let ((r (if el r (cons nil r)))) +++ (mme2 s (cdr lel) lp (1+ e) i (cons (cons (car lel) (car r)) (cdr r)) (or el (list (car lel)))))) +++ ((consp el) +++ (let* ((cr (nreverse (car r)))) +++ (mme2 s lel lp b (next-match i k) (cons (cons (car el) (list cr)) (cdr r))))) +++ (el +++ (let* ((cr (nreverse (car r)))) +++ (mme2 s (cdr lel) lp (1+ e) i (cons (cons el cr) (cdr r))))) +++ (lel (mme2 s (cdr lel) lp (1+ e) i (cons (car lel) r))) +++ ((nreverse r)))) +++ +++(defun do-repl (x y) +++ (labels ((r (x l &optional (b 0) &aux (f (string-match #v"\\*" x b))) +++ (if (eql f -1) (if (eql b 0) x (subseq x b)) +++ (concatenate 'string (subseq x b f) (or (car l) "") (r x (cdr l) (1+ f)))))) +++ (r y x))) +++ +++(defun dir-p (x) (when (consp x) (member (car x) '(:absolute :relative)))) +++ +++(defun source-portion (x y) +++ (cond +++ ((or (dir-p x) (dir-p y)) +++ (mapcan (lambda (z &aux (w (source-portion +++ (if y (when (wild-dir-element-p z) (setf x (member-if 'listp x)) (pop x)) z) +++ (when y z)))) +++ (if (listp w) w (list w))) (or y x))) +++ ((if y (eq y :wild-inferiors) t) (if (listp x) (if (listp (cadr x)) (cadr x) (car x)) x));(or y) +++ ((eq y :wild) (if (listp x) (car x) x));(or y) +++ ((stringp y) (do-repl (when (listp x) (unless (listp (cadr x)) (cdr x))) y)) +++ (y))) +++ +++(defun list-toggle-case (x f) +++ (typecase x +++ (string (funcall f x)) +++ (cons (mapcar (lambda (x) (list-toggle-case x f)) x)) +++ (otherwise x))) +++ +++(defun mme3 (sx px flp tlp) +++ (list-toggle-case +++ (lnp (mme2 sx (pnl1 (mlp px)) flp)) +++ (cond ((eq flp tlp) 'identity) +++ (flp 'string-downcase) +++ (tlp 'string-upcase)))) +++ +++(defun translate-pathname (source from to &key +++ &aux (psource (pathname source)) +++ (pto (pathname to)) +++ (match (pathname-match-p source from))) +++ (declare (optimize (safety 1))) +++ (check-type source pathname-designator) +++ (check-type from pathname-designator) +++ (check-type to pathname-designator) +++ (check-type match (not null)) +++ (apply 'make-pathname :host (pathname-host pto) :device (pathname-device pto) +++ (mapcan 'list +pathname-keys+ +++ (mapcar 'source-portion +++ (mme3 (namestring source) psource (typep psource 'logical-pathname) (typep pto 'logical-pathname)) +++ (mlp pto))))) +++ +++(defun translate-logical-pathname (spec &key &aux (p (pathname spec))) +++ (declare (optimize (safety 1))) +++ (check-type spec pathname-designator) +++ (typecase p +++ (logical-pathname +++ (let ((rules (assoc p (logical-pathname-translations (pathname-host p)) :test 'pathname-match-p))) +++ (unless rules +++ (error 'file-error :pathname p :format-control "No matching translations")) +++ (translate-logical-pathname (apply 'translate-pathname p rules)))) +++ (otherwise p))) +++ ++--- /dev/null +++++ gcl-2.6.12/lsp/gcl_truename.lsp ++@@ -0,0 +1,43 @@ +++(in-package :si) +++ +++(defun link-expand (str &optional (b 0) (n (length str)) fr) +++ (labels ((frame (b e) (make-array (- n b) :element-type 'character +++ :displaced-to str :displaced-index-offset b :fill-pointer (- e b))) +++ (set-fr (fr e &aux (fr (or fr (frame 0 b)))) (setf (fill-pointer fr) e) fr)) +++ (let* ((i (string-match #v"/" str b)) +++ (fr (set-fr fr (if (eql i -1) n i))) +++ (l (when (eq (stat fr) :link) (readlinkat 0 fr)))) +++ (cond (l (let ((b (if (eql #\/ (aref l 0)) 0 b))) +++ (link-expand (concatenate 'string (set-fr fr b) l (frame (if (eql i -1) n i) n)) b))) +++ ((eql i -1) str) +++ ((link-expand str (1+ i) n fr)))))) +++ +++(defun logical-pathname-designator-p (x) +++ (typecase x +++ (string (logical-pathname-parse x)) +++ (pathname (typep x 'logical-pathname)) +++ (stream (logical-pathname-designator-p (pathname x))))) +++ +++;(defvar *current-dir* (pathname (concatenate 'string (getcwd) "/"))) FIXME sync with chdir +++ +++(defun truename (pd &aux (ppd (translate-logical-pathname pd))(ns (namestring ppd))) +++ (declare (optimize (safety 1))) +++ (check-type pd pathname-designator) +++ (when (wild-pathname-p ns) +++ (error 'file-error :pathname pd :format-control "Pathname is wild")) +++ (let* ((ns (ensure-dir-string (link-expand ns)))) +++ (unless (or (zerop (length ns)) (stat ns)) +++ (error 'file-error :pathname ns :format-control "Pathname does not exist")) +++ (let* ((d (pathname-directory ppd)) +++ (d1 (subst :back :up d)) +++ (ppd (if (eq d d1) ppd (make-pathname :directory d1 :defaults ppd)))) +++ (if (eq (car d) :absolute) ppd (merge-pathnames ppd (concatenate 'string (getcwd) "/") nil))))) +++ +++ +++(defun probe-file (pd &aux (pn (translate-logical-pathname pd))) +++ (declare (optimize (safety 1))) +++ (check-type pd pathname-designator) +++ (when (wild-pathname-p pn) +++ (error 'file-error :pathname pn :format-control "Pathname is wild")) +++ (when (eq (stat (namestring pn)) :file) +++ (truename pn))) ++--- /dev/null +++++ gcl-2.6.12/lsp/gcl_wild_pathname_p.lsp ++@@ -0,0 +1,28 @@ +++(in-package :si) +++ +++(defun wild-namestring-p (x) +++ (when (stringp x) (>= (string-match #v"(\\*|\\?|\\[|\\{)" x) 0))) +++ +++(defun wild-dir-element-p (x) +++ (or (eq x :wild) (eq x :wild-inferiors) (wild-namestring-p x))) +++ +++(defun wild-path-element-p (x) +++ (or (eq x :wild) (wild-namestring-p x))) +++ +++#.`(defun wild-pathname-p (pd &optional f) +++ (declare (optimize (safety 1))) +++ (check-type pd pathname-designator) +++ (check-type f (or null (member ,@+pathname-keys+))) +++ (case f +++ ((nil) (or (wild-namestring-p (namestring pd)) +++ (when (typep pd 'pathname);FIXME stream +++ (eq :wild (pathname-version pd))))) +++ ;; ((nil) (if (stringp pd) (wild-namestring-p pd) +++ ;; (let ((p (pathname pd))) +++ ;; (when (member-if (lambda (x) (wild-pathname-p p x)) +pathname-keys+) t)))) +++ ((:host :device) nil) +++ (:directory (when (member-if 'wild-dir-element-p (pathname-directory pd)) t)) +++ (:name (wild-path-element-p (pathname-name pd))) +++ (:type (wild-path-element-p (pathname-type pd))) +++ (:version (wild-path-element-p (pathname-version pd))))) +++ ++--- gcl-2.6.12.orig/lsp/makefile +++++ gcl-2.6.12/lsp/makefile ++@@ -13,9 +13,12 @@ OBJS = gcl_sharp.o gcl_arraylib.o gcl_as ++ gcl_describe.o gcl_evalmacros.o gcl_fpe.o \ ++ gcl_iolib.o gcl_listlib.o gcl_mislib.o gcl_module.o gcl_numlib.o \ ++ gcl_packlib.o gcl_predlib.o \ +++ gcl_parse_namestring.o gcl_make_pathname.o gcl_namestring.o gcl_translate_pathname.o\ +++ gcl_logical_pathname_translations.o gcl_directory.o gcl_merge_pathnames.o gcl_truename.o gcl_sharp_uv.o\ ++ gcl_seq.o gcl_seqlib.o gcl_setf.o gcl_top.o gcl_trace.o gcl_sloop.o \ ++ gcl_debug.o gcl_info.o gcl_serror.o gcl_restart.o \ ++- gcl_destructuring_bind.o gcl_defpackage.o gcl_make_defpackage.o gcl_loop.o $(EXTRA_LOBJS) +++ gcl_rename_file.o gcl_pathname_match_p.o gcl_wild_pathname_p.o \ +++ gcl_destructuring_bind.o gcl_defpackage.o gcl_make_defpackage.o gcl_loop.o $(EXTRA_LOBJS) ++ # export.o autoload.o auto_new.o ++ ++ LISP=$(PORTDIR)/saved_pre_gcl$(EXE) ++--- gcl-2.6.12.orig/lsp/sys-proclaim.lisp +++++ gcl-2.6.12/lsp/sys-proclaim.lisp ++@@ -2,361 +2,223 @@ ++ (COMMON-LISP::IN-PACKAGE "SYSTEM") ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++- ANSI-LOOP::LOOP-EMIT-FINAL-VALUE SYSTEM::INSPECT-CHARACTER ++- SYSTEM::INSPECT-STRUCTURE SYSTEM::PRINT-IHS SYSTEM::DBL-RPL-LOOP ++- SYSTEM::RESTART-FUNCTION COMMON-LISP::TANH COMMON-LISP::FIFTH ++- SLOOP::PARSE-LOOP-INITIALLY SYSTEM::NEXT-STACK-FRAME ++- SYSTEM::IDESCRIBE SYSTEM::PROCESS-ARGS SYSTEM::LEAP-YEAR-P ++- SLOOP::AVERAGING-SLOOP-MACRO SYSTEM::FIX-LOAD-PATH ++- SLOOP::SUBSTITUTE-SLOOP-BODY SYSTEM::RESTART-REPORT-FUNCTION ++- COMMON-LISP::NINTH SLOOP::SLOOP-SLOOP-MACRO ++- SYSTEM::S-DATA-CONSTRUCTORS SYSTEM::FREEZE-DEFSTRUCT ++- COMMON-LISP::EIGHTH SYSTEM::FIND-DOCUMENTATION ++- ANSI-LOOP::LOOP-PSEUDO-BODY COMMON-LISP::RATIONAL ++- ANSI-LOOP::LOOP-EMIT-BODY COMMON-LISP::ASIN ++- COMMON-LISP::COMPILE-FILE-PATHNAME SYSTEM::S-DATA-P ++- SYSTEM::BKPT-FUNCTION SYSTEM::TRACE-ONE-PREPROCESS ++- COMMON-LISP::LOGNOT SYSTEM::SIMPLE-ARRAY-P SYSTEM::BKPT-FILE ++- SYSTEM::S-DATA-STATICP COMMON-LISP::ISQRT SYSTEM::INSTREAM-P ++- COMMON-LISP::SEVENTH SYSTEM::S-DATA-NAMED ++- ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS SYSTEM::INSPECT-NUMBER ++- COMMON-LISP::ATANH SYSTEM::RESTART-TEST-FUNCTION ++- SYSTEM::S-DATA-INCLUDES SYSTEM::S-DATA-HAS-HOLES ++- SYSTEM::CONTEXT-VEC FPE::XMM-LOOKUP SYSTEM::S-DATA-RAW ++- ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS ++- SYSTEM::RESTART-INTERACTIVE-FUNCTION ++- ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS ++- ANSI-LOOP::LOOP-COLLECTOR-NAME ANSI-LOOP::LOOP-PATH-NAMES ++- ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE ++- SYSTEM::S-DATA-INCLUDED SYSTEM::S-DATA-SLOT-DESCRIPTIONS ++- SYSTEM::S-DATA-OFFSET SLOOP::REPEAT-SLOOP-MACRO ++- SYSTEM::S-DATA-PRINT-FUNCTION ANSI-LOOP::LOOP-PATH-USER-DATA ++- COMMON-LISP::FIND-ALL-SYMBOLS COMMON-LISP::FIRST ++- SYSTEM::GET-BYTE-STREAM-NCHARS SYSTEM::BKPT-FORM ++- SYSTEM::NODES-FROM-INDEX SYSTEM::INSPECT-SYMBOL ++- SYSTEM::KNOWN-TYPE-P ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE ++- SYSTEM::MAKE-DEFPACKAGE-FORM COMMON-LISP::ARRAY-DIMENSIONS ++- SYSTEM::INSERT-BREAK-POINT SLOOP::PARSE-LOOP ++- ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED ++- ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS SYSTEM::SHORT-NAME ++- SYSTEM::CHECK-TRACE-SPEC ANSI-LOOP::DESTRUCTURING-SIZE ++- SYSTEM::BEST-ARRAY-ELEMENT-TYPE SYSTEM::CONTEXT-HASH ++- COMMON-LISP::SIXTH SYSTEM::IHS-VISIBLE SYSTEM::INSPECT-ARRAY ++- COMMON-LISP::BYTE-SIZE ANSI-LOOP::LOOP-COLLECTOR-CLASS ++- ANSI-LOOP::LOOP-HACK-ITERATION ++- ANSI-LOOP::LOOP-CONSTRUCT-RETURN SYSTEM::S-DATA-SLOT-POSITION ++- ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE SYSTEM::INSPECT-STRING ++- COMMON-LISP::PROVIDE COMMON-LISP::CIS ++- ANSI-LOOP::LOOP-MINIMAX-OPERATIONS ++- SYSTEM::BREAK-BACKWARD-SEARCH-STACK ++- ANSI-LOOP::LOOP-COLLECTOR-DTYPE ++- SYSTEM::IHS-NOT-INTERPRETED-ENV SYSTEM::SEARCH-STACK ++- COMMON-LISP::TENTH ANSI-LOOP::LOOP-DO-THEREIS ++- ANSI-LOOP::LOOP-MAXMIN-COLLECTION ++- ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA ++- ANSI-LOOP::LOOP-MAKE-PSETQ SYSTEM::ADD-TO-HOTLIST ++- SYSTEM::INSPECT-CONS ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS ++- SYSTEM::INSPECT-VECTOR COMMON-LISP::CONSTANTLY ++- SYSTEM::REWRITE-RESTART-CASE-CLAUSE SYSTEM::DM-BAD-KEY ++- SYSTEM::PRINT-SYMBOL-APROPOS SYSTEM::FRS-KIND FPE::ST-LOOKUP ++- COMMON-LISP::FOURTH SYSTEM::TERMINAL-INTERRUPT ++- SYSTEM::DM-KEY-NOT-ALLOWED SYSTEM::UNIQUE-ID ++- SYSTEM::S-DATA-FROZEN SLOOP::POINTER-FOR-COLLECT ++- SYSTEM::INSPECT-PACKAGE SYSTEM::DBL-EVAL ++- ANSI-LOOP::LOOP-MINIMAX-TYPE ANSI-LOOP::LOOP-UNIVERSE-ANSI ++- ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS SYSTEM::DWIM ++- SYSTEM::INSTREAM-STREAM-NAME SLOOP::RETURN-SLOOP-MACRO ++- SYSTEM::PATCH-SHARP SYSTEM::CONTEXT-P SYSTEM::INFO-GET-FILE ++- SYSTEM::RESTART-P COMMON-LISP::COSH COMMON-LISP::SINH ++- SYSTEM::GET-NEXT-VISIBLE-FUN SYSTEM::CHECK-DECLARATIONS ++- SYSTEM::GET-INSTREAM ++- ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD SYSTEM::S-DATA-NAME ++- ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS ++- SYSTEM::S-DATA-DOCUMENTATION SYSTEM::SHOW-BREAK-POINT ++- COMMON-LISP::ACOS COMMON-LISP::INVOKE-DEBUGGER ++- SYSTEM::BKPT-FILE-LINE ANSI-LOOP::LOOP-COLLECTOR-DATA ++- COMMON-LISP::THIRD SYSTEM::S-DATA-CONC-NAME ++- COMMON-LISP::SIGNUM ++- ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED ++- SYSTEM::NORMALIZE-TYPE ANSI-LOOP::LOOP-TYPED-INIT ++- ANSI-LOOP::LOOP-PATH-FUNCTION SYSTEM::INFO-NODE-FROM-POSITION ++- COMMON-LISP::ASINH SYSTEM::RE-QUOTE-STRING ++- SLOOP::LOOP-COLLECT-KEYWORD-P SYSTEM::PRINT-FRS ++- SYSTEM::EVAL-FEATURE ANSI-LOOP::LOOP-COLLECTOR-P ++- ANSI-LOOP::LOOP-COLLECTOR-HISTORY ++- ANSI-LOOP::LOOP-LIST-COLLECTION ++- SYSTEM::BREAK-FORWARD-SEARCH-STACK COMMON-LISP::RESTART-NAME ++- SLOOP::PARSE-NO-BODY ANSI-LOOP::LOOP-UNIVERSE-P ++- SYSTEM::NUMBER-OF-DAYS-FROM-1900 SYSTEM::NODE-OFFSET ++- ANSI-LOOP::LOOP-MINIMAX-P SYSTEM::IHS-FNAME FPE::LOOKUP ++- SLOOP::LOOP-LET-BINDINGS FPE::GREF COMMON-LISP::PHASE ++- COMMON-LISP::BYTE-POSITION SYSTEM::INSTREAM-STREAM ++- ANSI-LOOP::LOOP-PATH-P SYSTEM::SEQTYPE COMMON-LISP::ACOSH ++- COMMON-LISP::ABS COMMON-LISP::COMPLEMENT ++- ANSI-LOOP::LOOP-CONSTANTP SYSTEM::WALK-THROUGH ++- SYSTEM::SETUP-INFO SYSTEM::COMPUTING-ARGS-P ++- SYSTEM::CONTEXT-SPICE SYSTEM::MAKE-KCL-TOP-RESTART ++- COMMON-LISP::COMPILER-MACRO-FUNCTION ++- ANSI-LOOP::LOOP-MAKE-DESETQ SYSTEM::SHOW-ENVIRONMENT ++- SLOOP::TRANSLATE-NAME SYSTEM::INFO-GET-TAGS ++- COMMON-LISP::SECOND SYSTEM::RESET-TRACE-DECLARATIONS ++- SYSTEM::S-DATA-TYPE SYSTEM::FIND-KCL-TOP-RESTART ++- ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE SYSTEM::DO-F ++- ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS COMMON-LISP::VECTOR-POP)) +++ (COMMON-LISP::FUNCTION +++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER +++ COMMON-LISP::*) +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807)) +++ COMMON-LISP::FIXNUM) +++ SYSTEM::ATOI)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++- SYSTEM::IHS-BACKTRACE SYSTEM::BREAK-NEXT SYSTEM::BREAK-QUIT ++- SYSTEM::SHOW-BREAK-VARIABLES SYSTEM::BREAK-BDS ++- COMMON-LISP::MUFFLE-WARNING SYSTEM::BREAK-PREVIOUS ++- SYSTEM::INFO-ERROR ANSI-LOOP::LOOP-OPTIONAL-TYPE ++- SYSTEM::DBL-BACKTRACE SYSTEM::BREAK-LOCAL SYSTEM::BREAK-VS ++- COMMON-LISP::CONTINUE)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ (COMMON-LISP::OR COMMON-LISP::NULL +++ COMMON-LISP::HASH-TABLE)) +++ SYSTEM::CONTEXT-HASH)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) ++- COMMON-LISP::FIXNUM) ++- SYSTEM::DBL-WHAT-FRAME FPE::FE-ENABLE)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ SYSTEM::PARSE-DEFMACRO-LAMBDA-LIST SYSTEM::PARSE-DEFMACRO)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++- COMMON-LISP::SUBTYPEP COMMON-LISP::REDUCE SYSTEM::PARSE-BODY ++- COMMON-LISP::STABLE-SORT COMMON-LISP::SORT ++- SLOOP::FIND-IN-ORDERED-LIST)) +++ COMMON-LISP::SUBTYPEP COMMON-LISP::REDUCE +++ SLOOP::FIND-IN-ORDERED-LIST SYSTEM::PARSE-BODY +++ COMMON-LISP::STABLE-SORT COMMON-LISP::SORT)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++- SYSTEM::VERIFY-KEYWORDS SYSTEM::RESTART-PRINT ++- ANSI-LOOP::LOOP-GET-COLLECTION-INFO SYSTEM::LIST-MERGE-SORT ++- SYSTEM::READ-INSPECT-COMMAND SYSTEM::SHARP---READER ++- SYSTEM::SHARP-+-READER SYSTEM::SHARP-S-READER)) +++ SYSTEM::SHARP-+-READER SYSTEM::SHARP---READER +++ SYSTEM::SHARP-S-READER ANSI-LOOP::LOOP-GET-COLLECTION-INFO +++ SYSTEM::VERIFY-KEYWORDS SYSTEM::LIST-MERGE-SORT +++ SYSTEM::RESTART-PRINT SYSTEM::READ-INSPECT-COMMAND)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) ++ COMMON-LISP::*) ++- SYSTEM::PUSH-OPTIONAL-BINDING)) +++ SYSTEM::TRACE-CALL)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) ++ COMMON-LISP::*) ++- SYSTEM::PARSE-DEFMACRO-LAMBDA-LIST SYSTEM::PARSE-DEFMACRO)) +++ SYSTEM::EXPAND-WILD-DIRECTORY SYSTEM::MASET)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::*) ++- SYSTEM::TRACE-CALL)) +++ SYSTEM::MME3)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::*) ++- COMMON-LISP::*) ++- SYSTEM::MASET)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++- FPE::REG-LOOKUP SYSTEM::INSTREAM-LINE SYSTEM::THE-START ++- SYSTEM::S-DATA-LENGTH SYSTEM::S-DATA-SIZE)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) ++- SYSTEM::PUSH-CONTEXT SYSTEM::GET-CONTEXT)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) ++- SYSTEM::BREAK-CURRENT SYSTEM::GCL-TOP-LEVEL ++- SYSTEM::BREAK-MESSAGE SYSTEM::BREAK-RESUME ++- ANSI-LOOP::LOOP-DO-FOR SYSTEM::SIMPLE-BACKTRACE ++- SYSTEM::BREAK-HELP)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::STRING) COMMON-LISP::T) ++- SYSTEM::COERCE-SLASH-TERMINATED SYSTEM::RESET-SYS-PATHS)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::T) ++- COMMON-LISP::BIT COMMON-LISP::READ-BYTE ++- COMMON-LISP::CONCATENATE SYSTEM::INFO-SEARCH ++- COMMON-LISP::ARRAY-IN-BOUNDS-P ANSI-LOOP::LOOP-ERROR ++- ANSI-LOOP::LOOP-WARN COMMON-LISP::REMOVE-DUPLICATES ++- SYSTEM::BAD-SEQ-LIMIT SYSTEM::PROCESS-SOME-ARGS ++- ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES ++- SLOOP::LOOP-ADD-TEMPS COMMON-LISP::BIT-NOT COMMON-LISP::SIGNAL ++- SYSTEM::NTH-STACK-FRAME COMMON-LISP::ARRAY-ROW-MAJOR-INDEX ++- COMMON-LISP::MAKE-ARRAY SYSTEM::FILE-SEARCH ++- SYSTEM::LIST-MATCHES COMMON-LISP::FIND-RESTART ++- SYSTEM::BREAK-LEVEL COMMON-LISP::DELETE-DUPLICATES ++- SLOOP::ADD-FROM-DATA COMMON-LISP::ERROR COMMON-LISP::WARN ++- SYSTEM::FILE-TO-STRING ++- COMMON-LISP::UPGRADED-ARRAY-ELEMENT-TYPE COMMON-LISP::SBIT)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++- SYSTEM::FIND-DOC SYSTEM::RESTART-REPORT ++- ANSI-LOOP::ESTIMATE-CODE-SIZE-1 SYSTEM::NEWLINE ++- ANSI-LOOP::ESTIMATE-CODE-SIZE SYSTEM::NEW-SEMI-COLON-READER)) +++ SYSTEM::PUSH-OPTIONAL-BINDING)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) ++ SYSTEM::MAKE-KEYWORD)) ++-(COMMON-LISP::MAPC ++- (COMMON-LISP::LAMBDA (COMPILER::X) ++- (COMMON-LISP::SETF ++- (COMMON-LISP::GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE) ++- COMMON-LISP::T)) ++- '(SYSTEM::SI-CLASS-PRECEDENCE-LIST SYSTEM::SI-CLASSP ++- SYSTEM::SIMPLE-CONDITION-CLASS-P SYSTEM::UNTRACE-ONE ++- SYSTEM::CONDITIONP SYSTEM::CONDITION-CLASS-P ++- SYSTEM::MAKE-ACCESS-FUNCTION SYSTEM::SI-CLASS-NAME ++- SYSTEM::AUTOLOAD-MACRO SYSTEM::AUTOLOAD SYSTEM::SI-CLASS-OF ++- SYSTEM::WARNINGP SYSTEM::DEFINE-STRUCTURE ++- FPE::BREAK-ON-FLOATING-POINT-EXCEPTIONS SYSTEM::SI-FIND-CLASS ++- SYSTEM::TRACE-ONE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM +++ (COMMON-LISP::T +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807) +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807) ++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ SYSTEM::QUICK-SORT)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::T ++- COMMON-LISP::T) +++ (COMMON-LISP::T +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807) +++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ SYSTEM::BIGNTHCDR)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ COMMON-LISP::EVERY COMMON-LISP::SET-DIFFERENCE +++ SYSTEM::VECTOR-PUSH-STRING SYSTEM::PROCESS-ERROR +++ COMMON-LISP::POSITION-IF-NOT COMMON-LISP::FIND-IF +++ SLOOP::LOOP-ADD-BINDING COMMON-LISP::BIT-ORC1 +++ COMMON-LISP::READ-SEQUENCE SYSTEM::INTERNAL-COUNT-IF +++ COMMON-LISP::COUNT COMMON-LISP::MISMATCH +++ COMMON-LISP::ADJUST-ARRAY COMMON-LISP::INTERSECTION +++ COMMON-LISP::UNION COMMON-LISP::DELETE-IF-NOT +++ COMMON-LISP::NINTERSECTION COMMON-LISP::BIT-ANDC1 +++ COMMON-LISP::REMOVE-IF-NOT COMMON-LISP::TYPEP +++ COMMON-LISP::NUNION COMMON-LISP::WRITE-SEQUENCE +++ COMMON-LISP::VECTOR-PUSH-EXTEND COMMON-LISP::REMOVE +++ COMMON-LISP::BIT-IOR SLOOP::PARSE-LOOP-MACRO +++ COMMON-LISP::SEARCH COMMON-LISP::SUBSETP +++ COMMON-LISP::SET-EXCLUSIVE-OR SYSTEM::WREADDIR +++ COMMON-LISP::POSITION-IF COMMON-LISP::DELETE +++ COMMON-LISP::BIT-EQV COMMON-LISP::BIT-ANDC2 +++ COMMON-LISP::BIT-AND COMMON-LISP::NSET-EXCLUSIVE-OR +++ SLOOP::IN-ARRAY-SLOOP-FOR ANSI-LOOP::LOOP-CHECK-DATA-TYPE +++ COMMON-LISP::POSITION COMMON-LISP::MAKE-SEQUENCE +++ COMMON-LISP::NOTEVERY COMMON-LISP::MAP-INTO +++ COMMON-LISP::REPLACE COMMON-LISP::NSET-DIFFERENCE +++ COMMON-LISP::FIND-IF-NOT COMMON-LISP::BIT-ORC2 +++ COMMON-LISP::DELETE-IF COMMON-LISP::CERROR +++ COMMON-LISP::BIT-XOR COMMON-LISP::FIND COMMON-LISP::FILL +++ SYSTEM::INTERNAL-COUNT-IF-NOT COMMON-LISP::REMOVE-IF +++ COMMON-LISP::BIT-NAND COMMON-LISP::BIT-NOR COMMON-LISP::SOME +++ COMMON-LISP::COUNT-IF SYSTEM::BREAK-CALL +++ COMMON-LISP::COUNT-IF-NOT SYSTEM::FIND-IHS COMMON-LISP::NOTANY +++ SYSTEM::INTERNAL-COUNT)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE ANSI-LOOP::LOOP-FOR-IN ++- SYSTEM::DEFMACRO* SYSTEM::APPLY-DISPLAY-FUN ++- SYSTEM::WARN-VERSION ANSI-LOOP::HIDE-VARIABLE-REFERENCE ++- SYSTEM::SHARP-U-READER ANSI-LOOP::LOOP-FOR-ACROSS ++- SYSTEM::DM-VL SYSTEM::GET-SLOT-POS +++ SYSTEM::PATHNAME-PARSE ANSI-LOOP::LOOP-TRANSLATE +++ SYSTEM::CHECK-S-DATA SYSTEM::MFR FPE::REF +++ ANSI-LOOP::LOOP-STANDARD-EXPANSION ANSI-LOOP::LOOP-FOR-ON +++ ANSI-LOOP::LOOP-SUM-COLLECTION SYSTEM::SHARP-DQ-READER +++ COMMON-LISP::DPB SYSTEM::CHECK-TRACE-ARGS +++ SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS SYSTEM::RECURSE-DIR +++ SYSTEM::SHARP-U-READER SYSTEM::FLOATING-POINT-ERROR +++ ANSI-LOOP::LOOP-FOR-IN ANSI-LOOP::HIDE-VARIABLE-REFERENCE +++ SYSTEM::GET-SLOT-POS SYSTEM::APPLY-DISPLAY-FUN ++ SYSTEM::RESTART-CASE-EXPRESSION-CONDITION ++- SYSTEM::CHECK-TRACE-ARGS ANSI-LOOP::LOOP-FOR-ON FPE::REF ++- ANSI-LOOP::PRINT-LOOP-UNIVERSE ANSI-LOOP::LOOP-ANSI-FOR-EQUALS ++- SYSTEM::SETF-EXPAND-1 ANSI-LOOP::LOOP-SUM-COLLECTION ++- ANSI-LOOP::LOOP-STANDARD-EXPANSION SYSTEM::MAKE-T-TYPE ++- COMMON-LISP::DEPOSIT-FIELD SYSTEM::MAKE-BREAK-POINT ++- ANSI-LOOP::LOOP-FOR-BEING ANSI-LOOP::LOOP-TRANSLATE ++- SYSTEM::SHARP-A-READER COMMON-LISP::DPB ++- SYSTEM::FLOATING-POINT-ERROR SYSTEM::CHECK-S-DATA ++- SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS)) +++ SYSTEM::MAKE-BREAK-POINT SYSTEM::TO-REGEXP-OR-NAMESTRING +++ COMMON-LISP::DEPOSIT-FIELD SYSTEM::SHARP-V-READER +++ SYSTEM::MAKE-T-TYPE ANSI-LOOP::LOOP-FOR-ACROSS +++ ANSI-LOOP::LOOP-ANSI-FOR-EQUALS ANSI-LOOP::PRINT-LOOP-UNIVERSE +++ ANSI-LOOP::LOOP-FOR-BEING SYSTEM::SHARP-P-READER SYSTEM::DM-VL +++ SYSTEM::SHARP-A-READER ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE +++ SYSTEM::DEFMACRO* SYSTEM::SETF-EXPAND-1 SYSTEM::WARN-VERSION)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T) +++ COMMON-LISP::*) ++ COMMON-LISP::T) ++- SLOOP::FIRST-USE-SLOOP-FOR SYSTEM::COERCE-TO-CONDITION SYSTEM::DO-BREAK-LEVEL ++- SLOOP::FIRST-SLOOP-FOR ANSI-LOOP::LOOP-FOR-ARITHMETIC ++- SYSTEM::MAYBE-BREAK SYSTEM::SETF-STRUCTURE-ACCESS ++- SYSTEM::CALL-TEST SYSTEM::FIND-LINE-IN-FUN)) +++ SYSTEM::MME2 COMMON-LISP::NSUBSTITUTE SYSTEM::MATCH-COMPONENT +++ SYSTEM::COMPLETE-PROP SYSTEM::WALK-DIR +++ COMMON-LISP::TRANSLATE-PATHNAME ANSI-LOOP::ADD-LOOP-PATH +++ SYSTEM::DIR-PARSE ANSI-LOOP::LOOP-MAKE-VARIABLE +++ COMMON-LISP::SUBSTITUTE-IF COMMON-LISP::NSUBSTITUTE-IF +++ SYSTEM::PUSH-LET-BINDING COMMON-LISP::SUBSTITUTE +++ ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH COMMON-LISP::MAP +++ COMMON-LISP::SUBSTITUTE-IF-NOT COMMON-LISP::NSUBSTITUTE-IF-NOT +++ ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH +++ SLOOP::LOOP-DECLARE-BINDING +++ ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH +++ SYSTEM::CHECK-TYPE-SYMBOL)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ (COMMON-LISP::T COMMON-LISP::T +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807)) ++ COMMON-LISP::T) ++- COMMON-LISP::COUNT-IF COMMON-LISP::BIT-ANDC2 ++- COMMON-LISP::REMOVE SYSTEM::INTERNAL-COUNT-IF ++- SLOOP::LOOP-ADD-BINDING COMMON-LISP::MAP-INTO ++- COMMON-LISP::FIND-IF COMMON-LISP::NSET-DIFFERENCE ++- COMMON-LISP::UNION COMMON-LISP::NUNION ++- COMMON-LISP::MAKE-SEQUENCE COMMON-LISP::NOTANY ++- COMMON-LISP::POSITION COMMON-LISP::DELETE-IF ++- COMMON-LISP::BIT-ORC2 COMMON-LISP::REPLACE COMMON-LISP::DELETE ++- SYSTEM::BREAK-CALL COMMON-LISP::NINTERSECTION ++- COMMON-LISP::POSITION-IF SYSTEM::FIND-IHS COMMON-LISP::BIT-AND ++- COMMON-LISP::DELETE-IF-NOT ANSI-LOOP::LOOP-CHECK-DATA-TYPE ++- COMMON-LISP::REMOVE-IF COMMON-LISP::READ-SEQUENCE ++- SLOOP::PARSE-LOOP-MACRO COMMON-LISP::BIT-NAND ++- SYSTEM::INTERNAL-COUNT-IF-NOT COMMON-LISP::SUBSETP ++- COMMON-LISP::VECTOR-PUSH-EXTEND COMMON-LISP::EVERY ++- COMMON-LISP::SOME COMMON-LISP::WRITE-SEQUENCE ++- COMMON-LISP::MISMATCH COMMON-LISP::SET-EXCLUSIVE-OR ++- COMMON-LISP::REMOVE-IF-NOT COMMON-LISP::BIT-NOR ++- COMMON-LISP::BIT-XOR COMMON-LISP::BIT-EQV COMMON-LISP::SEARCH ++- COMMON-LISP::SET-DIFFERENCE COMMON-LISP::FILL ++- COMMON-LISP::CERROR COMMON-LISP::ADJUST-ARRAY ++- COMMON-LISP::BIT-ORC1 SYSTEM::INTERNAL-COUNT ++- COMMON-LISP::TYPEP SYSTEM::PROCESS-ERROR ++- COMMON-LISP::COUNT-IF-NOT COMMON-LISP::INTERSECTION ++- SLOOP::IN-ARRAY-SLOOP-FOR COMMON-LISP::FIND-IF-NOT ++- COMMON-LISP::BIT-ANDC1 COMMON-LISP::POSITION-IF-NOT ++- COMMON-LISP::NOTEVERY COMMON-LISP::NSET-EXCLUSIVE-OR ++- COMMON-LISP::FIND COMMON-LISP::COUNT COMMON-LISP::BIT-IOR)) +++ SYSTEM::SHARP-EQ-READER SYSTEM::SHARP-SHARP-READER)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) ++ COMMON-LISP::T) ++- SYSTEM::PUSH-SUB-LIST-BINDING SYSTEM::DO-ARG-COUNT-ERROR)) +++ SYSTEM::ELSUB SLOOP::FIRST-USE-SLOOP-FOR +++ SLOOP::FIRST-SLOOP-FOR SYSTEM::SETF-STRUCTURE-ACCESS +++ SYSTEM::FIND-LINE-IN-FUN SYSTEM::COERCE-TO-CONDITION +++ ANSI-LOOP::LOOP-FOR-ARITHMETIC SYSTEM::MAYBE-BREAK +++ SYSTEM::ELEMENT SYSTEM::DO-BREAK-LEVEL SYSTEM::CALL-TEST)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::*) +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) ++ COMMON-LISP::T) ++- ANSI-LOOP::ADD-LOOP-PATH COMMON-LISP::MAP ++- ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH ++- ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH ++- COMMON-LISP::SUBSTITUTE COMMON-LISP::NSUBSTITUTE ++- COMMON-LISP::NSUBSTITUTE-IF-NOT ANSI-LOOP::LOOP-MAKE-VARIABLE ++- COMMON-LISP::SUBSTITUTE-IF-NOT ++- ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH ++- SYSTEM::PUSH-LET-BINDING COMMON-LISP::SUBSTITUTE-IF ++- SYSTEM::CHECK-TYPE-SYMBOL SLOOP::LOOP-DECLARE-BINDING ++- SYSTEM::COMPLETE-PROP COMMON-LISP::NSUBSTITUTE-IF)) +++ ANSI-LOOP::LOOP-SEQUENCER)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- SYSTEM::MAKE-PREDICATE ++- SYSTEM::MAKE-CONSTRUCTOR)) +++ SYSTEM::MAKE-CONSTRUCTOR SYSTEM::MAKE-PREDICATE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::T) ++- SYSTEM::UNIVERSAL-ERROR-HANDLER)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::FIXNUM) +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- SYSTEM::SHARP-SHARP-READER SYSTEM::SHARP-EQ-READER)) +++ SYSTEM::PUSH-SUB-LIST-BINDING SYSTEM::DO-ARG-COUNT-ERROR)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++- SLOOP::DEF-LOOP-INTERNAL SYSTEM::PRINT-STACK-FRAME ++- COMMON-LISP::MERGE)) +++ SLOOP::DEF-LOOP-INTERNAL COMMON-LISP::MERGE +++ SYSTEM::PRINT-STACK-FRAME)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++@@ -369,154 +231,389 @@ ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T) +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++- ANSI-LOOP::LOOP-SEQUENCER)) +++ SYSTEM::UNIVERSAL-ERROR-HANDLER)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ COMMON-LISP::MERGE-PATHNAMES +++ COMMON-LISP::TRANSLATE-LOGICAL-PATHNAME ANSI-LOOP::LOOP-ERROR +++ COMMON-LISP::WILD-PATHNAME-P SLOOP::LOOP-ADD-TEMPS +++ SYSTEM::FILE-SEARCH SYSTEM::INFO-SEARCH +++ COMMON-LISP::PATHNAME-VERSION COMMON-LISP::WARN SYSTEM::MGSUB +++ COMMON-LISP::ARRAY-ROW-MAJOR-INDEX +++ COMMON-LISP::REMOVE-DUPLICATES COMMON-LISP::PATHNAME-NAME +++ COMMON-LISP::BIT COMMON-LISP::FIND-RESTART SYSTEM::TO-REGEXP +++ SYSTEM::PROCESS-SOME-ARGS COMMON-LISP::ERROR +++ COMMON-LISP::REQUIRE COMMON-LISP::OPEN +++ COMMON-LISP::UPGRADED-ARRAY-ELEMENT-TYPE SLOOP::ADD-FROM-DATA +++ SYSTEM::BREAK-LEVEL SYSTEM::LIST-MATCHES +++ COMMON-LISP::DELETE-DUPLICATES ANSI-LOOP::LOOP-WARN +++ COMMON-LISP::PATHNAME-DEVICE COMMON-LISP::LOAD +++ COMMON-LISP::PATHNAME-HOST COMMON-LISP::SBIT SYSTEM::NLOAD +++ COMMON-LISP::BIT-NOT COMMON-LISP::ENOUGH-NAMESTRING +++ COMMON-LISP::SIGNAL COMMON-LISP::ARRAY-IN-BOUNDS-P +++ COMMON-LISP::PATHNAME-TYPE SYSTEM::FILE-TO-STRING +++ SYSTEM::LOGICAL-PATHNAME-PARSE SYSTEM::NTH-STACK-FRAME +++ ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES SYSTEM::MGLIST +++ COMMON-LISP::DIRECTORY SYSTEM::BAD-SEQ-LIMIT +++ COMMON-LISP::PATHNAME-DIRECTORY COMMON-LISP::READ-BYTE +++ SYSTEM::LINK-EXPAND COMMON-LISP::CONCATENATE +++ COMMON-LISP::MAKE-ARRAY)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ SYSTEM::NEWLINE SYSTEM::LIST-TOGGLE-CASE +++ COMMON-LISP::RENAME-FILE ANSI-LOOP::ESTIMATE-CODE-SIZE +++ SYSTEM::SOURCE-PORTION SYSTEM::RESTART-REPORT SYSTEM::DO-REPL +++ SYSTEM::FIND-DOC ANSI-LOOP::ESTIMATE-CODE-SIZE-1 +++ SYSTEM::NEW-SEMI-COLON-READER)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::STRING COMMON-LISP::FIXNUM) +++ ((COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807)) ++ COMMON-LISP::FIXNUM) ++- SYSTEM::ATOI)) +++ FPE::FE-ENABLE SYSTEM::DBL-WHAT-FRAME)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ SYSTEM::INFO SYSTEM::GET-SETF-METHOD-MULTIPLE-VALUE +++ COMMON-LISP::FTRUNCATE COMMON-LISP::USE-VALUE +++ COMMON-LISP::INVOKE-RESTART COMMON-LISP::WRITE-TO-STRING +++ COMMON-LISP::FCEILING COMMON-LISP::FROUND +++ COMMON-LISP::READ-FROM-STRING COMMON-LISP::FFLOOR +++ SYSTEM::PARSE-BODY-HEADER SYSTEM::BREAK-FUNCTION +++ SYSTEM::APROPOS-DOC COMMON-LISP::APROPOS +++ COMMON-LISP::APROPOS-LIST +++ ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE +++ COMMON-LISP::GET-SETF-EXPANSION SYSTEM::PRINT-DOC +++ COMMON-LISP::PARSE-NAMESTRING +++ COMMON-LISP::ENSURE-DIRECTORIES-EXIST +++ COMMON-LISP::DECODE-UNIVERSAL-TIME SYSTEM::SHOW-INFO +++ COMMON-LISP::STORE-VALUE SYSTEM::STEPPER)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ COMMON-LISP::VECTOR-PUSH SYSTEM::DM-NTH COMMON-LISP::LOGORC1 +++ SLOOP::L-EQUAL SLOOP::NEVER-SLOOP-COLLECT +++ COMMON-LISP::LDB-TEST COMMON-LISP::LDB COMMON-LISP::LOGORC2 +++ SLOOP::COUNT-SLOOP-COLLECT SLOOP::MAXIMIZE-SLOOP-COLLECT +++ SYSTEM::ALL-MATCHES ANSI-LOOP::LOOP-TMEMBER SLOOP::THE-TYPE +++ SYSTEM::?PUSH SYSTEM::INCREMENT-CURSOR SYSTEM::SET-DIR +++ SYSTEM::DM-NTH-CDR SYSTEM::IN-INTERVAL-P SLOOP::MAKE-VALUE +++ SYSTEM::DBL-UP COMMON-LISP::COERCE SYSTEM::MATCH-DIMENSIONS +++ COMMON-LISP::LOGNAND SLOOP::=-SLOOP-FOR +++ SYSTEM::KEYWORD-SUPPLIED-P SYSTEM::OVERWRITE-SLOT-DESCRIPTIONS +++ SYSTEM::LEFT-PARENTHESIS-READER +++ ANSI-LOOP::LOOP-MAYBE-BIND-FORM SYSTEM::COERCE-TO-STRING +++ SYSTEM::ADD-FILE SLOOP::PARSE-LOOP-MAP COMMON-LISP::LOGNOR +++ SYSTEM::MSUB SYSTEM::SET-BACK SYSTEM::SUPER-GO +++ SYSTEM::SUBSTRINGP ANSI-LOOP::LOOP-TEQUAL +++ ANSI-LOOP::LOOP-DO-WHILE SYSTEM::GET-LINE-OF-FORM +++ FPE::READ-INSTRUCTION SYSTEM::SUB-INTERVAL-P +++ SYSTEM::CHECK-SEQ-START-END SYSTEM::*BREAK-POINTS* +++ ANSI-LOOP::MAKE-LOOP-MINIMAX SLOOP::IN-PACKAGE-SLOOP-MAP +++ SYSTEM::DM-V SYSTEM::INFO-AUX +++ ANSI-LOOP::HIDE-VARIABLE-REFERENCES +++ SLOOP::COLLATE-SLOOP-COLLECT COMMON-LISP::PATHNAME-MATCH-P +++ SYSTEM::SET-PATH-STREAM-NAME SLOOP::SUM-SLOOP-COLLECT +++ ANSI-LOOP::LOOP-LOOKUP-KEYWORD +++ ANSI-LOOP::LOOP-DECLARE-VARIABLE SYSTEM::BREAK-STEP-NEXT +++ FPE::RF SLOOP::IN-TABLE-SLOOP-MAP SYSTEM::OBJLT +++ FPE::READ-OPERANDS SYSTEM::BREAK-STEP-INTO COMMON-LISP::BYTE +++ SYSTEM::SEQUENCE-CURSOR SYSTEM::LIST-DELQ +++ SYSTEM::SETF-LOGICAL-PATHNAME-TRANSLATIONS +++ SYSTEM::CONDITION-PASS SYSTEM::SETF-HELPER FPE::0-READER +++ SYSTEM::DISPLAY-COMPILED-ENV COMMON-LISP::NTH +++ COMPILER::COMPILER-DEF-HOOK SYSTEM::DOT-DIR-P +++ COMMON-LISP::LOGTEST SYSTEM::QUOTATION-READER +++ SYSTEM::ITERATE-OVER-BKPTS COMMON-LISP::LOGANDC1 +++ SLOOP::ALWAYS-SLOOP-COLLECT SLOOP::DESETQ1 +++ SYSTEM::GET-INFO-CHOICES COMMON-LISP::WRITE-BYTE +++ ANSI-LOOP::LOOP-DO-IF ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION +++ ANSI-LOOP::LOOP-TASSOC SLOOP::IN-CAREFULLY-SLOOP-FOR +++ COMMON-LISP::DOCUMENTATION FPE::PAREN-READER SYSTEM::GET-NODES +++ SYSTEM::PARSE-SLOT-DESCRIPTION SLOOP::IN-FRINGE-SLOOP-MAP +++ SYSTEM::SAFE-EVAL SYSTEM::DISPLAY-ENV FPE::%-READER +++ SLOOP::THEREIS-SLOOP-COLLECT SYSTEM::LOOKUP-KEYWORD +++ COMMON-LISP::LOGANDC2 COMMON-LISP::NTHCDR +++ SLOOP::MINIMIZE-SLOOP-COLLECT SYSTEM::GET-MATCH +++ SYSTEM::SETF-EXPAND SLOOP::LOGXOR-SLOOP-COLLECT +++ ANSI-LOOP::LOOP-DO-ALWAYS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ ((COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807) +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807)) +++ COMMON-LISP::FIXNUM) +++ SYSTEM::ROUND-UP)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++- SYSTEM::DESCRIBE-ENVIRONMENT SYSTEM::STEP-NEXT ++- COMMON-LISP::BREAK COMMON-LISP::ABORT SYSTEM::MAKE-S-DATA ++- ANSI-LOOP::MAKE-LOOP-COLLECTOR SLOOP::PARSE-LOOP-DECLARE ++- ANSI-LOOP::LOOP-GENTEMP SYSTEM::MAKE-INSTREAM ++- SYSTEM::MAYBE-CLEAR-INPUT ++- ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL COMMON-LISP::Y-OR-N-P ++- SYSTEM::CURRENT-STEP-FUN ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL ++- COMMON-LISP::DRIBBLE SYSTEM::MAKE-RESTART ++- SLOOP::PARSE-LOOP-WITH SYSTEM::LOC COMMON-LISP::YES-OR-NO-P ++- SYSTEM::TRANSFORM-KEYWORDS SYSTEM::MAKE-CONTEXT ++- COMMON-LISP::COMPUTE-RESTARTS SYSTEM::DBL-READ ++- SYSTEM::STEP-INTO ANSI-LOOP::MAKE-LOOP-UNIVERSE ++- SYSTEM::BREAK-LOCALS ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE ++- COMMON-LISP::VECTOR ANSI-LOOP::MAKE-LOOP-PATH)) +++ COMMON-LISP::Y-OR-N-P COMMON-LISP::YES-OR-NO-P +++ COMMON-LISP::DRIBBLE COMMON-LISP::VECTOR SYSTEM::NEXT-MATCH +++ SYSTEM::MAKE-S-DATA SYSTEM::LOC SYSTEM::BREAK-LOCALS +++ SLOOP::PARSE-LOOP-WITH COMMON-LISP::USER-HOMEDIR-PATHNAME +++ SYSTEM::STEP-INTO SYSTEM::MAYBE-CLEAR-INPUT +++ ANSI-LOOP::MAKE-LOOP-PATH SYSTEM::STEP-NEXT +++ ANSI-LOOP::LOOP-GENTEMP COMMON-LISP::COMPUTE-RESTARTS +++ SYSTEM::CURRENT-STEP-FUN SYSTEM::MAKE-INSTREAM +++ ANSI-LOOP::MAKE-LOOP-COLLECTOR SYSTEM::MAKE-RESTART +++ SYSTEM::DESCRIBE-ENVIRONMENT SYSTEM::TRANSFORM-KEYWORDS +++ COMMON-LISP::ABORT ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE +++ ANSI-LOOP::MAKE-LOOP-UNIVERSE SLOOP::PARSE-LOOP-DECLARE +++ COMMON-LISP::BREAK ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL +++ SYSTEM::MAKE-CONTEXT SYSTEM::DBL-READ +++ COMMON-LISP::MAKE-PATHNAME +++ ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++- ANSI-LOOP::LOOP-LIST-STEP SYSTEM::INSPECT-OBJECT ++- COMMON-LISP::DESCRIBE ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES ++- SYSTEM::BREAK-GO SYSTEM::GET-&ENVIRONMENT ++- COMMON-LISP::PRINC-TO-STRING SYSTEM::WAITING ++- SYSTEM::INSTREAM-NAME ANSI-LOOP::NAMED-VARIABLE ++- COMMON-LISP::PRIN1-TO-STRING SYSTEM::INFO-SUBFILE ++- COMMON-LISP::INSPECT SYSTEM::END-WAITING ++- SYSTEM::FIND-DECLARATIONS ++- COMMON-LISP::INVOKE-RESTART-INTERACTIVELY ++- SYSTEM::BREAK-LEVEL-INVOKE-RESTART SYSTEM::ALOAD)) +++ ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES SYSTEM::BREAK-GO +++ COMMON-LISP::FILE-AUTHOR SYSTEM::ENSURE-DIR-STRING +++ SYSTEM::INFO-SUBFILE COMMON-LISP::DESCRIBE SYSTEM::END-WAITING +++ COMMON-LISP::PRIN1-TO-STRING SYSTEM::FIND-DECLARATIONS +++ COMMON-LISP::INSPECT ANSI-LOOP::NAMED-VARIABLE +++ SYSTEM::GET-&ENVIRONMENT SYSTEM::INSPECT-OBJECT +++ COMMON-LISP::PRINC-TO-STRING ANSI-LOOP::LOOP-LIST-STEP +++ SYSTEM::INSTREAM-NAME SYSTEM::BREAK-LEVEL-INVOKE-RESTART +++ SYSTEM::WAITING COMMON-LISP::INVOKE-RESTART-INTERACTIVELY)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +++ SYSTEM::IHS-NOT-INTERPRETED-ENV COMMON-LISP::NINTH +++ SYSTEM::FIND-KCL-TOP-RESTART COMMON-LISP::TRUENAME +++ SYSTEM::DIRECTORY-LIST-CHECK SYSTEM::REAL-ASINH +++ SYSTEM::SHOW-ENVIRONMENT SYSTEM::PRINT-FRS +++ SYSTEM::REWRITE-RESTART-CASE-CLAUSE +++ COMMON-LISP::TWO-WAY-STREAM-OUTPUT-STREAM +++ ANSI-LOOP::LOOP-COLLECTOR-DATA SLOOP::POINTER-FOR-COLLECT +++ SYSTEM::MLP SYSTEM::WILD-PATH-ELEMENT-P SYSTEM::LNP +++ ANSI-LOOP::LOOP-MINIMAX-OPERATIONS SYSTEM::FRS-KIND +++ SYSTEM::BKPT-FILE COMMON-LISP::FIFTH +++ ANSI-LOOP::LOOP-COLLECTOR-P ANSI-LOOP::LOOP-UNIVERSE-ANSI +++ ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS SYSTEM::IDESCRIBE +++ ANSI-LOOP::LOOP-CONSTANTP +++ ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS COMMON-LISP::PROBE-FILE +++ ANSI-LOOP::LOOP-UNIVERSE-P COMMON-LISP::SINH SYSTEM::RESTART-P +++ SYSTEM::S-DATA-DOCUMENTATION +++ COMMON-LISP::ECHO-STREAM-OUTPUT-STREAM +++ SYSTEM::FIND-DOCUMENTATION SYSTEM::INFO-GET-FILE +++ SLOOP::PARSE-NO-BODY COMMON-LISP::FILE-NAMESTRING +++ COMMON-LISP::COMPILER-MACRO-FUNCTION SYSTEM::PROCESS-ARGS +++ ANSI-LOOP::LOOP-COLLECTOR-DTYPE COMMON-LISP::PHASE +++ SYSTEM::MAKE-FRAME SYSTEM::INSTREAM-STREAM +++ ANSI-LOOP::LOOP-COLLECTOR-HISTORY SYSTEM::FIX-LOAD-PATH +++ SYSTEM::COMPUTING-ARGS-P +++ ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE COMMON-LISP::TENTH +++ ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE SYSTEM::WILD-NAMESTRING-P +++ SYSTEM::BEST-ARRAY-ELEMENT-TYPE SYSTEM::DM-BAD-KEY +++ SYSTEM::TERMINAL-INTERRUPT SYSTEM::REGEXP-CONV +++ COMMON-LISP::FILE-WRITE-DATE SLOOP::PARSE-LOOP +++ ANSI-LOOP::LOOP-CONSTRUCT-RETURN SYSTEM::DWIM +++ ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS +++ SLOOP::RETURN-SLOOP-MACRO SLOOP::AVERAGING-SLOOP-MACRO +++ SYSTEM::S-DATA-NAME SYSTEM::CHECK-TRACE-SPEC +++ SYSTEM::RESTRICT-STREAM-ELEMENT-TYPE SLOOP::TRANSLATE-NAME +++ SYSTEM::ADD-TO-HOTLIST SYSTEM::S-DATA-CONC-NAME +++ ANSI-LOOP::LOOP-MINIMAX-TYPE SYSTEM::PRINT-IHS +++ SYSTEM::DBL-RPL-LOOP SYSTEM::CANONICALIZE-PATHNAME-DIRECTORY +++ SYSTEM::INSPECT-CONS SYSTEM::INSTREAM-STREAM-NAME +++ SYSTEM::S-DATA-P SYSTEM::EVAL-FEATURE +++ COMMON-LISP::ARRAY-DIMENSIONS SYSTEM::IHS-VISIBLE +++ ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE +++ SYSTEM::CHECK-DECLARATIONS COMMON-LISP::TANH +++ ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS +++ COMMON-LISP::COMPILE-FILE-PATHNAME SYSTEM::INSPECT-PACKAGE +++ SLOOP::LOOP-LET-BINDINGS COMMON-LISP::CIS SYSTEM::SETUP-INFO +++ SYSTEM::NORMALIZE-TYPE ANSI-LOOP::LOOP-PSEUDO-BODY +++ SYSTEM::PATH-STREAM-NAME SYSTEM::INFO-GET-TAGS FPE::ST-LOOKUP +++ SYSTEM::BREAK-BACKWARD-SEARCH-STACK +++ ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE SYSTEM::SIMPLE-ARRAY-P +++ SYSTEM::S-DATA-TYPE COMMON-LISP::CONCATENATED-STREAM-STREAMS +++ SYSTEM::INSPECT-CHARACTER ANSI-LOOP::DESTRUCTURING-SIZE +++ SYSTEM::GET-BYTE-STREAM-NCHARS ANSI-LOOP::LOOP-PATH-P +++ COMMON-LISP::FIRST COMMON-LISP::SECOND +++ COMMON-LISP::TWO-WAY-STREAM-INPUT-STREAM +++ SYSTEM::MAKE-DEFPACKAGE-FORM SYSTEM::INSPECT-SYMBOL +++ SYSTEM::INSPECT-VECTOR +++ COMMON-LISP::LOAD-LOGICAL-PATHNAME-TRANSLATIONS +++ SYSTEM::RESTART-INTERACTIVE-FUNCTION SYSTEM::INSPECT-STRING +++ SYSTEM::DIR-P ANSI-LOOP::LOOP-COLLECTOR-CLASS +++ SYSTEM::S-DATA-CONSTRUCTORS SYSTEM::NODES-FROM-INDEX +++ SYSTEM::VERSION-PARSE SYSTEM::BKPT-FILE-LINE COMMON-LISP::ABS +++ SYSTEM::IHS-FNAME ANSI-LOOP::LOOP-MAKE-PSETQ +++ SYSTEM::LEAP-YEAR-P ANSI-LOOP::LOOP-EMIT-FINAL-VALUE +++ SYSTEM::GET-PATH SYSTEM::ALOAD SYSTEM::DM-KEY-NOT-ALLOWED +++ SYSTEM::MAKE-KCL-TOP-RESTART SYSTEM::S-DATA-SLOT-DESCRIPTIONS +++ COMMON-LISP::VECTOR-POP ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS +++ ANSI-LOOP::LOOP-PATH-USER-DATA SYSTEM::S-DATA-SLOT-POSITION +++ COMMON-LISP::BROADCAST-STREAM-STREAMS +++ SYSTEM::LOGICAL-PATHNAMEP SYSTEM::BREAK-FORWARD-SEARCH-STACK +++ SLOOP::SLOOP-SLOOP-MACRO COMMON-LISP::SIGNUM +++ SYSTEM::RESET-TRACE-DECLARATIONS SYSTEM::CONTEXT-P +++ SYSTEM::S-DATA-FROZEN SYSTEM::NUMBER-OF-DAYS-FROM-1900 +++ SYSTEM::S-DATA-STATICP ANSI-LOOP::LOOP-PATH-FUNCTION +++ SYSTEM::KNOWN-TYPE-P COMMON-LISP::PROVIDE SYSTEM::PNL1 +++ ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD +++ SYSTEM::COERCE-SLASH-TERMINATED COMMON-LISP::LOGICAL-PATHNAME +++ SYSTEM::DIR-CONJ SYSTEM::BKPT-FORM +++ SYSTEM::LOGICAL-PATHNAME-HOST-P SYSTEM::INSPECT-STRUCTURE +++ ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED +++ COMMON-LISP::FIND-ALL-SYMBOLS +++ ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS +++ ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED +++ COMMON-LISP::LOGICAL-PATHNAME-TRANSLATIONS +++ SYSTEM::TRACE-ONE-PREPROCESS COMMON-LISP::CONSTANTLY +++ COMMON-LISP::ACOS SYSTEM::S-DATA-OFFSET COMMON-LISP::ASINH +++ SYSTEM::SHORT-NAME SYSTEM::S-DATA-INCLUDED SYSTEM::DBL-EVAL +++ SYSTEM::BKPT-FUNCTION SYSTEM::INSPECT-NUMBER +++ SYSTEM::GET-INSTREAM SYSTEM::SHOW-BREAK-POINT FPE::LOOKUP +++ SYSTEM::NEXT-STACK-FRAME SYSTEM::INSPECT-ARRAY +++ SYSTEM::S-DATA-RAW ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA +++ SYSTEM::RESTART-REPORT-FUNCTION SYSTEM::TOGGLE-CASE +++ SYSTEM::NODE-OFFSET SYSTEM::INSTREAM-P +++ ANSI-LOOP::LOOP-PATH-NAMES SYSTEM::FREEZE-DEFSTRUCT +++ COMMON-LISP::SEVENTH SYSTEM::SEARCH-STACK COMMON-LISP::SIXTH +++ ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS FPE::GREF +++ FPE::XMM-LOOKUP COMMON-LISP::HOST-NAMESTRING +++ ANSI-LOOP::LOOP-TYPED-INIT +++ SYSTEM::LOGICAL-PATHNAME-DESIGNATOR-P +++ ANSI-LOOP::LOOP-DO-THEREIS COMMON-LISP::EIGHTH +++ SYSTEM::UNIQUE-ID COMMON-LISP::THIRD +++ COMMON-LISP::BYTE-POSITION COMMON-LISP::SYNONYM-STREAM-SYMBOL +++ SYSTEM::PATCH-SHARP SYSTEM::PRINT-SYMBOL-APROPOS +++ COMMON-LISP::LOGNOT SLOOP::REPEAT-SLOOP-MACRO +++ COMMON-LISP::FOURTH SLOOP::SUBSTITUTE-SLOOP-BODY +++ COMMON-LISP::ATANH SLOOP::LOOP-COLLECT-KEYWORD-P +++ SYSTEM::SEQTYPE SYSTEM::RE-QUOTE-STRING COMMON-LISP::ISQRT +++ SYSTEM::DO-F SYSTEM::S-DATA-HAS-HOLES +++ ANSI-LOOP::LOOP-HACK-ITERATION ANSI-LOOP::LOOP-COLLECTOR-NAME +++ COMMON-LISP::RESTART-NAME COMMON-LISP::DIRECTORY-NAMESTRING +++ ANSI-LOOP::LOOP-EMIT-BODY COMMON-LISP::ACOSH +++ SYSTEM::RESTART-FUNCTION SYSTEM::INFO-NODE-FROM-POSITION +++ COMMON-LISP::ASIN ANSI-LOOP::LOOP-LIST-COLLECTION +++ SYSTEM::S-DATA-INCLUDES SYSTEM::GET-NEXT-VISIBLE-FUN +++ COMMON-LISP::BYTE-SIZE COMMON-LISP::PATHNAME +++ ANSI-LOOP::LOOP-MINIMAX-P SLOOP::PARSE-LOOP-INITIALLY +++ COMMON-LISP::COSH SYSTEM::EXPAND-HOME-DIR +++ COMMON-LISP::ECHO-STREAM-INPUT-STREAM +++ SYSTEM::INSERT-BREAK-POINT SYSTEM::RESTART-TEST-FUNCTION +++ SYSTEM::S-DATA-PRINT-FUNCTION SYSTEM::WILD-DIR-ELEMENT-P +++ SYSTEM::S-DATA-NAMED COMMON-LISP::INVOKE-DEBUGGER +++ COMMON-LISP::NAMESTRING ANSI-LOOP::LOOP-MAKE-DESETQ +++ COMMON-LISP::COMPLEMENT SYSTEM::WALK-THROUGH +++ COMMON-LISP::RATIONAL ANSI-LOOP::LOOP-MAXMIN-COLLECTION +++ COMMON-LISP::DELETE-FILE ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) +++ SYSTEM::BREAK-QUIT SYSTEM::BREAK-BDS SYSTEM::DBL-BACKTRACE +++ SYSTEM::BREAK-LOCAL SYSTEM::INFO-ERROR +++ SYSTEM::SHOW-BREAK-VARIABLES SYSTEM::BREAK-VS +++ COMMON-LISP::CONTINUE COMMON-LISP::MUFFLE-WARNING +++ SYSTEM::IHS-BACKTRACE ANSI-LOOP::LOOP-OPTIONAL-TYPE +++ SYSTEM::BREAK-PREVIOUS SYSTEM::BREAK-NEXT)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ ((COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807) +++ COMMON-LISP::T) ++ COMMON-LISP::T) ++- ANSI-LOOP::MAKE-LOOP-MINIMAX COMMON-LISP::LDB ++- SYSTEM::LIST-DELQ FPE::RF SLOOP::L-EQUAL ++- ANSI-LOOP::LOOP-DECLARE-VARIABLE SYSTEM::DISPLAY-COMPILED-ENV ++- SYSTEM::SET-BACK ANSI-LOOP::HIDE-VARIABLE-REFERENCES ++- SYSTEM::GET-LINE-OF-FORM SYSTEM::BREAK-STEP-INTO ++- SLOOP::THE-TYPE SLOOP::COUNT-SLOOP-COLLECT ++- SYSTEM::KEYWORD-SUPPLIED-P COMMON-LISP::LOGANDC2 ++- ANSI-LOOP::LOOP-MAYBE-BIND-FORM SYSTEM::SET-DIR ++- SYSTEM::COERCE-TO-STRING COMMON-LISP::VECTOR-PUSH ++- SYSTEM::DM-NTH-CDR SLOOP::IN-FRINGE-SLOOP-MAP ++- SLOOP::MAXIMIZE-SLOOP-COLLECT SYSTEM::ADD-FILE ++- SYSTEM::ALL-MATCHES SYSTEM::DM-NTH ++- SLOOP::IN-CAREFULLY-SLOOP-FOR SYSTEM::PARSE-SLOT-DESCRIPTION ++- ANSI-LOOP::LOOP-LOOKUP-KEYWORD FPE::0-READER ++- ANSI-LOOP::LOOP-TMEMBER COMPILER::COMPILER-DEF-HOOK ++- SYSTEM::INFO-AUX COMMON-LISP::NTH SYSTEM::QUOTATION-READER ++- SYSTEM::CHECK-SEQ-START-END COMMON-LISP::LOGNAND ++- SYSTEM::SUBSTRINGP COMMON-LISP::LOGORC2 ++- ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION SYSTEM::SAFE-EVAL ++- ANSI-LOOP::LOOP-DO-IF SLOOP::THEREIS-SLOOP-COLLECT ++- SYSTEM::MATCH-DIMENSIONS SYSTEM::GET-MATCH ++- SYSTEM::SUB-INTERVAL-P FPE::PAREN-READER ++- SLOOP::IN-TABLE-SLOOP-MAP COMMON-LISP::LOGTEST ++- SLOOP::LOGXOR-SLOOP-COLLECT SYSTEM::DM-V ++- SYSTEM::GET-INFO-CHOICES SLOOP::COLLATE-SLOOP-COLLECT ++- SYSTEM::BREAK-STEP-NEXT ANSI-LOOP::LOOP-TEQUAL ++- COMMON-LISP::WRITE-BYTE COMMON-LISP::NTHCDR ++- SYSTEM::SETF-HELPER SLOOP::NEVER-SLOOP-COLLECT SLOOP::DESETQ1 ++- ANSI-LOOP::LOOP-DO-WHILE COMMON-LISP::DOCUMENTATION ++- FPE::%-READER SYSTEM::IN-INTERVAL-P SLOOP::SUM-SLOOP-COLLECT ++- SYSTEM::OBJLT COMMON-LISP::LDB-TEST SLOOP::PARSE-LOOP-MAP ++- SYSTEM::GET-NODES SLOOP::MAKE-VALUE SYSTEM::CONDITION-PASS ++- SLOOP::IN-PACKAGE-SLOOP-MAP SYSTEM::INCREMENT-CURSOR ++- ANSI-LOOP::LOOP-DO-ALWAYS SYSTEM::DISPLAY-ENV SYSTEM::SUPER-GO ++- SLOOP::MINIMIZE-SLOOP-COLLECT COMMON-LISP::LOGNOR ++- COMMON-LISP::LOGANDC1 COMMON-LISP::BYTE SYSTEM::DBL-UP ++- SYSTEM::ITERATE-OVER-BKPTS COMMON-LISP::LOGORC1 ++- FPE::READ-OPERANDS SLOOP::ALWAYS-SLOOP-COLLECT ++- SYSTEM::SETF-EXPAND SYSTEM::OVERWRITE-SLOT-DESCRIPTIONS ++- SYSTEM::*BREAK-POINTS* SYSTEM::LOOKUP-KEYWORD ++- ANSI-LOOP::LOOP-TASSOC SYSTEM::LEFT-PARENTHESIS-READER ++- SLOOP::=-SLOOP-FOR FPE::READ-INSTRUCTION COMMON-LISP::COERCE ++- SYSTEM::SEQUENCE-CURSOR)) +++ SYSTEM::SMALLNTHCDR)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::*) ++- COMMON-LISP::FFLOOR SYSTEM::BREAK-FUNCTION ++- COMMON-LISP::APROPOS-LIST COMMON-LISP::DECODE-UNIVERSAL-TIME ++- SYSTEM::STEPPER COMMON-LISP::REQUIRE SYSTEM::APROPOS-DOC ++- SYSTEM::PRINT-DOC SYSTEM::INFO COMMON-LISP::USE-VALUE ++- COMMON-LISP::WRITE-TO-STRING COMMON-LISP::FCEILING ++- SYSTEM::GET-SETF-METHOD ++- ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE SYSTEM::NLOAD ++- COMMON-LISP::ENSURE-DIRECTORIES-EXIST ++- COMMON-LISP::WILD-PATHNAME-P COMMON-LISP::FTRUNCATE ++- COMMON-LISP::FROUND SYSTEM::PARSE-BODY-HEADER ++- COMMON-LISP::INVOKE-RESTART SYSTEM::SHOW-INFO ++- COMMON-LISP::READ-FROM-STRING ++- SYSTEM::GET-SETF-METHOD-MULTIPLE-VALUE COMMON-LISP::APROPOS ++- COMMON-LISP::STORE-VALUE)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ COMMON-LISP::HASH-TABLE) +++ SYSTEM::CONTEXT-SPICE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++- ANSI-LOOP::LOOP-DO-WITH SYSTEM::WINE-TMP-REDIRECT ++- SLOOP::PARSE-ONE-WHEN-CLAUSE COMMON-LISP::TYPE-ERROR ++- SYSTEM::INSPECT-INDENT SYSTEM::SET-CURRENT SYSTEM::TEST-ERROR ++- SLOOP::LOOP-POP ANSI-LOOP::LOOP-DO-REPEAT ++- ANSI-LOOP::LOOP-GET-PROGN SYSTEM::DM-TOO-FEW-ARGUMENTS ++- ANSI-LOOP::LOOP-CONTEXT SYSTEM::READ-EVALUATED-FORM ++- SYSTEM::ALL-TRACE-DECLARATIONS ++- COMMON-LISP::LISP-IMPLEMENTATION-VERSION ++- SYSTEM::DEFAULT-SYSTEM-BANNER ANSI-LOOP::LOOP-DO-RETURN ++- SYSTEM::INSPECT-INDENT-1 SYSTEM::STEP-READ-LINE ++- SYSTEM::SET-ENV SYSTEM::DM-TOO-MANY-ARGUMENTS ++- ANSI-LOOP::LOOP-BIND-BLOCK SLOOP::PARSE-LOOP1 ++- ANSI-LOOP::LOOP-DO-NAMED SLOOP::PARSE-LOOP-COLLECT ++- SYSTEM::KCL-TOP-RESTARTS SYSTEM::INSPECT-READ-LINE ++- SYSTEM::SET-UP-TOP-LEVEL SYSTEM::SHOW-RESTARTS SYSTEM::DBL ++- SLOOP::PARSE-LOOP-FOR ANSI-LOOP::LOOP-ITERATION-DRIVER ++- ANSI-LOOP::LOOP-WHEN-IT-VARIABLE ANSI-LOOP::LOOP-DO-DO ++- SYSTEM::DEFAULT-INFO-HOTLIST SYSTEM::GET-TEMP-DIR ++- ANSI-LOOP::LOOP-POP-SOURCE SLOOP::LOOP-UN-POP ++- SYSTEM::TOP-LEVEL ANSI-LOOP::LOOP-DO-FINALLY ++- ANSI-LOOP::LOOP-DO-INITIALLY SYSTEM::GET-INDEX-NODE ++- SYSTEM::SETUP-LINEINFO SLOOP::PARSE-LOOP-WHEN SYSTEM::CLEANUP ++- ANSI-LOOP::LOOP-GET-FORM SLOOP::PARSE-LOOP-DO ++- SYSTEM::INIT-BREAK-POINTS SLOOP::LOOP-PEEK ++- SYSTEM::GET-SIG-FN-NAME SYSTEM::ILLEGAL-BOA)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) +++ SYSTEM::S-DATA-SIZE FPE::REG-LOOKUP SYSTEM::INSTREAM-LINE +++ SYSTEM::S-DATA-LENGTH SYSTEM::THE-START)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM COMMON-LISP::T) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) +++ SYSTEM::MATCH-BEGINNING SYSTEM::MATCH-END)) +++(COMMON-LISP::MAPC +++ (COMMON-LISP::LAMBDA (COMPILER::X) +++ (COMMON-LISP::SETF +++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) +++ COMMON-LISP::T)) +++ '(SYSTEM::CONDITION-CLASS-P SYSTEM::WARNINGP SYSTEM::SI-CLASS-OF +++ SYSTEM::SI-FIND-CLASS SYSTEM::DEFINE-STRUCTURE +++ FPE::BREAK-ON-FLOATING-POINT-EXCEPTIONS +++ SYSTEM::SIMPLE-CONDITION-CLASS-P SYSTEM::AUTOLOAD +++ SYSTEM::SI-CLASS-PRECEDENCE-LIST SYSTEM::SI-CLASS-NAME +++ SYSTEM::TRACE-ONE SYSTEM::MAKE-ACCESS-FUNCTION +++ SYSTEM::UNTRACE-ONE SYSTEM::SI-CLASSP SYSTEM::CONDITIONP +++ SYSTEM::AUTOLOAD-MACRO)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ ((COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807)) ++ COMMON-LISP::T) ++- SYSTEM::SMALLNTHCDR)) +++ SYSTEM::GET-CONTEXT SYSTEM::PUSH-CONTEXT)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++- SYSTEM::THE-END ANSI-LOOP::DUPLICATABLE-CODE-P ++- SYSTEM::RELATIVE-LINE SYSTEM::GET-NODE-INDEX)) +++ SYSTEM::RELATIVE-LINE SYSTEM::LENEL SYSTEM::THE-END +++ ANSI-LOOP::DUPLICATABLE-CODE-P SYSTEM::FASLINK +++ SYSTEM::GET-NODE-INDEX)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +++ SLOOP::PARSE-ONE-WHEN-CLAUSE ANSI-LOOP::LOOP-DO-FINALLY +++ SLOOP::LOOP-PEEK ANSI-LOOP::LOOP-DO-INITIALLY SLOOP::LOOP-POP +++ ANSI-LOOP::LOOP-GET-PROGN SYSTEM::KCL-TOP-RESTARTS +++ SYSTEM::INSPECT-READ-LINE SLOOP::PARSE-LOOP-WHEN +++ ANSI-LOOP::LOOP-GET-FORM SYSTEM::DEFAULT-SYSTEM-BANNER +++ SYSTEM::SET-UP-TOP-LEVEL SYSTEM::GET-INDEX-NODE +++ ANSI-LOOP::LOOP-DO-DO ANSI-LOOP::LOOP-WHEN-IT-VARIABLE +++ SYSTEM::SETUP-LINEINFO COMMON-LISP::TYPE-ERROR +++ SYSTEM::READ-EVALUATED-FORM SYSTEM::INSPECT-INDENT-1 +++ SLOOP::LOOP-UN-POP SLOOP::PARSE-LOOP-DO +++ ANSI-LOOP::LOOP-DO-WITH SYSTEM::INSPECT-INDENT +++ SYSTEM::GET-TEMP-DIR ANSI-LOOP::LOOP-ITERATION-DRIVER +++ SYSTEM::WINE-TMP-REDIRECT SLOOP::PARSE-LOOP-COLLECT +++ SYSTEM::DEFAULT-INFO-HOTLIST SLOOP::PARSE-LOOP1 +++ SYSTEM::CLEANUP ANSI-LOOP::LOOP-DO-NAMED SYSTEM::DBL +++ SYSTEM::ALL-TRACE-DECLARATIONS SYSTEM::TEST-ERROR +++ ANSI-LOOP::LOOP-BIND-BLOCK ANSI-LOOP::LOOP-DO-REPEAT +++ SYSTEM::ILLEGAL-BOA SYSTEM::SET-ENV SYSTEM::SET-CURRENT +++ SYSTEM::INIT-BREAK-POINTS SYSTEM::GET-SIG-FN-NAME +++ ANSI-LOOP::LOOP-DO-RETURN ANSI-LOOP::LOOP-CONTEXT +++ SYSTEM::SHOW-RESTARTS SYSTEM::STEP-READ-LINE +++ SLOOP::PARSE-LOOP-FOR SYSTEM::DM-TOO-MANY-ARGUMENTS +++ COMMON-LISP::LISP-IMPLEMENTATION-VERSION SYSTEM::TOP-LEVEL +++ ANSI-LOOP::LOOP-POP-SOURCE SYSTEM::DM-TOO-FEW-ARGUMENTS)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM) ++- COMMON-LISP::FIXNUM) ++- SYSTEM::ROUND-UP)) +++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER +++ COMMON-LISP::*)) +++ COMMON-LISP::T) +++ SYSTEM::RESET-SYS-PATHS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ (COMMON-LISP::VECTOR COMMON-LISP::T)) +++ SYSTEM::CONTEXT-VEC)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) +++ SYSTEM::BREAK-HELP SYSTEM::BREAK-MESSAGE +++ SYSTEM::SIMPLE-BACKTRACE ANSI-LOOP::LOOP-DO-FOR +++ SYSTEM::BREAK-CURRENT SYSTEM::GCL-TOP-LEVEL +++ SYSTEM::BREAK-RESUME)) ++\ No newline at end of file ++--- gcl-2.6.12.orig/o/alloc.c +++++ gcl-2.6.12/o/alloc.c ++@@ -447,7 +447,6 @@ set_tm_maxpage(struct typemanager *tm,fi ++ ++ fixnum r=tm->tm_type==t_relocatable,j=tm->tm_maxpage,z=(n-j)*(r ? 2 : 1); ++ if (z>available_pages) return 0; ++- if (r && 2*n+page(rb_start)>real_maxpage) return 0; ++ available_pages-=z; ++ tm->tm_adjgbccnt*=((double)j+1)/(n+1); ++ tm->tm_maxpage=n; ++@@ -909,7 +908,7 @@ alloc_after_reclaiming_pages(struct type ++ ++ fixnum m=tpage(tm,n),reloc_min; ++ ++- if (tm->tm_type>=t_end) return NULL; +++ if (tm->tm_type>t_end) return NULL; ++ ++ reloc_min=npage(rb_pointer-rb_start); ++ ++@@ -925,6 +924,8 @@ alloc_after_reclaiming_pages(struct type ++ ++ } ++ +++ if (tm->tm_type>=t_end) return NULL; +++ ++ maybe_reallocate_page(tm,tm->tm_percent_free*tm->tm_npage); ++ ++ return alloc_from_freelist(tm,n); ++@@ -1093,8 +1094,7 @@ DEFUNM_NEW("ALLOCATED",object,fSallocate ++ RV(make_fixnum(tm->tm_maxpage)), ++ RV(make_fixnum(tm->tm_nppage)), ++ RV(make_fixnum(tm->tm_gbccount)), ++- RV(make_fixnum(tm->tm_npage*tm->tm_nppage-tm->tm_nfree)) ++- )); +++ RV(make_fixnum(tm->tm_npage*tm->tm_nppage-tm->tm_nfree)))); ++ } ++ ++ #ifdef SGC_CONT_DEBUG ++@@ -1658,7 +1658,7 @@ DEFUN_NEW("GPROF-QUIT",object,fSgprof_qu ++ massert(getcwd(b,sizeof(b))); ++ massert(!chdir(P_tmpdir)); ++ _mcleanup(); ++- massert(snprintf(b1,sizeof(b1),"gprof %s",kcl_self)>0); +++ massert(snprintf(b1,sizeof(b1),"gprof '%s'",kcl_self)>0); ++ massert((pp=popen(b1,"r"))); ++ while ((n=fread(b1,1,sizeof(b1),pp))) ++ massert(fwrite(b1,1,n,stdout)); ++--- gcl-2.6.12.orig/o/array.c +++++ gcl-2.6.12/o/array.c ++@@ -1139,9 +1139,9 @@ Icheck_displaced(object displaced_list, ++ /* } */ ++ /* } */ ++ ++-DEFUNO_NEW("REPLACE-ARRAY",object,fSreplace_array,SI,2,2,NONE, ++- OO,OO,OO,OO,void,siLreplace_array,(object old,object new),"") ++-{ struct dummy fw ; +++DEFUN_NEW("REPLACE-ARRAY",object,fSreplace_array,SI,2,2,NONE,OO,OO,OO,OO,(object old,object new),"") { +++ +++ struct dummy fw; ++ fw = old->d; ++ ++ old = IisArray(old); ++--- gcl-2.6.12.orig/o/bind.c +++++ gcl-2.6.12/o/bind.c ++@@ -24,7 +24,6 @@ Foundation, 675 Mass Ave, Cambridge, MA ++ */ ++ ++ #include "include.h" ++-#include ++ ++ static void ++ illegal_lambda(void); ++@@ -95,17 +94,19 @@ lambda_bind(object *arg_top) ++ struct aux *aux=NULL; ++ int naux; ++ bool special_processed; +++ object s[1],ss; ++ vs_mark; ++ ++ bds_check; ++ lambda = vs_head; ++- if (type_of(lambda) != t_cons) +++ if (!consp(lambda)) ++ FEerror("No lambda list.", 0); ++ lambda_list = lambda->c.c_car; ++ body = lambda->c.c_cdr; ++ ++ required = (struct required *)vs_top; ++ nreq = 0; +++ s[0]=Cnil; ++ for (;;) { ++ if (endp(lambda_list)) ++ goto REQUIRED_ONLY; ++@@ -152,7 +153,7 @@ OPTIONAL: ++ goto SEARCH_DECLARE; ++ x = lambda_list->c.c_car; ++ lambda_list = lambda_list->c.c_cdr; ++- if (type_of(x) == t_cons) { +++ if (consp(x)) { ++ check_symbol(x->c.c_car); ++ check_var(x->c.c_car); ++ vs_push(x->c.c_car); ++@@ -226,9 +227,9 @@ KEYWORD: ++ goto SEARCH_DECLARE; ++ x = lambda_list->c.c_car; ++ lambda_list = lambda_list->c.c_cdr; ++- if (type_of(x) == t_cons) { ++- if (type_of(x->c.c_car) == t_cons) { ++- if (!keywordp(x->c.c_car->c.c_car)) +++ if (consp(x)) { +++ if (consp(x->c.c_car)) { +++ if (type_of(x->c.c_car->c.c_car)!=t_symbol) ++ /* FIXME better message */ ++ FEunexpected_keyword(x->c.c_car->c.c_car); ++ vs_push(x->c.c_car->c.c_car); ++@@ -296,7 +297,7 @@ AUX_L: ++ goto SEARCH_DECLARE; ++ x = lambda_list->c.c_car; ++ lambda_list = lambda_list->c.c_cdr; ++- if (type_of(x) == t_cons) { +++ if (consp(x)) { ++ check_symbol(x->c.c_car); ++ check_var(x->c.c_car); ++ vs_push(x->c.c_car); ++@@ -336,10 +337,10 @@ SEARCH_DECLARE: ++ break; ++ continue; ++ } ++- if (type_of(form)!=t_cons || !isdeclare(form->c.c_car)) +++ if (!consp(form) || !isdeclare(form->c.c_car)) ++ break; ++ for (ds = form->c.c_cdr; !endp(ds); ds = ds->c.c_cdr) { ++- if (type_of(ds->c.c_car) != t_cons) +++ if (!consp(ds->c.c_car)) ++ illegal_declare(form); ++ if (ds->c.c_car->c.c_car == sLspecial) { ++ vs = ds->c.c_car->c.c_cdr; ++@@ -381,8 +382,7 @@ SEARCH_DECLARE: ++ } ++ if (special_processed) ++ continue; ++- /* lex_special_bind(v); */ ++- lex_env[0] = MMcons(MMcons(v, Cnil), lex_env[0]); +++ s[0] = MMcons(MMcons(v, Cnil), s[0]); ++ ++ /**/ ++ } ++@@ -437,17 +437,20 @@ SEARCH_DECLARE: ++ bind_var(rest->rest_var, vs_head, rest->rest_spp); ++ } ++ if (key_flag) { +++ int allow_other_keys_found=0; ++ i = narg - nreq - nopt; ++ if (i >= 0 && i%2 != 0) ++ /* FIXME better message */ ++ FEunexpected_keyword(Cnil); ++ other_keys_appeared = FALSE; ++ for (i = nreq + nopt; i < narg; i += 2) { ++- if (!keywordp(base[i])) +++ if (type_of(base[i])!=t_symbol) ++ FEunexpected_keyword(base[i]); ++- if (base[i] == sKallow_other_keys && ++- base[i+1] != Cnil) +++ if (base[i] == sKallow_other_keys && !allow_other_keys_found) { +++ allow_other_keys_found=1; +++ if (base[i+1] != Cnil) ++ allow_other_keys_flag = TRUE; +++ } ++ for (j = 0; j < nkey; j++) { ++ if (keyword[j].key_word == base[i]) { ++ if (keyword[j].key_svar_val ++@@ -460,7 +463,8 @@ SEARCH_DECLARE: ++ goto NEXT_ARG; ++ } ++ } ++- other_keys_appeared = TRUE; +++ if (base[i] != sKallow_other_keys) +++ other_keys_appeared = TRUE; ++ ++ NEXT_ARG: ++ continue; ++@@ -492,7 +496,7 @@ SEARCH_DECLARE: ++ eval_assign(temporary, aux[i].aux_init); ++ bind_var(aux[i].aux_var, temporary, aux[i].aux_spp); ++ } ++- if (type_of(body) != t_cons || body->c.c_car == form) { +++ if (!consp(body) || body->c.c_car == form) { ++ vs_reset; ++ vs_head = body; ++ } else { ++@@ -500,6 +504,13 @@ SEARCH_DECLARE: ++ vs_reset; ++ vs_head = body; ++ } +++ +++ if (s[0]!=Cnil) { +++ for (ss=s[0];ss->c.c_cdr!=Cnil;ss=ss->c.c_cdr); +++ ss->c.c_cdr=lex_env[0]; +++ lex_env[0]=s[0]; +++ } +++ ++ return; ++ ++ REQUIRED_ONLY: ++@@ -515,10 +526,10 @@ REQUIRED_ONLY: ++ break; ++ continue; ++ } ++- if (type_of(form)!=t_cons || !isdeclare(form->c.c_car)) +++ if (!consp(form) || !isdeclare(form->c.c_car)) ++ break; ++ for (ds = form->c.c_cdr; !endp(ds); ds = ds->c.c_cdr) { ++- if (type_of(ds->c.c_car) != t_cons) +++ if (!consp(ds->c.c_car)) ++ illegal_declare(form); ++ if (ds->c.c_car->c.c_car == sLspecial) { ++ vs = ds->c.c_car->c.c_cdr; ++@@ -537,7 +548,7 @@ REQUIRED_ONLY: ++ continue; ++ /* lex_special_bind(v); */ ++ temporary = MMcons(v, Cnil); ++- lex_env[0] = MMcons(temporary, lex_env[0]); +++ s[0] = MMcons(temporary, s[0]); ++ ++ /**/ ++ } ++@@ -555,7 +566,7 @@ REQUIRED_ONLY: ++ bind_var(required[i].req_var, ++ base[i], ++ required[i].req_spp); ++- if (type_of(body) != t_cons || body->c.c_car == form) { +++ if (!consp(body) || body->c.c_car == form) { ++ vs_reset; ++ vs_head = body; ++ } else { ++@@ -563,6 +574,13 @@ REQUIRED_ONLY: ++ vs_reset; ++ vs_head = body; ++ } +++ +++ if (s[0]!=Cnil) { +++ for (ss=s[0];ss->c.c_cdr!=Cnil;ss=ss->c.c_cdr); +++ ss->c.c_cdr=lex_env[0]; +++ lex_env[0]=s[0]; +++ } +++ ++ } ++ ++ void ++@@ -612,7 +630,7 @@ struct bind_temp { ++ */ ++ ++ object ++-find_special(object body, struct bind_temp *start, struct bind_temp *end) +++find_special(object body, struct bind_temp *start, struct bind_temp *end,object *s) ++ { ++ object temporary; ++ object form=Cnil; ++@@ -622,6 +640,7 @@ find_special(object body, struct bind_te ++ vs_mark; ++ ++ vs_push(Cnil); +++ s=s ? s : lex_env; ++ for (; !endp(body); body = body->c.c_cdr) { ++ form = body->c.c_car; ++ ++@@ -634,10 +653,10 @@ find_special(object body, struct bind_te ++ break; ++ continue; ++ } ++- if (type_of(form)!=t_cons || !isdeclare(form->c.c_car)) +++ if (!consp(form) || !isdeclare(form->c.c_car)) ++ break; ++ for (ds = form->c.c_cdr; !endp(ds); ds = ds->c.c_cdr) { ++- if (type_of(ds->c.c_car) != t_cons) +++ if (!consp(ds->c.c_car)) ++ illegal_declare(form); ++ if (ds->c.c_car->c.c_car == sLspecial) { ++ vs = ds->c.c_car->c.c_cdr; ++@@ -655,14 +674,14 @@ find_special(object body, struct bind_te ++ continue; ++ /* lex_special_bind(v); */ ++ temporary = MMcons(v, Cnil); ++- lex_env[0] = MMcons(temporary, lex_env[0]); +++ s[0] = MMcons(temporary, s[0]); ++ /**/ ++ } ++ } ++ } ++ } ++ ++- if (body != Cnil && body->c.c_car != form) +++ if (body != Cnil && body->c.c_car != form && type_of(form)==t_cons && isdeclare(form->c.c_car))/*FIXME*/ ++ body = make_cons(form, body->c.c_cdr); ++ vs_reset; ++ return(body); ++@@ -674,10 +693,10 @@ let_bind(object body, struct bind_temp * ++ struct bind_temp *bt; ++ ++ bds_check; ++- vs_push(find_special(body, start, end)); ++ for (bt = start; bt < end; bt++) { ++ eval_assign(bt->bt_init, bt->bt_init); ++ } +++ vs_push(find_special(body, start, end,NULL)); ++ for (bt = start; bt < end; bt++) { ++ bind_var(bt->bt_var, bt->bt_init, bt->bt_spp); ++ } ++@@ -688,13 +707,20 @@ object ++ letA_bind(object body, struct bind_temp *start, struct bind_temp *end) ++ { ++ struct bind_temp *bt; ++- +++ object s[1],ss; +++ ++ bds_check; ++- vs_push(find_special(body, start, end)); +++ s[0]=Cnil; +++ vs_push(find_special(body, start, end,s)); ++ for (bt = start; bt < end; bt++) { ++ eval_assign(bt->bt_init, bt->bt_init); ++ bind_var(bt->bt_var, bt->bt_init, bt->bt_spp); ++ } +++ if (s[0]!=Cnil) { +++ for (ss=s[0];ss->c.c_cdr!=Cnil;ss=ss->c.c_cdr); +++ ss->c.c_cdr=lex_env[0]; +++ lex_env[0]=s[0]; +++ } ++ return(vs_pop); ++ } ++ ++@@ -703,12 +729,12 @@ letA_bind(object body, struct bind_temp ++ ++ #endif ++ ++-#define NOT_YET 10 ++-#define FOUND 11 +++#define NOT_YET stp_ordinary +++#define FOUND stp_special ++ #define NOT_KEYWORD 1 ++ ++ void ++-parse_key(object *base, bool rest, bool allow_other_keys,int n, ...) +++parse_key(object *base, bool rest, bool allow_other_keys, int n, ...) ++ { ++ object temporary; ++ va_list ap; ++@@ -735,7 +761,7 @@ parse_key(object *base, bool rest, bool ++ FEunexpected_keyword(Cnil); ++ if (narg == 2) { ++ k = base[0]; ++- if (!keywordp(k)) +++ if (type_of(k)!=t_symbol) ++ FEunexpected_keyword(k); ++ if (k == sKallow_other_keys && ! allow_other_keys_found) { ++ allow_other_keys_found=1; ++@@ -777,7 +803,7 @@ parse_key(object *base, bool rest, bool ++ va_end(ap); ++ for (v = base; v < vs_top; v += 2) { ++ k = v[0]; ++- if (!keywordp(k)) { +++ if (type_of(k)!=t_symbol) { ++ error_flag = NOT_KEYWORD; ++ other_key = k; ++ continue; ++@@ -827,16 +853,19 @@ check_other_key(object l, int n, ...) ++ object k; ++ int i; ++ bool allow_other_keys = FALSE; +++ int allow_other_keys_found=0; ++ ++ for (; !endp(l); l = l->c.c_cdr->c.c_cdr) { ++ k = l->c.c_car; ++- if (!keywordp(k)) +++ if (type_of(k)!=t_symbol) ++ FEunexpected_keyword(k); ++ if (endp(l->c.c_cdr)) ++ /* FIXME better message */ ++ FEunexpected_keyword(Cnil); ++- if (k == sKallow_other_keys && l->c.c_cdr->c.c_car != Cnil) { ++- allow_other_keys = TRUE; +++ if (k == sKallow_other_keys && !allow_other_keys_found) { +++ allow_other_keys_found=1; +++ if (l->c.c_cdr->c.c_car != Cnil) +++ allow_other_keys = TRUE; ++ } else { ++ char buf [100]; ++ bzero(buf,n); ++@@ -1110,7 +1139,7 @@ gcl_init_bind(void) ++ make_cons(make_ordinary("&BODY"), Cnil))))))))); ++ ++ make_constant("LAMBDA-PARAMETERS-LIMIT", ++- make_fixnum(64)); +++ make_fixnum(MAX_ARGS+1)); ++ ++ ++ ++--- gcl-2.6.12.orig/o/error.c +++++ gcl-2.6.12/o/error.c ++@@ -490,49 +490,78 @@ vfun_wrong_number_of_args(object x) ++ ++ ++ void ++-check_arg_range(int n, int m) ++-{ ++- object x,x1; +++check_arg_range(int n, int m) { ++ ++- x=make_fixnum(n); ++- x1=make_fixnum(VFUN_NARGS); ++ if (VFUN_NARGS < n) ++- Icall_error_handler( ++- sKtoo_few_arguments, ++- make_simple_string("Needed at least ~D args, but received ~d"), ++- 2,x,x1); ++- else if (VFUN_NARGS > m) ++- Icall_error_handler( ++- sKtoo_many_arguments, ++- make_simple_string("Needed no more than ~D args, but received ~d"), ++- 2,x,x1); ++- } +++ FEtoo_few_arguments(0,VFUN_NARGS); +++ if (VFUN_NARGS > m) +++ FEtoo_many_arguments(0,VFUN_NARGS); +++ +++} ++ ++ ++ DEF_ORDINARY("TERMINAL-INTERRUPT",sSterminal_interrupt,SI,""); ++-DEF_ORDINARY("WRONG-TYPE-ARGUMENT",sKwrong_type_argument,KEYWORD,""); ++-DEF_ORDINARY("TOO-FEW-ARGUMENTS",sKtoo_few_arguments,KEYWORD,""); ++-DEF_ORDINARY("TOO-MANY-ARGUMENTS",sKtoo_many_arguments,KEYWORD,""); ++-DEF_ORDINARY("UNEXPECTED-KEYWORD",sKunexpected_keyword,KEYWORD,""); ++-DEF_ORDINARY("INVALID-FORM",sKinvalid_form,KEYWORD,""); ++-DEF_ORDINARY("UNBOUND-VARIABLE",sKunbound_variable,KEYWORD,""); ++-DEF_ORDINARY("INVALID-VARIABLE",sKinvalid_variable,KEYWORD,""); ++-DEF_ORDINARY("UNDEFINED-FUNCTION",sKundefined_function,KEYWORD,""); ++-DEF_ORDINARY("INVALID-FUNCTION",sKinvalid_function,KEYWORD,""); ++-DEF_ORDINARY("PACKAGE-ERROR",sKpackage_error,KEYWORD,""); ++-DEF_ORDINARY("DATUM",sKdatum,KEYWORD,""); ++-DEF_ORDINARY("EXPECTED-TYPE",sKexpected_type,KEYWORD,""); ++-DEF_ORDINARY("PACKAGE",sKpackage,KEYWORD,""); ++-DEF_ORDINARY("FORMAT-CONTROL",sKformat_control,KEYWORD,""); ++-DEF_ORDINARY("FORMAT-ARGUMENTS",sKformat_arguments,KEYWORD,""); ++ DEF_ORDINARY("CATCH",sKcatch,KEYWORD,""); ++ DEF_ORDINARY("PROTECT",sKprotect,KEYWORD,""); ++ DEF_ORDINARY("CATCHALL",sKcatchall,KEYWORD,""); ++ ++ +++DEF_ORDINARY("CONDITION",sLcondition,LISP,""); +++DEF_ORDINARY("SERIOUS-CONDITION",sLserious_condition,LISP,""); +++DEF_ORDINARY("SIMPLE-CONDITION",sLsimple_condition,LISP,""); +++ +++DEF_ORDINARY("ERROR",sLerror,LISP,""); +++DEF_ORDINARY("SIMPLE-ERROR",sLsimple_error,LISP,""); +++DEF_ORDINARY("FORMAT-CONTROL",sKformat_control,KEYWORD,""); +++DEF_ORDINARY("FORMAT-ARGUMENTS",sKformat_arguments,KEYWORD,""); +++ +++DEF_ORDINARY("TYPE-ERROR",sLtype_error,LISP,""); +++DEF_ORDINARY("DATUM",sKdatum,KEYWORD,""); +++DEF_ORDINARY("EXPECTED-TYPE",sKexpected_type,KEYWORD,""); +++DEF_ORDINARY("SIMPLE-TYPE-ERROR",sLsimple_type_error,LISP,""); +++ +++DEF_ORDINARY("PROGRAM-ERROR",sLprogram_error,LISP,""); +++DEF_ORDINARY("CONTROL-ERROR",sLcontrol_error,LISP,""); +++DEF_ORDINARY("PACKAGE-ERROR",sLpackage_error,LISP,""); +++DEF_ORDINARY("PACKAGE",sKpackage,KEYWORD,""); +++ +++DEF_ORDINARY("STREAM-ERROR",sLstream_error,LISP,""); +++DEF_ORDINARY("STREAM",sKstream,KEYWORD,""); +++DEF_ORDINARY("END-OF-FILE",sLend_of_file,LISP,""); +++ +++DEF_ORDINARY("FILE-ERROR",sLfile_error,LISP,""); +++DEF_ORDINARY("PATHNAME",sKpathname,KEYWORD,""); +++ +++DEF_ORDINARY("CELL-ERROR",sLcell_error,LISP,""); +++DEF_ORDINARY("NAME",sKname,KEYWORD,""); +++DEF_ORDINARY("UNBOUND-SLOT",sLunbound_slot,LISP,""); +++DEF_ORDINARY("UNBOUND-VARIABLE",sLunbound_variable,LISP,""); +++DEF_ORDINARY("UNDEFINED-FUNCTION",sLundefined_function,LISP,""); +++ +++DEF_ORDINARY("ARITHMETIC-ERROR",sLarithmetic_error,LISP,""); +++DEF_ORDINARY("OPERATION",sKoperation,KEYWORD,""); +++DEF_ORDINARY("OPERANDS",sKoperands,KEYWORD,""); +++DEF_ORDINARY("DIVISION-BY-ZERO",sLdivision_by_zero,LISP,""); +++DEF_ORDINARY("FLOATING-POINT-OVERFLOW",sLfloating_point_overflow,LISP,""); +++DEF_ORDINARY("FLOATING-POINT-UNDERFLOW",sLfloating_point_underflow,LISP,""); +++DEF_ORDINARY("FLOATING-POINT-INEXACT",sLfloating_point_inexact,LISP,""); +++DEF_ORDINARY("FLOATING-POINT-INVALID-OPERATION",sLfloating_point_invalid_operation,LISP,""); +++ +++DEF_ORDINARY("PARSE-ERROR",sLparse_error,LISP,""); +++ +++DEF_ORDINARY("PRINT-NOT-READABLE",sLprint_not_readable,LISP,""); +++ +++DEF_ORDINARY("READER-ERROR",sLreader_error,LISP,""); +++DEF_ORDINARY("PATHNAME-ERROR",sLpathname_error,SI,""); +++ +++DEF_ORDINARY("STORAGE-CONDITION",sLstorage_condition,LISP,""); +++ +++DEF_ORDINARY("WARNING",sLwarning,LISP,""); +++DEF_ORDINARY("SIMPLE-WARNING",sLsimple_warning,LISP,""); +++DEF_ORDINARY("STYLE-WARNING",sLstyle_warning,LISP,""); +++ ++ void ++-gcl_init_error(void) ++-{ ++- null_string = make_simple_string(""); ++- enter_mark_origin(&null_string); +++gcl_init_error(void) { +++ null_string = make_simple_string(""); +++ enter_mark_origin(&null_string); ++ } ++--- gcl-2.6.12.orig/o/fasdump.c +++++ gcl-2.6.12/o/fasdump.c ++@@ -1501,14 +1501,12 @@ read_fasl_vector(object in) ++ object d; ++ int tem; ++ if (((tem=getc(((FILE *)in->sm.sm_fp))) == EOF) && feof(((FILE *)in->sm.sm_fp))) ++- { d = coerce_to_pathname(in); ++- d = make_pathname(d->pn.pn_host, ++- d->pn.pn_device, ++- d->pn.pn_directory, ++- d->pn.pn_name, ++- make_simple_string("data"), ++- d->pn.pn_version); ++- d = coerce_to_namestring(d); +++ { char *pf; +++ coerce_to_filename(in,FN1); +++ for (pf=FN1+strlen(FN1);pf>FN1 && pf[-1]!='.';pf--); +++ if (pf==FN1) {pf=FN1+strlen(FN1);*pf++='.';} +++ snprintf(pf,sizeof(FN1)-(pf-FN1),"data"); +++ d=make_simple_string(FN1); ++ in = open_stream(d,smm_input,Cnil,Cnil); ++ if (in == Cnil) ++ FEerror("Can't open file ~s",1,d); ++--- gcl-2.6.12.orig/o/file.d +++++ gcl-2.6.12/o/file.d ++@@ -138,7 +138,7 @@ void ++ end_of_stream(strm) ++ object strm; ++ { ++- FEerror("Unexpected end of ~S.", 1, strm); +++ END_OF_FILE(strm); ++ } ++ ++ /* ++@@ -167,6 +167,7 @@ BEGIN: ++ case smm_probe: ++ return(FALSE); ++ +++ case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -223,6 +224,7 @@ BEGIN: ++ case smm_probe: ++ return(FALSE); ++ +++ case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -270,6 +272,7 @@ BEGIN: ++ case smm_socket: ++ return (sLcharacter); ++ +++ case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -341,220 +344,208 @@ cannot_create(object); ++ Fn is a namestring. ++ */ ++ object ++-open_stream(fn, smm, if_exists, if_does_not_exist) ++-object fn; ++-enum smmode smm; ++-object if_exists, if_does_not_exist; ++-{ ++- object x; ++- FILE *fp=NULL; ++- char fname[PATH_MAX]; ++- object unzipped = 0; ++- vs_mark; +++open_stream(object fn,enum smmode smm, object if_exists, object if_does_not_exist) { ++ ++-/* ++- if (type_of(fn) != t_string) ++- FEwrong_type_argument(sLstring, fn); ++-*/ ++- /* if (fn->st.st_fillp > BUFSIZ - 1) */ ++- /* too_long_file_name(fn); */ ++- /* for (i = 0; i < fn->st.st_fillp; i++) */ ++- /* fname[i] = fn->st.st_self[i]; */ ++- ++- /* fname[i] = '\0'; */ ++- coerce_to_filename(fn,fname); ++- if (smm == smm_input || smm == smm_probe) { ++- if(fname[0]=='|') ++- fp = popen(fname+1,"r"); ++- else ++- fp = fopen_not_dir(fname, "r"); ++- ++- AGAIN: ++- if (fp == NULL) { ++- if (sSAallow_gzipped_fileA->s.s_dbind != sLnil) ++- { ++- static struct string st; ++- char buf[256]; ++- if (snprintf(buf,sizeof(buf),"%s.gz",fname)<=0) ++- FEerror("Cannot write .gz filename",0); ++- st.st_self=buf; ++- st.st_dim=st.st_fillp=strlen(buf); ++- set_type_of(&st,t_string); ++- if (file_exists((object)&st)) { ++- FILE *pp; ++- int n; ++- if (!(fp=tmpfile())) ++- FEerror("Cannot create temporary file",0); ++- if (snprintf(buf,sizeof(buf),"zcat %s.gz",fname)<=0) ++- FEerror("Cannot write zcat pipe name",0); ++- if (!(pp=popen(buf,"r"))) ++- FEerror("Cannot open zcat pipe",0); ++- while((n=fread(buf,1,sizeof(buf),pp))) ++- if (!fwrite(buf,1,n,fp)) ++- FEerror("Cannot write pipe output to temporary file",0); ++- if (pclose(pp)<0) ++- FEerror("Cannot close zcat pipe",0); ++- if (fseek(fp,0,SEEK_SET)) ++- FEerror("Cannot rewind temporary file\n",0); ++- goto AGAIN; ++- } ++- } ++- ++-/* fp = fopen_not_dir(buf,"r"); */ ++-/* if (fp) */ ++-/* { */ ++-/* #ifdef NO_MKSTEMP */ ++-/* char *tmp; */ ++-/* #else */ ++-/* char tmp[200]; */ ++-/* #endif */ ++-/* char command [500]; */ ++-/* fclose(fp); */ ++-/* #ifdef NO_MKSTEMP */ ++-/* tmp = tmpnam(0); */ ++-/* #else */ ++-/* snprintf(tmp,sizeof(tmp),"uzipXXXXXX"); */ ++- /* mkstemp(tmp); */ /* fixme: catch errors */ ++-/* #endif */ ++-/* unzipped = make_simple_string(tmp); */ ++-/* sprintf(command,"gzip -dc %s > %s",buf,tmp); */ ++-/* fp = 0; */ ++-/* if (0 == system(command)) */ ++-/* { */ ++-/* fp = fopen_not_dir(tmp,"r"); */ ++-/* if (fp) */ ++-/* goto AGAIN; */ ++-/* /\* should not get here *\/ */ ++-/* else { unlink(tmp);}} */ ++-/* }} */ ++- if (if_does_not_exist == sKerror) ++- cannot_open(fn); ++- else if (if_does_not_exist == sKcreate) { ++- fp = fopen_not_dir(fname, "w"); ++- if (fp == NULL) ++- cannot_create(fn); ++- fclose(fp); ++- fp = fopen_not_dir(fname, "r"); ++- if (fp == NULL) ++- cannot_open(fn); ++- } else if (if_does_not_exist == Cnil) ++- return(Cnil); ++- else ++- FEerror("~S is an illegal IF-DOES-NOT-EXIST option.", ++- 1, if_does_not_exist); ++- } ++- } else if (smm == smm_output || smm == smm_io) { ++- if (if_exists == sKnew_version && if_does_not_exist == sKcreate) ++- goto CREATE; ++- fp = fopen_not_dir(fname, "r"); ++- if (fp != NULL) { ++- fclose(fp); ++- if (if_exists == sKerror) ++- FEerror("The file ~A already exists.", 1, fn); ++- else if (if_exists == sKrename) { ++- if (smm == smm_output) ++- fp = backup_fopen(fname, "w"); ++- else ++- fp = backup_fopen(fname, "w+"); ++- if (fp == NULL) ++- cannot_create(fn); ++- } else if (if_exists == sKrename_and_delete || ++- if_exists == sKnew_version || ++- if_exists == sKsupersede) { ++- if (smm == smm_output) ++- fp = fopen_not_dir(fname, "w"); ++- else ++- fp = fopen_not_dir(fname, "w+"); ++- if (fp == NULL) ++- cannot_create(fn); ++- } else if (if_exists == sKoverwrite) { ++- fp = fopen_not_dir(fname, "r+"); ++- if (fp == NULL) ++- cannot_open(fn); ++- } else if (if_exists == sKappend) { ++- if (smm == smm_output) ++- fp = fopen_not_dir(fname, "a"); ++- else ++- fp = fopen_not_dir(fname, "a+"); ++- if (fp == NULL) ++- FEerror("Cannot append to the file ~A.",1,fn); ++- } else if (if_exists == Cnil) ++- return(Cnil); ++- else ++- FEerror("~S is an illegal IF-EXISTS option.", ++- 1, if_exists); ++- } else { ++- if (if_does_not_exist == sKerror) ++- FEerror("The file ~A does not exist.", 1, fn); ++- else if (if_does_not_exist == sKcreate) { ++- CREATE: ++- if (smm == smm_output) ++- { ++- if(fname[0]=='|') ++- fp = popen(fname+1,"w"); ++- else ++- fp = fopen_not_dir(fname, "w"); ++- } ++- else ++- fp = fopen_not_dir(fname, "w+"); ++- if (fp == NULL) ++- cannot_create(fn); ++- } else if (if_does_not_exist == Cnil) ++- return(Cnil); ++- else ++- FEerror("~S is an illegal IF-DOES-NOT-EXIST option.", ++- 1, if_does_not_exist); ++- } +++ object x; +++ FILE *fp=NULL; +++ vs_mark; +++ +++ coerce_to_filename(fn,FN1); +++ if (smm == smm_input || smm == smm_probe) { +++ if(FN1[0]=='|') +++ fp = popen(FN1+1,"r"); +++ else +++ fp = fopen_not_dir(FN1, "r"); +++ +++ if ((fp == NULL) && +++ (sSAallow_gzipped_fileA->s.s_dbind != sLnil)) { +++ union lispunion st; +++ char buf[256]; +++ if (snprintf(buf,sizeof(buf),"%s.gz",FN1)<=0) +++ FEerror("Cannot write .gz filename",0); +++ st.st.st_self=buf; +++ st.st.st_dim=st.st.st_fillp=strlen(buf); +++ set_type_of(&st,t_string); +++ if (fSstat((object)&st)!=Cnil) { +++ FILE *pp; +++ int n; +++ if (!(fp=tmpfile())) +++ FEerror("Cannot create temporary file",0); +++ if (snprintf(buf,sizeof(buf),"zcat %s.gz",FN1)<=0) +++ FEerror("Cannot write zcat pipe name",0); +++ if (!(pp=popen(buf,"r"))) +++ FEerror("Cannot open zcat pipe",0); +++ while((n=fread(buf,1,sizeof(buf),pp))) +++ if (!fwrite(buf,1,n,fp)) +++ FEerror("Cannot write pipe output to temporary file",0); +++ if (pclose(pp)<0) +++ FEerror("Cannot close zcat pipe",0); +++ if (fseek(fp,0,SEEK_SET)) +++ FEerror("Cannot rewind temporary file\n",0); +++ } +++ } +++ if (fp == NULL) { +++ if (if_does_not_exist == sKerror) +++ cannot_open(fn); +++ else if (if_does_not_exist == sKcreate) { +++ fp = fopen_not_dir(FN1, "w"); +++ if (fp == NULL) +++ cannot_create(fn); +++ fclose(fp); +++ fp = fopen_not_dir(FN1, "r"); +++ if (fp == NULL) +++ cannot_open(fn); +++ } else if (if_does_not_exist == Cnil) +++ return(Cnil); +++ else +++ FEerror("~S is an illegal IF-DOES-NOT-EXIST option.", +++ 1, if_does_not_exist); +++ } +++ } else if (smm == smm_output || smm == smm_io) { +++ if (FN1[0] == '|') +++ fp = NULL; +++ else +++ fp = fopen_not_dir(FN1, "r"); +++ if (fp != NULL) { +++ fclose(fp); +++ if (if_exists == sKerror) +++ FILE_ERROR(fn,"File exists"); +++ else if (if_exists == sKrename) { +++ massert(snprintf(FN2,sizeof(FN2),"%s.BAK",FN1)>=0); +++ massert(!rename(FN1,FN2)); +++ if (smm == smm_output) +++ fp = fopen(FN1, "w"); +++ else +++ fp = fopen(FN1, "w+"); +++ if (fp == NULL) +++ cannot_create(fn); +++ } else if (if_exists == sKrename_and_delete || +++ if_exists == sKnew_version || +++ if_exists == sKsupersede) { +++ if (smm == smm_output) +++ fp = fopen_not_dir(FN1, "w"); +++ else +++ fp = fopen_not_dir(FN1, "w+"); +++ if (fp == NULL) +++ cannot_create(fn); +++ } else if (if_exists == sKoverwrite) { +++ fp = fopen_not_dir(FN1, "r+"); +++ if (fp == NULL) +++ cannot_open(fn); +++ } else if (if_exists == sKappend) { +++ if (smm == smm_output) +++ fp = fopen_not_dir(FN1, "a"); +++ else +++ fp = fopen_not_dir(FN1, "a+"); +++ if (fp == NULL) +++ FEerror("Cannot append to the file ~A.",1,fn); +++ } else if (if_exists == Cnil) +++ return(Cnil); +++ else +++ FEerror("~S is an illegal IF-EXISTS option.", +++ 1, if_exists); +++ } else { +++ if (if_does_not_exist == sKerror) +++ FILE_ERROR(fn,"The file does not exist"); +++ else if (if_does_not_exist == sKcreate) { +++ if (smm == smm_output) { +++ if(FN1[0]=='|') +++ fp = popen(FN1+1,"w"); +++ else +++ fp = fopen_not_dir(FN1, "w"); ++ } else ++- error("illegal stream mode"); ++- x = alloc_object(t_stream); ++- x->sm.sm_mode = (short)smm; ++- x->sm.sm_fp = fp; +++ fp = fopen_not_dir(FN1, "w+"); +++ if (fp == NULL) +++ cannot_create(fn); +++ } else if (if_does_not_exist == Cnil) +++ return(Cnil); +++ else +++ FEerror("~S is an illegal IF-DOES-NOT-EXIST option.", +++ 1, if_does_not_exist); +++ } +++ } else +++ FEerror("Illegal open mode for ~S.",1,fn); +++ +++ vs_push(make_simple_string(FN1)); +++ x = alloc_object(t_stream); +++ x->sm.sm_mode = (short)smm; +++ x->sm.sm_fp = fp; +++ x->sm.sm_buffer = 0; +++ x->sm.sm_object0 = sLcharacter; +++ x->sm.sm_object1 = vs_head; +++ x->sm.sm_int0 = x->sm.sm_int1 = 0; +++ x->sm.sm_flags=0; +++ vs_push(x); +++ +++ setup_stream_buffer(x); +++ vs_reset; +++ +++ if (smm==smm_probe) +++ close_stream(x); +++ +++ return(x); ++ ++- x->sm.sm_buffer = 0; ++- x->sm.sm_object0 = (unzipped ? make_cons(sSAallow_gzipped_fileA,unzipped) : sLcharacter); ++- x->sm.sm_object1 = fn; ++- x->sm.sm_int0 = x->sm.sm_int1 = 0; ++- vs_push(x); ++- setup_stream_buffer(x); ++- vs_reset; ++- return(x); ++ } ++ ++ static void ++ gclFlushSocket(object); ++ +++DEFUN_NEW("OPEN-INT",object,fSopen_int,SI,8,8,NONE,OO,OO,OO,OO, +++ (object fn,object direction,object element_type,object if_exists, +++ object iesp,object if_does_not_exist,object idnesp, +++ object external_format),"") { +++ +++ enum smmode smm=0; +++ vs_mark; +++ object strm,filename; +++ +++ filename=fn; +++ if (direction == sKinput) { +++ smm = smm_input; +++ if (idnesp==Cnil) +++ if_does_not_exist = sKerror; +++ } else if (direction == sKoutput) { +++ smm = smm_output; +++ if (iesp==Cnil) +++ if_exists = sKnew_version; +++ if (idnesp==Cnil) { +++ if (if_exists == sKoverwrite || +++ if_exists == sKappend) +++ if_does_not_exist = sKerror; +++ else +++ if_does_not_exist = sKcreate; +++ } +++ } else if (direction == sKio) { +++ smm = smm_io; +++ if (iesp==Cnil) +++ if_exists = sKnew_version; +++ if (idnesp==Cnil) { +++ if (if_exists == sKoverwrite || +++ if_exists == sKappend) +++ if_does_not_exist = sKerror; +++ else +++ if_does_not_exist = sKcreate; +++ } +++ } else if (direction == sKprobe) { +++ smm = smm_probe; +++ if (idnesp==Cnil) +++ if_does_not_exist = Cnil; +++ } else +++ FEerror("~S is an illegal DIRECTION for OPEN.", 1, direction); +++ strm = open_stream(filename, smm, if_exists, if_does_not_exist); +++ if (type_of(strm) == t_stream) { +++ strm->sm.sm_object0 = element_type; +++ strm->sm.sm_object1 = fn; +++ } +++ vs_reset; +++ RETURN1(strm); +++} ++ ++ DEFUN_NEW("OPEN-STREAM-P",object,fLopen_stream_p,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ ++ check_type_stream(&x); ++ ++- switch(x->sm.sm_mode) { ++- case smm_output: ++- case smm_input: ++- case smm_io: ++- case smm_probe: ++- case smm_socket: ++- case smm_string_input: ++- case smm_string_output: ++- return x->d.tt==1 ? Cnil : Ct; ++- case smm_synonym: ++- return FFN(fLopen_stream_p)(symbol_value(x->sm.sm_object0)); ++- case smm_broadcast: ++- case smm_concatenated: ++- for (x=x->sm.sm_object0;!endp(x);x=x->c.c_cdr) ++- if (!FFN(fLopen_stream_p)(x)) ++- return Cnil; ++- return Ct; ++- case smm_two_way: ++- case smm_echo: ++- if (FFN(fLopen_stream_p)(STREAM_INPUT_STREAM(x))==Cnil) ++- return Cnil; ++- return FFN(fLopen_stream_p)(STREAM_OUTPUT_STREAM(x)); ++- default: ++- error("illegal stream mode"); ++- return Cnil; ++- } +++ return GET_STREAM_FLAG(x,gcl_sm_closed) ? Cnil : Ct; ++ ++ } ++ /* ++@@ -562,94 +553,132 @@ DEFUN_NEW("OPEN-STREAM-P",object,fLopen_ ++ The abort_flag is not used now. ++ */ ++ void ++-close_stream(strm) ++-object strm; ++-/*bool abort_flag; */ /* Not used now! */ ++-{ ++- object x; +++close_stream(object strm) { ++ ++-BEGIN: ++- strm->d.tt=1; +++ object x; ++ ++- switch (strm->sm.sm_mode) { ++- case smm_output: ++- if (strm->sm.sm_fp == stdout) ++- FEerror("Cannot close the standard output.", 0); ++- if (strm->sm.sm_fp == NULL) break; ++- fflush(strm->sm.sm_fp); ++- deallocate_stream_buffer(strm); ++- fclose(strm->sm.sm_fp); ++- strm->sm.sm_fp = NULL; ++- break; +++ if (FFN(fLopen_stream_p)(strm)==Cnil) +++ return; ++ +++ switch (strm->sm.sm_mode) { +++ case smm_output: +++ if (strm->sm.sm_fp == stdout) +++ FEerror("Cannot close the standard output.", 0); +++ fflush(strm->sm.sm_fp); +++ deallocate_stream_buffer(strm); +++ fclose(strm->sm.sm_fp); +++ strm->sm.sm_fp = NULL; +++ strm->sm.sm_fd = -1; +++ break; ++ ++- case smm_socket: ++- if (SOCKET_STREAM_FD(strm) < 2) ++- emsg("tried Closing %d ! as socket \n",SOCKET_STREAM_FD(strm)); ++- else { +++ case smm_socket: +++ if (SOCKET_STREAM_FD(strm) < 2) +++ emsg("tried Closing %d ! as socket \n",SOCKET_STREAM_FD(strm)); +++ else { ++ #ifdef HAVE_NSOCKET ++- if (GET_STREAM_FLAG(strm,gcl_sm_output)) ++- { ++- gclFlushSocket(strm); ++- /* there are two for one fd so close only one */ ++- tcpCloseSocket(SOCKET_STREAM_FD(strm)); ++- } +++ if (GET_STREAM_FLAG(strm,gcl_sm_output)) { +++ gclFlushSocket(strm); +++ /* there are two for one fd so close only one */ +++ tcpCloseSocket(SOCKET_STREAM_FD(strm)); +++ } ++ #endif ++- SOCKET_STREAM_FD(strm)=-1; ++- } +++ SOCKET_STREAM_FD(strm)=-1; +++ } ++ ++- case smm_input: ++- if (strm->sm.sm_fp == stdin) ++- FEerror("Cannot close the standard input.", 0); ++- ++- case smm_io: ++- case smm_probe: ++- if (strm->sm.sm_fp == NULL) break; ++- deallocate_stream_buffer(strm); ++- if (strm->sm.sm_object1 && ++- type_of(strm->sm.sm_object1)==t_string && ++- strm->sm.sm_object1->st.st_self[0] =='|') ++- pclose(strm->sm.sm_fp); ++- else ++- fclose(strm->sm.sm_fp); ++- strm->sm.sm_fp = NULL; ++- if (strm->sm.sm_object0 && ++- type_of(strm->sm.sm_object0 ) == t_cons && ++- Mcar(strm->sm.sm_object0 ) == sSAallow_gzipped_fileA) ++- fLdelete_file(Mcdr(strm->sm.sm_object0)); ++- break; +++ case smm_input: +++ if (strm->sm.sm_fp == stdin) +++ FEerror("Cannot close the standard input.", 0); ++ ++- case smm_synonym: ++- strm = symbol_value(strm->sm.sm_object0); ++- if (type_of(strm) != t_stream) ++- FEwrong_type_argument(sLstream, strm); ++- goto BEGIN; +++ case smm_io: +++ case smm_probe: +++ deallocate_stream_buffer(strm); +++ if (strm->sm.sm_object1 && +++ type_of(strm->sm.sm_object1)==t_string && +++ strm->sm.sm_object1->st.st_self[0] =='|') +++ pclose(strm->sm.sm_fp); +++ else +++ fclose(strm->sm.sm_fp); +++ strm->sm.sm_fp = NULL; +++ strm->sm.sm_fd = -1; +++ if (strm->sm.sm_object0 && +++ type_of(strm->sm.sm_object0 )==t_cons && +++ Mcar(strm->sm.sm_object0)==sSAallow_gzipped_fileA) +++ ifuncall1(sLdelete_file,Mcdr(strm->sm.sm_object0)); +++ break; ++ ++- case smm_broadcast: ++- for (x = strm->sm.sm_object0; !endp(x); x = x->c.c_cdr) ++- close_stream(x->c.c_car); ++- break; +++ case smm_file_synonym: +++ case smm_synonym: +++ strm = symbol_value(strm->sm.sm_object0); +++ if (type_of(strm) != t_stream) +++ TYPE_ERROR(strm,sLstream); +++ close_stream(strm); +++ break; ++ ++- case smm_concatenated: ++- for (x = strm->sm.sm_object0; !endp(x); x = x->c.c_cdr) ++- close_stream(x->c.c_car); ++- break; +++ case smm_broadcast: +++ case smm_concatenated: +++ for (x = strm->sm.sm_object0; !endp(x); x = x->c.c_cdr) +++ close_stream(x->c.c_car); +++ break; ++ ++- case smm_two_way: ++- case smm_echo: ++- close_stream(STREAM_INPUT_STREAM(strm)); ++- close_stream(STREAM_OUTPUT_STREAM(strm)); ++- break; +++ case smm_two_way: +++ case smm_echo: +++ close_stream(STREAM_INPUT_STREAM(strm)); +++ close_stream(STREAM_OUTPUT_STREAM(strm)); +++ break; ++ ++- case smm_string_input: ++- break; /* There is nothing to do. */ +++ case smm_string_input: +++ case smm_string_output: +++ break; ++ ++- case smm_string_output: ++- break; /* There is nothing to do. */ +++ default: +++ error("Illegal stream mode"); +++ } +++ +++ SET_STREAM_FLAG(strm,gcl_sm_closed,1); +++ +++} +++ +++DEFUN_NEW("INTERACTIVE-STREAM-P",object,fLinteractive_stream_p,LISP,1,1,NONE,OO,OO,OO,OO,(object strm),"") { +++ +++ check_type_stream(&strm); +++ +++ switch (strm->sm.sm_mode) { +++ case smm_output: +++ case smm_input: +++ case smm_io: +++ case smm_probe: +++ if ((strm->sm.sm_fp == stdin) || +++ (strm->sm.sm_fp == stdout) || +++ (strm->sm.sm_fp == stderr)) +++ return Ct; +++ return Cnil; +++ break; +++ case smm_file_synonym: +++ case smm_synonym: +++ strm = symbol_value(strm->sm.sm_object0); +++ if (type_of(strm) != t_stream) +++ FEwrong_type_argument(sLstream, strm); +++ break; +++ +++ case smm_broadcast: +++ case smm_concatenated: +++ if (( consp(strm->sm.sm_object0) ) && +++ ( type_of(strm->sm.sm_object0->c.c_car) == t_stream )) +++ strm=strm->sm.sm_object0->c.c_car; +++ else +++ return Cnil; +++ break; +++ +++ case smm_two_way: +++ case smm_echo: +++ strm=STREAM_INPUT_STREAM(strm); +++ break; +++ default: +++ return Cnil; +++ } +++ +++ return Cnil; ++ ++- default: ++- error("illegal stream mode"); ++- } ++ } ++ ++ object ++@@ -665,6 +694,7 @@ object istrm, ostrm; ++ STREAM_INPUT_STREAM(strm) = istrm; ++ STREAM_OUTPUT_STREAM(strm) = ostrm; ++ strm->sm.sm_int0 = strm->sm.sm_int1 = 0; +++ strm->sm.sm_flags=0; ++ return(strm); ++ } ++ ++@@ -694,6 +724,7 @@ int istart, iend; ++ strm->sm.sm_object1 = OBJNULL; ++ STRING_INPUT_STREAM_NEXT(strm)= istart; ++ STRING_INPUT_STREAM_END(strm)= iend; +++ strm->sm.sm_flags=0; ++ return(strm); ++ } ++ ++@@ -729,6 +760,7 @@ int line_length; ++ STRING_STREAM_STRING(strm) = strng; ++ strm->sm.sm_object1 = OBJNULL; ++ strm->sm.sm_int0 = STREAM_FILE_COLUMN(strm) = 0; +++ strm->sm.sm_flags=0; ++ vs_reset; ++ return(strm); ++ } ++@@ -782,6 +814,7 @@ BEGIN: ++ /* strm->sm.sm_int0++; */ ++ return(c==EOF ? c : (c&0377)); ++ +++ case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -884,6 +917,7 @@ BEGIN: ++ /* --strm->sm.sm_int0; */ /* use ftell now for position */ ++ break; ++ +++ case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -985,6 +1019,7 @@ BEGIN: ++ ++ break; ++ +++ case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -1095,6 +1130,7 @@ BEGIN: ++ #endif ++ closed_stream(strm); ++ break; +++ case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -1183,6 +1219,7 @@ BEGIN: ++ case smm_probe: ++ return(FALSE); ++ +++ case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ check_stream(strm); ++@@ -1308,6 +1345,7 @@ BEGIN: ++ #endif ++ return TRUE; ++ +++ case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -1363,6 +1401,7 @@ BEGIN: ++ case smm_string_output: ++ return(STRING_STREAM_STRING(strm)->st.st_fillp); ++ +++ case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -1412,6 +1451,7 @@ BEGIN: ++ } ++ return(0); ++ +++ case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -1448,6 +1488,7 @@ BEGIN: ++ ++ ++ +++ case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -1487,6 +1528,7 @@ BEGIN: ++ case smm_two_way: ++ strm=STREAM_OUTPUT_STREAM(strm); ++ goto BEGIN; +++ case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -1553,6 +1595,22 @@ load(const char *s) { ++ ++ ++ +++static int +++file_synonym_stream_p(object x) { +++ switch(x->sm.sm_mode) { +++ case smm_input: +++ case smm_output: +++ case smm_io: +++ case smm_probe: +++ case smm_file_synonym: +++ return 1; +++ case smm_synonym: +++ return file_synonym_stream_p(x->sm.sm_object0->s.s_dbind); +++ default: +++ return 0; +++ } +++} +++ ++ LFD(Lmake_synonym_stream)() ++ { ++ object x; ++@@ -1560,12 +1618,13 @@ LFD(Lmake_synonym_stream)() ++ check_arg(1); ++ check_type_sym(&vs_base[0]); ++ x = alloc_object(t_stream); ++- x->sm.sm_mode = (short)smm_synonym; +++ x->sm.sm_mode = file_synonym_stream_p(vs_base[0]) ? (short)smm_file_synonym : (short)smm_synonym; ++ x->sm.sm_fp = NULL; ++ x->sm.sm_buffer = 0; ++ x->sm.sm_object0 = vs_base[0]; ++ x->sm.sm_object1 = OBJNULL; ++ x->sm.sm_int0 = x->sm.sm_int1 = 0; +++ x->sm.sm_flags=0; ++ vs_base[0] = x; ++ } ++ ++@@ -1589,6 +1648,7 @@ LFD(Lmake_broadcast_stream)() ++ x->sm.sm_object0 = vs_base[0]; ++ x->sm.sm_object1 = OBJNULL; ++ x->sm.sm_int0 = x->sm.sm_int1 = 0; +++ x->sm.sm_flags=0; ++ vs_base[0] = x; ++ } ++ ++@@ -1612,6 +1672,7 @@ LFD(Lmake_concatenated_stream)() ++ x->sm.sm_object0 = vs_base[0]; ++ x->sm.sm_object1 = OBJNULL; ++ x->sm.sm_int0 = x->sm.sm_int1 = 0; +++ x->sm.sm_flags=0; ++ vs_base[0] = x; ++ } ++ ++@@ -1700,6 +1761,38 @@ LFD(siLoutput_stream_string)() ++ vs_base[0] = vs_base[0]->sm.sm_object0; ++ } ++ +++DEFUN_NEW("FILE-STREAM-P",object,fSfile_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ RETURN1(type_of(x)==t_stream && +++ (x->sm.sm_mode==smm_input || x->sm.sm_mode==smm_output || x->sm.sm_mode==smm_io || x->sm.sm_mode==smm_probe) +++ ? Ct : Cnil); +++} +++ +++DEFUN_NEW("SYNONYM-STREAM-P",object,fSsynonym_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ RETURN1(type_of(x)==t_stream && (x->sm.sm_mode==smm_file_synonym || x->sm.sm_mode==smm_synonym) ? Ct : Cnil); +++} +++ +++DEFUN_NEW("TERMINAL-INPUT-STREAM-P",object,fSterminal_input_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_input && x->sm.sm_fp && isatty(fileno((FILE *)x->sm.sm_fp)) ? Ct : Cnil); +++} +++ +++DEFUN_NEW("BROADCAST-STREAM-P",object,fSbroadcast_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_broadcast ? Ct : Cnil); +++} +++ +++DEFUN_NEW("ECHO-STREAM-P",object,fSecho_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_echo ? Ct : Cnil); +++} +++ +++DEFUN_NEW("TWO-WAY-STREAM-P",object,fStwo_way_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_two_way ? Ct : Cnil); +++} +++ +++DEFUN_NEW("CONCATENATED-STREAM-P",object,fSconcatenated_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_concatenated ? Ct : Cnil); +++} +++ +++ +++ ++ LFD(Lstreamp)() ++ { ++ check_arg(1); ++@@ -1747,54 +1840,6 @@ LFD(Lstream_element_type)() ++ @(return Ct) ++ @) ++ ++-@(static defun open (filename ++- &key (direction sKinput) ++- (element_type sLcharacter) ++- (if_exists Cnil iesp) ++- (if_does_not_exist Cnil idnesp) ++- &aux strm) ++- enum smmode smm=0; ++-@ ++- check_type_or_pathname_string_symbol_stream(&filename); ++- filename = coerce_to_namestring(filename); ++- if (direction == sKinput) { ++- smm = smm_input; ++- if (!idnesp) ++- if_does_not_exist = sKerror; ++- } else if (direction == sKoutput) { ++- smm = smm_output; ++- if (!iesp) ++- if_exists = sKnew_version; ++- if (!idnesp) { ++- if (if_exists == sKoverwrite || ++- if_exists == sKappend) ++- if_does_not_exist = sKerror; ++- else ++- if_does_not_exist = sKcreate; ++- } ++- } else if (direction == sKio) { ++- smm = smm_io; ++- if (!iesp) ++- if_exists = sKnew_version; ++- if (!idnesp) { ++- if (if_exists == sKoverwrite || ++- if_exists == sKappend) ++- if_does_not_exist = sKerror; ++- else ++- if_does_not_exist = sKcreate; ++- } ++- } else if (direction == sKprobe) { ++- smm = smm_probe; ++- if (!idnesp) ++- if_does_not_exist = Cnil; ++- } else ++- FEerror("~S is an illegal DIRECTION for OPEN.", ++- 1, direction); ++- strm = open_stream(filename, smm, if_exists, if_does_not_exist); ++- if (type_of(strm) == t_stream) ++- strm->sm.sm_object0 = element_type; ++- @(return strm) ++-@) ++ ++ @(defun file_position (file_stream &o position) ++ int i=0; ++@@ -1838,175 +1883,72 @@ object sLAload_pathnameA; ++ DEFVAR("*COLLECT-BINARY-MODULES*",sSAcollect_binary_modulesA,SI,sLnil,""); ++ DEFVAR("*BINARY-MODULES*",sSAbinary_modulesA,SI,Cnil,""); ++ ++-@(static defun load (pathname ++- &key (verbose `symbol_value(sLAload_verboseA)`) ++- print ++- (if_does_not_exist sKerror) ++- &aux pntype fasl_filename lsp_filename filename ++- defaults strm stdoutput x ++- package) ++- bds_ptr old_bds_top; ++- int i; ++- object strm1; ++-@ ++- check_type_or_pathname_string_symbol_stream(&pathname); ++- pathname = coerce_to_pathname(pathname); ++- defaults = symbol_value(Vdefault_pathname_defaults); ++- defaults = coerce_to_pathname(defaults); ++- pathname = merge_pathnames(pathname, defaults, sKnewest); ++- pntype = pathname->pn.pn_type; ++- filename = coerce_to_namestring(pathname); ++- if (user_match(filename->st.st_self,filename->st.st_fillp)) ++- @(return Cnil) ++- old_bds_top=bds_top; ++- if (pntype == Cnil || pntype == sKwild || ++- (type_of(pntype) == t_string && ++-#ifdef UNIX ++- string_eq(pntype, FASL_string))) { ++-#endif ++-#ifdef AOSVS +++DEFUN_NEW("LOAD-STREAM",object,fSload_stream,SI,2,2,NONE,OO,OO,OO,OO,(object strm,object print),"") { ++ ++-#endif ++- pathname->pn.pn_type = FASL_string; ++- fasl_filename = coerce_to_namestring(pathname); ++- } ++- if (pntype == Cnil || pntype == sKwild || ++- (type_of(pntype) == t_string && ++-#ifdef UNIX ++- string_eq(pntype, LSP_string))) { ++-#endif ++-#ifdef AOSVS +++ object x; ++ ++-#endif ++- pathname->pn.pn_type = LSP_string; ++- lsp_filename = coerce_to_namestring(pathname); ++- } ++- if (fasl_filename != Cnil && file_exists(fasl_filename)) { ++- if (verbose != Cnil) { ++- SETUP_PRINT_DEFAULT(fasl_filename); ++- if (file_column(PRINTstream) != 0) ++- write_str("\n"); ++- write_str("Loading "); ++- PRINTescape = FALSE; ++- write_object(fasl_filename, 0); ++- write_str("\n"); ++- CLEANUP_PRINT_DEFAULT; ++- flush_stream(PRINTstream); ++- } ++- package = symbol_value(sLApackageA); ++- bds_bind(sLApackageA, package); ++- bds_bind(sLAload_pathnameA,fasl_filename); ++- if (sSAcollect_binary_modulesA->s.s_dbind==Ct) { ++- object _x=sSAbinary_modulesA->s.s_dbind; ++- object _y=Cnil; ++- while (_x!=Cnil) { ++- _y=_x; ++- _x=_x->c.c_cdr; ++- } ++- if (_y==Cnil) ++- sSAbinary_modulesA->s.s_dbind=make_cons(fasl_filename,Cnil); ++- else ++- _y->c.c_cdr=make_cons(fasl_filename,Cnil); ++- } ++- i = fasload(fasl_filename); ++- if (print != Cnil) { ++- SETUP_PRINT_DEFAULT(Cnil); ++- vs_top = PRINTvs_top; ++- if (file_column(PRINTstream) != 0) ++- write_str("\n"); ++- write_str("Fasload successfully ended."); ++- write_str("\n"); ++- CLEANUP_PRINT_DEFAULT; ++- flush_stream(PRINTstream); ++- } ++- bds_unwind(old_bds_top); ++- if (verbose != Cnil) { ++- SETUP_PRINT_DEFAULT(fasl_filename); ++- if (file_column(PRINTstream) != 0) ++- write_str("\n"); ++- write_str("Finished loading "); ++- PRINTescape = FALSE; ++- write_object(fasl_filename, 0); ++- write_str("\n"); ++- CLEANUP_PRINT_DEFAULT; ++- flush_stream(PRINTstream); ++- } ++- @(return `make_fixnum(i)`) ++- } ++- if (lsp_filename != Cnil && file_exists(lsp_filename)) { ++- filename = lsp_filename; ++- } ++- if (if_does_not_exist != Cnil) ++- if_does_not_exist = sKerror; ++- strm1 = strm ++- = open_stream(filename, smm_input, Cnil, if_does_not_exist); ++- if (strm == Cnil) ++- @(return Cnil) ++- if (verbose != Cnil) { ++- SETUP_PRINT_DEFAULT(filename); ++- if (file_column(PRINTstream) != 0) ++- write_str("\n"); ++- write_str("Loading "); ++- PRINTescape = FALSE; ++- write_object(filename, 0); ++- write_str("\n"); ++- CLEANUP_PRINT_DEFAULT; ++- flush_stream(PRINTstream); ++- } ++- package = symbol_value(sLApackageA); ++- bds_bind(sLAload_pathnameA,pathname); ++- bds_bind(sLApackageA, package); ++- bds_bind(sLAstandard_inputA, strm); ++- frs_push(FRS_PROTECT, Cnil); ++- if (nlj_active) { ++- close_stream(strm1); ++- nlj_active = FALSE; ++- frs_pop(); ++- bds_unwind(old_bds_top); ++- unwind(nlj_fr, nlj_tag); ++- } ++- for (;;) { ++- preserving_whitespace_flag = FALSE; ++- detect_eos_flag = TRUE; ++- x = read_object_non_recursive(strm); ++- if (x == OBJNULL) ++- break; ++- { ++- object *base = vs_base, *top = vs_top, *lex = lex_env; ++- object xx; ++- ++- lex_new(); ++- eval(x); ++- xx = vs_base[0]; ++- lex_env = lex; ++- vs_top = top; ++- vs_base = base; ++- x = xx; ++- } ++- if (print != Cnil) { ++- SETUP_PRINT_DEFAULT(x); ++- write_object(x, 0); ++- write_str("\n"); ++- CLEANUP_PRINT_DEFAULT; ++- flush_stream(PRINTstream); ++- } ++- } ++- close_stream(strm); ++- frs_pop(); ++- bds_unwind(old_bds_top); ++- if (verbose != Cnil) { ++- SETUP_PRINT_DEFAULT(filename); ++- if (file_column(PRINTstream) != 0) ++- write_str("\n"); ++- write_str("Finished loading "); ++- PRINTescape = FALSE; ++- write_object(filename, 0); ++- write_str("\n"); ++- CLEANUP_PRINT_DEFAULT; ++- flush_stream(PRINTstream); ++- } ++- @(return Ct) ++-@) +++ for (;;) { +++ preserving_whitespace_flag = FALSE; +++ detect_eos_flag = TRUE; +++ x = read_object_non_recursive(strm); +++ if (x == OBJNULL) +++ break; +++ { +++ object *base = vs_base, *top = vs_top, *lex = lex_env; +++ object xx; +++ +++ lex_new(); +++ eval(x); +++ xx = vs_base[0]; +++ lex_env = lex; +++ vs_top = top; +++ vs_base = base; +++ x = xx; +++ } +++ if (print != Cnil) { +++ SETUP_PRINT_DEFAULT(x); +++ write_object(x, 0); +++ write_str("\n"); +++ CLEANUP_PRINT_DEFAULT; +++ flush_stream(PRINTstream); +++ } +++ } +++ +++ RETURN1(Ct); +++ +++} +++ +++DEFUN_NEW("LOAD-FASL",object,fSload_fasl,SI,2,2,NONE,OO,OO,OO,OO,(object fasl_filename,object print),"") { +++ +++ int i; +++ +++ if (sSAcollect_binary_modulesA->s.s_dbind==Ct) { +++ object _x=sSAbinary_modulesA->s.s_dbind; +++ object _y=Cnil; +++ while (_x!=Cnil) { +++ _y=_x; +++ _x=_x->c.c_cdr; +++ } +++ if (_y==Cnil) +++ sSAbinary_modulesA->s.s_dbind=make_cons(fasl_filename,Cnil); +++ else +++ _y->c.c_cdr=make_cons(fasl_filename,Cnil); +++ } +++ i = fasload(fasl_filename); +++ if (print != Cnil) { +++ SETUP_PRINT_DEFAULT(Cnil); +++ vs_top = PRINTvs_top; +++ if (file_column(PRINTstream) != 0) +++ write_str("\n"); +++ write_str(";; Fasload successfully ended."); +++ write_str("\n"); +++ CLEANUP_PRINT_DEFAULT; +++ flush_stream(PRINTstream); +++ } +++ +++ RETURN1(make_fixnum(i)); +++ +++} ++ ++ static void ++ FFN(siLget_string_input_stream_index)() ++@@ -2018,9 +1960,6 @@ FFN(siLget_string_input_stream_index)() ++ vs_base[0] = make_fixnum(STRING_INPUT_STREAM_NEXT(vs_base[0])); ++ } ++ ++-DEFUN_NEW("TERMINAL-INPUT-STREAM-P",object,fSterminal_input_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++- RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_input && x->sm.sm_fp && isatty(fileno((FILE *)x->sm.sm_fp)) ? Ct : Cnil); ++-} ++ ++ LFD(siLmake_string_output_stream_from_string)() ++ { ++@@ -2038,6 +1977,7 @@ LFD(siLmake_string_output_stream_from_st ++ strm->sm.sm_object1 = OBJNULL; ++ /* strm->sm.sm_int0 = strng->st.st_fillp; */ ++ STREAM_FILE_COLUMN(strm) = 0; +++ strm->sm.sm_flags=0; ++ vs_base[0] = strm; ++ } ++ ++@@ -2071,14 +2011,14 @@ static void ++ cannot_open(fn) ++ object fn; ++ { ++- FEerror("Cannot open the file ~A.", 1, fn); +++ FILE_ERROR(fn,"Cannot open"); ++ } ++ ++ static void ++ cannot_create(fn) ++ object fn; ++ { ++- FEerror("Cannot create the file ~A.", 1, fn); +++ FILE_ERROR(fn,"Cannot create"); ++ } ++ ++ static void ++@@ -2141,6 +2081,7 @@ int out; ++ if (type_of(strm) != t_stream) ++ FEwrong_type_argument(sLstream, strm); ++ switch (strm->sm.sm_mode){ +++ case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -2566,6 +2507,7 @@ gcl_init_file(void) ++ #endif ++ standard_input->sm.sm_int0 = 0; /* unused */ ++ standard_input->sm.sm_int1 = 0; /* unused */ +++ standard_input->sm.sm_flags=0; ++ ++ standard_output = alloc_object(t_stream); ++ standard_output->sm.sm_mode = (short)smm_output; ++@@ -2578,18 +2520,20 @@ gcl_init_file(void) ++ #endif ++ standard_output->sm.sm_int0 = 0; /* unused */ ++ STREAM_FILE_COLUMN(standard_output) = 0; +++ standard_output->sm.sm_flags=0; ++ ++ terminal_io = standard ++ = make_two_way_stream(standard_input, standard_output); ++ enter_mark_origin(&terminal_io); ++ ++ x = alloc_object(t_stream); ++- x->sm.sm_mode = (short)smm_synonym; +++ x->sm.sm_mode = (short)smm_file_synonym; ++ x->sm.sm_fp = NULL; ++ x->sm.sm_buffer = 0; ++ x->sm.sm_object0 = sLAterminal_ioA; ++ x->sm.sm_object1 = OBJNULL; ++ x->sm.sm_int0 = x->sm.sm_int1 = 0; /* unused */ +++ x->sm.sm_flags=0; ++ standard_io = x; ++ enter_mark_origin(&standard_io); ++ ++@@ -2597,7 +2541,9 @@ gcl_init_file(void) ++ ++ DEFVAR("*IGNORE-EOF-ON-TERMINAL-IO*",sSAignore_eof_on_terminal_ioA,SI,Cnil,""); ++ DEFVAR("*LOAD-PATHNAME*",sLAload_pathnameA,LISP,Cnil,""); +++DEFVAR("*LOAD-TRUENAME*",sSAload_truenameA,LISP,Cnil,""); ++ DEFVAR("*LOAD-VERBOSE*",sLAload_verboseA,LISP,Ct,""); +++DEFVAR("*LOAD-PRINT*",sLAload_printA,LISP,Cnil,""); ++ ++ DEF_ORDINARY("ABORT",sKabort,KEYWORD,""); ++ DEF_ORDINARY("APPEND",sKappend,KEYWORD,""); ++@@ -2622,6 +2568,7 @@ DEF_ORDINARY("SUPERSEDE",sKsupersede,KEY ++ DEF_ORDINARY("VERBOSE",sKverbose,KEYWORD,""); ++ ++ +++DEF_ORDINARY("DELETE-FILE",sLdelete_file,LISP,""); ++ ++ ++ void ++@@ -2673,13 +2620,9 @@ gcl_init_file_function() ++ make_function("STREAM-ELEMENT-TYPE", Lstream_element_type); ++ make_function("CLOSE", Lclose); ++ ++- make_function("OPEN", Lopen); ++- ++ make_function("FILE-POSITION", Lfile_position); ++ make_function("FILE-LENGTH", Lfile_length); ++ ++- make_function("LOAD", Lload); ++- ++ make_si_function("GET-STRING-INPUT-STREAM-INDEX", ++ siLget_string_input_stream_index); ++ make_si_function("MAKE-STRING-OUTPUT-STREAM-FROM-STRING", ++--- gcl-2.6.12.orig/o/gbc.c +++++ gcl-2.6.12/o/gbc.c ++@@ -57,7 +57,7 @@ mark_contblock(void *, int); ++ since this is more portable and faster lets use them --W. Schelter ++ These assume that DBEGIN is divisible by 32, or else we should have ++ #define Shamt(x) (((((int) x -DBEGIN) >> 2) & ~(~0 << 5))) ++-*/ +++*/ ++ #define LOG_BITS_CHAR 3 ++ ++ #if CPTR_SIZE == 8 ++@@ -72,7 +72,7 @@ void * ++ cb_in(void *p) { ++ struct contblock **cbpp; ++ int i; ++- +++ ++ for (cbpp=&cb_pointer,i=0;*cbpp;cbpp=&((*cbpp)->cb_link),i++) { ++ if ((void *)*cbpp<=p && ((void *)(*cbpp)+(*cbpp)->cb_size) >p) ++ return *cbpp; ++@@ -84,7 +84,7 @@ int ++ cb_print(void) { ++ struct contblock **cbpp; ++ int i; ++- +++ ++ for (cbpp=&cb_pointer,i=0;*cbpp;cbpp=&((*cbpp)->cb_link),i++) ++ emsg("%lu at %p\n",(*cbpp)->cb_size,*cbpp); ++ emsg("%u blocks\n",i); ++@@ -146,7 +146,7 @@ pageinfo_p(void *v) { ++ (!pi->next || (void *)pi->next>=v+(pi->type==t_contiguous ? pi->in_use : 1)*PAGESIZE); ++ ++ } ++- +++ ++ static inline char ++ get_bit(char *v,struct pageinfo *pi,void *x) { ++ void *ve=CB_DATA_START(pi); ++@@ -157,16 +157,6 @@ get_bit(char *v,struct pageinfo *pi,void ++ return (v[i]>>s)&0x1; ++ } ++ ++-/* static inline void */ ++-/* set_bit(char *v,struct pageinfo *pi,void *x) { */ ++-/* void *ve=CB_DATA_START(pi); */ ++-/* fixnum off=(x-ve)>>LOG_BYTES_CONTBLOCK,i=off>>LOG_BITS_CHAR,s=off&~(~0UL<>s)&0x1) ++ #define bit_set(v,i,s) (v[i]|=(1UL<d.st>=ngc_thresh && ++ (dp=alloc_contblock_no_gc(s,static_promotion_limit))) { ++- +++ ++ *pp=memcpy(dp,p,s); ++ x->d.st=0; ++ ++ return; ++ ++- } +++ } ++ ++ if (x && x->d.std.st++; ++ ++@@ -460,7 +440,7 @@ mark_leaf_data(object x,void **pp,ufixnu ++ ++ static void mark_object1(object); ++ #define mark_object(x) if (marking(x)) mark_object1(x) ++- +++ ++ static inline void ++ mark_object_address(object *o,int f) { ++ ++@@ -468,7 +448,7 @@ mark_object_address(object *o,int f) { ++ static ufixnum lr; ++ ++ ufixnum p=page(o); ++- +++ ++ if (lp!=p || !f) { ++ lp=p; ++ lr= ++@@ -496,7 +476,7 @@ mark_object_array(object *o,object *oe) ++ ++ static void ++ mark_object1(object x) { ++- +++ ++ fixnum i,j=0;/*FIXME*/ ++ ++ if (is_marked_or_free(x)) ++@@ -567,7 +547,7 @@ mark_object1(object x) { ++ break; ++ ++ case t_array: ++- MARK_LEAF_DATA(x,x->a.a_dims,sizeof(int)*x->a.a_rank); +++ MARK_LEAF_DATA(x,x->a.a_dims,sizeof(*x->a.a_dims)*x->a.a_rank); ++ ++ case t_vector: ++ case t_bitvector: ++@@ -615,7 +595,7 @@ mark_object1(object x) { ++ x->v.v_self=p; ++ adjust_displaced(x,j); ++ } ++- } +++ } ++ mark_object(x->v.v_displaced); ++ break; ++ ++@@ -627,7 +607,7 @@ mark_object1(object x) { ++ mark_object(x->str.str_def); ++ if (x->str.str_self) ++ for (i=0,j=S_DATA(def)->length;istr.str_self,S_DATA(def)->size); ++ } ++@@ -646,7 +626,8 @@ mark_object1(object x) { ++ MARK_LEAF_DATA(x,x->sm.sm_buffer,BUFSIZ); ++ } ++ break; ++- +++ +++ case smm_file_synonym: ++ case smm_synonym: ++ mark_object(x->sm.sm_object0); ++ break; ++@@ -676,7 +657,7 @@ mark_object1(object x) { ++ error("mark stream botch"); ++ } ++ break; ++- +++ ++ case t_random: ++ MARK_LEAF_DATA_ALIGNED(x,x->rnd.rnd_state._mp_seed->_mp_d,x->rnd.rnd_state._mp_seed->_mp_alloc*MP_LIMB_SIZE,MP_LIMB_SIZE); ++ break; ++@@ -700,6 +681,7 @@ mark_object1(object x) { ++ mark_object(x->pn.pn_name); ++ mark_object(x->pn.pn_type); ++ mark_object(x->pn.pn_version); +++ mark_object(x->pn.pn_namestring); ++ break; ++ ++ case t_closure: ++@@ -854,24 +836,6 @@ mark_phase(void) { ++ } ++ #endif ++ ++- /* ++- if (what_to_collect != t_symbol && ++- (int)what_to_collect < (int)t_contiguous) { ++- */ ++- ++- /* {int size; */ ++- ++- /* for (pp = pack_pointer; pp != NULL; pp = pp->p_link) { */ ++- /* size = pp->p_internal_size; */ ++- /* if (pp->p_internal != NULL) */ ++- /* for (i = 0; i < size; i++) */ ++- /* mark_object(pp->p_internal[i]); */ ++- /* size = pp->p_external_size; */ ++- /* if (pp->p_external != NULL) */ ++- /* for (i = 0; i < size; i++) */ ++- /* mark_object(pp->p_external[i]); */ ++- /* }} */ ++- ++ /* mark the c stack */ ++ #ifndef N_RECURSION_REQD ++ #define N_RECURSION_REQD 2 ++@@ -979,15 +943,15 @@ mark_c_stack(jmp_buf env1, int n, void ( ++ extern void * __libc_ia64_register_backing_store_base; ++ void * bst=GC_save_regs_in_stack(); ++ void * bsb=__libc_ia64_register_backing_store_base; ++- +++ ++ if (bsb>bst) ++ (*fn)(bsb,bst,C_GC_OFFSET); ++ else ++ (*fn)(bst,bsb,C_GC_OFFSET); ++- +++ ++ } ++ #endif ++- +++ ++ } ++ ++ static void ++@@ -1035,7 +999,7 @@ contblock_sweep_phase(void) { ++ struct pageinfo *v; ++ STATIC char *s, *e, *p, *q; ++ ufixnum i; ++- +++ ++ reset_contblock_freelist(); ++ ++ for (i=0;iv.v_fillp && (v=(void *)contblock_array->v.v_self[i]);i++) { ++@@ -1045,7 +1009,7 @@ contblock_sweep_phase(void) { ++ #ifdef SGC ++ if (sgc_enabled && !(v->sgc_flags&SGC_PAGE_FLAG)) continue; ++ #endif ++- +++ ++ s=CB_DATA_START(v); ++ e=(void *)v+v->in_use*PAGESIZE; ++ ++@@ -1070,25 +1034,6 @@ contblock_sweep_phase(void) { ++ int (*GBC_enter_hook)() = NULL; ++ int (*GBC_exit_hook)() = NULL; ++ ++-/* void */ ++-/* ttss(void) { */ ++- ++-/* struct typemanager *tm; */ ++-/* void *x,*y; */ ++- ++-/* for (tm=tm_table;tmtm_free;x!=OBJNULL;x=(void *)((struct freelist *)x)->f_link) { */ ++-/* if (x==Cnil) */ ++-/* printf("barr\n"); */ ++-/* /\* for (y=(void *)((struct freelist *)x)->f_link;y!=OBJNULL && y!=x;y=(void *)((struct freelist *)y)->f_link); *\/ */ ++-/* /\* if (y==x) *\/ */ ++-/* /\* printf("circle\n"); *\/ */ ++-/* } */ ++-/* } */ ++- ++-/* } */ ++- ++ fixnum fault_pages=0; ++ ++ static ufixnum ++@@ -1102,7 +1047,7 @@ count_contblocks(void) { ++ return ncb; ++ ++ } ++- +++ ++ ++ void ++ GBC(enum type t) { ++@@ -1120,7 +1065,7 @@ GBC(enum type t) { ++ ++ ngc_thresh=fix(sSAleaf_collection_thresholdA->s.s_dbind); ++ recent_allocation=0; ++- +++ ++ if (in_signal_handler && t == t_relocatable) ++ error("cant gc relocatable in signal handler"); ++ ++@@ -1146,7 +1091,6 @@ GBC(enum type t) { ++ close_stream(o); ++ } ++ ++- /* t = t_relocatable; */ ++ gc_time = -1; ++ } ++ ++@@ -1265,54 +1209,6 @@ GBC(enum type t) { ++ #endif ++ } ++ ++- ++-/* { */ ++-/* static int promoting; */ ++-/* if (!promoting && promotion_pointer>promotion_pointer1) { */ ++-/* object *p,st; */ ++-/* promoting=1; */ ++-/* st=alloc_simple_string(""); */ ++-/* for (p=promotion_pointer1;pst.st_dim; */ ++- ++-/* else switch (x->v.v_elttype) { */ ++- ++-/* case aet_lf: */ ++-/* j=sizeof(longfloat)*x->v.v_dim; */ ++-/* break; */ ++-/* case aet_bit: */ ++-/* #define W_SIZE (8*sizeof(fixnum)) */ ++-/* j=sizeof(fixnum)*((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE); */ ++-/* break; */ ++-/* case aet_char: */ ++-/* case aet_uchar: */ ++-/* j=sizeof(char)*x->v.v_dim; */ ++-/* break; */ ++-/* case aet_short: */ ++-/* case aet_ushort: */ ++-/* j=sizeof(short)*x->v.v_dim; */ ++-/* break; */ ++-/* default: */ ++-/* j=sizeof(fixnum)*x->v.v_dim; */ ++-/* } */ ++- ++-/* st->st.st_dim=j; */ ++-/* st->st.st_self=alloc_contblock(st->st.st_dim); */ ++-/* fprintf(stderr,"Promoting vector leaf bytes %lu at %p, %p -> %p\n",j,x,x->v.v_self,st->st.st_self); */ ++-/* fflush(stderr); */ ++-/* memcpy(st->st.st_self,x->v.v_self,st->st.st_dim); */ ++-/* x->v.v_self=(void *)st->st.st_self; */ ++-/* } */ ++-/* promoting=0; */ ++-/* } */ ++-/* } */ ++- ++- ++ #ifdef DEBUG ++ if (debug) { ++ int i,j; ++@@ -1361,8 +1257,6 @@ GBC(enum type t) { ++ ++ CHECK_INTERRUPT; ++ ++- /* ttss(); */ ++- ++ } ++ ++ static void ++@@ -1472,7 +1366,7 @@ mark_contblock(void *p, int s) { ++ STATIC char *q; ++ STATIC char *x, *y; ++ struct pageinfo *v; ++- +++ ++ if (NULL_OR_ON_C_STACK(p)) ++ return; ++ ++@@ -1495,17 +1389,17 @@ DEFUN_NEW("CONTIGUOUS-REPORT",object,fSc ++ ufixnum i,j,k,s; ++ struct typemanager *tm=tm_of(t_cfdata); ++ void *p; ++- +++ ++ for (i=j=0,cbpp=&cb_pointer;(*cbpp);) { ++ for (k=0,s=(*cbpp)->cb_size,p=*cbpp;*cbpp && (*cbpp)->cb_size==s;i+=(*cbpp)->cb_size,j++,k++,cbpp=&(*cbpp)->cb_link); ++ emsg("%lu %lu starting at %p\n",k,s,p); ++ } ++ emsg("\nTotal free %lu in %lu pieces\n\n",i,j); ++- ++- for (i=j=k=0;kv.v_fillp && (v=(void *)contblock_array->v.v_self[k]);k++,i+=v->in_use,j++) +++ +++ for (i=j=k=0;kv.v_fillp && (v=(void *)contblock_array->v.v_self[k]);k++,i+=v->in_use,j++) ++ emsg("%lu pages at %p\n",(unsigned long)v->in_use,v); ++ emsg("\nTotal pages %lu in %lu pieces\n\n",i,j); ++- +++ ++ for (i=j=0,v=cell_list_head;v;v=v->next) ++ if (tm->tm_type==v->type) { ++ void *p; ++@@ -1520,7 +1414,7 @@ DEFUN_NEW("CONTIGUOUS-REPORT",object,fSc ++ } ++ } ++ emsg("\nTotal code bytes %lu in %lu pieces\n",i,j); ++- +++ ++ for (i=j=0,v=cell_list_head;v;v=v->next) { ++ struct typemanager *tm=tm_of(v->type); ++ void *p; ++@@ -1589,15 +1483,13 @@ DEFUN_NEW("CONTIGUOUS-REPORT",object,fSc ++ } ++ } ++ emsg("\nTotal leaf bytes %lu in %lu pieces\n",i,j); ++- +++ ++ return Cnil; ++ ++ } ++ ++ DEFUN_NEW("GBC",object,fSgbc,SI,1,1,NONE,OO,OO,OO,OO,(object x0),"") { ++ ++- /* 1 args */ ++- ++ if (x0 == Ct) { ++ tm_table[t_contiguous].tm_adjgbccnt--; ++ GBC(t_other); ++@@ -1644,5 +1536,5 @@ gcl_init_GBC(void) { ++ #ifdef SGC ++ make_si_function("SGC-ON",siLsgc_on); ++ #endif ++- +++ ++ } ++--- gcl-2.6.12.orig/o/iteration.c +++++ gcl-2.6.12/o/iteration.c ++@@ -95,7 +95,7 @@ do_var_list(object var_list) ++ ++ ++ ++- if (type_of(x) != t_cons) +++ if (!consp(x)) ++ FEinvalid_form("The index, ~S, is illegal.", x); ++ y = MMcar(x); ++ check_var(y); ++@@ -326,7 +326,7 @@ FFN(Fdolist)(VOL object arg) ++ } ++ ++ eval_assign(start->bt_init, listform); ++- body = find_special(MMcdr(arg), start, start+1); +++ body = find_special(MMcdr(arg), start, start+1,NULL); /*?*/ ++ vs_push(body); ++ bind_var(start->bt_var, Cnil, start->bt_spp); ++ if ((enum stype)start->bt_var->s.s_stype != stp_ordinary) ++@@ -410,7 +410,7 @@ FFN(Fdotimes)(VOL object arg) ++ if (type_of(start->bt_init) != t_fixnum && ++ type_of(start->bt_init) != t_bignum) ++ FEwrong_type_argument(sLinteger, start->bt_init); ++- body = find_special(MMcdr(arg), start, start+1); +++ body = find_special(MMcdr(arg), start, start+1,NULL); /*?*/ ++ vs_push(body); ++ bind_var(start->bt_var, make_fixnum(0), start->bt_spp); ++ if ((enum stype)start->bt_var->s.s_stype != stp_ordinary) { ++--- gcl-2.6.12.orig/o/let.c +++++ gcl-2.6.12/o/let.c ++@@ -151,7 +151,7 @@ FFN(Fmultiple_value_bind)(object form) ++ } ++ { ++ object *vt = vs_top; ++- vs_push(find_special(body, start, (struct bind_temp *)vt)); +++ vs_push(find_special(body, start, (struct bind_temp *)vt,NULL)); /*?*/ ++ } ++ for (i = 0; i < n; i++) ++ bind_var(start[i].bt_var, ++@@ -230,7 +230,7 @@ is an illegal function definition in FLE ++ lex_fun_bind(MMcar(def), top[0]); ++ def_list = MMcdr(def_list); ++ } ++- vs_push(find_special(MMcdr(args), NULL, NULL)); +++ vs_push(find_special(MMcdr(args), NULL, NULL,NULL)); ++ Fprogn(vs_head); ++ lex_env = lex; ++ } ++@@ -271,7 +271,7 @@ is an illegal function definition in LAB ++ MMcaar(closure_list) = lex_env[1]; ++ closure_list = MMcdr(closure_list); ++ } ++- vs_push(find_special(MMcdr(args), NULL, NULL)); +++ vs_push(find_special(MMcdr(args), NULL, NULL,NULL)); ++ Fprogn(vs_head); ++ lex_env = lex; ++ } ++@@ -304,7 +304,7 @@ is an illegal macro definition in MACROF ++ lex_macro_bind(MMcar(def), MMcaddr(top[0])); ++ def_list = MMcdr(def_list); ++ } ++- vs_push(find_special(MMcdr(args), NULL, NULL)); +++ vs_push(find_special(MMcdr(args), NULL, NULL,NULL)); ++ Fprogn(vs_head); ++ lex_env = lex; ++ } ++--- gcl-2.6.12.orig/o/pathname.d +++++ gcl-2.6.12/o/pathname.d ++@@ -28,744 +28,93 @@ Foundation, 675 Mass Ave, Cambridge, MA ++ #include ++ #include "include.h" ++ +++DEFUN_NEW("C-SET-T-TT",object,fSc_set_t_tt,SI,2,2,NONE,OO,IO,OO,OO,(object x,fixnum y),"") { +++ x->d.tt=y; +++ RETURN1(x); +++} +++ +++ +++DEFUN_NEW("C-T-TT",object,fSc_t_tt,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") { +++ RETURN1((object)(fixnum)x->d.tt); +++} +++ +++ +++DEFUN_NEW("C-SET-PATHNAME-NAMESTRING",object,fSc_set_pathname_namestring,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { +++ check_type_pathname(&x); +++ x->pn.pn_namestring=y; +++ RETURN1(x); +++} +++ +++DEFUN_NEW("C-PATHNAME-HOST",object,fSc_pathname_host,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ check_type_pathname(&x); +++ RETURN1(x->pn.pn_host); +++} +++DEFUN_NEW("C-PATHNAME-DEVICE",object,fSc_pathname_device,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ check_type_pathname(&x); +++ RETURN1(x->pn.pn_device); +++} +++DEFUN_NEW("C-PATHNAME-DIRECTORY",object,fSc_pathname_directory,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ check_type_pathname(&x); +++ RETURN1(x->pn.pn_directory); +++} +++DEFUN_NEW("C-PATHNAME-NAME",object,fSc_pathname_name,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ check_type_pathname(&x); +++ RETURN1(x->pn.pn_name); +++} +++DEFUN_NEW("C-PATHNAME-TYPE",object,fSc_pathname_type,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ check_type_pathname(&x); +++ RETURN1(x->pn.pn_type); +++} +++DEFUN_NEW("C-PATHNAME-VERSION",object,fSc_pathname_version,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ check_type_pathname(&x); +++ RETURN1(x->pn.pn_version); +++} +++DEFUN_NEW("C-PATHNAME-NAMESTRING",object,fSc_pathname_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ check_type_pathname(&x); +++ RETURN1(x->pn.pn_namestring); +++} ++ ++-object ++-make_pathname(host, device, directory, name, type, version) ++-object host, device, directory, name, type, version; ++-{ ++- object x; ++- ++- x = alloc_object(t_pathname); ++- x->pn.pn_host = host; ++- x->pn.pn_device = device; ++- x->pn.pn_directory = directory; ++- x->pn.pn_name = name; ++- x->pn.pn_type = type; ++- x->pn.pn_version = version; ++- return(x); ++-} ++- ++-static void ++-make_one(s, end) ++-char *s; ++-int end; ++-{ ++- int i; ++- ++-#ifdef UNIX ++- for (i = 0; i < end; i++) ++- token->st.st_self[i] = s[i]; ++-#endif ++-#ifdef AOSVS ++- ++- ++- ++-#endif ++- token->st.st_fillp = end; ++- vs_push(copy_simple_string(token)); ++-} ++- ++-/* The function below does not attempt to handle DOS pathnames ++- which use backslashes as directory separators. It needs ++- TLC from someone who feels pedantic. MJT */ ++- ++-/* !!!!! Bug Fix. NLG */ ++-object ++-parse_namestring(s, start, end, ep) ++-object s; ++-int start, end, *ep; ++-{ ++- int i, j, k, founddosdev = FALSE, oldstart=start, oldend=end, justdevice = FALSE; ++- int d; ++- object *vsp; ++- object x; ++- vs_mark; ++- ++-#ifndef IS_DIR_SEPARATOR ++-#define IS_DIR_SEPARATOR(x) (x == '/') ++-#endif ++- ++- *ep=oldend; ++- vsp = vs_top + 1; ++- for (;--end >= start && isspace((int)s->st.st_self[end]);); ++- ++- /* Check for a DOS path and process later */ ++- if ( ( (start+1) <= end) && (s->st.st_self[start+1] == ':' )) { ++- start+=2; ++- founddosdev = TRUE; ++- } ++- if ( start > end ) { ++- make_one(&s->st.st_self[0], 0); ++- justdevice = TRUE; ++- } else { ++- for (i = j = start; i <= end; ) { ++-#ifdef UNIX ++- if (IS_DIR_SEPARATOR(s->st.st_self[i])) { ++-#endif ++- if (j == start && i == start) { ++- i++; ++- vs_push(sKroot); ++- j = i; ++- continue; ++- } ++-#ifdef UNIX ++- if (i-j == 1 && s->st.st_self[j] == '.') { ++- vs_push(sKcurrent); ++- } else if (i-j == 1 && s->st.st_self[j] == '*') { ++- vs_push(sKwild); ++- } else if (i-j==2 && s->st.st_self[j]=='.' && s->st.st_self[j+1]=='.') { ++- vs_push(sKparent); ++- } else { ++- make_one(&s->st.st_self[j], i-j); ++- } ++-#endif ++- i++; ++- j = i; ++- } else { ++- i++; ++- } ++- } ++- *ep = i; ++- vs_push(Cnil); ++- while (vs_top > vsp) ++- stack_cons(); ++- if (i == j) { ++- /* no file and no type */ ++- vs_push(Cnil); ++- vs_push(Cnil); ++- goto L; ++- } ++- for (k = j, d = -1; k < i; k++) ++- if (s->st.st_self[k] == '.') ++- d = k; ++- if (d == -1) { ++- /* no file type */ ++-#ifdef UNIX ++- if (i-j == 1 && s->st.st_self[j] == '*') ++-#endif ++- vs_push(sKwild); ++- else ++- make_one(&s->st.st_self[j], i-j); ++- ++- vs_push(Cnil); ++- } else if (d == j) { ++- /* no file name */ ++- vs_push(Cnil); ++-#ifdef UNIX ++- if (i-d-1 == 1 && s->st.st_self[d+1] == '*') ++-#endif ++- vs_push(sKwild); ++- else ++- make_one(&s->st.st_self[d+1], i-d-1); ++- } else { ++- /* file name and file type */ ++-#ifdef UNIX ++- if (d-j == 1 && s->st.st_self[j] == '*') ++-#endif ++- vs_push(sKwild); ++- else { ++- make_one(&s->st.st_self[j], d-j); ++- } ++-#ifdef UNIX ++- if (i-d-1 == 1 && s->st.st_self[d+1] == '*') ++-#endif ++- vs_push(sKwild); ++- else ++- make_one(&s->st.st_self[d+1], i-d-1); ++- } ++- } ++-L: ++- /* Process DOS device name found earlier, build a string in a list and push it */ ++- if ( founddosdev ) { ++- /* Drive letter */ ++- token->st.st_self[0] = s->st.st_self[oldstart]; ++- /* Colon */ ++- token->st.st_self[1] = s->st.st_self[oldstart+1]; ++- /* Fill pointer */ ++- token->st.st_fillp = 2; ++- /* Push */ ++- vs_push(make_cons(copy_simple_string(token),Cnil)); ++- } else { ++- /* No device name */ ++- vs_push(Cnil); ++- } ++- if ( justdevice ) { ++- x = make_pathname ( Cnil, vs_top[-1], Cnil, Cnil, Cnil, Cnil ); ++- } else { ++- x = make_pathname ( Cnil, vs_top[-1], vs_top[-4], vs_top[-3], vs_top[-2], Cnil ); ++- } ++- vs_reset; ++- return(x); ++-} ++- ++-object ++-coerce_to_pathname(x) ++-object x; ++-{ ++- object y; ++- int e; ++- ++-L: ++- switch (type_of(x)) { ++- case t_symbol: ++- case t_string: ++- /* !!!!! Bug Fix. NLG */ ++- y = parse_namestring(x, 0, x->st.st_fillp, &e); ++- if (y == OBJNULL || e != x->st.st_fillp) ++- goto CANNOT_COERCE; ++- return(y); ++- ++- case t_pathname: ++- return(x); ++- ++- case t_stream: ++- switch (x->sm.sm_mode) { ++- case smm_input: ++- case smm_output: ++- case smm_probe: ++- case smm_io: ++- x = x->sm.sm_object1; ++- /* ++- The file was stored in sm.sm_object1. ++- See open. ++- */ ++- goto L; ++- ++- case smm_synonym: ++- x = symbol_value(x->sm.sm_object0); ++- goto L; ++- ++- default: ++- goto CANNOT_COERCE; ++- } ++- ++- default: ++- CANNOT_COERCE: ++- FEerror("~S cannot be coerced to a pathname.", 1, x); ++- return(Cnil); ++- } ++-} ++- ++-static object ++-default_device(host) ++-object host; ++-{ ++- return(Cnil); ++- /* not implemented yet */ ++-} ++- ++-object ++-merge_pathnames(path, defaults, default_version) ++-object path, defaults, default_version; ++-{ ++- object host, device, directory, name, type, version; ++- ++- if (path->pn.pn_host == Cnil) ++- host = defaults->pn.pn_host; ++- else ++- host = path->pn.pn_host; ++- if (path->pn.pn_device == Cnil) ++- if (path->pn.pn_host == Cnil) ++- device = defaults->pn.pn_device; ++- else if (path->pn.pn_host == defaults->pn.pn_host) ++- device = defaults->pn.pn_device; ++- else ++- device = default_device(path->pn.pn_host); ++- else ++- device = path->pn.pn_device; ++- ++- if (defaults->pn.pn_directory==Cnil || ++- (type_of(path->pn.pn_directory)==t_cons ++- && path->pn.pn_directory->c.c_car==sKroot)) ++- directory=path->pn.pn_directory; ++- else ++- directory=path->pn.pn_directory==Cnil ? ++- defaults->pn.pn_directory : ++- append(defaults->pn.pn_directory,path->pn.pn_directory); ++- ++- if (path->pn.pn_name == Cnil) ++- name = defaults->pn.pn_name; ++- else ++- name = path->pn.pn_name; ++- if (path->pn.pn_type == Cnil) ++- type = defaults->pn.pn_type; ++- else ++- type = path->pn.pn_type; ++- version = Cnil; ++- /* ++- In this implimentation, version is not counted ++- */ ++- return(make_pathname(host,device,directory,name,type,version)); ++-} ++- ++-/* ++- Namestring(x) converts a pathname to a namestring. ++-*/ ++-object ++-namestring(x) ++-object x; ++-{ ++- ++- int i, j; ++- object l, y; ++- ++- i = 0; ++- ++- l = x->pn.pn_device; ++- if (endp(l)) { ++- goto D; ++- } ++- y = l->c.c_car; ++- y = coerce_to_string(y); ++- for (j = 0; j < y->st.st_fillp; j++) { ++- token->st.st_self[i++] = y->st.st_self[j]; ++- } ++- ++-D: l = x->pn.pn_directory; ++- if (endp(l)) ++- goto L; ++- y = l->c.c_car; ++- if (y == sKroot) { ++-#ifdef UNIX ++- token->st.st_self[i++] = '/'; ++-#endif ++- l = l->c.c_cdr; ++- } ++- for (; !endp(l); l = l->c.c_cdr) { ++- y = l->c.c_car; ++-#ifdef UNIX ++- if (y == sKcurrent) { ++- token->st.st_self[i++] = '.'; ++- token->st.st_self[i++] = '/'; ++- continue; ++- } else if (y == sKwild) { ++- token->st.st_self[i++] = '*'; ++- token->st.st_self[i++] = '/'; ++- continue; ++- } else if (y == sKparent) { ++- token->st.st_self[i++] = '.'; ++- token->st.st_self[i++] = '.'; ++- token->st.st_self[i++] = '/'; ++- continue; ++- } ++-#endif ++- y = coerce_to_string(y); ++- for (j = 0; j < y->st.st_fillp; j++) ++- token->st.st_self[i++] ++- = y->st.st_self[j]; ++-#ifdef UNIX ++- token->st.st_self[i++] = '/'; ++-#endif ++-#ifdef AOSVS ++- ++-#endif ++- } ++-L: ++- y = x->pn.pn_name; ++- if (y == Cnil) ++- goto M; ++- if (y == sKwild) { ++-#ifdef UNIX ++- token->st.st_self[i++] = '*'; ++-#endif ++-#ifdef AOSVS ++- ++-#endif ++- goto M; ++- } ++- if (type_of(y) != t_string) ++- FEerror("~S is an illegal pathname name.", 1, y); ++- for (j = 0; j < y->st.st_fillp; j++) ++- token->st.st_self[i++] = y->st.st_self[j]; ++-M: ++- y = x->pn.pn_type; ++- if (y == Cnil) ++- goto N; ++- if (y == sKwild) { ++- token->st.st_self[i++] = '.'; ++-#ifdef UNIX ++- token->st.st_self[i++] = '*'; ++-#endif ++-#ifdef AOSVS ++- ++-#endif ++- goto N; ++- } ++- if (type_of(y) != t_string) ++- FEerror("~S is an illegal pathname name.", 1, y); ++- token->st.st_self[i++] = '.'; ++- for (j = 0; j < y->st.st_fillp; j++) ++- token->st.st_self[i++] = y->st.st_self[j]; ++-N: ++- token->st.st_fillp = i; ++-#ifdef FIX_FILENAME ++- {char buf[MAXPATHLEN]; ++- if (i > MAXPATHLEN-1) i =MAXPATHLEN-1; ++- memcpy(buf,token->st.st_self,i); ++- buf[i]=0; ++- FIX_FILENAME(x,buf); ++- return (make_simple_string(buf)); ++- } ++-#endif ++- return(copy_simple_string(token)); ++-} ++- ++-object ++-coerce_to_namestring(x) ++-object x; ++-{ ++- ++-L: ++- switch (type_of(x)) { ++- case t_symbol: ++- {BEGIN_NO_INTERRUPT; ++- vs_push(alloc_simple_string(x->s.s_fillp)); ++- /* By Nick Gall */ ++- vs_head->st.st_self = alloc_relblock(x->s.s_fillp); ++- { ++- int i; ++- for (i = 0; i < x->s.s_fillp; i++) ++- vs_head->st.st_self[i] = x->s.s_self[i]; ++- } ++- END_NO_INTERRUPT;} ++- return(vs_pop); ++- ++- case t_string: ++- return(x); ++- ++- case t_pathname: ++- return(namestring(x)); ++- ++- case t_stream: ++- switch (x->sm.sm_mode) { ++- case smm_input: ++- case smm_output: ++- case smm_probe: ++- case smm_io: ++- x = x->sm.sm_object1; ++- /* ++- The file was stored in sm.sm_object1. ++- See open. ++- */ ++- goto L; ++- ++- case smm_synonym: ++- x = symbol_value(x->sm.sm_object0); ++- goto L; ++- ++- default: ++- goto CANNOT_COERCE; ++- } ++- ++- default: ++- CANNOT_COERCE: ++- FEerror("~S cannot be coerced to a namestring.", 1, x); ++- return(Cnil); ++- } ++-} ++- ++-LFD(Lpathname)(void) ++-{ ++- check_arg(1); ++- check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++- vs_base[0] = coerce_to_pathname(vs_base[0]); ++-} ++- ++-@(defun parse_namestring (thing ++- &o host ++- (defaults `symbol_value(Vdefault_pathname_defaults)`) ++- &k start end junk_allowed ++- &a x y) ++- int s, e, ee; ++-@ ++- check_type_or_pathname_string_symbol_stream(&thing); ++- check_type_or_pathname_string_symbol_stream(&defaults); ++- defaults = coerce_to_pathname(defaults); ++- x = thing; ++-L: ++- switch (type_of(x)) { ++- case t_symbol: ++- case t_string: ++- get_string_start_end(x, start, end, &s, &e); ++- for (; s < e && isspace((int)x->st.st_self[s]); s++) ++- ; ++- y ++- /* !!!!! Bug Fix. NLG */ ++- = parse_namestring(x, ++- s, ++- e - s, ++- &ee); ++- if (junk_allowed == Cnil) { ++- for (; ee < e - s; ee++) ++- if (!isspace((int)x->st.st_self[s + ee])) ++- break; ++- if (y == OBJNULL || ee != e - s) ++- FEerror("Cannot parse the namestring ~S~%\ ++-from ~S to ~S.", ++- 3, x, start, end); ++- } else ++- if (y == OBJNULL) ++- @(return Cnil `make_fixnum(s + ee)`) ++- start = make_fixnum(s + ee); ++- break; ++- ++- case t_pathname: ++- y = x; ++- break; ++- ++- case t_stream: ++- switch (x->sm.sm_mode) { ++- case smm_input: ++- case smm_output: ++- case smm_probe: ++- case smm_io: ++- x = x->sm.sm_object1; ++- /* ++- The file was stored in sm.sm_object1. ++- See open. ++- */ ++- goto L; ++- ++- case smm_synonym: ++- x = symbol_value(x->sm.sm_object0); ++- goto L; ++- ++- default: ++- goto CANNOT_PARSE; ++- } ++- ++- default: ++- CANNOT_PARSE: ++- FEerror("Cannot parse the namestring ~S.", 1, x); ++- } ++- if (host != Cnil && y->pn.pn_host != Cnil && ++- host != y->pn.pn_host) ++- FEerror("The hosts ~S and ~S do not match.", ++- 2, host, y->pn.pn_host); ++- @(return y start) ++-@) ++- ++-@(defun merge_pathnames (path ++- &o (defaults `symbol_value(Vdefault_pathname_defaults)`) ++- (default_version sKnewest)) ++-@ ++- check_type_or_pathname_string_symbol_stream(&path); ++- check_type_or_pathname_string_symbol_stream(&defaults); ++- path = coerce_to_pathname(path); ++- defaults = coerce_to_pathname(defaults); ++- @(return `merge_pathnames(path, defaults, default_version)`) ++-@) ++- ++-@(defun make_pathname (&key ++- (host `Cnil` host_supplied_p) ++- (device `Cnil` device_supplied_p) ++- (directory `Cnil` directory_supplied_p) ++- (name `Cnil` name_supplied_p) ++- (type `Cnil` type_supplied_p) ++- (version `Cnil` version_supplied_p) ++- defaults ++- &aux x) ++-@ ++- if ( defaults == Cnil ) { ++- defaults = symbol_value ( Vdefault_pathname_defaults ); ++- defaults = coerce_to_pathname ( defaults ); ++- defaults = make_pathname ( defaults->pn.pn_host, ++- Cnil, Cnil, Cnil, Cnil, Cnil); ++- } else { ++- defaults = coerce_to_pathname(defaults); ++- } ++- x = make_pathname(host, device, directory, name, type, version); ++- x = merge_pathnames(x, defaults, Cnil); ++- if ( host_supplied_p) x->pn.pn_host = host; ++- if (device_supplied_p) x->pn.pn_device = device; ++- if (directory_supplied_p) x->pn.pn_directory = directory; ++- if (name_supplied_p) x->pn.pn_name = name; ++- if (type_supplied_p) x->pn.pn_type = type; ++- if (version_supplied_p) x->pn.pn_version = version; ++- @(return x) ++-@) ++- ++-LFD(Lpathnamep)(void) ++-{ ++- check_arg(1); ++- ++- if (type_of(vs_base[0]) == t_pathname) ++- vs_base[0] = Ct; ++- else ++- vs_base[0] = Cnil; ++-} ++- ++-LFD(Lpathname_host)(void) ++-{ ++- check_arg(1); ++- ++- check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++- vs_base[0] = coerce_to_pathname(vs_base[0]); ++- vs_base[0] = vs_base[0]->pn.pn_host; ++-} ++- ++-LFD(Lpathname_device)(void) ++-{ ++- check_arg(1); ++- ++- check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++- vs_base[0] = coerce_to_pathname(vs_base[0]); ++- vs_base[0] = vs_base[0]->pn.pn_device; ++-} ++- ++-LFD(Lpathname_directory)(void) ++-{ ++- check_arg(1); ++- ++- check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++- vs_base[0] = coerce_to_pathname(vs_base[0]); ++- vs_base[0] = vs_base[0]->pn.pn_directory; ++-} ++- ++-LFD(Lpathname_name)(void) ++-{ ++- check_arg(1); ++- ++- check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++- vs_base[0] = coerce_to_pathname(vs_base[0]); ++- vs_base[0] = vs_base[0]->pn.pn_name; ++-} ++- ++-LFD(Lpathname_type)(void) ++-{ ++- check_arg(1); ++- ++- check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++- vs_base[0] = coerce_to_pathname(vs_base[0]); ++- vs_base[0] = vs_base[0]->pn.pn_type; ++-} ++- ++-LFD(Lpathname_version)(void) ++-{ ++- check_arg(1); ++- ++- check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++- vs_base[0] = coerce_to_pathname(vs_base[0]); ++- vs_base[0] = vs_base[0]->pn.pn_version; ++-} ++- ++-LFD(Lnamestring)(void) ++-{ ++- check_arg(1); ++- ++- check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++- vs_base[0] = coerce_to_namestring(vs_base[0]); ++-} ++- ++-LFD(Lfile_namestring)(void) ++-{ ++- check_arg(1); ++- ++- check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++- vs_base[0] = coerce_to_pathname(vs_base[0]); ++- vs_base[0] ++- = make_pathname(Cnil, Cnil, Cnil, ++- vs_base[0]->pn.pn_name, ++- vs_base[0]->pn.pn_type, ++- vs_base[0]->pn.pn_version); ++- vs_base[0] = namestring(vs_base[0]); ++-} ++- ++-LFD(Ldirectory_namestring)(void) ++-{ ++- check_arg(1); ++- ++- check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++- vs_base[0] = coerce_to_pathname(vs_base[0]); ++- vs_base[0] ++- = make_pathname(Cnil, Cnil, ++- vs_base[0]->pn.pn_directory, ++- Cnil, Cnil, Cnil); ++- vs_base[0] = namestring(vs_base[0]); ++-} ++- ++-LFD(Lhost_namestring)(void) ++-{ ++- check_arg(1); ++- ++- check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++- vs_base[0] = coerce_to_pathname(vs_base[0]); ++- vs_base[0] = vs_base[0]->pn.pn_host; ++- if (vs_base[0] == Cnil || vs_base[0] == sKwild) ++- vs_base[0] = make_simple_string(""); ++-} ++- ++-@(defun enough_namestring (path ++- &o (defaults `symbol_value(Vdefault_pathname_defaults)`)) ++-@ ++- check_type_or_pathname_string_symbol_stream(&path); ++- check_type_or_pathname_string_symbol_stream(&defaults); ++- defaults = coerce_to_pathname(defaults); ++- path = coerce_to_pathname(path); ++- path ++- = make_pathname(equalp(path->pn.pn_host, defaults->pn.pn_host) ? ++- Cnil : path->pn.pn_host, ++- equalp(path->pn.pn_device, ++- defaults->pn.pn_device) ? ++- Cnil : path->pn.pn_device, ++- equalp(path->pn.pn_directory, ++- defaults->pn.pn_directory) ? ++- Cnil : path->pn.pn_directory, ++- equalp(path->pn.pn_name, defaults->pn.pn_name) ? ++- Cnil : path->pn.pn_name, ++- equalp(path->pn.pn_type, defaults->pn.pn_type) ? ++- Cnil : path->pn.pn_type, ++- equalp(path->pn.pn_version, ++- defaults->pn.pn_version) ? ++- Cnil : path->pn.pn_version); ++- @(return `namestring(path)`) ++-@) +++ +++DEFUN_NEW("C-STREAM-OBJECT0",object,fSc_stream_object0,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ RETURN1(x->sm.sm_object0); +++} +++ +++DEFUN_NEW("C-STREAM-OBJECT1",object,fSc_stream_object1,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ RETURN1(x->sm.sm_object1); +++} +++ +++DEFUN_NEW("C-SET-STREAM-OBJECT1",object,fSc_set_stream_object1,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { +++ x->sm.sm_object1=y; +++ RETURN1(x); +++} +++ +++DEFUN_NEW("INIT-PATHNAME",object,fSinit_pathname,SI,7,7,NONE,OO,OO,OO,OO, +++ (object host,object device,object directory,object name,object type,object version,object namestring),"") { +++ +++ object x=alloc_object(t_pathname); +++ +++ x->pn.pn_host=host; +++ x->pn.pn_device=device; +++ x->pn.pn_directory=directory; +++ x->pn.pn_name=name; +++ x->pn.pn_type=type; +++ x->pn.pn_version=version; +++ x->pn.pn_namestring=namestring; +++ +++ RETURN1(x); +++ +++} +++ +++DEFUN_NEW("PATHNAMEP",object,fLpathnamep,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ RETURN1(type_of(x)==t_pathname ? Ct : Cnil); +++} ++ ++ void ++-gcl_init_pathname(void) ++-{ ++- Vdefault_pathname_defaults = ++- make_special("*DEFAULT-PATHNAME-DEFAULTS*", ++- make_pathname(Cnil, Cnil, Cnil, Cnil, Cnil, Cnil)); ++- ++- sKwild = make_keyword("WILD"); ++- sKnewest = make_keyword("NEWEST"); ++- ++- sKstart = make_keyword("START"); ++- sKend = make_keyword("END"); ++- sKjunk_allowed = make_keyword("JUNK-ALLOWED"); ++- ++- sKhost = make_keyword("HOST"); ++- sKdevice = make_keyword("DEVICE"); ++- sKdirectory = make_keyword("DIRECTORY"); ++- sKname = make_keyword("NAME"); ++- sKtype = make_keyword("TYPE"); ++- sKversion = make_keyword("VERSION"); ++- sKdefaults = make_keyword("DEFAULTS"); ++- ++- sKroot = make_keyword("ROOT"); ++- sKcurrent = make_keyword("CURRENT"); ++- sKparent = make_keyword("PARENT"); ++- sKper = make_keyword("PER"); +++gcl_init_pathname(void) { +++ ++ } ++ ++ void ++-gcl_init_pathname_function() ++-{ ++- make_function("PATHNAME", Lpathname); ++- make_function("PARSE-NAMESTRING", Lparse_namestring); ++- make_function("MERGE-PATHNAMES", Lmerge_pathnames); ++- make_function("MAKE-PATHNAME", Lmake_pathname); ++- make_function("PATHNAMEP", Lpathnamep); ++- make_function("PATHNAME-HOST", Lpathname_host); ++- make_function("PATHNAME-DEVICE", Lpathname_device); ++- make_function("PATHNAME-DIRECTORY", Lpathname_directory); ++- make_function("PATHNAME-NAME", Lpathname_name); ++- make_function("PATHNAME-TYPE", Lpathname_type); ++- make_function("PATHNAME-VERSION", Lpathname_version); ++- make_function("NAMESTRING", Lnamestring); ++- make_function("FILE-NAMESTRING", Lfile_namestring); ++- make_function("DIRECTORY-NAMESTRING", Ldirectory_namestring); ++- make_function("HOST-NAMESTRING", Lhost_namestring); ++- make_function("ENOUGH-NAMESTRING", Lenough_namestring); +++gcl_init_pathname_function(void) { +++ ++ } ++--- gcl-2.6.12.orig/o/predicate.c +++++ gcl-2.6.12/o/predicate.c ++@@ -29,6 +29,10 @@ Foundation, 675 Mass Ave, Cambridge, MA ++ #include ++ #include "include.h" ++ +++DEFUN_NEW("PATHNAME-DESIGNATORP",object,fSpathname_designatorp,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ RETURN1(pathname_designatorp(x) ? Ct : Cnil); +++} +++ ++ DEFUNO_NEW("NULL",object,fLnull,LISP ++ ,1,1,NONE,OO,OO,OO,OO,void,Lnull,(object x0),"") ++ { ++--- gcl-2.6.12.orig/o/print.d +++++ gcl-2.6.12/o/print.d ++@@ -1260,6 +1260,7 @@ int level; ++ write_ch('>'); ++ break; ++ +++ case smm_file_synonym: ++ case smm_synonym: ++ write_str("#sm.sm_object0, level); ++@@ -1381,7 +1382,7 @@ int level; ++ if (1 || PRINTescape) { ++ write_ch('#'); ++ write_ch('p'); ++- vs_push(namestring(x)); +++ vs_push(x->pn.pn_namestring==Cnil ? make_simple_string("") : x->pn.pn_namestring); ++ write_object(vs_head, level); ++ vs_popp; ++ } else { ++--- gcl-2.6.12.orig/o/read.d +++++ gcl-2.6.12/o/read.d ++@@ -1564,38 +1564,6 @@ Ldefault_dispatch_macro() ++ } ++ ++ /* ++- #p" ... " returns the pathname with namestring ... . ++-*/ ++-static void ++-Lsharp_p_reader() ++-{ ++- check_arg(3); ++- if (vs_base[2] != Cnil && !READsuppress) ++- extra_argument('p'); ++- vs_popp; ++- vs_popp; ++- vs_base[0] = read_object(vs_base[0]); ++- vs_base[0] = coerce_to_pathname(vs_base[0]); ++-} ++- ++-/* ++- #" ... " returns the pathname with namestring ... . ++-*/ ++-static void ++-Lsharp_double_quote_reader() ++-{ ++- check_arg(3); ++- ++- if (vs_base[2] != Cnil && !READsuppress) ++- extra_argument('"'); ++- vs_popp; ++- unread_char(vs_base[1], vs_base[0]); ++- vs_popp; ++- vs_base[0] = read_object(vs_base[0]); ++- vs_base[0] = coerce_to_pathname(vs_base[0]); ++-} ++- ++-/* ++ #$ fixnum returns a random-state with the fixnum ++ as its content. ++ */ ++@@ -2369,9 +2337,6 @@ gcl_init_read() ++ dtab['<'] = make_cf(Lsharp_less_than_reader); ++ */ ++ dtab['|'] = make_cf(Lsharp_vertical_bar_reader); ++- dtab['"'] = make_cf(Lsharp_double_quote_reader); ++- dtab['p'] = make_cf(Lsharp_p_reader); ++- dtab['P'] = make_cf(Lsharp_p_reader); ++ /* This is specific to this implimentation */ ++ dtab['$'] = make_cf(Lsharp_dollar_reader); ++ /* This is specific to this implimentation */ ++--- gcl-2.6.12.orig/o/regexp.c +++++ gcl-2.6.12/o/regexp.c ++@@ -117,7 +117,7 @@ min_initial_branch_length(regexp *, unsi ++ #define PLUS 11 /* node Match this (simple) thing 1 or more times. */ ++ #define OPEN 20 /* no Mark this point in input as start of #n. */ ++ /* OPEN+1 is number 1, etc. */ ++-#define CLOSE 30 /* no Analogous to OPEN. */ +++#define CLOSE (OPEN+NSUBEXP) /* no Analogous to OPEN. */ ++ ++ /* ++ * Opcode notes: ++@@ -1083,15 +1083,8 @@ regmatch(char *prog) ++ break; ++ case BACK: ++ break; ++- case OPEN+1: ++- case OPEN+2: ++- case OPEN+3: ++- case OPEN+4: ++- case OPEN+5: ++- case OPEN+6: ++- case OPEN+7: ++- case OPEN+8: ++- case OPEN+9: { +++ case OPEN+1 ... OPEN+NSUBEXP-1: +++ { ++ register int no; ++ register char *save; ++ ++@@ -1112,15 +1105,8 @@ regmatch(char *prog) ++ } ++ /* NOTREACHED */ ++ break; ++- case CLOSE+1: ++- case CLOSE+2: ++- case CLOSE+3: ++- case CLOSE+4: ++- case CLOSE+5: ++- case CLOSE+6: ++- case CLOSE+7: ++- case CLOSE+8: ++- case CLOSE+9: { +++ case CLOSE+1 ... CLOSE+NSUBEXP-1: +++ { ++ register int no; ++ register char *save; ++ ++@@ -1394,27 +1380,11 @@ char *op; ++ case END: ++ p = "END"; ++ break; ++- case OPEN+1: ++- case OPEN+2: ++- case OPEN+3: ++- case OPEN+4: ++- case OPEN+5: ++- case OPEN+6: ++- case OPEN+7: ++- case OPEN+8: ++- case OPEN+9: +++ case OPEN+1 ... OPEN+NSUBEXP-1: ++ sprintf(buf+strlen(buf), "OPEN%d", OP(op)-OPEN); ++ p = NULL; ++ break; ++- case CLOSE+1: ++- case CLOSE+2: ++- case CLOSE+3: ++- case CLOSE+4: ++- case CLOSE+5: ++- case CLOSE+6: ++- case CLOSE+7: ++- case CLOSE+8: ++- case CLOSE+9: +++ case CLOSE+1 ... CLOSE+NSUBEXP-1: ++ sprintf(buf+strlen(buf), "CLOSE%d", OP(op)-CLOSE); ++ p = NULL; ++ break; ++--- gcl-2.6.12.orig/o/regexp.h +++++ gcl-2.6.12/o/regexp.h ++@@ -1,7 +1,7 @@ ++ #ifndef _REGEXP ++ #define _REGEXP 1 ++ ++-#define NSUBEXP 10 +++#define NSUBEXP 19 ++ typedef struct regexp { ++ char *startp[NSUBEXP]; ++ char *endp[NSUBEXP]; ++--- gcl-2.6.12.orig/o/regexpr.c +++++ gcl-2.6.12/o/regexpr.c ++@@ -81,6 +81,7 @@ DEFUN_NEW("COMPILE-REGEXP",object,fScomp ++ res->v.v_elttype=aet_uchar; ++ res->v.v_adjustable=0; ++ res->v.v_offset=0; +++ res->v.v_self=NULL; ++ if (!(res->v.v_self=(void *)regcomp(tmp,&res->v.v_dim))) ++ FEerror("regcomp failure",0); ++ res->v.v_fillp=res->v.v_dim; ++--- gcl-2.6.12.orig/o/run_process.c +++++ gcl-2.6.12/o/run_process.c ++@@ -177,10 +177,12 @@ void run_process ( char *name ) ++ stream_in->sm.sm_mode = smm_input; ++ stream_in->sm.sm_fp = ofp; ++ stream_in->sm.sm_buffer = 0; +++ stream_in->sm.sm_flags=0; ++ stream_out = (object) alloc_object(t_stream); ++ stream_out->sm.sm_mode = smm_output; ++ stream_out->sm.sm_fp = ifp; ++ stream_out->sm.sm_buffer = 0; +++ stream_out->sm.sm_flags=0; ++ setup_stream_buffer ( stream_in ); ++ setup_stream_buffer ( stream_out ); ++ stream = make_two_way_stream ( stream_in, stream_out ); ++@@ -433,6 +435,7 @@ enum smmode smm; ++ stream->sm.sm_object0 = sLcharacter; ++ stream->sm.sm_object1 = host_l; ++ stream->sm.sm_int0 = stream->sm.sm_int1 = 0; +++ stream->sm.sm_flags=0; ++ vs_push(stream); ++ setup_stream_buffer(stream); ++ vs_reset; ++@@ -503,6 +506,7 @@ make_socket_pair() ++ stream_in->sm.sm_int0 = sockets_in[1]; ++ stream_in->sm.sm_int1 = 0; ++ stream_in->sm.sm_object0=stream_in->sm.sm_object1=OBJNULL; +++ stream_in->sm.sm_flags = 0; ++ stream_out = (object) alloc_object(t_stream); ++ stream_out->sm.sm_mode = smm_output; ++ stream_out->sm.sm_fp = fp2; ++@@ -511,6 +515,7 @@ make_socket_pair() ++ setup_stream_buffer(stream_out); ++ stream_out->sm.sm_int0 = sockets_out[1]; ++ stream_out->sm.sm_int1 = 0; +++ stream_out->sm.sm_flags = 0; ++ stream_out->sm.sm_object0=stream_out->sm.sm_object1=OBJNULL; ++ stream = make_two_way_stream(stream_in, stream_out); ++ return(stream); ++--- gcl-2.6.12.orig/o/sfaslcoff.c +++++ gcl-2.6.12/o/sfaslcoff.c ++@@ -151,6 +151,16 @@ find_init_address(struct syment *sym,str ++ ++ } ++ +++static ul +++get_sym_value(const char *name) { +++ +++ struct node *answ; +++ +++ return (answ=find_sym_ptable(name)) ? answ->address : +++ ({massert(!emsg("Unrelocated non-local symbol: %s\n",name));0;}); +++ +++} +++ ++ static void ++ relocate_symbols(struct syment *sym,struct syment *sye,struct scnhdr *sec1,char *st1) { ++ ++@@ -163,22 +173,10 @@ relocate_symbols(struct syment *sym,stru ++ ++ else if (!sym->n_scnum) { ++ ++- char c=0,*s; ++- ++- if (sym->n.n.n_zeroes) { ++- c=sym->n.n_name[8]; ++- sym->n.n_name[8]=0; ++- s=sym->n.n_name; ++- } else ++- s=st1+sym->n.n.n_offset; ++- ++- if ((answ=find_sym_ptable(s))) ++- sym->n_value=answ->address; +++ if (sym->n.n.n_zeroes) +++ STOP(sym->n.n_name,sym->n_value=get_sym_value(sym->n.n_name)); ++ else ++- massert(!emsg("Unrelocated non-local symbol: %s\n",s)); ++- ++- if (c) ++- sym->n.n_name[8]=c; +++ sym->n_value=get_sym_value(st1+sym->n.n.n_offset); ++ ++ } ++ ++@@ -391,13 +389,11 @@ fasload(object faslfile) { ++ struct reloc *rel,*rele; ++ object memory, data; ++ FILE *fp; ++- char filename[MAXPATHLEN],*st1,*ste; +++ char *st1,*ste; ++ int i; ++ ul init_address=0; ++ void *st,*est; ++ ++- coerce_to_filename(faslfile, filename); ++- faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); ++ fp = faslfile->sm.sm_fp; ++ ++ massert(st=get_mmap(fp,&est)); ++@@ -427,7 +423,6 @@ fasload(object faslfile) { ++ data = read_fasl_vector(faslfile); ++ ++ massert(!un_mmap(st,est)); ++- close_stream(faslfile); ++ ++ #ifdef CLEAR_CACHE ++ CLEAR_CACHE; ++--- gcl-2.6.12.orig/o/sfaslelf.c +++++ gcl-2.6.12/o/sfaslelf.c ++@@ -542,15 +542,13 @@ int ++ fasload(object faslfile) { ++ ++ FILE *fp; ++- char filename[256],*sn,*st1,*dst1; +++ char *sn,*st1,*dst1; ++ ul init_address=0,end,gs=0,*got=&gs,*gote=got+1; ++ object memory,data; ++ Shdr *sec1,*sece; ++ Sym *sym1,*syme,*dsym1,*dsyme; ++ void *v1,*ve; ++ ++- coerce_to_filename(faslfile, filename); ++- faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); ++ fp = faslfile->sm.sm_fp; ++ ++ massert(v1=get_mmap(fp,&ve)); ++@@ -573,7 +571,6 @@ fasload(object faslfile) { ++ data=feof(fp) ? 0 : read_fasl_vector(faslfile); ++ ++ massert(!un_mmap(v1,ve)); ++- close_stream(faslfile); ++ ++ massert(!clear_protect_memory(memory)); ++ ++--- gcl-2.6.12.orig/o/sfaslmacho.c +++++ gcl-2.6.12/o/sfaslmacho.c ++@@ -524,7 +524,6 @@ fasload(object faslfile) { ++ ++ FILE *fp; ++ object data; ++- char filename[256]; ++ ul init_address=-1; ++ object memory; ++ void *v1,*ve,*p; ++@@ -533,8 +532,6 @@ fasload(object faslfile) { ++ char *st1=NULL,*ste=NULL; ++ ul gs,*got=&gs,*gote,*io1=NULL,rls,start; ++ ++- coerce_to_filename(faslfile, filename); ++- faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); ++ fp = faslfile->sm.sm_fp; ++ ++ massert(v1=get_mmap(fp,&ve)); ++@@ -563,7 +560,6 @@ fasload(object faslfile) { ++ #endif ++ ++ massert(!un_mmap(v1,ve)); ++- close_stream(faslfile); ++ ++ init_address-=(ul)memory->cfd.cfd_start; ++ call_init(init_address,memory,data,0); ++--- gcl-2.6.12.orig/o/sgbc.c +++++ gcl-2.6.12/o/sgbc.c ++@@ -717,7 +717,7 @@ sgc_start(void) { ++ void *p=NULL,*pe; ++ struct pageinfo *pi; ++ ufixnum i; ++- +++ ++ old_cb_pointer=cb_pointer; ++ reset_contblock_freelist(); ++ ++@@ -774,6 +774,8 @@ sgc_start(void) { ++ object v=sSAwritableA->s.s_dbind; ++ for (i=page(v->v.v_self);i<=page(v->v.v_self+CEI(v->bv.bv_offset+v->v.v_dim-1,8*sizeof(fixnum))/(8*sizeof(fixnum)));i++) ++ SET_WRITABLE(i); +++ SET_WRITABLE(page(v)); +++ SET_WRITABLE(page(sSAwritableA)); ++ } ++ ++ tm_of(t_relocatable)->tm_alt_npage=0; ++@@ -787,7 +789,7 @@ sgc_start(void) { ++ Turn memory protection on for the pages which are writable. ++ */ ++ sgc_enabled=1; ++- if (memory_protect(1)) +++ if (memory_protect(1)) ++ sgc_quit(); ++ if (sSAnotify_gbcA->s.s_dbind != Cnil) ++ emsg("[SGC on]"); ++@@ -897,7 +899,7 @@ sgc_quit(void) { ++ for (p=pagetochar(page(v)),j=tm->tm_nppage;j>0;--j,p+=tm->tm_size) ++ ((object) p)->d.s=SGC_NORMAL; ++ #endif ++- +++ ++ for (i=0;iv.v_fillp &&(v=(void *)contblock_array->v.v_self[i]);i++) ++ if (v->sgc_flags&SGC_PAGE_FLAG) ++ bzero(CB_SGCF_START(v),CB_DATA_START(v)-CB_SGCF_START(v)); ++@@ -931,7 +933,7 @@ memprotect_handler(int sig, long code, v ++ #endif ++ if (faddr >= (void *)core_end || faddr < data_start) { ++ static void *old_faddr; ++- if (old_faddr==faddr) +++ if (old_faddr==faddr) ++ if (fault_count++ > 300) error("fault count too high"); ++ old_faddr=faddr; ++ INSTALL_MPROTECT_HANDLER; ++@@ -1017,7 +1019,7 @@ memory_protect(int on) { ++ ++ if (writable==WRITABLE_PAGE_P(i) && ism.sm_fp); ++ ++ #endif ++ ++-static void ++-FFN(siLfaslink)(void) ++-{ ++- bds_ptr old_bds_top; ++- int i; ++- object package; ++- ++- check_arg(2); ++- check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++- check_type_string(&vs_base[1]); ++- vs_base[0] = coerce_to_pathname(vs_base[0]); ++- vs_base[0]->pn.pn_type = FASL_string; ++- vs_base[0] = namestring(vs_base[0]); ++- package = symbol_value(sLApackageA); ++- old_bds_top = bds_top; ++- bds_bind(sLApackageA, package); ++- i = faslink(vs_base[0], vs_base[1]); ++- bds_unwind(old_bds_top); ++- vs_top = vs_base; ++- vs_push(make_fixnum(i)); ++-} ++- ++ #endif ++ #endif/* svr4 */ ++ #endif /* UNIXFASL */ ++ ++ void ++-gcl_init_unixfasl(void) ++-{ ++-#ifdef FASLINK ++- make_si_function("FASLINK", siLfaslink); ++-#endif +++gcl_init_unixfasl(void) { ++ } ++--- gcl-2.6.12.orig/o/unixfsys.c +++++ gcl-2.6.12/o/unixfsys.c ++@@ -44,10 +44,6 @@ Foundation, 675 Mass Ave, Cambridge, MA ++ #define HAVE_RENAME ++ #endif ++ ++-void Ldirectory(void); ++- ++- ++- ++ #ifdef NEED_GETWD ++ #include ++ ++@@ -168,17 +164,41 @@ getwd(char *buffer) { ++ b_[_c+_d]=0;\ ++ }) ++ +++static object +++get_string(object x) { +++ switch(type_of(x)) { +++ case t_symbol: +++ case t_string: +++ return x; +++ case t_pathname: +++ return x->pn.pn_namestring; +++ case t_stream: +++ switch(x->sm.sm_mode) { +++ case smm_input: +++ case smm_output: +++ case smm_probe: +++ case smm_io: +++ return get_string(x->sm.sm_object1); +++ case smm_file_synonym: +++ case smm_synonym: +++ return get_string(x->sm.sm_object0->s.s_dbind); +++ } +++ } +++ return Cnil; +++} +++ +++ ++ void ++ coerce_to_filename(object pathname,char *p) { ++ ++- object namestring=coerce_to_namestring(pathname); +++ object namestring=get_string(pathname); ++ unsigned e=namestring->st.st_fillp; ++- char *q=namestring->st.st_self,*qe=q+e;; +++ char *q=namestring->st.st_self,*qe=q+e; ++ ++- if (pathname==Cnil) +++ if (pathname==Cnil||namestring==Cnil) ++ FEerror ( "NIL argument.", 1, pathname ); ++ ++- if (*q=='~') { +++ if (*q=='~' && e) { ++ ++ unsigned m=0; ++ char *s=++q,*c; ++@@ -224,134 +244,6 @@ coerce_to_filename(object pathname,char ++ ++ } ++ ++-object ++-truename(object pathname) ++-{ ++- register char *p, *q; ++- char filename[MAXPATHLEN]; ++- char truefilename[MAXPATHLEN]; ++- char current_directory[MAXPATHLEN]; ++- char directory[MAXPATHLEN]; ++-#ifdef __MINGW32__ ++- DWORD current_directory_length = ++- GetCurrentDirectory ( MAXPATHLEN, current_directory ); ++- if ( MAXPATHLEN < current_directory_length ) { ++- FEerror ( "truename got a current directory name larger than MAXPATHLEN", 1, "" ); ++- } ++- if ( 0 == current_directory_length ) { ++- FEerror ( "truename could not determine the current directory.", 1, "" ); ++- } ++-#else ++- massert(current_directory==getcwd(current_directory,sizeof(current_directory))); ++-#endif ++- ++- coerce_to_filename(pathname, filename); ++- ++-#ifdef S_IFLNK ++- { ++- ++- struct stat filestatus; ++- int islinkcount=8; ++- ++- if (lstat(filename, &filestatus) >= 0) ++- ++- while (((filestatus.st_mode&S_IFMT) == S_IFLNK) && (--islinkcount>0)) { ++- ++- char newname[MAXPATHLEN]; ++- int newlen; ++- ++- newlen=readlink(filename,newname,MAXPATHLEN-1); ++- if (newlen < 0) ++- return((FEerror("Symlink broken at ~S.",1,pathname),Cnil)); ++- ++- for (p = filename, q = 0; *p != '\0'; p++) ++- if (*p == '/') q = p; ++- if (q == 0 || *newname == '/') ++- q = filename; ++- else ++- q++; ++- ++- memcpy(q,newname,newlen); ++- q[newlen]=0; ++- if (lstat(filename, &filestatus) < 0) ++- islinkcount=0; /* It would be ANSI to do the following : ++- return(file_error("Symlink broken at ~S.",pathname)); ++- but this would break DIRECTORY if a file points to nowhere */ ++- } ++- } ++-#endif ++- ++- for (p = filename, q = 0; *p != '\0'; p++) ++- if (*p == '/') ++- q = p; ++- if (q == filename) { ++- q++; ++- p = "/"; ++- } else if (q == 0) { ++- q = filename; ++- p = current_directory; ++- } else ++-#ifdef __MINGW32__ ++- if ( ( q > filename ) && ( q[-1] == ':' ) ) { ++- int current = (q++, q[0]); ++- q[0]=0; ++- if (chdir(filename) < 0) ++- FEerror("Cannot get the truename of ~S.", 1, pathname); ++- current_directory_length = ++- GetCurrentDirectory ( MAXPATHLEN, directory ); ++- if ( MAXPATHLEN < current_directory_length ) { ++- FEerror ( "truename got a current directory name larger than MAXPATHLEN", 1, "" ); ++- } ++- if ( 0 == current_directory_length ) { ++- FEerror ( "truename could not determine the current directory.", 1, "" ); ++- } ++- p = directory; ++- if ( p[1]==':' && ( p[2]=='\\' || p[2]=='/' ) && p[3]==0 ) p[2]=0; ++- q[0]=current; ++- } ++- else ++-#endif ++- { ++- *q++ = '\0'; ++- if (chdir(filename) < 0) ++- FEerror("Cannot get the truename of ~S.", 1, pathname); ++-#ifdef __MINGW32__ ++- current_directory_length = GetCurrentDirectory ( MAXPATHLEN, directory ); ++- if ( MAXPATHLEN < current_directory_length ) { ++- FEerror ( "truename got a current directory name larger than MAXPATHLEN", 1, "" ); ++- } ++- if ( 0 == current_directory_length ) { ++- FEerror ( "truename could not determine the current directory.", 1, "" ); ++- } ++- p = directory; ++-#else ++- p = getcwd(directory,sizeof(directory)); ++-#endif ++- } ++- if (p[0] == '/' && p[1] == '\0') { ++- if (strcmp(q, "..") == 0) ++- strcpy(truefilename, "/."); ++- else ++- sprintf(truefilename, "/%s", q); ++- } else if (strcmp(q, ".") == 0) ++- strcpy(truefilename, p); ++- else if (strcmp(q, "..") == 0) { ++- for (q = p + strlen(p); *--q != '/';) ; ++- if (p == q) ++- strcpy(truefilename, "/."); ++- else { ++- *q = '\0'; ++- strcpy(truefilename, p); ++- *q = '/'; ++- } ++- } else ++- sprintf(truefilename, "%s/%s", p, q); ++- massert(!chdir(current_directory)); ++- vs_push(make_simple_string(truefilename)); ++- pathname = coerce_to_pathname(vs_head); ++- vs_popp; ++- return(pathname); ++-} ++ object sSAallow_gzipped_fileA; ++ ++ bool ++@@ -429,41 +321,6 @@ file_len(FILE *fp) ++ else return 0; ++ } ++ ++-LFD(Ltruename)(void) ++-{ ++- check_arg(1); ++- check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++- vs_base[0] = truename(vs_base[0]); ++-} ++- ++-LFD(Lrename_file)(void) ++-{ ++- char filename[MAXPATHLEN]; ++- char newfilename[MAXPATHLEN]; ++- ++- check_arg(2); ++- check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++- check_type_or_Pathname_string_symbol(&vs_base[1]); ++- coerce_to_filename(vs_base[0], filename); ++- vs_base[0] = coerce_to_pathname(vs_base[0]); ++- vs_base[1] = coerce_to_pathname(vs_base[1]); ++- vs_base[1] = merge_pathnames(vs_base[1], vs_base[0], Cnil); ++- coerce_to_filename(vs_base[1], newfilename); ++-#ifdef HAVE_RENAME ++- if (rename(filename, newfilename) < 0) ++- FEerror("Cannot rename the file ~S to ~S.", ++- 2, vs_base[0], vs_base[1]); ++-#else ++- sprintf(command, "mv %s %s", filename, newfilename); ++- msystem(command); ++-#endif ++- vs_push(vs_base[1]); ++- vs_push(truename(vs_base[0])); ++- vs_push(truename(vs_base[1])); ++- vs_base += 2; ++-} ++- ++- ++ DEF_ORDINARY("DIRECTORY",sKdirectory,KEYWORD,""); ++ DEF_ORDINARY("LINK",sKlink,KEYWORD,""); ++ DEF_ORDINARY("FILE",sKfile,KEYWORD,""); ++@@ -500,33 +357,28 @@ int gcl_putc(int i,void *v) {return putc ++ ++ ++ ++-DEFUN_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object path),"") { +++DEFUNM_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ ++- char filename[4096]; ++ struct stat ss; ++- ++ ++- bzero(filename,sizeof(filename)); ++- coerce_to_filename(path,filename); +++ check_type_string(&x); +++ coerce_to_filename(x,FN1); +++ ++ #ifdef __MINGW32__ ++ { ++- char *p=filename+strlen(filename)-1; ++- for (;p>filename && *p=='/';p--) +++ char *p=FN1+strlen(FN1)-1; +++ for (;p>FN1 && *p=='/';p--) ++ *p=0; ++ } ++ #endif ++- if (lstat(filename,&ss)) +++ if (lstat(FN1,&ss)) ++ RETURN1(Cnil); ++- else {/* ctime_r insufficiently portable */ ++- /* int j; ++- ctime_r(&ss.st_ctime,filename); ++- j=strlen(filename); ++- if (isspace(filename[j-1])) ++- filename[j-1]=0;*/ ++- RETURN1(list(3,S_ISDIR(ss.st_mode) ? sKdirectory : ++- (S_ISLNK(ss.st_mode) ? sKlink : sKfile), ++- make_fixnum(ss.st_size),make_fixnum(ss.st_ctime))); ++- } +++ else +++ RETURN4(S_ISDIR(ss.st_mode) ? sKdirectory : +++ (S_ISLNK(ss.st_mode) ? sKlink : sKfile), +++ make_fixnum(ss.st_size), +++ make_fixnum(ss.st_ctime), +++ make_fixnum(ss.st_uid)); ++ } ++ ++ DEFUN_NEW("SETENV",object,fSsetenv,SI,2,2,NONE,OO,OO,OO,OO,(object variable,object value),"Set environment VARIABLE to VALUE") ++@@ -551,266 +403,6 @@ DEFUN_NEW("SETENV",object,fSsetenv,SI,2, ++ RETURN1((res == 0 ? Ct : Cnil )); ++ } ++ ++-DEFUNO_NEW("DELETE-FILE",object,fLdelete_file,LISP ++- ,1,1,NONE,OO,OO,OO,OO,void,Ldelete_file,(object path),"") ++- ++-{ ++- char filename[MAXPATHLEN]; ++- ++- /* 1 args */ ++- check_type_or_pathname_string_symbol_stream(&path); ++- coerce_to_filename(path, filename); ++- if (unlink(filename) < 0 && rmdir(filename) < 0) ++- FEerror("Cannot delete the file ~S: ~s.", 2, path, make_simple_string(strerror(errno))); ++- path = Ct; ++- RETURN1(path); ++-} ++-#ifdef STATIC_FUNCTION_POINTERS ++-object ++-fLdelete_file(object path) { ++- return FFN(fLdelete_file)(path); ++-} ++-#endif ++- ++-LFD(Lprobe_file)(void) ++-{ ++- check_arg(1); ++- ++- check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++- if (file_exists(vs_base[0])) ++- vs_base[0] = truename(vs_base[0]); ++- else ++- vs_base[0] = Cnil; ++-} ++- ++-LFD(Lfile_write_date)(void) ++-{ ++- char filename[MAXPATHLEN]; ++- struct stat filestatus; ++- ++- check_arg(1); ++- check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++- coerce_to_filename(vs_base[0], filename); ++- if (stat(filename, &filestatus) < 0 || S_ISDIR(filestatus.st_mode)) ++- { vs_base[0] = Cnil; return;} ++- vs_base[0] = unix_time_to_universal_time(filestatus.st_mtime); ++-} ++- ++-LFD(Lfile_author)(void) ++-{ ++-#if !defined(NO_PWD_H) && !defined(STATIC_LINKING) ++- char filename[MAXPATHLEN]; ++- struct stat filestatus; ++- struct passwd *pwent; ++-#ifndef __STDC__ ++- extern struct passwd *getpwuid(); ++-#endif ++- ++- check_arg(1); ++- check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++- coerce_to_filename(vs_base[0], filename); ++- if (stat(filename, &filestatus) < 0 || S_ISDIR(filestatus.st_mode)) ++- { vs_base[0] = Cnil; return;} ++- pwent = getpwuid(filestatus.st_uid); ++- vs_base[0] = make_simple_string(pwent->pw_name); ++-#else ++- vs_base[0] = Cnil; return; ++-#endif ++- ++-} ++- ++-static void ++-FFN(Luser_homedir_pathname)(void) ++-{ ++- ++- char filename[MAXPATHLEN]; ++- ++- coerce_to_filename(make_simple_string("~/"),filename); ++- vs_base[0]=coerce_to_pathname(make_simple_string(filename)); ++- vs_top = vs_base+1; ++- ++-} ++- ++- ++-#ifdef BSD ++-LFD(Ldirectory)(void) ++-{ ++- char filename[MAXPATHLEN]; ++- char command[MAXPATHLEN * 2]; ++- FILE *fp; ++- register int i, c; ++- object *top = vs_top; ++- char iobuffer[BUFSIZ]; ++- extern FILE *popen(const char *, const char *); ++- ++- check_arg(1); ++- ++- check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++- vs_base[0] = coerce_to_pathname(vs_base[0]); ++- if (vs_base[0]->pn.pn_name==Cnil && vs_base[0]->pn.pn_type==Cnil) { ++- coerce_to_filename(vs_base[0], filename); ++- strcat(filename, "*"); ++- } else if (vs_base[0]->pn.pn_name==Cnil) { ++- vs_base[0]->pn.pn_name = sKwild; ++- coerce_to_filename(vs_base[0], filename); ++- vs_base[0]->pn.pn_name = Cnil; ++- } else if (vs_base[0]->pn.pn_type==Cnil) { ++- coerce_to_filename(vs_base[0], filename); ++- strcat(filename, "*"); ++- } else ++- coerce_to_filename(vs_base[0], filename); ++- sprintf(command, "ls -d %s 2> /dev/null", filename); ++- fp = popen(command, "r"); ++- setbuf(fp, iobuffer); ++- for (;;) { ++- for (i = 0; (c = getc(fp)); i++) ++- if (c <= 0) ++- goto L; ++- else if (c == '\n') ++- break; ++- else ++- filename[i] = c; ++- filename[i] = '\0'; ++- vs_push(make_simple_string(filename)); ++- vs_head = truename(vs_head); ++- } ++-L: ++- pclose(fp); ++- vs_push(Cnil); ++- while (vs_top > top + 1) ++- stack_cons(); ++- vs_base = top; ++-} ++-#endif ++- ++- ++-#ifdef ATT ++-LFD(Ldirectory)() ++-{ ++- object name, type; ++- char filename[MAXPATHLEN]; ++- FILE *fp; ++- object *top = vs_top; ++- char iobuffer[BUFSIZ]; ++- struct direct dir; ++- int i; ++- ++- check_arg(1); ++- ++- check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++- vs_base[0] = coerce_to_pathname(vs_base[0]); ++- vs_push(vs_base[0]->pn.pn_name); ++- vs_push(vs_base[0]->pn.pn_type); ++- vs_base[0]->pn.pn_name = Cnil; ++- vs_base[0]->pn.pn_type = Cnil; ++- coerce_to_filename(vs_base[0], filename); ++- type = vs_base[0]->pn.pn_type = vs_pop; ++- name = vs_base[0]->pn.pn_name = vs_pop; ++- i = strlen(filename); ++- if (i > 1 && filename[i-1] == '/') ++- filename[i-1] = '\0'; ++- if (i == 0) ++- strcpy(filename, "."); ++- fp = fopen(filename, "r"); ++- if (fp == NULL) { ++- vs_push(make_simple_string(filename)); ++- FEerror("Can't open the directory ~S.", 1, vs_head); ++- } ++- setbuf(fp, iobuffer); ++- fread(&dir, sizeof(struct direct), 1, fp); ++- fread(&dir, sizeof(struct direct), 1, fp); ++- filename[DIRSIZ] = '\0'; ++- for (;;) { ++- if (fread(&dir, sizeof(struct direct), 1, fp) <=0) ++- break; ++- if (dir.d_ino == 0) ++- continue; ++- strncpy(filename, dir.d_name, DIRSIZ); ++- vs_push(make_simple_string(filename)); ++- vs_head = coerce_to_pathname(vs_head); ++- if ((name == Cnil || name == sKwild || ++- equal(name, vs_head->pn.pn_name)) && ++- (type == Cnil || type == sKwild || ++- equal(type, vs_head->pn.pn_type))) { ++- vs_head->pn.pn_directory ++- = vs_base[0]->pn.pn_directory; ++- vs_head = truename(vs_head); ++- } else ++- vs_pop; ++- } ++- fclose(fp); ++- vs_push(Cnil); ++- while (vs_top > top + 1) ++- stack_cons(); ++- vs_base = top; ++-} ++-#endif ++- ++- ++-#ifdef E15 ++-#include ++- ++-LFD(Ldirectory)() ++-{ ++- object name, type; ++- char filename[MAXPATHLEN]; ++- FILE *fp; ++- object *top = vs_top; ++- char iobuffer[BUFSIZ]; ++- struct direct dir; ++- int i; ++- ++- check_arg(1); ++- ++- check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++- vs_base[0] = coerce_to_pathname(vs_base[0]); ++- vs_push(vs_base[0]->pn.pn_name); ++- vs_push(vs_base[0]->pn.pn_type); ++- vs_base[0]->pn.pn_name = Cnil; ++- vs_base[0]->pn.pn_type = Cnil; ++- coerce_to_filename(vs_base[0], filename); ++- type = vs_base[0]->pn.pn_type = vs_pop; ++- name = vs_base[0]->pn.pn_name = vs_pop; ++- i = strlen(filename); ++- if (i > 1 && filename[i-1] == '/') ++- filename[i-1] = '\0'; ++- if (i == 0) ++- strcpy(filename, "."); ++- fp = fopen(filename, "r"); ++- if (fp == NULL) { ++- vs_push(make_simple_string(filename)); ++- FEerror("Can't open the directory ~S.", 1, vs_head); ++- } ++- setbuf(fp, iobuffer); ++- fread(&dir, sizeof(struct direct), 1, fp); ++- fread(&dir, sizeof(struct direct), 1, fp); ++- filename[DIRSIZ] = '\0'; ++- for (;;) { ++- if (fread(&dir, sizeof(struct direct), 1, fp) <=0) ++- break; ++- if (dir.d_ino == 0) ++- continue; ++- strncpy(filename, dir.d_name, DIRSIZ); ++- vs_push(make_simple_string(filename)); ++- vs_head = coerce_to_pathname(vs_head); ++- if ((name == Cnil || name == sKwild || ++- equal(name, vs_head->pn.pn_name)) && ++- (type == Cnil || type == sKwild || ++- equal(type, vs_head->pn.pn_type))) { ++- vs_head->pn.pn_directory ++- = vs_base[0]->pn.pn_directory; ++- vs_head = truename(vs_head); ++- } else ++- vs_pop; ++- } ++- fclose(fp); ++- vs_push(Cnil); ++- while (vs_top > top + 1) ++- stack_cons(); ++- vs_base = top; ++-} ++-#endif ++- ++ #include ++ #include ++ ++@@ -840,17 +432,31 @@ DEFUN_NEW("D-TYPE-LIST",object,fSd_type_ ++ } ++ #endif ++ ++-DEFUN_NEW("READDIR",object,fSreaddir,SI,2,2,NONE,OI,IO,OO,OO,(fixnum x,fixnum y),"") { +++DEFUN_NEW("READDIR",object,fSreaddir,SI,3,3,NONE,OI,IO,OO,OO,(fixnum x,fixnum y,object s),"") { ++ struct dirent *e; ++ object z; +++ long tl; +++ size_t l; ++ if (!x) RETURN1(Cnil); ++- e=readdir((DIR *)x); ++- RETURN1(e ? make_simple_string(e->d_name) : Cnil); +++ tl=telldir((DIR *)x); ++ #ifdef HAVE_D_TYPE ++ for (;(e=readdir((DIR *)x)) && y!=DT_UNKNOWN && e->d_type!=y;); ++ #endif ++ if (!e) RETURN1(Cnil); ++- z=make_simple_string(e->d_name); +++ if (s==Cnil) +++ z=make_simple_string(e->d_name); +++ else { +++ check_type_string(&s); +++ l=strlen(e->d_name); +++ if (s->st.st_dim-s->st.st_fillp>=l) { +++ memcpy(s->st.st_self+s->st.st_fillp,e->d_name,l); +++ s->st.st_fillp+=l; +++ z=s; +++ } else { +++ seekdir((DIR *)x,tl); +++ RETURN1(make_fixnum(l)); +++ } +++ } ++ #ifdef HAVE_D_TYPE ++ if (y==DT_UNKNOWN) z=MMcons(z,make_fixnum(e->d_type)); ++ #endif ++@@ -882,7 +488,126 @@ DEFUN_NEW("MKDIR",object,fSmkdir,SI,1,1, ++ ++ } ++ +++DEFUN_NEW("RMDIR",object,fSrmdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ check_type_string(&x); +++ +++ coerce_to_filename(x,FN1); +++ +++ RETURN1(rmdir(FN1) ? Cnil : Ct); +++ +++} +++ +++ +++ +++#include +++#include +++#include +++#include +++ +++DEFUN_NEW("READLINKAT",object,fSreadlinkat,SI,2,2,NONE,OI,OO,OO,OO,(fixnum d,object s),"") { +++ char *b1,*b2=NULL; +++ ssize_t l,z1,z2; +++ check_type_string(&s); +++ /* l=s->st.st_hasfillp ? s->st.st_fillp : s->st.st_dim; */ +++ z1=length(s); +++ massert((b1=alloca(z1+1))); +++ memcpy(b1,s->st.st_self,z1); +++ b1[z1]=0; +++ for (l=z2=0;l>=z2;) { +++ memset(b2,0,z2); +++ z2+=z2+10; +++ massert((b2=alloca(z2))); +++ massert((l=readlinkat(d ? dirfd((DIR *)d) : AT_FDCWD,b1,b2,z2))>=0); +++ } +++ b2[l]=0; +++ s=make_simple_string(b2); +++ memset(b1,0,z1); +++ memset(b2,0,z2); +++ RETURN1(s); +++} +++ +++DEFUN_NEW("GETCWD",object,fSgetcwd,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { +++ char *b=NULL; +++ size_t z; +++ object s; +++ +++ for (z=0;!(errno=0) && !getcwd(b,z) && errno==ERANGE;b=memset(b,0,z),z+=z+10,({massert((b=alloca(z)));})); +++ massert((b=getcwd(b,z))); +++ s=make_simple_string(b); +++ memset(b,0,z); +++ RETURN1(s); +++ +++} +++ +++DEFUN_NEW("UID-TO-NAME",object,fSuid_to_name,SI,1,1,NONE,OI,OO,OO,OO,(fixnum uid),"") { +++ struct passwd *pwent,pw; +++ char *b; +++ long r; +++ +++ massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); +++ massert(b=alloca(r)); +++ +++ massert(!getpwuid_r(uid,&pw,b,r,&pwent)); +++ +++ RETURN1(make_simple_string(pwent->pw_name)); +++ +++} +++ +++DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") { +++ +++ struct passwd *pwent,pw; +++ char *b; +++ long r; +++ +++ massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); +++ massert(b=alloca(r)); ++ +++ if (nm->st.st_fillp==1) +++ +++ if ((pw.pw_dir=getenv("HOME"))) +++ pwent=&pw; +++ else +++ massert(!getpwuid_r(getuid(),&pw,b,r,&pwent)); +++ +++ else { +++ +++ char *name; +++ +++ massert(name=alloca(nm->st.st_fillp)); +++ memcpy(name,nm->st.st_self+1,nm->st.st_fillp-1); +++ name[nm->st.st_fillp-1]=0; +++ +++ massert(!getpwnam_r(name,&pw,b,r,&pwent)); +++ +++ } +++ +++ massert((b=alloca(strlen(pwent->pw_dir)+2))); +++ memcpy(b,pwent->pw_dir,strlen(pwent->pw_dir)); +++ b[strlen(pwent->pw_dir)]='/'; +++ b[strlen(pwent->pw_dir)+1]=0; +++ RETURN1(make_simple_string(b)); +++ +++} +++ +++DEFUN_NEW("RENAME",object,fSrename,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { +++ +++ check_type_string(&x); +++ check_type_string(&y); +++ +++ coerce_to_filename(x,FN1); +++ coerce_to_filename(y,FN2); +++ +++ RETURN1(rename(FN1,FN2) ? Cnil : Ct); +++ +++} +++ +++DEFUN_NEW("UNLINK",object,fSunlink,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ +++ coerce_to_filename(x,FN1); +++ +++ RETURN1(unlink(FN1) ? Cnil : Ct); +++ +++} ++ ++ ++ static void ++@@ -900,16 +625,8 @@ FFN(siLchdir)(void) ++ } ++ ++ void ++-gcl_init_unixfsys(void) ++-{ ++- make_function("TRUENAME", Ltruename); ++- make_function("RENAME-FILE", Lrename_file); ++- make_function("DELETE-FILE", Ldelete_file); ++- make_function("PROBE-FILE", Lprobe_file); ++- make_function("FILE-WRITE-DATE", Lfile_write_date); ++- make_function("FILE-AUTHOR", Lfile_author); ++- make_function("USER-HOMEDIR-PATHNAME", Luser_homedir_pathname); ++- make_function("DIRECTORY", Ldirectory); +++gcl_init_unixfsys(void) { +++ +++ make_si_function("CHDIR", siLchdir); ++ ++- make_si_function("CHDIR", siLchdir); ++ } ++--- gcl-2.6.12.orig/o/usig.c +++++ gcl-2.6.12/o/usig.c ++@@ -148,13 +148,15 @@ DEFUN_NEW("FLD",object,fSfld,SI,1,1,NONE ++ ++ #endif ++ ++-DEFUN_NEW("*FIXNUM",fixnum,fSAfixnum,SI,1,1,NONE,II,OO,OO,OO,(fixnum addr),"") { ++- RETURN1(*(fixnum *)addr); +++/* For now ignore last three args governing offsets and data modification, just to +++ support fpe sync with master*/ +++DEFUN_NEW("*FIXNUM",object,fSAfixnum,SI,4,4,NONE,OI,OO,OO,OO,(fixnum addr,object x,object y,object z),"") { +++ RETURN1((object)*(fixnum *)addr); ++ } ++-DEFUN_NEW("*FLOAT",object,fSAfloat,SI,1,1,NONE,OI,OO,OO,OO,(fixnum addr),"") { +++DEFUN_NEW("*FLOAT",object,fSAfloat,SI,4,4,NONE,OI,OO,OO,OO,(fixnum addr,object x,object y,object z),"") { ++ RETURN1(make_shortfloat(*(float *)addr)); ++ } ++-DEFUN_NEW("*DOUBLE",object,fSAdouble,SI,1,1,NONE,OI,OO,OO,OO,(fixnum addr),"") { +++DEFUN_NEW("*DOUBLE",object,fSAdouble,SI,4,4,NONE,OI,OO,OO,OO,(fixnum addr,object x,object y,object z),"") { ++ RETURN1(make_longfloat(*(double *)addr)); ++ } ++ ++@@ -264,7 +266,6 @@ sigpipe(void) ++ FEerror("Broken pipe", 0); ++ } ++ ++- ++ void ++ sigint(void) ++ { ++@@ -272,8 +273,6 @@ sigint(void) ++ terminal_interrupt(1); ++ } ++ ++- ++- ++ static void ++ sigalrm(void) ++ { ++--- gcl-2.6.12.orig/unixport/sys_ansi_gcl.c +++++ gcl-2.6.12/unixport/sys_ansi_gcl.c ++@@ -41,7 +41,6 @@ gcl_init_system(object no_init) ++ #ifdef HAVE_JAPI_H ++ ar_check_init(gcl_japi,no_init); ++ #endif ++- ar_check_init(gcl_iolib,no_init); ++ ar_check_init(gcl_listlib,no_init); ++ ar_check_init(gcl_mislib,no_init); ++ ar_check_init(gcl_numlib,no_init); ++@@ -56,9 +55,23 @@ gcl_init_system(object no_init) ++ ar_check_init(gcl_defpackage,no_init); ++ ar_check_init(gcl_make_defpackage,no_init); ++ ar_check_init(gcl_sharp,no_init); ++- ar_check_init(gcl_fpe,no_init); ++ +++ ar_check_init(gcl_sharp_uv,no_init); +++ ar_check_init(gcl_namestring,no_init); +++ ar_check_init(gcl_logical_pathname_translations,no_init); +++ ar_check_init(gcl_make_pathname,no_init); +++ ar_check_init(gcl_parse_namestring,no_init); +++ ar_check_init(gcl_translate_pathname,no_init); +++ ar_check_init(gcl_directory,no_init); +++ ar_check_init(gcl_merge_pathnames,no_init); +++ ar_check_init(gcl_truename,no_init); +++ ar_check_init(gcl_rename_file,no_init); +++ ar_check_init(gcl_wild_pathname_p,no_init); +++ ar_check_init(gcl_pathname_match_p,no_init); ++ +++ ar_check_init(gcl_iolib,no_init); +++ ar_check_init(gcl_fpe,no_init); +++ ++ ar_check_init(gcl_cmpinline,no_init); ++ ar_check_init(gcl_cmputil,no_init); ++ ++@@ -107,6 +120,7 @@ gcl_init_system(object no_init) ++ ar_check_init(gcl_index,no_init); ++ #endif ++ +++ lsp_init("../pcl/package.lisp"); ++ ar_check_init(gcl_pcl_pkg,no_init); ++ ar_check_init(gcl_pcl_walk,no_init); ++ ar_check_init(gcl_pcl_iterate,no_init); ++@@ -142,6 +156,7 @@ gcl_init_system(object no_init) ++ ar_check_init(gcl_pcl_precom1,no_init); ++ ar_check_init(gcl_pcl_precom2,no_init); ++ +++ lsp_init("../clcs/package.lisp"); ++ ar_check_init(gcl_clcs_precom,no_init); ++ ar_check_init(gcl_clcs_handler,no_init); ++ ar_check_init(gcl_clcs_conditions,no_init); ++--- gcl-2.6.12.orig/unixport/sys_gcl.c +++++ gcl-2.6.12/unixport/sys_gcl.c ++@@ -34,7 +34,6 @@ gcl_init_system(object no_init) { ++ #ifdef HAVE_JAPI_H ++ ar_check_init(gcl_japi,no_init); ++ #endif ++- ar_check_init(gcl_iolib,no_init); ++ ar_check_init(gcl_listlib,no_init); ++ ar_check_init(gcl_mislib,no_init); ++ ar_check_init(gcl_numlib,no_init); ++@@ -49,9 +48,23 @@ gcl_init_system(object no_init) { ++ ar_check_init(gcl_defpackage,no_init); ++ ar_check_init(gcl_make_defpackage,no_init); ++ ar_check_init(gcl_sharp,no_init); ++- ar_check_init(gcl_fpe,no_init); ++ +++ ar_check_init(gcl_sharp_uv,no_init); +++ ar_check_init(gcl_namestring,no_init); +++ ar_check_init(gcl_logical_pathname_translations,no_init); +++ ar_check_init(gcl_make_pathname,no_init); +++ ar_check_init(gcl_parse_namestring,no_init); +++ ar_check_init(gcl_translate_pathname,no_init); +++ ar_check_init(gcl_directory,no_init); +++ ar_check_init(gcl_merge_pathnames,no_init); +++ ar_check_init(gcl_truename,no_init); +++ ar_check_init(gcl_rename_file,no_init); +++ ar_check_init(gcl_wild_pathname_p,no_init); +++ ar_check_init(gcl_pathname_match_p,no_init); ++ +++ ar_check_init(gcl_iolib,no_init); +++ ar_check_init(gcl_fpe,no_init); +++ ++ ar_check_init(gcl_cmpinline,no_init); ++ ar_check_init(gcl_cmputil,no_init); ++ ++--- gcl-2.6.12.orig/unixport/sys_init.lsp.in +++++ gcl-2.6.12/unixport/sys_init.lsp.in ++@@ -9,9 +9,6 @@ ++ (in-package :system) ++ (use-package :fpe) ++ ++-#+(or pcl ansi-cl)(load "../pcl/package.lisp") ++-#+ansi-cl(load "../clcs/package.lisp") ++- ++ (init-system) ++ (in-package :si) ++ (gbc t) ++@@ -20,7 +17,7 @@ ++ (setq *link-array* (make-array (ash 1 11) :element-type 'character :fill-pointer 0))) ++ (use-fast-links t) ++ ++-(let* ((x (append (pathname-directory *system-directory*) (list :parent))) +++(let* ((x (append (pathname-directory *system-directory*) (list :back))) ++ (lsp (append x (list "lsp"))) ++ (cmpnew (append x (list "cmpnew"))) ++ (h (append x (list "h"))) ++@@ -59,6 +56,7 @@ ++ ++ (fmakunbound 'init-cmp-anon) ++ (when (fboundp 'user-init) (user-init)) +++ ++ (in-package :compiler) ++ (setq *cc* @LI-CC@ ++ *ld* @LI-LD@ ++@@ -79,7 +77,9 @@ ++ #-ansi-cl(do-symbols (s :cltl1-compat) (export s :lisp))) ++ ++ #+ansi-cl (use-package :pcl :user) ++-#+ansi-cl (import 'si::(clines defentry defcfun object void int double quit bye gbc system) :user) +++ +++(import 'si::(clines defentry defcfun object void int double quit bye gbc system +++ *lib-directory* *system-directory*) :user) ++ ++ (let* ((i 4096)(j (si::equal-tail-recursion-check i))) ++ (unless (<= (ash i -1) j) ++--- gcl-2.6.12.orig/unixport/sys_pcl_gcl.c +++++ gcl-2.6.12/unixport/sys_pcl_gcl.c ++@@ -41,7 +41,6 @@ gcl_init_system(object no_init) ++ #ifdef HAVE_JAPI_H ++ ar_check_init(gcl_japi,no_init); ++ #endif ++- ar_check_init(gcl_iolib,no_init); ++ ar_check_init(gcl_listlib,no_init); ++ ar_check_init(gcl_mislib,no_init); ++ ar_check_init(gcl_numlib,no_init); ++@@ -56,9 +55,23 @@ gcl_init_system(object no_init) ++ ar_check_init(gcl_defpackage,no_init); ++ ar_check_init(gcl_make_defpackage,no_init); ++ ar_check_init(gcl_sharp,no_init); ++- ar_check_init(gcl_fpe,no_init); ++ +++ ar_check_init(gcl_sharp_uv,no_init); +++ ar_check_init(gcl_namestring,no_init); +++ ar_check_init(gcl_logical_pathname_translations,no_init); +++ ar_check_init(gcl_make_pathname,no_init); +++ ar_check_init(gcl_parse_namestring,no_init); +++ ar_check_init(gcl_translate_pathname,no_init); +++ ar_check_init(gcl_directory,no_init); +++ ar_check_init(gcl_merge_pathnames,no_init); +++ ar_check_init(gcl_truename,no_init); +++ ar_check_init(gcl_rename_file,no_init); +++ ar_check_init(gcl_wild_pathname_p,no_init); +++ ar_check_init(gcl_pathname_match_p,no_init); ++ +++ ar_check_init(gcl_iolib,no_init); +++ ar_check_init(gcl_fpe,no_init); +++ ++ ar_check_init(gcl_cmpinline,no_init); ++ ar_check_init(gcl_cmputil,no_init); ++ ++@@ -107,6 +120,7 @@ gcl_init_system(object no_init) ++ ar_check_init(gcl_index,no_init); ++ #endif ++ +++ lsp_init("../pcl/package.lisp"); ++ ar_check_init(gcl_pcl_pkg,no_init); ++ ar_check_init(gcl_pcl_walk,no_init); ++ ar_check_init(gcl_pcl_iterate,no_init); ++--- gcl-2.6.12.orig/unixport/sys_pre_gcl.c +++++ gcl-2.6.12/unixport/sys_pre_gcl.c ++@@ -39,7 +39,6 @@ gcl_init_system(object no_init) ++ #ifdef HAVE_JAPI_H ++ lsp_init("../lsp/gcl_japi.lsp"); ++ #endif ++- lsp_init("../lsp/gcl_iolib.lsp"); ++ /* lsp_init("../lsp/gcl_listlib.lsp"); */ ++ lsp_init("../lsp/gcl_mislib.lsp"); ++ lsp_init("../lsp/gcl_numlib.lsp"); ++@@ -54,6 +53,21 @@ gcl_init_system(object no_init) ++ lsp_init("../lsp/gcl_defpackage.lsp"); ++ lsp_init("../lsp/gcl_make_defpackage.lsp"); ++ lsp_init("../lsp/gcl_sharp.lsp"); +++ +++ lsp_init("../lsp/gcl_sharp_uv.lsp"); +++ lsp_init("../lsp/gcl_logical_pathname_translations.lsp"); +++ lsp_init("../lsp/gcl_make_pathname.lsp"); +++ lsp_init("../lsp/gcl_parse_namestring.lsp"); +++ lsp_init("../lsp/gcl_namestring.lsp"); +++ lsp_init("../lsp/gcl_translate_pathname.lsp"); +++ lsp_init("../lsp/gcl_directory.lsp"); +++ lsp_init("../lsp/gcl_merge_pathnames.lsp"); +++ lsp_init("../lsp/gcl_truename.lsp"); +++ lsp_init("../lsp/gcl_rename_file.lsp"); +++ lsp_init("../lsp/gcl_wild_pathname_p.lsp"); +++ lsp_init("../lsp/gcl_pathname_match_p.lsp"); +++ +++ lsp_init("../lsp/gcl_iolib.lsp"); ++ lsp_init("../lsp/gcl_fpe.lsp"); ++ ++ lsp_init("../cmpnew/gcl_cmpinline.lsp"); ++--- gcl-2.6.12.orig/xbin/make-fn +++++ gcl-2.6.12/xbin/make-fn ++@@ -6,10 +6,13 @@ TMP=/tmp/tmpd$$ ++ mkdir ${TMP} ++ cp $@ ${TMP} ++ ++-for v in $@ ; +++for v in $1 ; ++ do ++ echo '(load (format nil "~a~a" si::*system-directory* "../cmpnew/gcl_collectfn"))' \ ++ '(compiler::emit-fn t)'\ +++ "(compile-file \"${TMP}/$v\" :o-file nil)" +++echo '(load (format nil "~a~a" si::*system-directory* "../cmpnew/gcl_collectfn"))' \ +++ '(compiler::emit-fn t)'\ ++ "(compile-file \"${TMP}/$v\" :o-file nil)" | ${LISP} ++ done ++ diff --cc debian/patches/pathnames1.11 index 00000000,00000000..71bab921 new file mode 100644 --- /dev/null +++ b/debian/patches/pathnames1.11 @@@ -1,0 -1,0 +1,246 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-45) unstable; urgency=high ++ . ++ * pathnames1.11 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2016-10-31 ++ ++--- gcl-2.6.12.orig/cmpnew/gcl_lfun_list.lsp +++++ gcl-2.6.12/cmpnew/gcl_lfun_list.lsp ++@@ -144,7 +144,7 @@ ++ (DEFSYSFUN 'SVREF "Lsvref" '(T T) 'T NIL NIL) ++ (DEFSYSFUN 'APPLY "Lapply" '(T T *) 'T NIL NIL) ++ (DEFSYSFUN 'DECODE-FLOAT "Ldecode_float" '(T) '(VALUES T T T) NIL NIL) ++-(DEFSYSFUN 'SUBST-IF-NOT "Lsubst_if_not" '(T T T *) 'T NIL NIL) +++;(DEFSYSFUN 'SUBST-IF-NOT "Lsubst_if_not" '(T T T *) 'T NIL NIL) ++ (DEFSYSFUN 'RPLACA "Lrplaca" '(T T) 'T NIL NIL) ++ (DEFSYSFUN 'SYMBOL-PLIST "Lsymbol_plist" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'WRITE-STRING "Lwrite_string" '(T *) 'T NIL NIL) ++@@ -210,7 +210,7 @@ ++ (DEFSYSFUN 'NSUBLIS "Lnsublis" '(T T *) 'T NIL NIL) ++ (DEFSYSFUN 'CHAR-NOT-EQUAL "Lchar_not_equal" '(T *) 'T NIL T) ++ (DEFSYSFUN 'MACRO-FUNCTION "Lmacro_function" '(T) 'T NIL NIL) ++-(DEFSYSFUN 'SUBST-IF "Lsubst_if" '(T T T *) 'T NIL NIL) +++;(DEFSYSFUN 'SUBST-IF "Lsubst_if" '(T T T *) 'T NIL NIL) ++ (DEFSYSFUN 'COMPLEXP "Lcomplexp" '(T) 'T NIL T) ++ (DEFSYSFUN 'READ-LINE "Lread_line" '(*) '(VALUES T T) NIL NIL) ++ (DEFSYSFUN 'MAX "Lmax" '(T *) 'T NIL NIL) ++@@ -232,7 +232,7 @@ ++ (DEFSYSFUN 'FLOAT "Lfloat" '(T *) 'T NIL NIL) ++ ;(DEFSYSFUN 'FIRST "Lcar" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'ROUND "Lround" '(T *) '(VALUES T T) NIL NIL) ++-(DEFSYSFUN 'SUBST "Lsubst" '(T T T *) 'T NIL NIL) +++;(DEFSYSFUN 'SUBST "Lsubst" '(T T T *) 'T NIL NIL) ++ (DEFSYSFUN 'UPPER-CASE-P "Lupper_case_p" '(T) 'T NIL T) ++ (DEFSYSFUN 'ARRAY-ELEMENT-TYPE "Larray_element_type" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'ADJOIN "Ladjoin" '(T T *) 'T NIL NIL) ++--- gcl-2.6.12.orig/lsp/gcl_arraylib.lsp +++++ gcl-2.6.12/lsp/gcl_arraylib.lsp ++@@ -262,8 +262,6 @@ ++ (static (staticp array)) ++ &aux (fill-pointer (or fill-pointer (when (array-has-fill-pointer-p array) (fill-pointer array))))) ++ ++- (declare (ignore element-type)) ++- ++ (let ((x (if initial-contents-supplied-p ++ (make-array new-dimensions ++ :adjustable t ++--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp +++++ gcl-2.6.12/lsp/gcl_iolib.lsp ++@@ -80,7 +80,7 @@ ++ 0 l))) ++ ++ (defun get-string-input-stream-index (stream &aux (s (c-stream-object0 stream))) ++- (+ (fill-pointer s) (multiple-value-bind (a b) (array-displacement s) b))) +++ (+ (fill-pointer s) (multiple-value-bind (a b) (array-displacement s) (declare (ignore a)) b))) ++ ++ (defmacro with-input-from-string ((var string &key index (start 0) end) . body) ++ (declare (optimize (safety 1))) ++@@ -457,10 +457,10 @@ ++ if-exists iesp if-does-not-exist idnesp external-format))) ++ (when (typep s 'stream) (c-set-stream-object1 s pf) s))) ++ ++-(defun load-pathname-exists (z) ++- (or (probe-file z) ++- (when *allow-gzipped-file* ++- (when (probe-file (string-concatenate (namestring z) ".gz")) +++(defun load-pathname-exists (z &aux (z (link-expand (namestring z)))) +++ (cond ((eq (stat z) :file) z) +++ (*allow-gzipped-file* +++ (when (eq (stat (string-concatenate (namestring z) ".gz")) :file) ++ z)))) ++ ++ (defun load-pathname (p print if-does-not-exist external-format ++--- gcl-2.6.12.orig/lsp/gcl_listlib.lsp +++++ gcl-2.6.12/lsp/gcl_listlib.lsp ++@@ -180,3 +180,34 @@ ++ (defmacro nth-value (n expr) ++ (declare (optimize (safety 1))) ++ `(nth ,n (multiple-value-list ,expr))) +++ +++(eval-when (compile eval) +++ +++ (defmacro repl-if (tc) `(labels ((l (tr &aux (k (if kf (funcall kf tr) tr))) +++ (cond (,tc n) +++ ((atom tr) tr) +++ ((let* ((ca (car tr))(a (l ca))(cd (cdr tr))(d (l cd))) +++ (if (and (eq a ca) (eq d cd)) tr (cons a d))))))) +++ (declare (ftype (function (t) t) l)) +++ (l tr)))) +++ +++(defun subst (n o tr &key key test test-not +++ &aux (kf (when key (coerce key 'function))) +++ (tf (when test (coerce test 'function))) +++ (ntf (when test-not (coerce test-not 'function)))) +++ (declare (optimize (safety 1))) +++ (check-type key (or null function)) +++ (check-type test (or null function)) +++ (check-type test-not (or null function)) +++ (repl-if (cond (tf (funcall tf o k))(ntf (not (funcall ntf o k)))((eql o k))))) +++ +++(defun subst-if (n p tr &key key &aux (kf (when key (coerce key 'function)))) +++ (declare (optimize (safety 1))) +++ (check-type p function) +++ (check-type key (or null function)) +++ (repl-if (funcall p k))) +++(defun subst-if-not (n p tr &key key &aux (kf (when key (coerce key 'function)))) +++ (declare (optimize (safety 1))) +++ (check-type p function) +++ (check-type key (or null function)) +++ (repl-if (not (funcall p k))))) ++--- gcl-2.6.12.orig/lsp/gcl_truename.lsp +++++ gcl-2.6.12/lsp/gcl_truename.lsp ++@@ -23,7 +23,8 @@ ++ (check-type pd pathname-designator) ++ (when (wild-pathname-p ns) ++ (error 'file-error :pathname pd :format-control "Pathname is wild")) ++- (let* ((ns (ensure-dir-string (link-expand ns)))(ppd (pathname ns))) +++ (let* ((ns (ensure-dir-string (link-expand ns))) +++ (ppd (if (eq (namestring pd) ns) pd (pathname ns)))) ++ (unless (or (zerop (length ns)) (stat ns)) ++ (error 'file-error :pathname ns :format-control "Pathname does not exist")) ++ (let* ((d (pathname-directory ppd)) ++--- gcl-2.6.12.orig/o/list.d +++++ gcl-2.6.12/o/list.d ++@@ -528,26 +528,26 @@ object x; ++ vs_check_push(x); ++ } ++ ++-/* ++- Subst(new, tree) pushes ++- the result of substituting new in tree ++- onto vs. ++-*/ ++-static void ++-subst(new, tree) ++-object new, tree; ++-{ ++- cs_check(new); ++- ++- if (TEST(tree)) ++- vs_check_push(new); ++- else if (type_of(tree) == t_cons) { ++- subst(new, tree->c.c_car); ++- subst(new, tree->c.c_cdr); ++- stack_cons(); ++- } else ++- vs_check_push(tree); ++-} +++/* /\* */ +++/* Subst(new, tree) pushes */ +++/* the result of substituting new in tree */ +++/* onto vs. */ +++/* *\/ */ +++/* static void */ +++/* subst(new, tree) */ +++/* object new, tree; */ +++/* { */ +++/* cs_check(new); */ +++ +++/* if (TEST(tree)) */ +++/* vs_check_push(new); */ +++/* else if (type_of(tree) == t_cons) { */ +++/* subst(new, tree->c.c_car); */ +++/* subst(new, tree->c.c_cdr); */ +++/* stack_cons(); */ +++/* } else */ +++/* vs_check_push(tree); */ +++/* } */ ++ ++ /* static object */ ++ /* subst1(object new, object tree) { */ ++@@ -1153,25 +1153,25 @@ LFD(Lrplacd)() ++ vs_popp; ++ } ++ ++-@(defun subst (new old tree &key test test_not key) ++- saveTEST; ++-@ ++- protectTEST; ++- setupTEST(old, test, test_not, key); ++- subst(new, tree); ++- tree = vs_pop; ++- /* if (kf==identity && */ ++- /* tf==test_eql && */ ++- /* (is_imm_fixnum(item_compared) || */ ++- /* ({enum type tp=type_of(item_compared);tp>t_complex || tpt_complex || tp ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-46) unstable; urgency=high ++ . ++ * pathnames1.12 ++ * Bug fix: "maintainer script(s) do not start on #!", thanks to ++ treinen@debian.org; (Closes: #843303). ++Author: Camm Maguire ++Bug-Debian: https://bugs.debian.org/843303 ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2016-11-18 ++ ++--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp +++++ gcl-2.6.12/lsp/gcl_iolib.lsp ++@@ -457,11 +457,10 @@ ++ if-exists iesp if-does-not-exist idnesp external-format))) ++ (when (typep s 'stream) (c-set-stream-object1 s pf) s))) ++ ++-(defun load-pathname-exists (z &aux (z (link-expand (namestring z)))) ++- (cond ((eq (stat z) :file) z) ++- (*allow-gzipped-file* ++- (when (eq (stat (string-concatenate (namestring z) ".gz")) :file) ++- z)))) +++(defun load-pathname-exists (z) +++ (or (probe-file z) +++ (when *allow-gzipped-file* +++ (probe-file (string-concatenate (namestring z) ".gz"))))) ++ ++ (defun load-pathname (p print if-does-not-exist external-format ++ &aux (pp (merge-pathnames p)) ++--- gcl-2.6.12.orig/lsp/gcl_listlib.lsp +++++ gcl-2.6.12/lsp/gcl_listlib.lsp ++@@ -123,8 +123,8 @@ ++ ++ (defun smallnthcdr (n x) ++ (declare (fixnum n)) ++- (cond ((atom x) (when x (tp-error x proper-list))) ++- ((= n 0) x) +++ (cond ((= n 0) x) +++ ((atom x) (when x (tp-error x proper-list))) ++ ((smallnthcdr (1- n) (cdr x))))) ++ ++ (defun bignthcdr (n i s f) ++--- gcl-2.6.12.orig/lsp/gcl_truename.lsp +++++ gcl-2.6.12/lsp/gcl_truename.lsp ++@@ -38,5 +38,5 @@ ++ (check-type pd pathname-designator) ++ (when (wild-pathname-p pn) ++ (error 'file-error :pathname pn :format-control "Pathname is wild")) ++- (when (eq (stat (namestring pn)) :file) +++ (when (eq (stat (link-expand (namestring pn))) :file) ++ (truename pn))) diff --cc debian/patches/pathnames1.13 index 00000000,00000000..57073da4 new file mode 100644 --- /dev/null +++ b/debian/patches/pathnames1.13 @@@ -1,0 -1,0 +1,40 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-46) unstable; urgency=high ++ . ++ * pathnames1.12 ++ * Bug fix: "maintainer script(s) do not start on #!", thanks to ++ treinen@debian.org; (Closes: #843303). ++Author: Camm Maguire ++Bug-Debian: https://bugs.debian.org/843303 ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2016-11-22 ++ ++--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp +++++ gcl-2.6.12/lsp/gcl_iolib.lsp ++@@ -460,7 +460,8 @@ ++ (defun load-pathname-exists (z) ++ (or (probe-file z) ++ (when *allow-gzipped-file* ++- (probe-file (string-concatenate (namestring z) ".gz"))))) +++ (when (probe-file (string-concatenate (namestring z) ".gz")) +++ z)))) ++ ++ (defun load-pathname (p print if-does-not-exist external-format ++ &aux (pp (merge-pathnames p)) diff --cc debian/patches/pathnames1.2 index 00000000,00000000..f7bb1114 new file mode 100644 --- /dev/null +++ b/debian/patches/pathnames1.2 @@@ -1,0 -1,0 +1,1196 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-39) unstable; urgency=medium ++ . ++ * pathnames1.1 ++ * ansi-test clean target ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2016-10-12 ++ ++--- gcl-2.6.12.orig/h/notcomp.h +++++ gcl-2.6.12/h/notcomp.h ++@@ -296,6 +296,8 @@ gcl_init_cmp_anon(void); ++ ++ char FN1[PATH_MAX],FN2[PATH_MAX],FN3[PATH_MAX],FN4[PATH_MAX],FN5[PATH_MAX]; ++ +++#define coerce_to_filename(a_,b_) coerce_to_filename1(a_,b_,sizeof(b_)) +++ ++ #include ++ #define massert(a_) ({errno=0;if (!(a_)||errno) assert_error(#a_,__LINE__,__FILE__,__FUNCTION__);}) ++ ++--- gcl-2.6.12.orig/h/protoize.h +++++ gcl-2.6.12/h/protoize.h ++@@ -508,7 +508,7 @@ typedef void (*funcvoid)(void); ++ /* unexlin.c:808:OF */ extern int write_segment (int new, register char *ptr, register char *end); /* (new, ptr, end) int new; register char *ptr; register char *end; */ ++ /* unixfasl.c:409:OF */ extern void gcl_init_unixfasl (void); /* () */ ++ /* unixfsys.c:145:OF */ extern char *getwd (char *buffer); /* (buffer) char *buffer; */ ++-/* unixfsys.c:209:OF */ extern void coerce_to_filename (object pathname, char *p); /* (pathname, p) object pathname; char *p; */ +++/* unixfsys.c:209:OF */ extern void coerce_to_filename1 (object pathname, char *p,unsigned sz); /* (pathname, p) object pathname; char *p; */ ++ /* unixfsys.c:329:OF */ extern bool file_exists (object file); /* (file) object file; */ ++ /* unixfsys.c:359:OF */ extern FILE *backup_fopen (char *filename, char *option); /* (filename, option) char *filename; char *option; */ ++ /* unixfsys.c:359:OF */ extern FILE *fopen_not_dir (char *filename, char *option); /* (filename, option) char *filename; char *option; */ ++--- gcl-2.6.12.orig/lsp/gcl_directory.lsp +++++ gcl-2.6.12/lsp/gcl_directory.lsp ++@@ -48,8 +48,12 @@ ++ (expand-wild-directory (cons :relative (cdr x)) f q e)) :directory));FIXME ++ ((funcall f z y)))))) ++ +++(defun chdir (s) +++ (when (chdir1 (namestring (pathname s)));to expand ~/ +++ (setq *current-directory* (current-directory-pathname)))) +++ ++ (defun directory (p &key &aux (p (translate-logical-pathname p))(d (pathname-directory p)) ++- (c (unless (eq (car d) :absolute) (make-frame (concatenate 'string (getcwd) "/")))) +++ (c (unless (eq (car d) :absolute) (make-frame (namestring *current-directory*)))) ++ (lc (when c (length c))) ++ (filesp (or (pathname-name p) (pathname-type p))) ++ (v (compile-regexp (to-regexp p)))(*up-key* :back) r) ++--- gcl-2.6.12.orig/lsp/gcl_rename_file.lsp +++++ gcl-2.6.12/lsp/gcl_rename_file.lsp ++@@ -35,6 +35,7 @@ ++ (check-type spec pathname-designator) ++ (multiple-value-bind ++ (tp sz tm) (stat (namestring (truename spec))) +++ (declare (ignore tp sz)) ++ (+ tm (* (+ 17 (* 70 365)) (* 24 60 60))))) ++ ++ ++@@ -43,5 +44,6 @@ ++ (check-type spec pathname-designator) ++ (multiple-value-bind ++ (tp sz tm uid) (stat (namestring (truename spec))) +++ (declare (ignore tp sz tm)) ++ (uid-to-name uid))) ++ ++--- gcl-2.6.12.orig/lsp/gcl_top.lsp +++++ gcl-2.6.12/lsp/gcl_top.lsp ++@@ -607,8 +607,13 @@ First directory is checked for first nam ++ (defvar *ld* "ld") ++ (defvar *objdump* "objdump --source ") ++ +++(defvar *current-directory* *system-directory*) +++ +++(defun current-directory-pathname nil (pathname (concatenate 'string (getcwd) "/"))) +++ ++ (defun set-up-top-level (&aux (i (argc)) tem) ++ (declare (fixnum i)) +++ (setq *current-directory* (current-directory-pathname)) ++ (setq *tmp-dir* (get-temp-dir) ++ *cc* (get-path *cc*) ++ *ld* (get-path *ld*) ++--- gcl-2.6.12.orig/lsp/gcl_truename.lsp +++++ gcl-2.6.12/lsp/gcl_truename.lsp ++@@ -18,20 +18,18 @@ ++ (pathname (typep x 'logical-pathname)) ++ (stream (logical-pathname-designator-p (pathname x))))) ++ ++-;(defvar *current-dir* (pathname (concatenate 'string (getcwd) "/"))) FIXME sync with chdir ++- ++-(defun truename (pd &aux (ppd (translate-logical-pathname pd))(ns (namestring ppd))) +++(defun truename (pd &aux (ns (namestring (translate-logical-pathname pd)))) ++ (declare (optimize (safety 1))) ++ (check-type pd pathname-designator) ++ (when (wild-pathname-p ns) ++ (error 'file-error :pathname pd :format-control "Pathname is wild")) ++- (let* ((ns (ensure-dir-string (link-expand ns)))) +++ (let* ((ns (ensure-dir-string (link-expand ns)))(ppd (pathname ns))) ++ (unless (or (zerop (length ns)) (stat ns)) ++ (error 'file-error :pathname ns :format-control "Pathname does not exist")) ++ (let* ((d (pathname-directory ppd)) ++ (d1 (subst :back :up d)) ++ (ppd (if (eq d d1) ppd (make-pathname :directory d1 :defaults ppd)))) ++- (if (eq (car d) :absolute) ppd (merge-pathnames ppd (concatenate 'string (getcwd) "/") nil))))) +++ (if (eq (car d) :absolute) ppd (merge-pathnames ppd *current-directory* nil))))) ++ ++ ++ (defun probe-file (pd &aux (pn (translate-logical-pathname pd))) ++--- gcl-2.6.12.orig/o/file.d +++++ gcl-2.6.12/o/file.d ++@@ -351,120 +351,86 @@ open_stream(object fn,enum smmode smm, o ++ vs_mark; ++ ++ coerce_to_filename(fn,FN1); ++- if (smm == smm_input || smm == smm_probe) { ++- if(FN1[0]=='|') ++- fp = popen(FN1+1,"r"); ++- else ++- fp = fopen_not_dir(FN1, "r"); ++ ++- if ((fp == NULL) && ++- (sSAallow_gzipped_fileA->s.s_dbind != sLnil)) { ++- union lispunion st; ++- char buf[256]; ++- if (snprintf(buf,sizeof(buf),"%s.gz",FN1)<=0) ++- FEerror("Cannot write .gz filename",0); ++- st.st.st_self=buf; ++- st.st.st_dim=st.st.st_fillp=strlen(buf); ++- set_type_of(&st,t_string); ++- if (fSstat((object)&st)!=Cnil) { +++ switch(smm) { +++ +++ case smm_input: +++ case smm_probe: +++ +++ if (!(fp=*FN1=='|' ? popen(FN1+1,"r") : fopen_not_dir(FN1,"r")) && sSAallow_gzipped_fileA->s.s_dbind!=Cnil) { +++ +++ struct stat ss; +++ massert(snprintf(FN2,sizeof(FN2),"%s.gz",FN1)>0); +++ +++ if (!stat(FN2,&ss)) { +++ ++ FILE *pp; ++ int n; ++- if (!(fp=tmpfile())) ++- FEerror("Cannot create temporary file",0); ++- if (snprintf(buf,sizeof(buf),"zcat %s.gz",FN1)<=0) ++- FEerror("Cannot write zcat pipe name",0); ++- if (!(pp=popen(buf,"r"))) ++- FEerror("Cannot open zcat pipe",0); ++- while((n=fread(buf,1,sizeof(buf),pp))) ++- if (!fwrite(buf,1,n,fp)) ++- FEerror("Cannot write pipe output to temporary file",0); ++- if (pclose(pp)<0) ++- FEerror("Cannot close zcat pipe",0); ++- if (fseek(fp,0,SEEK_SET)) ++- FEerror("Cannot rewind temporary file\n",0); +++ +++ massert((fp=tmpfile())); +++ massert(snprintf(FN3,sizeof(FN2),"zcat %s",FN2)>0); +++ massert(pp=popen(FN3,"r")); +++ while ((n=fread(FN4,1,sizeof(FN3),pp))) +++ massert(fwrite(FN4,1,n,fp)==n); +++ massert(pclose(pp)>=0); +++ massert(!fseek(fp,0,SEEK_SET)); +++ ++ } +++ ++ } ++- if (fp == NULL) { ++- if (if_does_not_exist == sKerror) ++- cannot_open(fn); ++- else if (if_does_not_exist == sKcreate) { ++- fp = fopen_not_dir(FN1, "w"); ++- if (fp == NULL) ++- cannot_create(fn); +++ +++ if (!fp) { +++ +++ if (if_does_not_exist==sKerror) cannot_open(fn); +++ else if (if_does_not_exist==sKcreate) { +++ if (!(fp=fopen_not_dir(FN1,"w"))) cannot_create(fn); ++ fclose(fp); ++- fp = fopen_not_dir(FN1, "r"); ++- if (fp == NULL) ++- cannot_open(fn); ++- } else if (if_does_not_exist == Cnil) ++- return(Cnil); ++- else ++- FEerror("~S is an illegal IF-DOES-NOT-EXIST option.", ++- 1, if_does_not_exist); +++ if (!(fp=fopen_not_dir(FN1,"r"))) cannot_open(fn); +++ } else if (if_does_not_exist==Cnil) return(Cnil); +++ else FEerror("~S is an illegal IF-DOES-NOT-EXIST option.",1,if_does_not_exist); +++ ++ } ++- } else if (smm == smm_output || smm == smm_io) { ++- if (FN1[0] == '|') ++- fp = NULL; ++- else ++- fp = fopen_not_dir(FN1, "r"); ++- if (fp != NULL) { +++ break; +++ +++ case smm_output: +++ case smm_io: +++ +++ if ((fp=*FN1=='|' ? NULL : fopen_not_dir(FN1,"r"))) { +++ ++ fclose(fp); ++- if (if_exists == sKerror) ++- FILE_ERROR(fn,"File exists"); ++- else if (if_exists == sKrename) { +++ if (if_exists==sKerror) FILE_ERROR(fn,"File exists"); +++ else if (if_exists==sKrename) { ++ massert(snprintf(FN2,sizeof(FN2),"%s.BAK",FN1)>=0); ++ massert(!rename(FN1,FN2)); ++- if (smm == smm_output) ++- fp = fopen(FN1, "w"); ++- else ++- fp = fopen(FN1, "w+"); ++- if (fp == NULL) ++- cannot_create(fn); ++- } else if (if_exists == sKrename_and_delete || ++- if_exists == sKnew_version || ++- if_exists == sKsupersede) { ++- if (smm == smm_output) ++- fp = fopen_not_dir(FN1, "w"); ++- else ++- fp = fopen_not_dir(FN1, "w+"); ++- if (fp == NULL) ++- cannot_create(fn); ++- } else if (if_exists == sKoverwrite) { ++- fp = fopen_not_dir(FN1, "r+"); ++- if (fp == NULL) ++- cannot_open(fn); ++- } else if (if_exists == sKappend) { ++- if (smm == smm_output) ++- fp = fopen_not_dir(FN1, "a"); ++- else ++- fp = fopen_not_dir(FN1, "a+"); ++- if (fp == NULL) +++ if (!(fp=fopen(FN1,smm==smm_output ? "w" : "w+"))) cannot_create(fn); +++ } else if (if_exists==sKrename_and_delete || +++ if_exists==sKnew_version || +++ if_exists==sKsupersede) { +++ if (!(fp=fopen(FN1,smm==smm_output ? "w" : "w+"))) cannot_create(fn); +++ } else if (if_exists==sKoverwrite) { +++ if (!(fp=fopen_not_dir(FN1,"r+"))) cannot_open(fn); +++ } else if (if_exists==sKappend) { +++ if (!(fp = fopen_not_dir(FN1,smm==smm_output ? "a" : "a+"))) ++ FEerror("Cannot append to the file ~A.",1,fn); ++- } else if (if_exists == Cnil) ++- return(Cnil); ++- else ++- FEerror("~S is an illegal IF-EXISTS option.", ++- 1, if_exists); +++ } else if (if_exists == Cnil) return(Cnil); +++ else FEerror("~S is an illegal IF-EXISTS option.",1,if_exists); +++ ++ } else { +++ ++ if (if_does_not_exist == sKerror) ++ FILE_ERROR(fn,"The file does not exist"); ++ else if (if_does_not_exist == sKcreate) { ++- if (smm == smm_output) { ++- if(FN1[0]=='|') ++- fp = popen(FN1+1,"w"); ++- else ++- fp = fopen_not_dir(FN1, "w"); ++- } else ++- fp = fopen_not_dir(FN1, "w+"); ++- if (fp == NULL) +++ if (!(fp=smm==smm_output ? (*FN1=='|' ? popen(FN1+1,"w") : fopen_not_dir(FN1, "w")) : fopen_not_dir(FN1, "w+"))) ++ cannot_create(fn); ++- } else if (if_does_not_exist == Cnil) ++- return(Cnil); ++- else ++- FEerror("~S is an illegal IF-DOES-NOT-EXIST option.", ++- 1, if_does_not_exist); +++ } else if (if_does_not_exist==Cnil) return(Cnil); +++ else FEerror("~S is an illegal IF-DOES-NOT-EXIST option.",1,if_does_not_exist); ++ } ++- } else +++ break; +++ +++ default: ++ FEerror("Illegal open mode for ~S.",1,fn); +++ break; +++ } ++ ++ vs_push(make_simple_string(FN1)); ++ x = alloc_object(t_stream); ++@@ -600,10 +566,6 @@ close_stream(object strm) { ++ fclose(strm->sm.sm_fp); ++ strm->sm.sm_fp = NULL; ++ strm->sm.sm_fd = -1; ++- if (strm->sm.sm_object0 && ++- type_of(strm->sm.sm_object0 )==t_cons && ++- Mcar(strm->sm.sm_object0)==sSAallow_gzipped_fileA) ++- ifuncall1(sLdelete_file,Mcdr(strm->sm.sm_object0)); ++ break; ++ ++ case smm_file_synonym: ++@@ -1762,9 +1724,7 @@ LFD(siLoutput_stream_string)() ++ } ++ ++ DEFUN_NEW("FILE-STREAM-P",object,fSfile_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++- RETURN1(type_of(x)==t_stream && ++- (x->sm.sm_mode==smm_input || x->sm.sm_mode==smm_output || x->sm.sm_mode==smm_io || x->sm.sm_mode==smm_probe) ++- ? Ct : Cnil); +++ RETURN1(type_of(x)==t_stream && file_synonym_stream_p(x) ? Ct : Cnil); ++ } ++ ++ DEFUN_NEW("SYNONYM-STREAM-P",object,fSsynonym_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++--- gcl-2.6.12.orig/o/unixfsys.c +++++ gcl-2.6.12/o/unixfsys.c ++@@ -19,8 +19,6 @@ Foundation, 675 Mass Ave, Cambridge, MA ++ ++ */ ++ ++-#include ++-#include ++ #include ++ #include ++ ++@@ -32,140 +30,17 @@ Foundation, 675 Mass Ave, Cambridge, MA ++ #include ++ #endif ++ ++-#ifdef __MINGW32__ ++-# include +++#ifdef __MINGW32__ +++# include ++ /* Windows has no symlink, therefore no lstat. Without symlinks lstat ++ is equivalent to stat anyway. */ ++ # define S_ISLNK(a) 0 ++ # define lstat stat ++-#endif ++- ++-#ifdef BSD ++-#define HAVE_RENAME ++ #endif ++ ++-#ifdef NEED_GETWD ++-#include ++- ++- ++-#ifndef HAVE_GETCWD ++-char dotdot[3*16+2] = "../../../../../../../../../../../../../../../../."; ++-#include ++-static char *getwd_buf; ++-static int getwd_bufp; ++- ++-static char * ++-getwd(buffer) ++-char *buffer; ++-{ ++- getwd_buf = buffer; ++- getwd1(0); ++- if (getwd_bufp == 0) ++- getwd_buf[getwd_bufp++] = '/'; ++- getwd_buf[getwd_bufp] = '\0'; ++- return(getwd_buf); ++-} ++- ++-getwd1(n) ++-int n; ++-{ ++- struct stat st, dev_st; ++- struct direct dir; ++- ino_t ino; ++- struct mnttab mnt; ++- FILE *fp; ++- register int i; ++- char buf[BUFSIZ]; ++- static char dev_name[64]; ++- ++- if (stat(dotdot+(16-n)*3, &st) < 0) ++- FEerror("Can't get the current working directory.", 0); ++- ino = st.st_ino; ++- if (ino == 2) ++- goto ROOT; ++- getwd1(n+1); ++- fp = fopen(dotdot+(16-n-1)*3, "r"); ++- if (fp == NULL) ++- FEerror("Can't get the current working directory.", 0); ++- setbuf(fp, buf); ++- fread(&dir, sizeof(struct direct), 1, fp); ++- fread(&dir, sizeof(struct direct), 1, fp); ++- for (;;) { ++- if (fread(&dir, sizeof(struct direct), 1, fp) <= 0) ++- break; ++- if (dir.d_ino == ino) ++- goto FOUND; ++- } ++- fclose(fp); ++- FEerror("Can't get the current working directory.", 0); ++- ++-FOUND: ++- fclose(fp); ++- getwd_buf[getwd_bufp++] = '/'; ++- for (i = 0; i < DIRSIZ && dir.d_name[i] != '\0'; i++) ++- getwd_buf[getwd_bufp++] = dir.d_name[i]; ++- return; ++- ++-ROOT: ++- fp = fopen("/etc/mnttab", "r"); ++- if (fp == NULL) ++- FEerror("Can't get the current working directory.", 0); ++- setbuf(fp, buf); ++- for (;;) { ++- if (fread(&mnt, sizeof(struct mnttab), 1, fp) <= 0) ++- break; ++- if (mnt.mt_dev[0] != '/') { ++- strcpy(dev_name, "/dev/dsk/"); ++- strcat(dev_name, mnt.mt_dev); ++- stat(dev_name, &dev_st); ++- } else ++- stat(mnt.mt_dev, &dev_st); ++- if (dev_st.st_rdev == st.st_dev) ++- goto DEV_FOUND; ++- } ++- fclose(fp); ++- getwd_bufp = 0; ++- return; ++- ++-DEV_FOUND: ++- fclose(fp); ++- getwd_bufp = 0; ++- for (i = 0; mnt.mt_filsys[i] != '\0'; i++) ++- getwd_buf[i] = mnt.mt_filsys[i]; ++- /* BUG FIX by Grant J. Munsey */ ++- if (i == 1 && *getwd_buf == '/') ++- i = 0; /* don't add an empty directory name */ ++- /* END OF BUG FIX */ ++- getwd_bufp = i; ++-} ++-#endif /* not HAVE_GETCWD */ ++-#endif ++- ++-#ifndef MAXPATHLEN ++-#define MAXPATHLEN 512 ++-#endif ++- ++- ++-#ifdef HAVE_GETCWD ++-char * ++-getwd(char *buffer) { ++-#ifndef _WIN32 ++- char *getcwd(char *, size_t); ++-#endif ++- return(getcwd(buffer, MAXPATHLEN)); ++-} ++-#endif ++- ++- ++-#define pcopy(a_,b_,c_,d_) ({\ ++- unsigned _c=c_,_d=d_;\ ++- if (_c+_d>=MAXPATHLEN-16) FEerror("Can't expand pathname ~a",1,namestring);\ ++- bcopy(a_,b_+_c,_d);\ ++- b_[_c+_d]=0;\ ++- }) ++- ++ static object ++ get_string(object x) { +++ ++ switch(type_of(x)) { ++ case t_symbol: ++ case t_string: ++@@ -180,182 +55,110 @@ get_string(object x) { ++ case smm_io: ++ return get_string(x->sm.sm_object1); ++ case smm_file_synonym: ++- case smm_synonym: ++ return get_string(x->sm.sm_object0->s.s_dbind); ++ } ++ } +++ ++ return Cnil; ++-} ++ +++} ++ ++ void ++-coerce_to_filename(object pathname,char *p) { +++coerce_to_filename1(object spec, char *p,unsigned sz) { ++ ++- object namestring=get_string(pathname); ++- unsigned e=namestring->st.st_fillp; ++- char *q=namestring->st.st_self,*qe=q+e; +++ object namestring=get_string(spec); ++ ++- if (pathname==Cnil||namestring==Cnil) ++- FEerror ( "NIL argument.", 1, pathname ); ++- ++- if (*q=='~' && e) { +++ massert(namestring->st.st_fillpst.st_self,namestring->st.st_fillp); +++ p[namestring->st.st_fillp]=0; ++ ++- unsigned m=0; ++- char *s=++q,*c; +++#ifdef FIX_FILENAME +++ FIX_FILENAME(spec,p); +++#endif ++ ++- for (;spw_dir,p,0,m=strlen(pwent->pw_dir)); ++- ++- } ++-#endif +++ massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); +++ massert(rpw_name)); ++ ++- pcopy(q,p,0,e); ++- ++-#ifdef FIX_FILENAME ++- FIX_FILENAME(pathname,p); ++-#endif ++- ++ } ++ ++-object sSAallow_gzipped_fileA; +++DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") { ++ ++-bool ++-file_exists(object file) ++-{ ++- char filename[MAXPATHLEN]; ++- struct stat filestatus; +++ struct passwd *pwent,pw; +++ long r; ++ ++- coerce_to_filename(file, filename); +++ massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); +++ massert(r filename) && ++- ( ( *(p-1) == '/' ) || ( *(p-1) == '\\' ) ) ) { ++- *(p-1) = '\0'; ++- } ++- } ++-#endif ++- ++- if (stat(filename, &filestatus) >= 0 && !S_ISDIR(filestatus.st_mode)) ++- { ++-#ifdef AIX ++- /* if /tmp/foo is not a directory /tmp/foo/ should not exist */ ++- if (filename[strlen(filename)-1] == '/' && ++- !( filestatus.st_mode & S_IFDIR)) ++- return(FALSE); ++-#endif ++- ++- return TRUE; ++- } ++- else ++- if (sSAallow_gzipped_fileA->s.s_dbind != sLnil ++- && (strcat(filename,".gz"), ++- stat(filename, &filestatus) >= 0 && !S_ISDIR(filestatus.st_mode))) ++- ++- return TRUE; +++ if (nm->st.st_fillp==1) ++ ++- else ++- return(FALSE); ++-} +++ if ((pw.pw_dir=getenv("HOME"))) +++ pwent=&pw; +++ else +++ massert(!getpwuid_r(getuid(),&pw,FN1,r,&pwent) && pwent); ++ ++-FILE * ++-fopen_not_dir(char *filename,char * option) { +++ else { ++ ++- struct stat ss; +++ massert(nm->st.st_fillpst.st_self+1,nm->st.st_fillp-1); +++ FN2[nm->st.st_fillp-1]=0; ++ ++- if (!stat(filename,&ss) && S_ISDIR(ss.st_mode)) ++- return NULL; ++- else ++- return fopen(filename,option); +++ massert(!getpwnam_r(FN2,&pw,FN1,r,&pwent) && pwent); +++ +++ } +++ +++ massert(strlen(pwent->pw_dir)+2pw_dir,strlen(pwent->pw_dir)); +++ FN3[strlen(pwent->pw_dir)]='/'; +++ FN3[strlen(pwent->pw_dir)+1]=0; +++ RETURN1(make_simple_string(FN3)); ++ ++ } ++ +++#define FILE_EXISTS_P(a_,b_) !stat(a_,&b_) && S_ISREG(b_.st_mode) +++#define DIR_EXISTS_P(a_,b_) !stat(a_,&b_) && S_ISDIR(b_.st_mode) +++ ++ FILE * ++-backup_fopen(char *filename, char *option) ++-{ ++- char backupfilename[MAXPATHLEN]; ++- char command[MAXPATHLEN * 2]; +++fopen_not_dir(char *filename,char *option) { +++ +++ struct stat ss; +++ +++ return DIR_EXISTS_P(filename,ss) ? NULL : fopen(filename,option); ++ ++- strcat(strcpy(backupfilename, filename), ".BAK"); ++- sprintf(command, "mv %s %s", filename, backupfilename); ++- msystem(command); ++- return(fopen(filename, option)); ++ } ++ ++ int ++-file_len(FILE *fp) ++-{ ++- struct stat filestatus; +++file_len(FILE *fp) {/*FIXME dir*/ ++ ++- if (fstat(fileno(fp), &filestatus)==0) ++- return(filestatus.st_size); ++- else return 0; ++-} +++ struct stat filestatus; ++ ++-DEF_ORDINARY("DIRECTORY",sKdirectory,KEYWORD,""); ++-DEF_ORDINARY("LINK",sKlink,KEYWORD,""); ++-DEF_ORDINARY("FILE",sKfile,KEYWORD,""); +++ return fstat(fileno(fp), &filestatus) ? 0 : filestatus.st_size; ++ ++-/* export these for AXIOM */ ++-int gcl_putenv(char *s) {return putenv(s);} ++-char *gcl_strncpy(char *d,const char *s,size_t z) {return strncpy(d,s,z);} ++-char *gcl_strncpy_chk(size_t z) {char a[10],b[10];return strncpy(a,b,z);}/*compile in __strncpy_chk with FORTIFY_SOURCE*/ ++-#ifdef __MINGW32__ ++-#define uid_t int ++-#endif ++-uid_t gcl_geteuid(void) { ++-#ifndef __MINGW32__ ++- return geteuid(); ++-#else ++- return 0; ++-#endif ++-} ++-uid_t gcl_getegid(void) { ++-#ifndef __MINGW32__ ++- return getegid(); ++-#else ++- return 0; ++-#endif ++ } ++-int gcl_dup2(int o,int n) {return dup2(o,n);} ++-char *gcl_gets(char *s,int z) {return fgets(s,z,stdin);} ++-int gcl_puts(const char *s) {int i=fputs(s,stdout);fflush(stdout);return i;} ++ +++bool +++file_exists(object x) { ++ ++-int gcl_feof(void *v) {return feof(((FILE *)v));} ++-int gcl_getc(void *v) {return getc(((FILE *)v));} ++-int gcl_putc(int i,void *v) {return putc(i,((FILE *)v));} +++ struct stat ss; +++ +++ coerce_to_filename(x,FN1); ++ +++ return FILE_EXISTS_P(FN1,ss) ? TRUE : FALSE; ++ +++} +++ +++DEF_ORDINARY("DIRECTORY",sKdirectory,KEYWORD,""); +++DEF_ORDINARY("LINK",sKlink,KEYWORD,""); +++DEF_ORDINARY("FILE",sKfile,KEYWORD,""); ++ ++ DEFUNM_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ ++@@ -381,6 +184,31 @@ DEFUNM_NEW("STAT",object,fSstat,SI,1,1,N ++ make_fixnum(ss.st_uid)); ++ } ++ +++#include +++#include +++#include +++#include +++ +++DEFUN_NEW("READLINKAT",object,fSreadlinkat,SI,2,2,NONE,OI,OO,OO,OO,(fixnum d,object s),"") { +++ ssize_t l,z1; +++ +++ check_type_string(&s); +++ /* l=s->st.st_hasfillp ? s->st.st_fillp : s->st.st_dim; */ +++ z1=length(s); +++ massert(z1st.st_self,z1); +++ FN1[z1]=0; +++ massert((l=readlinkat(d ? dirfd((DIR *)d) : AT_FDCWD,FN1,FN2,sizeof(FN2)))>=0 && l ++ ++ DEFUN_NEW("OPENDIR",object,fSopendir,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") { ++- DIR *d; ++- char filename[MAXPATHLEN]; ++ check_type_string(&x); ++- memcpy(filename,x->st.st_self,x->st.st_fillp); ++- filename[x->st.st_fillp]=0; ++- d=opendir(filename); ++- return (object)d; +++ coerce_to_filename(x,FN1); +++ return (object)opendir(FN1); ++ } ++ ++ #ifdef HAVE_D_TYPE ++@@ -430,19 +254,27 @@ DEFUN_NEW("D-TYPE-LIST",object,fSd_type_ ++ MMcons(make_fixnum(DT_UNKNOWN),make_keyword("UNKNOWN")) ++ )); ++ } +++#else +++#define DT_UNKNOWN 0 ++ #endif ++ ++ DEFUN_NEW("READDIR",object,fSreaddir,SI,3,3,NONE,OI,IO,OO,OO,(fixnum x,fixnum y,object s),"") { +++ ++ struct dirent *e; ++ object z; ++ long tl; ++ size_t l; +++ ++ if (!x) RETURN1(Cnil); +++ ++ tl=telldir((DIR *)x); ++-#ifdef HAVE_D_TYPE ++- for (;(e=readdir((DIR *)x)) && y!=DT_UNKNOWN && e->d_type!=y;); +++ +++#ifndef HAVE_D_TYPE +++ y=DT_UNKNOWN; ++ #endif +++ for (;(e=readdir((DIR *)x)) && y!=DT_UNKNOWN && e->d_type!=y;); ++ if (!e) RETURN1(Cnil); +++ ++ if (s==Cnil) ++ z=make_simple_string(e->d_name); ++ else { ++@@ -457,10 +289,13 @@ DEFUN_NEW("READDIR",object,fSreaddir,SI, ++ RETURN1(make_fixnum(l)); ++ } ++ } +++ ++ #ifdef HAVE_D_TYPE ++ if (y==DT_UNKNOWN) z=MMcons(z,make_fixnum(e->d_type)); ++ #endif +++ ++ RETURN1(z); +++ ++ } ++ ++ DEFUN_NEW("CLOSEDIR",object,fSclosedir,SI,1,1,NONE,OI,OO,OO,OO,(fixnum x),"") { ++@@ -468,165 +303,174 @@ DEFUN_NEW("CLOSEDIR",object,fSclosedir,S ++ return Cnil; ++ } ++ ++-DEFUN_NEW("MKDIR",object,fSmkdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++- ++- char filename[MAXPATHLEN]; +++DEFUN_NEW("RENAME",object,fSrename,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { ++ ++ check_type_string(&x); +++ check_type_string(&y); ++ ++- memcpy(filename,x->st.st_self,x->st.st_fillp); ++- filename[x->st.st_fillp]=0; ++- ++-#ifdef __MINGW32__ ++- if (mkdir(filename) < 0) ++-#else ++- if (mkdir(filename,01777) < 0) ++-#endif ++- FEerror("Cannot make the directory ~S.", 1, vs_base[0]); +++ coerce_to_filename(x,FN1); +++ coerce_to_filename(y,FN2); ++ ++- RETURN1(x); +++ RETURN1(rename(FN1,FN2) ? Cnil : Ct); ++ ++ } ++ ++-DEFUN_NEW("RMDIR",object,fSrmdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++DEFUN_NEW("UNLINK",object,fSunlink,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ ++ check_type_string(&x); ++ ++ coerce_to_filename(x,FN1); ++ ++- RETURN1(rmdir(FN1) ? Cnil : Ct); +++ RETURN1(unlink(FN1) ? Cnil : Ct); ++ ++ } ++ ++ +++DEFUN_NEW("CHDIR1",object,fSchdir1,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ ++-#include ++-#include ++-#include ++-#include +++ check_type_string(&x); ++ ++-DEFUN_NEW("READLINKAT",object,fSreadlinkat,SI,2,2,NONE,OI,OO,OO,OO,(fixnum d,object s),"") { ++- char *b1,*b2=NULL; ++- ssize_t l,z1,z2; ++- check_type_string(&s); ++- /* l=s->st.st_hasfillp ? s->st.st_fillp : s->st.st_dim; */ ++- z1=length(s); ++- massert((b1=alloca(z1+1))); ++- memcpy(b1,s->st.st_self,z1); ++- b1[z1]=0; ++- for (l=z2=0;l>=z2;) { ++- memset(b2,0,z2); ++- z2+=z2+10; ++- massert((b2=alloca(z2))); ++- massert((l=readlinkat(d ? dirfd((DIR *)d) : AT_FDCWD,b1,b2,z2))>=0); ++- } ++- b2[l]=0; ++- s=make_simple_string(b2); ++- memset(b1,0,z1); ++- memset(b2,0,z2); ++- RETURN1(s); ++-} +++ coerce_to_filename(x,FN1); ++ ++-DEFUN_NEW("GETCWD",object,fSgetcwd,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { ++- char *b=NULL; ++- size_t z; ++- object s; ++- ++- for (z=0;!(errno=0) && !getcwd(b,z) && errno==ERANGE;b=memset(b,0,z),z+=z+10,({massert((b=alloca(z)));})); ++- massert((b=getcwd(b,z))); ++- s=make_simple_string(b); ++- memset(b,0,z); ++- RETURN1(s); +++ RETURN1(chdir(FN1) ? Cnil : Ct); ++ ++ } ++ ++-DEFUN_NEW("UID-TO-NAME",object,fSuid_to_name,SI,1,1,NONE,OI,OO,OO,OO,(fixnum uid),"") { ++- struct passwd *pwent,pw; ++- char *b; ++- long r; +++DEFUN_NEW("MKDIR",object,fSmkdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ ++- massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); ++- massert(b=alloca(r)); +++ check_type_string(&x); ++ ++- massert(!getpwuid_r(uid,&pw,b,r,&pwent)); +++ coerce_to_filename(x,FN1); ++ ++- RETURN1(make_simple_string(pwent->pw_name)); +++ RETURN1(mkdir(FN1 +++#ifndef __MINGW32__ +++ ,01777 +++#endif +++ ) ? Cnil : Ct); ++ ++ } ++ ++-DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") { +++DEFUN_NEW("RMDIR",object,fSrmdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +++ check_type_string(&x); ++ ++- struct passwd *pwent,pw; ++- char *b; ++- long r; +++ coerce_to_filename(x,FN1); ++ ++- massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); ++- massert(b=alloca(r)); +++ RETURN1(rmdir(FN1) ? Cnil : Ct); ++ ++- if (nm->st.st_fillp==1) +++} ++ ++- if ((pw.pw_dir=getenv("HOME"))) ++- pwent=&pw; ++- else ++- massert(!getpwuid_r(getuid(),&pw,b,r,&pwent)); +++DEFVAR("*LOAD-WITH-FREAD*",sSAload_with_freadA,SI,Cnil,""); ++ ++- else { +++#ifdef _WIN32 ++ ++- char *name; +++void * +++get_mmap(FILE *fp,void **ve) { ++ ++- massert(name=alloca(nm->st.st_fillp)); ++- memcpy(name,nm->st.st_self+1,nm->st.st_fillp-1); ++- name[nm->st.st_fillp-1]=0; +++ int n; +++ void *st; +++ size_t sz; +++ HANDLE handle; +++ +++ massert((sz=file_len(fp))>0); +++ if (sSAload_with_freadA->s.s_dbind==Cnil) { +++ n=fileno(fp); +++ massert((n=fileno(fp))>2); +++ massert(handle = CreateFileMapping((HANDLE)_get_osfhandle(n), NULL, PAGE_WRITECOPY, 0, 0, NULL)); +++ massert(st=MapViewOfFile(handle,FILE_MAP_COPY,0,0,sz)); +++ CloseHandle(handle); +++ } else { +++ massert(st=malloc(sz)); +++ massert(fread(st,sz,1,fp)==1); +++ } ++ ++- massert(!getpwnam_r(name,&pw,b,r,&pwent)); +++ *ve=st+sz; ++ ++- } +++ return st; +++ +++} ++ ++- massert((b=alloca(strlen(pwent->pw_dir)+2))); ++- memcpy(b,pwent->pw_dir,strlen(pwent->pw_dir)); ++- b[strlen(pwent->pw_dir)]='/'; ++- b[strlen(pwent->pw_dir)+1]=0; ++- RETURN1(make_simple_string(b)); +++int +++un_mmap(void *v1,void *ve) { +++ +++ if (sSAload_with_freadA->s.s_dbind==Cnil) +++ return UnmapViewOfFile(v1) ? 0 : -1; +++ else { +++ free(v1); +++ return 0; +++ } ++ ++ } ++ ++-DEFUN_NEW("RENAME",object,fSrename,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { ++ ++- check_type_string(&x); ++- check_type_string(&y); +++#else ++ ++- coerce_to_filename(x,FN1); ++- coerce_to_filename(y,FN2); +++#include ++ ++- RETURN1(rename(FN1,FN2) ? Cnil : Ct); +++void * +++get_mmap(FILE *fp,void **ve) { +++ +++ int n; +++ void *v1; +++ struct stat ss; +++ +++ massert((n=fileno(fp))>2); +++ massert(!fstat(n,&ss)); +++ if (sSAload_with_freadA->s.s_dbind==Cnil) { +++ massert((v1=mmap(0,ss.st_size,PROT_READ|PROT_WRITE,MAP_PRIVATE,n,0))!=(void *)-1); +++ } else { +++ massert(v1=malloc(ss.st_size)); +++ massert(fread(v1,ss.st_size,1,fp)==1); +++ } +++ +++ *ve=v1+ss.st_size; +++ return v1; ++ ++ } ++ ++-DEFUN_NEW("UNLINK",object,fSunlink,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ ++- coerce_to_filename(x,FN1); +++int +++un_mmap(void *v1,void *ve) { ++ ++- RETURN1(unlink(FN1) ? Cnil : Ct); +++ if (sSAload_with_freadA->s.s_dbind==Cnil) +++ return munmap(v1,ve-v1); +++ else { +++ free(v1); +++ return 0; +++ } ++ ++ } ++ +++#endif ++ ++-static void ++-FFN(siLchdir)(void) ++-{ ++- char filename[MAXPATHLEN]; ++- ++- check_arg(1); ++- check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++- coerce_to_filename(vs_base[0], filename); ++- ++- if (chdir(filename) < 0) ++- FEerror("Can't change the current directory to ~S.", ++- 1, vs_base[0]); +++/* export these for AXIOM */ +++int gcl_putenv(char *s) {return putenv(s);} +++char *gcl_strncpy(char *d,const char *s,size_t z) {return strncpy(d,s,z);} +++char *gcl_strncpy_chk(size_t z) {char a[10],b[10];return strncpy(a,b,z);}/*compile in __strncpy_chk with FORTIFY_SOURCE*/ +++#ifdef __MINGW32__ +++#define uid_t int +++#endif +++uid_t gcl_geteuid(void) { +++#ifndef __MINGW32__ +++ return geteuid(); +++#else +++ return 0; +++#endif +++} +++uid_t gcl_getegid(void) { +++#ifndef __MINGW32__ +++ return getegid(); +++#else +++ return 0; +++#endif ++ } +++int gcl_dup2(int o,int n) {return dup2(o,n);} +++char *gcl_gets(char *s,int z) {return fgets(s,z,stdin);} +++int gcl_puts(const char *s) {int i=fputs(s,stdout);fflush(stdout);return i;} +++ +++int gcl_feof(void *v) {return feof(((FILE *)v));} +++int gcl_getc(void *v) {return getc(((FILE *)v));} +++int gcl_putc(int i,void *v) {return putc(i,((FILE *)v));} ++ ++ void ++ gcl_init_unixfsys(void) { ++- ++- make_si_function("CHDIR", siLchdir); ++- ++ } ++--- gcl-2.6.12.orig/o/unixsys.c +++++ gcl-2.6.12/o/unixsys.c ++@@ -235,89 +235,6 @@ DEFUN_NEW("GETPID",object,fSgetpid,SI,0, ++ } ++ ++ ++-DEFVAR("*LOAD-WITH-FREAD*",sSAload_with_freadA,SI,Cnil,""); ++- ++-#ifdef _WIN32 ++- ++-void * ++-get_mmap(FILE *fp,void **ve) { ++- ++- int n; ++- void *st; ++- size_t sz; ++- HANDLE handle; ++- ++- massert((sz=file_len(fp))>0); ++- if (sSAload_with_freadA->s.s_dbind==Cnil) { ++- n=fileno(fp); ++- massert((n=fileno(fp))>2); ++- massert(handle = CreateFileMapping((HANDLE)_get_osfhandle(n), NULL, PAGE_WRITECOPY, 0, 0, NULL)); ++- massert(st=MapViewOfFile(handle,FILE_MAP_COPY,0,0,sz)); ++- CloseHandle(handle); ++- } else { ++- massert(st=malloc(sz)); ++- massert(fread(st,sz,1,fp)==1); ++- } ++- ++- *ve=st+sz; ++- ++- return st; ++- ++-} ++- ++-int ++-un_mmap(void *v1,void *ve) { ++- ++- if (sSAload_with_freadA->s.s_dbind==Cnil) ++- return UnmapViewOfFile(v1) ? 0 : -1; ++- else { ++- free(v1); ++- return 0; ++- } ++- ++-} ++- ++- ++-#else ++- ++-#include ++- ++-void * ++-get_mmap(FILE *fp,void **ve) { ++- ++- int n; ++- void *v1; ++- struct stat ss; ++- ++- massert((n=fileno(fp))>2); ++- massert(!fstat(n,&ss)); ++- if (sSAload_with_freadA->s.s_dbind==Cnil) { ++- massert((v1=mmap(0,ss.st_size,PROT_READ|PROT_WRITE,MAP_PRIVATE,n,0))!=(void *)-1); ++- } else { ++- massert(v1=malloc(ss.st_size)); ++- massert(fread(v1,ss.st_size,1,fp)==1); ++- } ++- ++- *ve=v1+ss.st_size; ++- return v1; ++- ++-} ++- ++- ++-int ++-un_mmap(void *v1,void *ve) { ++- ++- if (sSAload_with_freadA->s.s_dbind==Cnil) ++- return munmap(v1,ve-v1); ++- else { ++- free(v1); ++- return 0; ++- } ++- ++-} ++- ++-#endif ++- ++ void ++ gcl_init_unixsys(void) { ++ diff --cc debian/patches/pathnames1.3 index 00000000,00000000..311c6277 new file mode 100644 --- /dev/null +++ b/debian/patches/pathnames1.3 @@@ -1,0 -1,0 +1,48 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-40) unstable; urgency=medium ++ . ++ * pathnames1.2 ++ * Bug fix: "popen arguments not quoted causes trouble and security ++ issues", thanks to axel (Closes: #802203). ++Author: Camm Maguire ++Bug-Debian: https://bugs.debian.org/802203 ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2016-10-14 ++ ++--- gcl-2.6.12.orig/o/unixfsys.c +++++ gcl-2.6.12/o/unixfsys.c ++@@ -83,7 +83,7 @@ DEFUN_NEW("UID-TO-NAME",object,fSuid_to_ ++ long r; ++ ++ massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); ++- massert(r=0); ++- massert(rst.st_fillp==1) ++ diff --cc debian/patches/pathnames1.4 index 00000000,00000000..e52d8916 new file mode 100644 --- /dev/null +++ b/debian/patches/pathnames1.4 @@@ -1,0 -1,0 +1,36 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-41) unstable; urgency=medium ++ . ++ * pathnames1.3, kfreebsd fix ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2016-10-14 ++ ++--- gcl-2.6.12.orig/o/unixfsys.c +++++ gcl-2.6.12/o/unixfsys.c ++@@ -180,7 +180,7 @@ DEFUNM_NEW("STAT",object,fSstat,SI,1,1,N ++ RETURN4(S_ISDIR(ss.st_mode) ? sKdirectory : ++ (S_ISLNK(ss.st_mode) ? sKlink : sKfile), ++ make_fixnum(ss.st_size), ++- make_fixnum(ss.st_ctime), +++ make_fixnum(ss.st_mtime), ++ make_fixnum(ss.st_uid)); ++ } ++ diff --cc debian/patches/pathnames1.5 index 00000000,00000000..66b8ac0d new file mode 100644 --- /dev/null +++ b/debian/patches/pathnames1.5 @@@ -1,0 -1,0 +1,10494 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-41) unstable; urgency=medium ++ . ++ * pathnames1.4, kfreebsd fix ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2016-10-26 ++ ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp ++@@ -488,20 +488,6 @@ Cannot compile ~a.~%" ++ (t (setq dir "."))) ++ (setq na (namestring ++ (make-pathname :name name :type (pathname-type(first args))))) ++- #+(or dos winnt) ++- (format nil "~a -I~a ~a ~a -c -w ~a -o ~a" ++- *cc* ++- (concatenate 'string si::*system-directory* "../h") ++- (if (and (boundp '*c-debug*) *c-debug*) " -g " "") ++- (case *speed* ++- (3 *opt-three* ) ++- (2 *opt-two*) ++- (t "")) ++- (namestring (make-pathname :type "c" :defaults (first args))) ++- (namestring (make-pathname :type "o" :defaults (first args))) ++- ) ++- ++- #-(or dos winnt) ++ (format nil "~a -I~a ~a ~a -c ~a -o ~a ~a" ++ *cc* ++ (concatenate 'string si::*system-directory* "../h") ++@@ -527,8 +513,8 @@ Cannot compile ~a.~%" ++ #+expect-unresolved "-expect_unresolved '*'" ++ na na na)) ++ ++- #+bsd ""; "-w" ++- #-(or aix3 bsd irix3) " 2> /dev/null ") +++ #+(or winnt bsd) ""; "-w" +++ #-(or aix3 bsd winnt irix3) " 2> /dev/null ") ++ ++ ++ ) ++@@ -543,30 +529,14 @@ Cannot compile ~a.~%" ++ (prep-win-path-acc finish (concatenate 'string acc start "~"))) ++ (concatenate 'string acc s)))) ++ ++-#+winnt ++-(defun no-device (c) ++- (let* ((c (namestring (truename c))) ++- (p (search ":" c))) ++- (if p (subseq c (1+ p)) c))) ++- ++-;; #+winnt ++-;; (defun prep-win-path (c o) ++-;; (let* ((w si::*wine-detected*) ++-;; (c (if w (no-device c) c)) ++-;; (o (if w (no-device o) o))) ++-;; (prep-win-path-acc (compiler-command c o) ""))) ++- ++ (defun compiler-cc (c-pathname o-pathname) ++ (safe-system ++ (format ++ nil ++- (prog1 ++- #+irix5 (compiler-command c-pathname o-pathname ) ++- #+vax "~a ~@[~*-O ~]-S -I. -w ~a ; as -J -W -o ~A ~A" ++- #+(or system-v e15 dgux sgi ) "~a ~@[~*-O ~]-c -I. ~a 2> /dev/null" ++- #+winnt (prep-win-path-acc (compiler-command c-pathname o-pathname) "") ++- #-winnt (compiler-command c-pathname o-pathname) ++- ) +++ #+vax "~a ~@[~*-O ~]-S -I. -w ~a ; as -J -W -o ~A ~A" +++ #+(or system-v e15 dgux sgi ) "~a ~@[~*-O ~]-c -I. ~a 2> /dev/null" +++ #+winnt (prep-win-path-acc (compiler-command c-pathname o-pathname) "") +++ #-(or vax system-v e15 dgux sgi) (compiler-command c-pathname o-pathname) ++ *cc* ++ (if (or (= *speed* 2) (= *speed* 3)) t nil) ++ (namestring c-pathname) ++@@ -763,20 +733,9 @@ Cannot compile ~a.~%" ++ `(let ((,q (si::string-match ,x ,y ,@(when z (list z))))) ++ (if (= ,q -1) (length ,y) ,q))))) ++ ++-(defun ts (s &optional (r "")) ++- (declare (string s) (ignorable r)) ++- #+winnt ++- (if (not si::*wine-detected*) s ++- (let* ((x (sml (fcr #u"[^ \n\t]") s)) ++- (y (sml (fcr #u"[ \n\t]") s x)) ++- (f (subseq s x y)) ++- (l (subseq s y)) ++- (k (when (> (length f) 0) (aref f 0))) ++- (q (if (eql k #\") (string k) "")) ++- (f (if (eql k #\") (subseq f 1 (1- (length f))) f)) ++- (f (if (and k (not (eql k #\-))) (namestring (no-device f)) f))) ++- (if k (concatenate 'string r q f q (ts l " ")) ""))) ++- #-winnt s) +++(defun ts (s) +++ (declare (string s)) +++ s) ++ ++ (defun mdelete-file (x) ++ (delete-file (ts (namestring x)))) ++@@ -795,8 +754,7 @@ Cannot compile ~a.~%" ++ raw)) ++ (map (merge-pathnames (make-pathname ++ :name (concatenate 'string (pathname-name raw) "_map")) raw)) ++- #+winnt (raw (merge-pathnames (make-pathname :type "exe") raw)) ++- ) +++ #+winnt (raw (merge-pathnames (make-pathname :type "exe") raw))) ++ ++ (with-open-file (st (namestring map) :direction :output)) ++ (safe-system ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -624,7 +624,6 @@ use ++ GNU_LD ++ LEADING_UNDERSCORE ++ EXTRA_LOBJS ++-PRELINK_CHECK ++ O2FLAGS ++ O3FLAGS ++ NIFLAGS ++@@ -678,6 +677,7 @@ EGREP ++ GREP ++ MAKEINFO ++ AWK +++GCL_CC ++ CPP ++ OBJEXT ++ EXEEXT ++@@ -686,7 +686,7 @@ CPPFLAGS ++ LDFLAGS ++ CFLAGS ++ CC ++-PROCESSOR_FLAGS +++PRELINK_CHECK ++ host_os ++ host_vendor ++ host_cpu ++@@ -738,41 +738,38 @@ SHELL' ++ ac_subst_files='' ++ ac_user_opts=' ++ enable_option_checking +++enable_machine ++ enable_widecons ++ enable_safecdr ++ enable_safecdrdbg ++ enable_prelink ++-enable_fastimmfix ++-enable_holepage ++ enable_vssize ++ enable_bdssize ++ enable_ihssize ++ enable_frssize ++-enable_machine ++-enable_immfix ++-enable_notify ++-enable_tcltk ++-enable_tkconfig ++-enable_tclconfig ++ enable_infodir ++ enable_emacsdir ++-enable_common_binary ++-enable_japi ++-enable_xdr ++ enable_xgcl ++ enable_dlopen ++ enable_statsysbfd ++ enable_dynsysbfd ++ enable_custreloc ++ enable_debug ++-enable_gprof ++ enable_static ++ enable_pic ++-enable_oldgmp +++enable_gprof ++ enable_dynsysgmp ++ with_x ++-enable_readline +++enable_xdr +++enable_immfix +++enable_fastimmfix ++ enable_ansi +++enable_japi +++enable_readline +++enable_tcltk +++enable_tkconfig +++enable_tclconfig +++enable_notify ++ ' ++ ac_precious_vars='build_alias ++ host_alias ++@@ -1410,51 +1407,37 @@ Optional Features: ++ --disable-option-checking ignore unrecognized --enable/--with options ++ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) ++ --enable-FEATURE[=ARG] include FEATURE [ARG=yes] ++-use a three word cons with simplified typing ++-protect cdr from immfix and speed up type processing ++-debug safecdr code ++---enable-prelink will insist that the produced images may be prelinked ++---enable-fastimmfix=XXXX will reject low immediate fixnums unless 1<&6; } ++ ++ } # ac_fn_c_check_member ++ +++# ac_fn_c_try_link LINENO +++# ----------------------- +++# Try to link conftest.$ac_ext, and return whether this succeeded. +++ac_fn_c_try_link () +++{ +++ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack +++ rm -f conftest.$ac_objext conftest$ac_exeext +++ if { { ac_try="$ac_link" +++case "(($ac_try" in +++ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; +++ *) ac_try_echo=$ac_try;; +++esac +++eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +++$as_echo "$ac_try_echo"; } >&5 +++ (eval "$ac_link") 2>conftest.err +++ ac_status=$? +++ if test -s conftest.err; then +++ grep -v '^ *+' conftest.err >conftest.er1 +++ cat conftest.er1 >&5 +++ mv -f conftest.er1 conftest.err +++ fi +++ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 +++ test $ac_status = 0; } && { +++ test -z "$ac_c_werror_flag" || +++ test ! -s conftest.err +++ } && test -s conftest$ac_exeext && { +++ test "$cross_compiling" = yes || +++ test -x conftest$ac_exeext +++ }; then : +++ ac_retval=0 +++else +++ $as_echo "$as_me: failed program was:" >&5 +++sed 's/^/| /' conftest.$ac_ext >&5 +++ +++ ac_retval=1 +++fi +++ # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information +++ # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would +++ # interfere with the next link command; also delete a directory that is +++ # left behind by Apple's compiler. We do this before executing the actions. +++ rm -rf conftest.dSYM conftest_ipa8_conftest.oo +++ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno +++ as_fn_set_status $ac_retval +++ +++} # ac_fn_c_try_link +++ ++ # ac_fn_c_check_func LINENO FUNC VAR ++ # ---------------------------------- ++ # Tests whether FUNC exists, setting the cache variable VAR accordingly ++@@ -2506,226 +2535,6 @@ ac_config_headers="$ac_config_headers h/ ++ VERSION=`cat majvers`.`cat minvers` ++ ++ ++-# some parts of this configure script are taken from the tcl configure.in ++- ++-# ++-# Arguments ++-# ++- ++- ++- ++- ++-# Check whether --enable-widecons was given. ++-if test "${enable_widecons+set}" = set; then : ++- enableval=$enable_widecons; ++-$as_echo "#define WIDE_CONS 1" >>confdefs.h ++- ++-fi ++- ++- ++- ++-# Check whether --enable-safecdr was given. ++-if test "${enable_safecdr+set}" = set; then : ++- enableval=$enable_safecdr; ++-else ++- enable_safecdr="no" ++-fi ++- ++-if test "$enable_safecdr" = "yes" ; then ++- ++-$as_echo "#define USE_SAFE_CDR 1" >>confdefs.h ++- ++-fi ++-# Check whether --enable-safecdrdbg was given. ++-if test "${enable_safecdrdbg+set}" = set; then : ++- enableval=$enable_safecdrdbg; ++-$as_echo "#define DEBUG_SAFE_CDR 1" >>confdefs.h ++- ++-fi ++- ++- ++-# Check whether --enable-prelink was given. ++-if test "${enable_prelink+set}" = set; then : ++- enableval=$enable_prelink; PRELINK_CHECK=t ++-else ++- PRELINK_CHECK= ++-fi ++- ++- ++-# Check whether --enable-fastimmfix was given. ++-if test "${enable_fastimmfix+set}" = set; then : ++- enableval=$enable_fastimmfix; ++-else ++- enable_fastimmfix=64 ++-fi ++- ++- ++- ++-# Check whether --enable-holepage was given. ++-if test "${enable_holepage+set}" = set; then : ++- enableval=$enable_holepage; ++-cat >>confdefs.h <<_ACEOF ++-#define HOLEPAGE $enable_holepage ++-_ACEOF ++- ++-fi ++- ++- ++-# Check whether --enable-vssize was given. ++-if test "${enable_vssize+set}" = set; then : ++- enableval=$enable_vssize; ++-else ++- enable_vssize=262144 ++-fi ++- ++- ++-cat >>confdefs.h <<_ACEOF ++-#define VSSIZE $enable_vssize ++-_ACEOF ++- ++- ++-# Check whether --enable-bdssize was given. ++-if test "${enable_bdssize+set}" = set; then : ++- enableval=$enable_bdssize; ++-else ++- enable_bdssize=2048 ++-fi ++- ++- ++-cat >>confdefs.h <<_ACEOF ++-#define BDSSIZE $enable_bdssize ++-_ACEOF ++- ++- ++-# Check whether --enable-ihssize was given. ++-if test "${enable_ihssize+set}" = set; then : ++- enableval=$enable_ihssize; ++-else ++- enable_ihssize=4096 ++-fi ++- ++- ++-cat >>confdefs.h <<_ACEOF ++-#define IHSSIZE $enable_ihssize ++-_ACEOF ++- ++- ++-# Check whether --enable-frssize was given. ++-if test "${enable_frssize+set}" = set; then : ++- enableval=$enable_frssize; ++-else ++- enable_frssize=4096 ++-fi ++- ++- ++-cat >>confdefs.h <<_ACEOF ++-#define FRSSIZE $enable_frssize ++-_ACEOF ++- ++- ++-# Check whether --enable-machine was given. ++-if test "${enable_machine+set}" = set; then : ++- enableval=$enable_machine; enable_machine=$enableval ++-else ++- enable_machine="" ++-fi ++- ++- ++-# Check whether --enable-immfix was given. ++-if test "${enable_immfix+set}" = set; then : ++- enableval=$enable_immfix; ++-else ++- enable_immfix=yes ++-fi ++- ++- ++-#AC_ARG_ENABLE(gmp,[ --enable-gmp=no will disable use of GMP gnu multiprecision arithmetic, (default is =yes)] , ++-#[use_gmp=$enableval],[use_gmp="yes"]) ++- ++-use_gmp="yes" ++- ++-# Check whether --enable-notify was given. ++-if test "${enable_notify+set}" = set; then : ++- enableval=$enable_notify; enable_notify=$enableval ++-else ++- enable_notify="yes" ++-fi ++- ++- ++-# Check whether --enable-tcltk was given. ++-if test "${enable_tcltk+set}" = set; then : ++- enableval=$enable_tcltk; enable_tcltk=$enableval ++-else ++- enable_tcltk="yes" ++-fi ++- ++- ++-# Check whether --enable-tkconfig was given. ++-if test "${enable_tkconfig+set}" = set; then : ++- enableval=$enable_tkconfig; TK_CONFIG_PREFIX=$enableval ++-else ++- TK_CONFIG_PREFIX="unknown" ++-fi ++- ++- ++- ++-# Check whether --enable-tclconfig was given. ++-if test "${enable_tclconfig+set}" = set; then : ++- enableval=$enable_tclconfig; TCL_CONFIG_PREFIX=$enableval ++-else ++- TCL_CONFIG_PREFIX="unknown" ++-fi ++- ++- ++-# Check whether --enable-infodir was given. ++-if test "${enable_infodir+set}" = set; then : ++- enableval=$enable_infodir; INFO_DIR=$enableval ++-else ++- INFO_DIR=$prefix/share/info ++-fi ++- ++-INFO_DIR=`eval echo $INFO_DIR/` ++- ++-# Check whether --enable-emacsdir was given. ++-if test "${enable_emacsdir+set}" = set; then : ++- enableval=$enable_emacsdir; EMACS_SITE_LISP=$enableval ++-else ++- EMACS_SITE_LISP=$prefix/share/emacs/site-lisp ++-fi ++- ++-EMACS_SITE_LISP=`eval echo $EMACS_SITE_LISP/` ++- ++-# Check whether --enable-common-binary was given. ++-if test "${enable_common_binary+set}" = set; then : ++- enableval=$enable_common_binary; use_common_binary=$enableval ++-else ++- use_common_binary="yes" ++-fi ++- ++- ++-# Check whether --enable-japi was given. ++-if test "${enable_japi+set}" = set; then : ++- enableval=$enable_japi; try_japi=$enableval ++-else ++- try_japi="no" ++-fi ++- ++- ++-# Check whether --enable-xdr was given. ++-if test "${enable_xdr+set}" = set; then : ++- enableval=$enable_xdr; enable_xdr=$enableval ++-else ++- enable_xdr="yes" ++-fi ++- ++- ++-# Check whether --enable-xgcl was given. ++-if test "${enable_xgcl+set}" = set; then : ++- enableval=$enable_xgcl; enable_xgcl=$enableval ++-else ++- enable_xgcl="yes" ++-fi ++- ++ ++ # ++ # Host information ++@@ -2856,380 +2665,247 @@ fi ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: host=$host" >&5 ++ $as_echo "host=$host" >&6; } ++ ++-PROCESSOR_FLAGS=${PROCESSOR_FLAGS:-""} ++- ++ use=unknown ++-TLDFLAGS="" ++ case $canonical in ++- older) ++- use=386-bsd;; ++- ++- sh4*linux*) ++- use=sh4-linux;; ++- ++- *x86_64*linux*) ++- use=amd64-linux;; ++- ++- *x86_64*kfreebsd*) ++- use=amd64-kfreebsd;; ++- ++- *86*linux*) ++- use=386-linux;; ++- ++- *86*kfreebsd*) ++- use=386-kfreebsd;; ++- ++- *86*gnu*) ++- use=386-gnu;; ++- ++-# m6800 not working with gcc-3.2 ++- m68k*linux*) ++- if test "$use_common_binary" = "yes"; then ++- host=m68020-unknown-linux-gnu ++- echo "The host is canonicalised to $host" ++- fi ++- use=m68k-linux;; ++- ++- alpha*linux*) ++- use=alpha-linux;; ++- ++- mips*linux*) ++- use=mips-linux;; ++- ++- mipsel*linux*) ++- use=mipsel-linux;; ++- ++- sparc*linux*) ++- use=sparc-linux;; ++- ++- aarch64*linux*) ++- use=aarch64-linux;; ++- ++- arm*linux*) ++- use=arm-linux;; ++- ++- s390*linux*) ++- use=s390-linux;; ++- ++- ia64*linux*) ++- use=ia64-linux;; ++- ++- hppa*linux*) ++- use=hppa-linux;; ++- ++- powerpc*linux*) ++- use=powerpc-linux;; ++- ++- powerpc-*-darwin*) ++- use=powerpc-macosx;; ++- ++- *86*darwin*) ++- use=386-macosx ++- if test "$build_cpu" = "x86_64" ; then ++- CFLAGS="-m64 $CFLAGS"; ++- LDFLAGS="-m64 -Wl,-headerpad,72 -Wl,-no_pie $LDFLAGS"; ++- else ++- CFLAGS="-m32 $CFLAGS"; ++- LDFLAGS="-m32 -Wl,-headerpad,56 -Wl,-no_pie $LDFLAGS"; +++ sh4*linux*) use=sh4-linux;; +++ *x86_64*linux*) use=amd64-linux;; +++ *x86_64*kfreebsd*) use=amd64-kfreebsd;; +++ *86*linux*) use=386-linux;; +++ *86*kfreebsd*) use=386-kfreebsd;; +++ *86*gnu*) use=386-gnu;; +++ m68k*linux*) use=m68k-linux;; +++ alpha*linux*) use=alpha-linux;; +++ mips*linux*) use=mips-linux;; +++ mipsel*linux*) use=mipsel-linux;; +++ sparc*linux*) use=sparc-linux;; +++ aarch64*linux*) use=aarch64-linux;; +++ arm*linux*) use=arm-linux;; +++ s390*linux*) use=s390-linux;; +++ ia64*linux*) use=ia64-linux;; +++ hppa*linux*) use=hppa-linux;; +++ powerpc*linux*) use=powerpc-linux;; +++ powerpc-*-darwin*) use=powerpc-macosx;; +++ *86*darwin*) use=386-macosx;; +++ i*mingw*|i*msys*) use=mingw;; +++ i*cygwin*) +++ if $CC -v 2>&1 | fgrep ming > /dev/null ; +++ then use=mingw +++ else use=gnuwin95 ++ fi;; +++ *openbsd*) use=FreeBSD;; +++ sparc-sun-solaris*) use=solaris;; +++ i?86-pc-solaris*) use=solaris-i386;; +++esac ++ ++- alpha-dec-osf) ++- use=alpha-osf1;; ++- ++- mips-dec-ultrix) ++- use=dec3100;; ++- ++- old) ++- use=dos-go32;; ++- ++- *86*-freebsd*) ++- use=FreeBSD;; ++- ++- hp3*-*hpux*) ++- use=hp300;; ++- ++- hp3*-*-*bsd*) ++- use=hp300-bsd;; ++- ++- hppa*-*hpux*) ++- use=hp800;; ++- ++- mips-sgi-irix) ++- case $system in ++- IRIX5*) ++- use=irix5;; ++- IRIX6*) ++- use=irix6;; ++- IRIX3*) ++- use=sgi4d;; ++- esac ;; ++- ++- ++- m68k-apple-aux*) ++- use=mac2;; ++- ++- old) ++- use=mp386;; +++# Check whether --enable-machine was given. +++if test "${enable_machine+set}" = set; then : +++ enableval=$enable_machine; echo enable_machine=$enableval ; use=$enableval +++fi ++ ++- *86-ncr-sysv4) ++- use=ncr;; ++ ++- *3-986-*netbsd*) ++- use=NetBSD;; +++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: use=$use" >&5 +++$as_echo "use=$use" >&6; } ++ ++- old) ++- use=NeXT;; +++def_dlopen="no" +++def_statsysbfd="no" +++def_custreloc="yes" +++def_oldgmp="no" +++def_pic="no"; +++def_static="no"; +++def_debug="no"; +++case $use in +++ *kfreebsd) +++ ln -snf linux.defs h/$use.defs;; +++ *gnu) +++ ln -snf linux.defs h/$use.defs;; +++ *linux) +++ ln -snf linux.defs h/$use.defs; +++ case $use in +++ ia64*) +++ def_dlopen="yes" ; def_custreloc="no" ;; +++ hppa*) +++ def_pic="yes" ;; +++ esac;; +++esac ++ ++- old) ++- use=NeXT30-m68k;; +++# Check whether --enable-widecons was given. +++if test "${enable_widecons+set}" = set; then : +++ enableval=$enable_widecons; if test "$enableval" = "yes" ; then +++$as_echo "#define WIDE_CONS 1" >>confdefs.h +++ fi +++fi ++ ++- *86-*nextstep*) ++- use=NeXT32-i386;; ++ ++- *m68*-*nextstep*) ++- use=NeXT32-m68k;; +++# Check whether --enable-safecdr was given. +++if test "${enable_safecdr+set}" = set; then : +++ enableval=$enable_safecdr; if test "$enableval" = "yes" ; then ++ ++- *rs6000-*-aix4*) ++- use=rios;; +++$as_echo "#define USE_SAFE_CDR 1" >>confdefs.h ++ ++- *rs6000-*-aix3*) ++- use=rios-aix3;; +++ # Check whether --enable-safecdrdbg was given. +++if test "${enable_safecdrdbg+set}" = set; then : +++ enableval=$enable_safecdrdbg; if test "$enableval" = "yes" ; then +++$as_echo "#define DEBUG_SAFE_CDR 1" >>confdefs.h +++ fi +++fi ++ ++- old) ++- use=rt_aix;; +++ fi +++fi ++ ++- old) ++- use=sgi;; ++ ++- sparc-sun-solaris*) ++- use=solaris;; +++# Check whether --enable-prelink was given. +++if test "${enable_prelink+set}" = set; then : +++ enableval=$enable_prelink; if test "$enable_prelink" = "yes" ; then PRELINK_CHECK=t; fi +++fi ++ ++- i?86-pc-solaris*) ++- use=solaris-i386;; ++ ++- old) ++- use=sun2r3;; ++ ++- old) ++- use=sun3;; +++# Check whether --enable-vssize was given. +++if test "${enable_vssize+set}" = set; then : +++ enableval=$enable_vssize; +++cat >>confdefs.h <<_ACEOF +++#define VSSIZE $enableval +++_ACEOF ++ ++- m68*-sunos*) ++- use=sun3-os4;; +++fi ++ ++- old) ++- use=sun386i;; +++# Check whether --enable-bdssize was given. +++if test "${enable_bdssize+set}" = set; then : +++ enableval=$enable_bdssize; +++cat >>confdefs.h <<_ACEOF +++#define BDSSIZE $enableval +++_ACEOF ++ ++- sparc*sunos*) ++- use=sun4;; +++fi ++ ++- *86-sequent-dynix) ++- use=symmetry;; +++# Check whether --enable-ihssize was given. +++if test "${enable_ihssize+set}" = set; then : +++ enableval=$enable_ihssize; +++cat >>confdefs.h <<_ACEOF +++#define IHSSIZE $enableval +++_ACEOF ++ ++- u370*aix) ++- use=u370_aix;; +++fi ++ ++- old) ++- use=vax;; +++# Check whether --enable-frssize was given. +++if test "${enable_frssize+set}" = set; then : +++ enableval=$enable_frssize; +++cat >>confdefs.h <<_ACEOF +++#define FRSSIZE $enableval +++_ACEOF ++ ++- i*mingw*) ++- if test "$use_common_binary" = "yes"; then ++- host=i386-pc-mingw32 ++- PROCESSOR_FLAGS="-march=i386 " ++- echo "The host is canonicalised to $host" ++- fi ++- use=mingw;; +++fi ++ ++- i*cygwin*) ++- if $CC -v 2>&1 | fgrep ming > /dev/null ; ++- then use=mingw ++- else use=gnuwin95 ++- fi;; ++ ++- *openbsd*) ++- # 'ld -Z' means disable W^X ++- TLDFLAGS="$TLDFLAGS -Z" ++- use=FreeBSD;; +++# Check whether --enable-infodir was given. +++if test "${enable_infodir+set}" = set; then : +++ enableval=$enable_infodir; INFO_DIR=$enableval +++else +++ INFO_DIR=$prefix/share/info +++fi ++ ++-esac +++INFO_DIR=`eval echo $INFO_DIR/` ++ +++# Check whether --enable-emacsdir was given. +++if test "${enable_emacsdir+set}" = set; then : +++ enableval=$enable_emacsdir; EMACS_SITE_LISP=$enableval +++else +++ EMACS_SITE_LISP=$prefix/share/emacs/site-lisp +++fi ++ +++EMACS_SITE_LISP=`eval echo $EMACS_SITE_LISP/` ++ ++-echo enable_machine=$enable_machine ++-if test "x$enable_machine" != "x" ; then ++- use=$enable_machine +++# Check whether --enable-xgcl was given. +++if test "${enable_xgcl+set}" = set; then : +++ enableval=$enable_xgcl; +++else +++ enable_xgcl=yes ++ fi ++ ++-def_dlopen="no" ++-def_statsysbfd="no" ++-def_custreloc="yes" ++-#def_statsysbfd="yes" ++-#def_custreloc="no" ++-def_locbfd="no" ++-def_oldgmp="no" ++-def_pic="no"; ++-def_static="no"; ++-def_debug="no"; ++-case $use in ++- *kfreebsd) ++- ln -snf linux.defs h/$use.defs;; ++- *gnu) ++- ln -snf linux.defs h/$use.defs;; ++- *linux) ++- ln -snf linux.defs h/$use.defs; ++- case $use in ++-# def_static -- Function descriptors are currently realized at runtime in a non-reproducible fashion ++-# on these architectures -- CM ++- powerpc*) ++-# if test "$host_cpu" = "powerpc64" ; then def_dlopen="yes" ; def_custreloc="no" ; fi ++- ;; ++- ia64*) ++- def_dlopen="yes" ; def_custreloc="no" ;; ++- hppa*) ++- def_pic="yes" ;; ++-# def_dlopen="yes" ; def_custreloc="no" ; def_pic="yes" ;; ++- esac;; ++-esac ++ ++ # Check whether --enable-dlopen was given. ++ if test "${enable_dlopen+set}" = set; then : ++ enableval=$enable_dlopen; ++ else ++- enable_dlopen="$def_dlopen" +++ enable_dlopen=$def_dlopen ++ fi ++ ++ # Check whether --enable-statsysbfd was given. ++ if test "${enable_statsysbfd+set}" = set; then : ++ enableval=$enable_statsysbfd; ++ else ++- enable_statsysbfd="$def_statsysbfd" +++ enable_statsysbfd=$def_statsysbfd ++ fi ++ ++ # Check whether --enable-dynsysbfd was given. ++ if test "${enable_dynsysbfd+set}" = set; then : ++ enableval=$enable_dynsysbfd; ++ else ++- enable_dynsysbfd="no" +++ enable_dynsysbfd=no ++ fi ++ ++-#AC_ARG_ENABLE(locbfd, ++-# [ --enable-locbfd uses a static bfd library built from this source tree for loading and relocationing object files ] ++-# ,,enable_locbfd="$def_locbfd") ++ # Check whether --enable-custreloc was given. ++ if test "${enable_custreloc+set}" = set; then : ++ enableval=$enable_custreloc; ++ else ++- enable_custreloc="$def_custreloc" +++ enable_custreloc=$def_custreloc ++ fi ++ +++ ++ # Check whether --enable-debug was given. ++ if test "${enable_debug+set}" = set; then : ++ enableval=$enable_debug; ++ else ++- enable_debug="$def_debug" ++-fi ++- ++-# Check whether --enable-gprof was given. ++-if test "${enable_gprof+set}" = set; then : ++- enableval=$enable_gprof; ++-else ++- enable_gprof="no" +++ enable_debug=$def_debug ++ fi ++ ++ # Check whether --enable-static was given. ++ if test "${enable_static+set}" = set; then : ++- enableval=$enable_static; enable_static=$enableval +++ enableval=$enable_static; ++ else ++- enable_static="$def_static" +++ enable_static=$def_static ++ fi ++ ++ # Check whether --enable-pic was given. ++ if test "${enable_pic+set}" = set; then : ++ enableval=$enable_pic; ++ else ++- enable_pic="$def_pic" ++-fi ++- ++- ++-# Check whether --enable-oldgmp was given. ++-if test "${enable_oldgmp+set}" = set; then : ++- enableval=$enable_oldgmp; ++-else ++- enable_oldgmp="$def_oldgmp" +++ enable_pic=$def_pic ++ fi ++ ++ ++-# Check whether --enable-dynsysgmp was given. ++-if test "${enable_dynsysgmp+set}" = set; then : ++- enableval=$enable_dynsysgmp; ++-else ++- enable_dynsysgmp="yes" ++-fi ++- ++- ++-load_opt="0" +++load_opt=0 ++ if test "$enable_dlopen" = "yes" ; then ++- load_opt=1 +++ load_opt=1 ++ fi ++ if test "$enable_statsysbfd" = "yes" ; then ++- case $load_opt in ++- 0) load_opt=1;; ++- 1) load_opt=2;; ++- esac +++ case $load_opt in +++ 0) load_opt=1;; +++ 1) load_opt=2;; +++ esac ++ fi ++ if test "$enable_dynsysbfd" = "yes" ; then ++- case $load_opt in ++- 0) load_opt=1;; ++- 1) load_opt=2;; ++- 2) load_opt=3;; ++- esac ++-fi ++-if test "$enable_locbfd" = "yes" ; then ++- case $load_opt in ++- 0) load_opt=1;; ++- 1) load_opt=2;; ++- 2) load_opt=3;; ++- 3) load_opt=4;; ++- esac +++ case $load_opt in +++ 0) load_opt=1;; +++ 1) load_opt=2;; +++ 2) load_opt=3;; +++ esac ++ fi ++ if test "$enable_custreloc" = "yes" ; then ++- case $load_opt in ++- 0) load_opt=1;; ++- 1) load_opt=2;; ++- 2) load_opt=3;; ++- 3) load_opt=4;; ++- 4) load_opt=5;; ++- esac +++ case $load_opt in +++ 0) load_opt=1;; +++ 1) load_opt=2;; +++ 2) load_opt=3;; +++ 3) load_opt=4;; +++ 4) load_opt=5;; +++ esac ++ fi ++ ++ if test "$load_opt" != "1" ; then ++- echo "Exactly one loader option must be chosen: dlopen=$enable_dlopen statsysbfd=$enable_statsysbfd dynsysbfd=$enable_dynsysbfd locbfd=$enable_locbfd custreloc=$enable_custreloc" ++- exit 1 +++ echo "Exactly one loader option must be chosen: dlopen=$enable_dlopen statsysbfd=$enable_statsysbfd dynsysbfd=$enable_dynsysbfd custreloc=$enable_custreloc" +++ as_fn_error $? "loader option failure" "$LINENO" 5 ++ fi ++ ++-TLDFLAGS="" ++-if test "$enable_static" = "yes" ; then ++- TLDFLAGS="-static -Wl,-zmuldefs $TLDFLAGS"; #FIXME should be in unixport/makefile ++- ++-$as_echo "#define STATIC_LINKING 1" >>confdefs.h ++- ++-fi ++-case $use in ++- *gnuwin*) ++- TLDFLAGS="$TLDFLAGS -Wl,--stack,8000000";; ++-esac ++- ++-## finally warn if we did not find a recognized machine.s ++-## ++-#if test "$use" = "unknown" ; then ++-#types=`echo h/*.defs` | sed -e "s:h/::g" -e "s:\.defs:g"` ++-#echo got canonical=$canonical, but was not recognized. ++-#echo Unable to guess type to use. Try one of ++-#exit(1) ++-#fi ++- ++-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: use=$use" >&5 ++-$as_echo "use=$use" >&6; } ++- ++ ++ # ++ # System programs ++@@ -3238,10 +2914,10 @@ $as_echo "use=$use" >&6; } ++ # We set the default CFLAGS below, and don't want the autoconf default ++ # CM 20040106 ++ if test "$CFLAGS" = "" ; then ++- CFLAGS=" " +++ CFLAGS=" " ++ fi ++ if test "$LDFLAGS" = "" ; then ++- LDFLAGS=" " +++ LDFLAGS=" " ++ fi ++ ++ ac_ext=c ++@@ -4171,74 +3847,90 @@ ac_link='$CC -o conftest$ac_exeext $CFLA ++ ac_compiler_gnu=$ac_cv_c_compiler_gnu ++ ++ +++GCL_CC=`basename $CC` +++if echo $GCL_CC |grep gcc |grep -q win; then +++ GCL_CC=gcc +++fi ++ ++ ++-# can only test for numbers -- CM ++-# if test "${GCC}" -eq "yes" ; then ++-#if [[ "${GCC}" = "yes" ]] ; then ++-# Allog for environment variable overrides on compiler selection -- CM ++-#GCC=$CC ++-#else ++-#GCC="" ++-#fi ++-# subst GCC not only under 386-linux, but where available -- CM ++- ++-TCFLAGS="-fsigned-char -fno-builtin-malloc -fno-builtin-free" ++- ++-if test "$GCC" = "yes" ; then ++- ++- TCFLAGS="$TCFLAGS -Wall" +++add_arg_to_tcflags() { ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for clang" >&5 ++-$as_echo_n "checking for clang... " >&6; } +++ local i=1 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFLAG $1" >&5 +++$as_echo_n "checking for CFLAG $1... " >&6; } +++ CFLAGS_ORI=$CFLAGS +++ CFLAGS="$CFLAGS -Werror $1 `echo $1|sed 's,-Wno-,-W,1'`" ++ ++ if test "$cross_compiling" = yes; then : ++- { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++-as_fn_error $? "cannot run test program while cross compiling ++-See \`config.log' for more details" "$LINENO" 5; } +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +++$as_echo "no" >&6; } ++ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ +++int +++main () +++{ ++ ++- int main() { ++- return ++- #ifdef __clang__ ++- 0 ++- #else ++- 1 ++- #endif ++- ;} +++ ; +++ return 0; +++} ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++-$as_echo "yes" >&6; } ++- clang="yes" ++- TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign" ++- ++-$as_echo "#define CLANG 1" >>confdefs.h ++- +++ TCFLAGS="$TCFLAGS $1";{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +++$as_echo "yes" >&6; };i=0 ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++ $as_echo "no" >&6; } ++- #FIXME -Wno-unused-but-set-variable when time ++- TMPF=-Wno-unused-but-set-variable ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFLAG $TMPF" >&5 ++-$as_echo_n "checking for CFLAG $TMPF... " >&6; } ++- CFLAGS_ORI=$CFLAGS ++- CFLAGS="$CFLAGS $TMPF" ++- if test "$cross_compiling" = yes; then : +++fi +++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ +++ conftest.$ac_objext conftest.beam conftest.$ac_ext +++fi +++ +++ CFLAGS=$CFLAGS_ORI +++ return $i +++ +++} +++ +++assert_arg_to_tcflags() { +++ if ! add_arg_to_tcflags $1 ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot add $1 to CFLAGS" >&5 +++$as_echo "cannot add $1 to CFLAGS" >&6; }; exit 1 ; fi +++ return 0 +++} +++ +++add_args_to_tcflags() { +++ +++ while test "$#" -ge 1 ; do +++ add_arg_to_tcflags $1 +++ shift +++ done +++} +++ +++add_arg_to_tldflags() { +++ +++ local i=1 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for LDFLAG $1" >&5 +++$as_echo_n "checking for LDFLAG $1... " >&6; } +++ LDFLAGS_ORI=$LDFLAGS +++ LDFLAGS="$LDFLAGS -Werror $1" +++ if test "$cross_compiling" = yes; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++ $as_echo "no" >&6; } ++ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++-int main() {return 0;} +++ +++int +++main () +++{ +++ +++ ; +++ return 0; +++} ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++- TCFLAGS="$TCFLAGS $TMPF";{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++-$as_echo "yes" >&6; } +++ TLDFLAGS="$TLDFLAGS $1";{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +++$as_echo "yes" >&6; };i=0 ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++ $as_echo "no" >&6; } ++@@ -4247,48 +3939,136 @@ rm -f core *.core core.conftest.* gmon.o ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++ fi ++ ++- CFLAGS=$CFLAGS_ORI +++ LDFLAGS=$LDFLAGS_ORI +++ return $i +++ +++} +++ +++assert_arg_to_tldflags() { +++ if ! add_arg_to_tldflags $1 ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot add $1 to LDFLAGS" >&5 +++$as_echo "cannot add $1 to LDFLAGS" >&6; }; exit 1 ; fi +++ return 0 +++} +++ +++add_args_to_tldflags() { +++ +++ while test "$#" -ge 1 ; do +++ add_arg_to_tldflags $1 +++ shift +++ done +++} +++ +++remove_arg_from_ldflags() { +++ +++ NEW_LDFLAGS="" +++ for i in $LDFLAGS; do +++ if ! test "$i" = "$1" ; then +++ NEW_LDFLAGS="$NEW_LDFLAGS $i" +++ else +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: removing $1 from LDFLAGS" >&5 +++$as_echo "removing $1 from LDFLAGS" >&6; } +++ fi +++ done +++ LDFLAGS=$NEW_LDFLAGS +++ +++ return 0 +++ +++} +++ +++TCFLAGS="" +++add_args_to_tcflags -fsigned-char -pipe \ +++ -fno-builtin-malloc -fno-builtin-free \ +++ -fno-PIE -fno-pie -fno-PIC -fno-pic \ +++ -Wall \ +++ -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign \ +++ -Wno-unused-but-set-variable -Wno-misleading-indentation +++ +++TLDFLAGS="" +++add_args_to_tldflags -Wl,-no_pie -no-pie -Wl,-z,lazy +++ +++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for clang" >&5 +++$as_echo_n "checking for clang... " >&6; } +++if test "$cross_compiling" = yes; then : +++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +++as_fn_error $? "cannot run test program while cross compiling +++See \`config.log' for more details" "$LINENO" 5; } +++else +++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext +++/* end confdefs.h. */ +++ +++ #ifdef __clang__ +++ #define RET 0 +++ #else +++ #define RET 1 +++ #endif +++ +++int +++main () +++{ +++ +++ return RET; +++ +++ ; +++ return 0; +++} +++_ACEOF +++if ac_fn_c_try_run "$LINENO"; then : +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +++$as_echo "yes" >&6; } +++ clang="yes" +++ remove_arg_from_ldflags -pie +++ +++$as_echo "#define CLANG 1" >>confdefs.h +++ +++else +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +++$as_echo "no" >&6; } ++ fi ++ rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++ fi ++ ++-fi ++ ++-if test "$GCC" = "yes" ; then ++- TCFLAGS="$TCFLAGS -pipe" ++- case $use in ++- *mingw*) ++-# echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." ++-# echo " It is otherwise needed for the Unexec stuff to work." ++-# if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi ++- TCFLAGS="$TCFLAGS -fno-zero-initialized-in-bss -mms-bitfields";; ++- *gnuwin*) ++-# echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." ++-# echo " It is otherwise needed for the Unexec stuff to work." ++-# if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi ++- TCFLAGS="$TCFLAGS -fno-zero-initialized-in-bss -mms-bitfields";; ++- esac ++-fi ++-#if test -f /proc/sys/kernel/exec-shield ; then ++-# exec_stat=`cat /proc/sys/kernel/exec-shield` ++-# if test "$exec_stat" != "0" ; then ++-# # CFLAGS here to hopefully cover the DBEGIN routine below ++-# CFLAGS="$CFLAGS -Wa,--execstack" ++-# fi ++-#fi +++case $use in +++ *mingw*) +++ assert_arg_to_tcflags -fno-zero-initialized-in-bss +++ assert_arg_to_tcflags -mms-bitfields;; +++ *gnuwin*) +++ assert_arg_to_tcflags -fno-zero-initialized-in-bss +++ assert_arg_to_tcflags -mms-bitfields +++ assert_arg_to_tldflags -Wl,--stack,8000000;; +++ 386-macosx) +++ assert_arg_to_tldflags -Wl,-no_pie +++ if test "$build_cpu" = "x86_64" ; then +++ assert_arg_to_tcflags -m64 +++ assert_arg_to_tldflags -m64 +++ assert_arg_to_tldflags -Wl,-headerpad,72 +++ else +++ assert_arg_to_tcflags -m32 +++ assert_arg_to_tldflags -m32 +++ assert_arg_to_tldflags -Wl,-headerpad,56 +++ fi;; +++ FreeBSD) assert_arg_to_tldflags -Z;; +++esac +++ +++if test "$enable_static" = "yes" ; then +++ assert_arg_to_tldflags -static +++ assert_arg_to_tldflags -Wl,-zmuldefs +++ +++$as_echo "#define STATIC_LINKING 1" >>confdefs.h +++ +++fi ++ ++ TO3FLAGS="" ++ TO2FLAGS="" ++ ++-#TFPFLAG="-fomit-frame-pointer" ++-# FIXME -- remove when mingw compiler issues are fixed ++ case "$use" in ++- *mingw*) +++ *mingw*) ++ TFPFLAG="";; ++- m68k*)#FIXME gcc 4.x bug workaround +++ m68k*)#FIXME gcc 4.x bug workaround ++ TFPFLAG="";; ++- *) +++ *) ++ TFPFLAG="-fomit-frame-pointer";; ++ esac ++ ++@@ -4335,143 +4115,104 @@ fi ++ done ++ ++ ++-# Work around system/gprof mips/hppa hang ++-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking working gprof" >&5 +++# Check whether --enable-gprof was given. +++if test "${enable_gprof+set}" = set; then : +++ enableval=$enable_gprof; if test "$enableval" = "yes" ; then +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking working gprof" >&5 ++ $as_echo_n "checking working gprof... " >&6; } ++-old_enable_gprof=$enable_gprof ++-case $use in ++- powerpc*) if test "$host_cpu" = "powerpc64le" ; then enable_gprof="no"; fi;; ++- sh4*) enable_gprof="no";; ++- ia64*) enable_gprof="no";; ++-# mips*) enable_gprof="no";; ++- hppa*) enable_gprof="no";; ++- arm*) enable_gprof="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++- *gnu) enable_gprof="no";; ++-esac ++-if test "$enable_gprof" = "$old_enable_gprof" ; then ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5 ++-$as_echo "ok" >&6; } ++-else ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: disabled" >&5 +++ case $use in +++ powerpc*) if test "$host_cpu" = "powerpc64le" ; then enableval="no"; fi;; +++ sh4*) enableval="no";; +++ ia64*) enableval="no";; +++ hppa*) enableval="no";; +++ arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible +++ *gnu) enableval="no";; +++ esac +++ if test "$enableval" != "yes" ; then +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: disabled" >&5 ++ $as_echo "disabled" >&6; } ++-fi ++- ++-if test "$enable_gprof" = "yes" ; then ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for text start" >&5 +++ else +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5 +++$as_echo "ok" >&6; } +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for text start" >&5 ++ $as_echo_n "checking for text start... " >&6; } ++- echo 'int main () {return(0);}' >foo.c ++- $CC foo.c -o foo ++- GCL_GPROF_START=`nm foo | $AWK '/ *[TD] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc ++- rm -f foo.c foo ++- if test "$GCL_GPROF_START" != "" ; then ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GCL_GPROF_START" >&5 +++ echo 'int main () {return(0);}' >foo.c +++ $CC foo.c -o foo +++ GCL_GPROF_START=`nm foo | $AWK '/ *[TD] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc +++ rm -f foo.c foo +++ if test "$GCL_GPROF_START" != "" ; then +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GCL_GPROF_START" >&5 ++ $as_echo "$GCL_GPROF_START" >&6; } ++ ++ cat >>confdefs.h <<_ACEOF ++ #define GCL_GPROF_START $GCL_GPROF_START ++ _ACEOF ++ ++- case "$use" in ++- arm*) ++- #FIXME report and remove this when done ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: Reducing optimization on profiling arm build to workaround gcc bug" >&5 ++-$as_echo "Reducing optimization on profiling arm build to workaround gcc bug" >&6; } ++- enable_debug=yes;; ++- esac ++- TCFLAGS="$TCFLAGS -pg"; ++- case $use in ++- s390*) ;; # relocation truncation bug in gcc ++- *) TLIBS="$TLIBS -pg";; ++- esac ++- TFPFLAG="" +++ assert_arg_to_tcflags -pg +++ case $use in +++ s390*) ;; # relocation truncation bug in gcc +++ *) TLIBS="$TLIBS -pg";; +++ esac +++ TFPFLAG="" ++ ++ $as_echo "#define GCL_GPROF 1" >>confdefs.h ++ ++- else ++- enable_gprof="no"; ++- fi ++-fi ++- ++-if $CC -v 2>&1 | tail -1 | grep "gcc version 4.6.1" >/dev/null ; then ++- case "$use" in ++- arm*) ++- #FIXME report and remove this when done ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: Reducing optimization on arm build to workaround gcc 4.6 bug" >&5 ++-$as_echo "Reducing optimization on arm build to workaround gcc 4.6 bug" >&6; } ++- enable_debug=yes;; ++- esac +++ fi +++ fi +++ fi ++ fi ++ ++ ++ if test "$enable_debug" = "yes" ; then ++- TCFLAGS="$TCFLAGS -g" ++- # for subconfigurations ++- CFLAGS="$CFLAGS -g" +++ assert_arg_to_tcflags -g +++ # for subconfigurations +++ CFLAGS="$CFLAGS -g" ++ else ++- TO3FLAGS="-O3 $TFPFLAG" ++- TO2FLAGS="-O" +++ TO3FLAGS="-O3 $TFPFLAG" +++ TO2FLAGS="-O" ++ fi ++ ++ # gcc on ppc cannot compile our new_init.c with full opts --CM ++ TONIFLAGS="" ++ case $use in ++- powerpc*macosx) ++- TCFLAGS="$TCFLAGS -mlongcall";; ++- *linux) +++ powerpc*macosx) assert_arg_to_tcflags -mlongcall;; +++ *linux) ++ case $use in ++-# amd64*) # stack-boundary option does not work ++-# TCFLAGS="$TCFLAGS -m64 -mpreferred-stack-boundary=8";; ++- alpha*) ++- TCFLAGS="$TCFLAGS -mieee" ++- if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1 ++- ;; ++-# m68k*) ++-# TCFLAGS="$TCFLAGS -ffloat-store";; ++- aarch64*) ++- TLIBS="$TLIBS -lgcc_s";; ++- hppa*) ++- TCFLAGS="$TCFLAGS -mlong-calls " ++- TLIBS="$TLIBS -lgcc_s" # workaround hppa __moddi3 local func symbols with default linker flags ++- if test "$enable_debug" != "yes" ; then TO3FLAGS="-O2" ; TFPFLAG=""; fi #FIXME needed asof gcc 4.8.1 ++-# TCFLAGS="$TCFLAGS -ffunction-sections" ++-# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O $TFPFLAG" ; fi ++-# if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi ++- ;; ++- mips*) ++- case $canonical in ++- mips64*linux*) ++- TLIBS="$TLIBS -Wl,-z -Wl,now";; ++- esac ++-# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 ++- ;; ++- ia64*) ++- if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 ++- ;; ++- arm*) ++- TCFLAGS="$TCFLAGS -mlong-calls -fdollars-in-identifiers -g " ++-# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.6.2 ++-# if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi ++- ;; ++- powerpc*) ++- TCFLAGS="$TCFLAGS -mlongcall" ++- ;; ++-# if $CC -v 2>&1 | grep -q "gcc version 3.2" ; then ++-# echo Reducing optimization for buggy gcc-3.2 ++-# if test "$enable_debug" != "yes" ; then TONIFLAGS="-O $TFPFLAG" ; fi ++-# fi; ++-# echo Probing for longcall ++-# if ! $CC -v 2>&1 | $AWK '/^gcc version / {split($3,A,".");if (A[[1]]+0>3 || (A[[1]]+0>=3 && A[[2]]+0>=3)) exit 1;}'; then ++-# echo Enabling longcall on gcc 3.3 or later ++-# TCFLAGS="$TCFLAGS -mlongcall" ++-# echo Reducing optimization for buggy gcc 3.3 or later ++-# if test "$enable_debug" != "yes" ; then TONIFLAGS="-O $TFPFLAG" ; fi ++-# fi;; +++ alpha*) +++ assert_arg_to_tcflags -mieee +++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1 +++ ;; +++ aarch64*) +++ TLIBS="$TLIBS -lgcc_s";; +++ hppa*) +++ assert_arg_to_tcflags -mlong-calls +++ TLIBS="$TLIBS -lgcc_s" # workaround hppa __moddi3 local func symbols with default linker flags +++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O2" ; TFPFLAG=""; fi #FIXME needed asof gcc 4.8.1 +++ ;; +++ mips*) +++ case $canonical in +++ mips64*linux*) +++ assert_arg_to_tldflags -Wl,-z,now;; +++ esac +++ ;; +++ ia64*) +++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 +++ ;; +++ arm*) +++ assert_arg_to_tcflags -mlong-calls +++ assert_arg_to_tcflags -fdollars-in-identifiers +++ assert_arg_to_tcflags -g #? +++ ;; +++ powerpc*) +++ assert_arg_to_tcflags -mlongcall +++ ;; ++ esac;; ++ esac ++ if test "$enable_pic" = "yes" ; then ++- TCFLAGS="$TCFLAGS -fPIC" +++ assert_arg_to_tcflags -fPIC ++ fi ++ +++ ++ FDEBUG=`echo $CFLAGS | tr ' ' '\012' |grep "^\-g$"|tr '\012' ' '` ++ #CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-g$"` ++ FOMITF=`echo $CFLAGS | tr ' ' '\012' |grep "^\-fomit-frame-pointer$"|tr '\012' ' '` ++@@ -4488,27 +4229,27 @@ FOOPT0=`echo $CFLAGS | tr ' ' '\012' |gr ++ CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-O0$"|tr '\012' ' '` ++ ++ if test "$FOOPT0" != "" ; then ++- TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[123 ],-O0 ,g' | sed 's,\-O$,-O0 ,g'` ++- TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[123 ],-O0 ,g' | sed 's,\-O$,-O0 ,g'` +++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[123 ],-O0 ,g' | sed 's,\-O$,-O0 ,g'` +++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[123 ],-O0 ,g' | sed 's,\-O$,-O0 ,g'` ++ else ++-if test "$FOOPT1" != "" ; then ++- TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[2-3],-O1,g'` ++- TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[2-3],-O1,g'` ++-else ++-if test "$FOOPT2" != "" ; then ++- TO3FLAGS=`echo "$TO3FLAGS" | sed 's,\-O3,-O2,g'` ++- TO2FLAGS=`echo "$TO2FLAGS" | sed 's,\-O3,-O2,g'` ++-fi ++-fi +++ if test "$FOOPT1" != "" ; then +++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[2-3],-O1,g'` +++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[2-3],-O1,g'` +++ else +++ if test "$FOOPT2" != "" ; then +++ TO3FLAGS=`echo "$TO3FLAGS" | sed 's,\-O3,-O2,g'` +++ TO2FLAGS=`echo "$TO2FLAGS" | sed 's,\-O3,-O2,g'` +++ fi +++ fi ++ fi ++ ++ if test "$FDEBUG" != "" ; then ++- TO3FLAGS=`echo $TO3FLAGS | sed 's,\-fomit-frame-pointer,,g'` ++- TO2FLAGS=`echo $TO2FLAGS | sed 's,\-fomit-frame-pointer,,g'` +++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-fomit-frame-pointer,,g'` +++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-fomit-frame-pointer,,g'` ++ fi ++ ++ if test "$FOMITF" != "" ; then ++- TO3FLAGS="$TO3FLAGS $FOMITF" +++ TO3FLAGS="$TO3FLAGS $FOMITF" ++ fi ++ ++ # Step 1: set the variable "system" to hold the name and version number ++@@ -4569,8 +4310,8 @@ if test -f /usr/lib/NextStep/software_ve ++ else ++ system=`uname -s`-`uname -r` ++ if test "$?" -ne 0 ; then ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: unknown (can't find uname command)" >&5 ++-$as_echo "unknown (can't find uname command)" >&6; } +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: unknown (cannot find uname command)" >&5 +++$as_echo "unknown (cannot find uname command)" >&6; } ++ system=unknown ++ else ++ # Special check for weird MP-RAS system (uname returns weird ++@@ -4588,7 +4329,7 @@ $as_echo "$system" >&6; } ++ fi ++ ++ case $use in ++- *macosx) +++ *macosx) ++ ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 ++ $as_echo_n "checking for grep that handles long lines and -e... " >&6; } ++@@ -4864,7 +4605,7 @@ fi ++ done ++ ++ ac_fn_c_check_member "$LINENO" "struct _malloc_zone_t" "memalign" "ac_cv_member_struct__malloc_zone_t_memalign" " ++- #include +++ #include ++ ++ " ++ if test "x$ac_cv_member_struct__malloc_zone_t_memalign" = xyes; then : ++@@ -4877,7 +4618,6 @@ fi ++ ;; ++ esac ++ ++- ++ for ac_header in setjmp.h ++ do : ++ ac_fn_c_check_header_mongrel "$LINENO" "setjmp.h" "ac_cv_header_setjmp_h" "$ac_includes_default" ++@@ -4887,7 +4627,7 @@ if test "x$ac_cv_header_setjmp_h" = xyes ++ _ACEOF ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking sizeof jmp_buf" >&5 ++ $as_echo_n "checking sizeof jmp_buf... " >&6; } ++- if test "$cross_compiling" = yes; then : +++ if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++ $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++ as_fn_error $? "cannot run test program while cross compiling ++@@ -4896,19 +4636,24 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ +++ #include +++ #include ++ ++- #include ++- #include ++- int main() { ++- FILE *fp=fopen("conftest1","w"); ++- fprintf(fp,"%lu\n",sizeof(jmp_buf)); ++- fclose(fp); ++- return 0; ++- } +++int +++main () +++{ +++ +++ FILE *fp=fopen("conftest1","w"); +++ fprintf(fp,"%lu\n",sizeof(jmp_buf)); +++ fclose(fp); +++ +++ ; +++ return 0; +++} ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++ sizeof_jmp_buf=`cat conftest1` ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $sizeof_jmp_buf" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $sizeof_jmp_buf" >&5 ++ $as_echo "$sizeof_jmp_buf" >&6; } ++ ++ cat >>confdefs.h <<_ACEOF ++@@ -4929,7 +4674,6 @@ done ++ ++ ++ # sysconf ++- ++ for ac_header in unistd.h ++ do : ++ ac_fn_c_check_header_mongrel "$LINENO" "unistd.h" "ac_cv_header_unistd_h" "$ac_includes_default" ++@@ -4944,52 +4688,6 @@ if ${ac_cv_lib_c_sysconf+:} false; then ++ else ++ ac_check_lib_save_LIBS=$LIBS ++ LIBS="-lc $LIBS" ++- ++-# ac_fn_c_try_link LINENO ++-# ----------------------- ++-# Try to link conftest.$ac_ext, and return whether this succeeded. ++-ac_fn_c_try_link () ++-{ ++- as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack ++- rm -f conftest.$ac_objext conftest$ac_exeext ++- if { { ac_try="$ac_link" ++-case "(($ac_try" in ++- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; ++- *) ac_try_echo=$ac_try;; ++-esac ++-eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" ++-$as_echo "$ac_try_echo"; } >&5 ++- (eval "$ac_link") 2>conftest.err ++- ac_status=$? ++- if test -s conftest.err; then ++- grep -v '^ *+' conftest.err >conftest.er1 ++- cat conftest.er1 >&5 ++- mv -f conftest.er1 conftest.err ++- fi ++- $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 ++- test $ac_status = 0; } && { ++- test -z "$ac_c_werror_flag" || ++- test ! -s conftest.err ++- } && test -s conftest$ac_exeext && { ++- test "$cross_compiling" = yes || ++- test -x conftest$ac_exeext ++- }; then : ++- ac_retval=0 ++-else ++- $as_echo "$as_me: failed program was:" >&5 ++-sed 's/^/| /' conftest.$ac_ext >&5 ++- ++- ac_retval=1 ++-fi ++- # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information ++- # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would ++- # interfere with the next link command; also delete a directory that is ++- # left behind by Apple's compiler. We do this before executing the actions. ++- rm -rf conftest.dSYM conftest_ipa8_conftest.oo ++- eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno ++- as_fn_set_status $ac_retval ++- ++-} # ac_fn_c_try_link ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++@@ -5022,39 +4720,40 @@ $as_echo "$ac_cv_lib_c_sysconf" >&6; } ++ if test "x$ac_cv_lib_c_sysconf" = xyes; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking _SC_CLK_TCK" >&5 ++ $as_echo_n "checking _SC_CLK_TCK... " >&6; } ++- if test "$cross_compiling" = yes; then : ++- hz=0 +++ hz=0 +++ if test "$cross_compiling" = yes; then : +++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +++as_fn_error $? "cannot run test program while cross compiling +++See \`config.log' for more details" "$LINENO" 5; } ++ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++-#include ++- #include ++- int ++- main() { ++- FILE *fp=fopen("conftest1","w"); ++- fprintf(fp,"%lu\n",sysconf(_SC_CLK_TCK)); ++- fclose(fp); ++- return 0; ++- } ++-_ACEOF ++-if ac_fn_c_try_run "$LINENO"; then : ++- hz=`cat conftest1` ++ ++-cat >>confdefs.h <<_ACEOF ++-#define HZ $hz ++-_ACEOF +++ #include +++ #include ++ +++int +++main () +++{ +++ +++ FILE *fp=fopen("conftest1","w"); +++ fprintf(fp,"%lu\n",sysconf(_SC_CLK_TCK)); +++ fclose(fp); +++ +++ ; +++ return 0; +++} +++_ACEOF +++if ac_fn_c_try_run "$LINENO"; then : ++ ++-else ++- hz=0 ++ fi ++ rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++ fi ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $hz" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $hz" >&5 ++ $as_echo "$hz" >&6; } ++- ++ fi ++ ++ fi ++@@ -5063,20 +4762,16 @@ done ++ ++ ++ ++-#MY_SUBDIRS= ++- ++-# ++-# GMP ++-# ++- ++ rm -f makedefsafter ++ ++-MP_INCLUDE="" ++-if test $use_gmp = yes ; then +++# Check whether --enable-dynsysgmp was given. +++if test "${enable_dynsysgmp+set}" = set; then : +++ enableval=$enable_dynsysgmp; +++fi +++ ++ ++- PATCHED_SYMBOLS="" ++- if test "$enable_dynsysgmp" = "yes" ; then ++- for ac_header in gmp.h +++if test "$enable_dynsysgmp" != "no" ; then +++ for ac_header in gmp.h ++ do : ++ ac_fn_c_check_header_mongrel "$LINENO" "gmp.h" "ac_cv_header_gmp_h" "$ac_includes_default" ++ if test "x$ac_cv_header_gmp_h" = xyes; then : ++@@ -5120,100 +4815,97 @@ fi ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gmp___gmpz_init" >&5 ++ $as_echo "$ac_cv_lib_gmp___gmpz_init" >&6; } ++ if test "x$ac_cv_lib_gmp___gmpz_init" = xyes; then : ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking \"for external gmp version\"" >&5 ++-$as_echo_n "checking \"for external gmp version\"... " >&6; } ++- if test "$cross_compiling" = yes; then : ++- echo "Cannot use dynamic gmp lib" +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for external gmp version" >&5 +++$as_echo_n "checking for external gmp version... " >&6; } +++ if test "$cross_compiling" = yes; then : +++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +++as_fn_error $? "cannot run test program while cross compiling +++See \`config.log' for more details" "$LINENO" 5; } ++ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++-#include ++- int main() { ++- #if __GNU_MP_VERSION > 3 ++- return 0; ++- #else ++- return -1; ++- #endif ++- } +++ +++ #include +++ +++int +++main () +++{ +++ +++ #if __GNU_MP_VERSION > 3 +++ return 0; +++ #else +++ return -1; +++ #endif +++ +++ ; +++ return 0; +++} ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++- # MPFILES=$GMPDIR/mpn/mul_n.o ++-# PATCHED_SYMBOLS=__gmpn_toom3_mul_n ++- MPFILES= ++- PATCHED_SYMBOLS= ++-# if test "$use" = "m68k-linux" ; then ++-# MPFILES="$MPFILES $GMPDIR/mpn/lshift.o $GMPDIR/mpn/rshift.o" ++-# PATCHED_SYMBOLS="$PATCHED_SYMBOLS __gmpn_lshift __gmpn_rshift" ++-# fi ++- TLIBS="$TLIBS -lgmp" ++- echo "#include \"gmp.h\"" >foo.c ++- echo "int main() {return 0;}" >>foo.c ++- MP_INCLUDE=`cpp foo.c | $AWK '/(\/|\\\\)gmp.h/ {if (!i) print $3;i=1}' | tr -d '"'` ++- rm -f foo.c ++-else ++- echo "Cannot use dynamic gmp lib" +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: good" >&5 +++$as_echo "good" >&6; } +++ TLIBS="$TLIBS -lgmp" +++ echo "#include \"gmp.h\"" >foo.c +++ echo "int main() {return 0;}" >>foo.c +++ MP_INCLUDE=`cpp foo.c | $AWK '/(\/|\\\\)gmp.h/ {if (!i) print $3;i=1}' | tr -d '"'` +++ rm -f foo.c ++ fi ++ rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++ fi ++ ++-else ++- echo "Cannot use dynamic gmp lib" ++ fi ++ ++-else ++- echo "Cannot use dynamic gmp lib" ++ fi ++ ++ done ++ +++ +++ if test "$MP_INCLUDE" = "" ; then +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: Cannot use dynamic gmp lib" >&5 +++$as_echo "Cannot use dynamic gmp lib" >&6; } +++ fi +++ ++ fi ++ ++-NEED_LOCAL_GMP='' +++ ++ if test "$MP_INCLUDE" = "" ; then ++- NEED_LOCAL_GMP=1; ++-fi ++-if test "$PATCHED_SYMBOLS" != "" ; then ++- NEED_LOCAL_GMP=1; ++-fi ++ ++-if test "$NEED_LOCAL_GMP" != "" ; then +++ GMPDIR=gmp4 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking doing configure in gmp directory" >&5 +++$as_echo_n "checking doing configure in gmp directory... " >&6; } +++ echo +++ echo "#" +++ echo "#" +++ echo "# -------------------" +++ echo "# Subconfigure of GMP" +++ echo "#" +++ echo "#" ++ ++- GMPDIR=gmp4 ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking use_gmp=yes, doing configure in gmp directory" >&5 ++-$as_echo_n "checking use_gmp=yes, doing configure in gmp directory... " >&6; } ++- echo ++- echo "#" ++- echo "#" ++- echo "# -------------------" ++- echo "# Subconfigure of GMP" ++- echo "#" ++- echo "#" ++- ++- if test "$use_common_binary" = "yes"; then ++- cd $GMPDIR && ./configure --build=$host && cd .. ++- else ++- cd $GMPDIR && ./configure && cd .. ++- fi ++- #MY_SUBDIRS="$MY_SUBDIRS $GMPDIR" ++- ++- echo "#" ++- echo "#" ++- echo "#" ++- echo "# Subconfigure of GMP done" ++- echo "# ------------------------" ++- echo "#" ++- ++- if test "$MP_INCLUDE" = "" ; then ++- cp $GMPDIR/gmp.h h/gmp.h ++- MP_INCLUDE=h/gmp.h ++- MPFILES=gmp_all ++- fi +++ if test "$use_common_binary" = "yes"; then +++ cd $GMPDIR && ./configure --build=$host && cd .. +++ else +++ cd $GMPDIR && ./configure --host=$host --build=$build && cd .. +++ fi +++ #MY_SUBDIRS="$MY_SUBDIRS $GMPDIR" ++ +++ echo "#" +++ echo "#" +++ echo "#" +++ echo "# Subconfigure of GMP done" +++ echo "# ------------------------" +++ echo "#" +++ +++ if test "$MP_INCLUDE" = "" ; then +++ cp $GMPDIR/gmp.h h/gmp.h +++ MP_INCLUDE=h/gmp.h +++ MPFILES=gmp_all +++ fi ++ fi ++ ++-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking \"for leading underscore in object symbols\"" >&5 ++-$as_echo_n "checking \"for leading underscore in object symbols\"... " >&6; } +++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for leading underscore in object symbols" >&5 +++$as_echo_n "checking for leading underscore in object symbols... " >&6; } ++ cat>foo.c < ++ #include ++@@ -5221,15 +4913,15 @@ int main() {FILE *f;double d=0.0;getc(f) ++ EOFF ++ $CC -c foo.c -o foo.o ++ if nm foo.o |grep " U " | grep "_cos" >/dev/null || nm foo.o |grep " U " | grep " _getc" >/dev/null ; then ++- LEADING_UNDERSCORE=1 +++ LEADING_UNDERSCORE=1 ++ ++ $as_echo "#define LEADING_UNDERSCORE 1" >>confdefs.h ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"yes\"" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"yes\"" >&5 ++ $as_echo "\"yes\"" >&6; } ++ else ++- LEADING_UNDERSCORE="" ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"no\"" >&5 +++ LEADING_UNDERSCORE="" +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"no\"" >&5 ++ $as_echo "\"no\"" >&6; } ++ fi ++ ++@@ -5239,16 +4931,16 @@ $as_echo_n "checking \"for GNU ld option ++ touch map ++ $CC -o foo -Wl,-Map map foo.o >/dev/null 2>&1 ++ if test `cat map | wc -l` != "0" ; then ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"yes\"" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"yes\"" >&5 ++ $as_echo "\"yes\"" >&6; } ++ ++ $as_echo "#define HAVE_GNU_LD 1" >>confdefs.h ++ ++- GNU_LD=1 +++ GNU_LD=1 ++ else ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"no\"" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"no\"" >&5 ++ $as_echo "\"no\"" >&6; } ++- GNU_LD= +++ GNU_LD= ++ fi ++ rm -f foo.c foo.o foo map ++ ++@@ -5263,17 +4955,16 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- #include ++- #include "$MP_INCLUDE" +++ #include +++ #include "$MP_INCLUDE" ++ ++ int ++ main () ++ { ++ ++- FILE *fp=fopen("conftest1","w"); ++- fprintf(fp,"%u",sizeof(mp_limb_t)); ++- fclose(fp); ++- return 0; +++ FILE *fp=fopen("conftest1","w"); +++ fprintf(fp,"%u",sizeof(mp_limb_t)); +++ fclose(fp); ++ ++ ; ++ return 0; ++@@ -5307,18 +4998,18 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- #include ++- #include "$MP_INCLUDE" +++ #include +++ #include "$MP_INCLUDE" ++ ++ int ++ main () ++ { ++ ++- #ifdef _SHORT_LIMB ++- return 0; ++- #else ++- return 1; ++- #endif +++ #ifdef _SHORT_LIMB +++ return 0; +++ #else +++ return 1; +++ #endif ++ ++ ; ++ return 0; ++@@ -5349,18 +5040,18 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- #include ++- #include "$MP_INCLUDE" +++ #include +++ #include "$MP_INCLUDE" ++ ++ int ++ main () ++ { ++ ++- #ifdef _LONG_LONG_LIMB ++- return 0; ++- #else ++- return 1; ++- #endif +++ #ifdef _LONG_LONG_LIMB +++ return 0; +++ #else +++ return 1; +++ #endif ++ ++ ; ++ return 0; ++@@ -5380,17 +5071,17 @@ rm -f core *.core core.conftest.* gmon.o ++ fi ++ ++ ++- GMP=1 +++GMP=1 ++ ++ $as_echo "#define GMP 1" >>confdefs.h ++ ++ ++ ++- echo > makedefsafter ++- echo "MPFILES=$MPFILES" >> makedefsafter ++- echo "PATCHED_SYMBOLS=$PATCHED_SYMBOLS" >> makedefsafter ++- echo >> makedefsafter ++-fi +++echo > makedefsafter +++echo "MPFILES=$MPFILES" >> makedefsafter +++echo "PATCHED_SYMBOLS=$PATCHED_SYMBOLS" >> makedefsafter +++echo >> makedefsafter +++ ++ ++ ++ # ++@@ -5399,7 +5090,7 @@ fi ++ ++ if test "$enable_xgcl" = "yes" ; then ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for X" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for X" >&5 ++ $as_echo_n "checking for X... " >&6; } ++ ++ ++@@ -5592,24 +5283,14 @@ else ++ $as_echo "libraries $x_libraries, headers $x_includes" >&6; } ++ fi ++ ++-# AC_PATH_XTRA ++-# echo $X_CFLAGS ++-# echo $X_LIBS ++-# echo $X_EXTRA_LIBS ++-# echo $X_PRE_LIBS ++- ++- miss=0 ++-# AC_CHECK_LIB(Xmu,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS)#FIXME remove these ++-# AC_CHECK_LIB(Xt,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS) ++-# AC_CHECK_LIB(Xext,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS) ++-# AC_CHECK_LIB(Xaw,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS)#until here ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lX11" >&5 +++ +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lX11" >&5 ++ $as_echo_n "checking for main in -lX11... " >&6; } ++ if ${ac_cv_lib_X11_main+:} false; then : ++ $as_echo_n "(cached) " >&6 ++ else ++ ac_check_lib_save_LIBS=$LIBS ++-LIBS="-lX11 $X_LIBS $LIBS" +++LIBS="-lX11 $LIBS" ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++@@ -5635,22 +5316,14 @@ fi ++ $as_echo "$ac_cv_lib_X11_main" >&6; } ++ if test "x$ac_cv_lib_X11_main" = xyes; then : ++ X_LIBS="$X_LIBS -lX11" +++$as_echo "#define HAVE_XGCL 1" >>confdefs.h +++ ++ else ++- miss=1 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: missing x libraries -- cannot compile xgcl" >&5 +++$as_echo "missing x libraries -- cannot compile xgcl" >&6; } ++ fi ++ ++ ++- if test "$miss" = "1" ; then ++- X_CFLAGS= ++- X_LIBS= ++- X_EXTRA_LIBS= ++- X_PRE_LIBS= ++- echo missing x libraries -- cannot compile xgcl ++- else ++- ++-$as_echo "#define HAVE_XGCL 1" >>confdefs.h ++- ++- fi ++ fi ++ ++ ++@@ -5663,7 +5336,7 @@ fi ++ ++ if test "$enable_dlopen" = "yes" ; then ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 ++ $as_echo_n "checking for dlopen in -ldl... " >&6; } ++ if ${ac_cv_lib_dl_dlopen+:} false; then : ++ $as_echo_n "(cached) " >&6 ++@@ -5700,25 +5373,27 @@ fi ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 ++ $as_echo "$ac_cv_lib_dl_dlopen" >&6; } ++ if test "x$ac_cv_lib_dl_dlopen" = xyes; then : ++- have_dl=1 +++ cat >>confdefs.h <<_ACEOF +++#define HAVE_LIBDL 1 +++_ACEOF +++ +++ LIBS="-ldl $LIBS" +++ ++ else ++- have_dl=0 +++ as_fn_error $? "Cannot find dlopen" "$LINENO" 5 ++ fi ++ ++- if test "$have_dl" = "0" ; then ++- echo "Cannot find dlopen in -dl" ++- exit 1 ++- fi ++ ++- TLIBS="$TLIBS -ldl -rdynamic" ++- TCFLAGS="-fPIC $TCFLAGS" +++ TLIBS="$TLIBS -ldl -rdynamic" +++ assert_arg_to_tcflags -fPIC ++ ++ $as_echo "#define USE_DLOPEN 1" >>confdefs.h ++ +++ ++ fi ++ ++ if test "$enable_statsysbfd" = "yes" || test "$enable_dynsysbfd" = "yes" ; then ++- for ac_header in bfd.h +++ for ac_header in bfd.h ++ do : ++ ac_fn_c_check_header_mongrel "$LINENO" "bfd.h" "ac_cv_header_bfd_h" "$ac_includes_default" ++ if test "x$ac_cv_header_bfd_h" = xyes; then : ++@@ -5763,18 +5438,28 @@ fi ++ $as_echo "$ac_cv_lib_bfd_bfd_init" >&6; } ++ if test "x$ac_cv_lib_bfd_bfd_init" = xyes; then : ++ # ++- # Old binutils appear to need CONST defined to const ++- # ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking if need to define CONST for bfd" >&5 ++-$as_echo_n "checking if need to define CONST for bfd... " >&6; } ++- if test "$cross_compiling" = yes; then : +++ # Old binutils appear to need CONST defined to const +++ # +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking need to define CONST for bfd" >&5 +++$as_echo_n "checking need to define CONST for bfd... " >&6; } +++ if test "$cross_compiling" = yes; then : ++ as_fn_error $? "cannot use bfd" "$LINENO" 5 ++ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++-#define IN_GCC ++- #include ++- int main() { symbol_info t; return 0;} +++ +++ #define IN_GCC +++ #include +++ +++int +++main () +++{ +++ +++ symbol_info t; +++ +++ ; +++ return 0; +++} ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++@@ -5785,10 +5470,20 @@ else ++ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++-#define CONST const ++- #define IN_GCC ++- #include ++- int main() {symbol_info t; return 0;} +++ +++ #define CONST const +++ #define IN_GCC +++ #include +++ +++int +++main () +++{ +++ +++ symbol_info t; +++ +++ ; +++ return 0; +++} ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++@@ -5820,13 +5515,13 @@ done ++ $as_echo "#define HAVE_LIBBFD 1" >>confdefs.h ++ ++ ++-# ++-# BFD boolean syntax ++-# +++ # +++ # BFD boolean syntax +++ # ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for useable bfd_boolean" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for useable bfd_boolean" >&5 ++ $as_echo_n "checking for useable bfd_boolean... " >&6; } ++- if test "$cross_compiling" = yes; then : +++ if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++ $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++ as_fn_error $? "cannot run test program while cross compiling ++@@ -5835,14 +5530,14 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- #define IN_GCC ++- #include ++- bfd_boolean foo() {return FALSE;} +++ #define IN_GCC +++ #include +++ bfd_boolean foo() {return FALSE;} ++ ++ int ++ main () ++ { ++-return 0; +++ ++ ; ++ return 0; ++ } ++@@ -5862,13 +5557,13 @@ rm -f core *.core core.conftest.* gmon.o ++ fi ++ ++ ++-# ++-# bfd_link_info.output_bfd minimal configure change check ++-# ++- ++- ac_fn_c_check_member "$LINENO" "struct bfd_link_info" "output_bfd" "ac_cv_member_struct_bfd_link_info_output_bfd" " ++- #include ++- #include +++ # +++ # bfd_link_info.output_bfd minimal configure change check +++ # +++ +++ ac_fn_c_check_member "$LINENO" "struct bfd_link_info" "output_bfd" "ac_cv_member_struct_bfd_link_info_output_bfd" " +++ #include +++ #include ++ ++ " ++ if test "x$ac_cv_member_struct_bfd_link_info_output_bfd" = xyes; then : ++@@ -5879,25 +5574,25 @@ fi ++ ++ ++ ++-# ++-# FIXME: Need to workaround mingw before this point -- CM ++-# ++- if test "$enable_statsysbfd" = "yes" && ! $CC -v 2>&1 | fgrep ming > /dev/null ; then ++- echo 'int main() {bfd_init();bfd_openr("/dev/null",0);return 0;}' >foo.c ++- MP=`$CC -Wl,-M -static -o foo foo.c -lbfd -liberty -ldl 2>&1 | grep -v : | tr '()' '\012\012' | $AWK '{print $NF}' | sort | uniq` ++- rm -f foo.c foo ++- if echo $MP | tr ' ' '\012' | grep libbfd.a >/dev/null; then ++- LIBBFD="`echo $MP | tr ' ' '\012' | grep libbfd.a | $AWK '{i=split($1,A,"/");for (j=1;j<=i;j++) if (j>1 && A[j]=="..") {j--;i-=2;for (k=j;k<=i;k++) A[k]=A[k+2];j--;}} END {for (j=1;j<=i;j++) printf("%s%s",A[j],j!=i ? "/" : "")}'`" ++- else ++- as_fn_error $? "cannot locate external libbfd.a" "$LINENO" 5 ++- fi ++- if echo $MP | tr ' ' '\012' | grep libiberty.a >/dev/null ; then ++- LIBIBERTY="`echo $MP | tr ' ' '\012' | grep libiberty.a | $AWK '{i=split($1,A,"/");for (j=1;j<=i;j++) if (j>1 && A[j]=="..") {j--;i-=2;for (k=j;k<=i;k++) A[k]=A[k+2];j--;}} END {for (j=1;j<=i;j++) printf("%s%s",A[j],j!=i ? "/" : "")}'`" ++- else ++- as_fn_error $? "cannot locate external libiberty.a" "$LINENO" 5 ++- fi ++- BUILD_BFD=copy_bfd ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inflate in -lz" >&5 +++ # +++ # FIXME: Need to workaround mingw before this point -- CM +++ # +++ if test "$enable_statsysbfd" = "yes" && ! $CC -v 2>&1 | fgrep ming > /dev/null ; then +++ echo 'int main() {bfd_init();bfd_openr("/dev/null",0);return 0;}' >foo.c +++ MP=`$CC -Wl,-M -static -o foo foo.c -lbfd -liberty -ldl 2>&1 | grep -v : | tr '()' '\012\012' | $AWK '{print $NF}' | sort | uniq` +++ rm -f foo.c foo +++ if echo $MP | tr ' ' '\012' | grep libbfd.a >/dev/null; then +++ LIBBFD="`echo $MP | tr ' ' '\012' | grep libbfd.a | $AWK '{i=split($1,A,\"/\");for (j=1;j<=i;j++) if (j>1 && A[j]==\"..\") {j--;i-=2;for (k=j;k<=i;k++) A[k]=A[k+2];j--;}} END {for (j=1;j<=i;j++) printf(\"%s%s\",A[j],j!=i ? \"/\" : \"\")}'`" +++ else +++ as_fn_error $? "cannot locate external libbfd.a" "$LINENO" 5 +++ fi +++ if echo $MP | tr ' ' '\012' | grep libiberty.a >/dev/null ; then +++ LIBIBERTY="`echo $MP | tr ' ' '\012' | grep libiberty.a | $AWK '{i=split($1,A,\"/\");for (j=1;j<=i;j++) if (j>1 && A[j]==\"..\") {j--;i-=2;for (k=j;k<=i;k++) A[k]=A[k+2];j--;}} END {for (j=1;j<=i;j++) printf(\"%s%s\",A[j],j!=i ? \"/\" : \"\")}'`" +++ else +++ as_fn_error $? "cannot locate external libiberty.a" "$LINENO" 5 +++ fi +++ BUILD_BFD=copy_bfd +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inflate in -lz" >&5 ++ $as_echo_n "checking for inflate in -lz... " >&6; } ++ if ${ac_cv_lib_z_inflate+:} false; then : ++ $as_echo_n "(cached) " >&6 ++@@ -5939,7 +5634,7 @@ else ++ as_fn_error $? "Need zlib for bfd linking" "$LINENO" 5 ++ fi ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlsym in -ldl" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlsym in -ldl" >&5 ++ $as_echo_n "checking for dlsym in -ldl... " >&6; } ++ if ${ac_cv_lib_dl_dlsym+:} false; then : ++ $as_echo_n "(cached) " >&6 ++@@ -5985,76 +5680,22 @@ fi ++ ++ ++ ++- else ++- TLIBS="$TLIBS -lbfd -liberty -ldl" ++- fi +++ else +++ TLIBS="$TLIBS -lbfd -liberty -ldl" +++ fi ++ fi ++ ++-if test "$enable_locbfd" = "yes" ; then ++- ++- # check for gettext. It is part of glibc, but others ++- # need GNU gettext separately. ++-# AC_CHECK_HEADERS(libintl.h, true, ++-# AC_MSG_ERROR(libintl.h (gettext) not found)) ++-# AC_SEARCH_LIBS(dgettext, intl, true, AC_MSG_ERROR(gettext library not found)) ++- ++- echo "#" ++- echo "#" ++- echo "# -------------------------" ++- echo "# Subconfigure of LIBINTL" ++- echo "#" ++- echo "#" ++- cd binutils/intl && chmod +x configure && ./configure --disable-nls && cd ../.. ++-# MY_SUBDIRS="$MY_SUBDIRS binutils/libiberty " ++- echo "#" ++- echo "#" ++- echo "#" ++- echo "# Subconfigure of LIBINTL done" ++- echo "# ------------------------------" ++- echo "#" ++- echo "#" ++- echo "#" ++- echo "# -------------------------" ++- echo "# Subconfigure of LIBIBERTY" ++- echo "#" ++- echo "#" ++- cd binutils/libiberty && chmod +x configure && ./configure --disable-nls && cd ../.. ++-# MY_SUBDIRS="$MY_SUBDIRS binutils/libiberty " ++- echo "#" ++- echo "#" ++- echo "#" ++- echo "# Subconfigure of LIBIBERTY done" ++- echo "# ------------------------------" ++- echo "#" ++- echo "#" ++- echo "#" ++- echo "# -------------------" ++- echo "# Subconfigure of BFD" ++- echo "#" ++- echo "#" ++- cd binutils/bfd && chmod +x configure && ./configure --with-included-gettext --disable-nls && cd ../.. ++-# MY_SUBDIRS="$MY_SUBDIRS binutils/bfd " ++- echo "#" ++- echo "#" ++- echo "#" ++- echo "# Subconfigure of BFD done" ++- echo "# ------------------------" ++- echo "#" ++-# TLIBS="$TLIBS `pwd`/binutils/bfd/libbfd.a `pwd`/binutils/libiberty/libiberty.a" ++- ++-$as_echo "#define HAVE_LIBBFD 1" >>confdefs.h ++- ++- BUILD_BFD="h/bfd.h h/bfdlink.h h/ansidecl.h h/symcat.h" ++- +++# Check whether --enable-xdr was given. +++if test "${enable_xdr+set}" = set; then : +++ enableval=$enable_xdr; ++ fi ++ ++ ++-if test "$enable_xdr" = "yes" ; then ++- ac_fn_c_check_func "$LINENO" "xdr_double" "ac_cv_func_xdr_double" +++if test "$enable_xdr" != "no" ; then +++ XDR_LIB="" +++ ac_fn_c_check_func "$LINENO" "xdr_double" "ac_cv_func_xdr_double" ++ if test "x$ac_cv_func_xdr_double" = xyes; then : ++- ++-$as_echo "#define HAVE_XDR 1" >>confdefs.h ++- +++ XDR_LIB=" " ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -ltirpc" >&5 ++ $as_echo_n "checking for xdr_double in -ltirpc... " >&6; } ++@@ -6093,10 +5734,7 @@ fi ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tirpc_xdr_double" >&5 ++ $as_echo "$ac_cv_lib_tirpc_xdr_double" >&6; } ++ if test "x$ac_cv_lib_tirpc_xdr_double" = xyes; then : ++- ++-$as_echo "#define HAVE_XDR 1" >>confdefs.h ++- ++- TLIBS="$TLIBS -ltirpc" TCFLAGS="$TCFLAGS -I/usr/include/tirpc" +++ XDR_LIB=tirpc ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -lgssrpc" >&5 ++ $as_echo_n "checking for xdr_double in -lgssrpc... " >&6; } ++@@ -6135,10 +5773,7 @@ fi ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gssrpc_xdr_double" >&5 ++ $as_echo "$ac_cv_lib_gssrpc_xdr_double" >&6; } ++ if test "x$ac_cv_lib_gssrpc_xdr_double" = xyes; then : ++- ++-$as_echo "#define HAVE_XDR 1" >>confdefs.h ++- ++- TLIBS="$TLIBS -lgssrpc" TCFLAGS="$TCFLAGS -I/usr/include/gssrpc" +++ XDR_LIB=gssrpc ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -lrpc" >&5 ++ $as_echo_n "checking for xdr_double in -lrpc... " >&6; } ++@@ -6177,10 +5812,7 @@ fi ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_rpc_xdr_double" >&5 ++ $as_echo "$ac_cv_lib_rpc_xdr_double" >&6; } ++ if test "x$ac_cv_lib_rpc_xdr_double" = xyes; then : ++- ++-$as_echo "#define HAVE_XDR 1" >>confdefs.h ++- ++- TLIBS="$TLIBS -lrpc" TCFLAGS="$TCFLAGS -I/usr/include/rpc" +++ XDR_LIB=rpc ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -loncrpc" >&5 ++ $as_echo_n "checking for xdr_double in -loncrpc... " >&6; } ++@@ -6219,10 +5851,7 @@ fi ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_oncrpc_xdr_double" >&5 ++ $as_echo "$ac_cv_lib_oncrpc_xdr_double" >&6; } ++ if test "x$ac_cv_lib_oncrpc_xdr_double" = xyes; then : ++- ++-$as_echo "#define HAVE_XDR 1" >>confdefs.h ++- ++- TLIBS="$TLIBS -loncrpc" TCFLAGS="$TCFLAGS -I/usr/include/oncrpc" +++ XDR_LIB=oncrpc ++ fi ++ ++ fi ++@@ -6233,6 +5862,16 @@ fi ++ ++ fi ++ +++ +++ if test "$XDR_LIB" != ""; then +++ +++$as_echo "#define HAVE_XDR 1" >>confdefs.h +++ +++ if test "$XDR_LIB" != " "; then +++ TLIBS="$TLIBS -l$XDR_LIB" +++ add_arg_to_tcflags -I/usr/include/$XDR_LIB +++ fi +++ fi ++ fi ++ ++ ++@@ -6247,18 +5886,24 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- #include ++- #include ++- int main() { ++- unsigned long u; ++- long j; ++- if (__builtin_clzl(0)!=sizeof(long)*8) ++- return -1; ++- for (u=1,j=sizeof(long)*8-1;j>=0;j--,u<<=1) ++- if (__builtin_clzl(u)!=j) ++- return -1; ++- return 0; ++- } +++ #include +++ #include +++ +++int +++main () +++{ +++ +++ unsigned long u; +++ long j; +++ if (__builtin_clzl(0)!=sizeof(long)*8) +++ return -1; +++ for (u=1,j=sizeof(long)*8-1;j>=0;j--,u<<=1) +++ if (__builtin_clzl(u)!=j) +++ return -1; +++ +++ ; +++ return 0; +++} ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++@@ -6286,18 +5931,24 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- #include ++- #include ++- int main() { ++- unsigned long u; ++- long j; ++- if (__builtin_ctzl(0)!=sizeof(long)*8) ++- return -1; ++- for (u=1,j=0;j +++ #include +++ +++int +++main () +++{ +++ +++ unsigned long u; +++ long j; +++ if (__builtin_ctzl(0)!=sizeof(long)*8) +++ return -1; +++ for (u=1,j=0;j&5 ++@@ -6316,13 +5967,13 @@ fi ++ ++ ++ case $use in ++- sh4*) ;; #FIXME, these exceptions needed as of gcc 4.7 ++- hppa*) ;; #FIXME ++- powerpc*) ;; #FIXME ++- alpha*) ;; #FIXME ++- ia64*) ;; #FIXME ++- *) ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking __builtin___clear_cache" >&5 +++ sh4*) ;; #FIXME, these exceptions needed as of gcc 4.7 +++ hppa*) ;; #FIXME +++ powerpc*) ;; #FIXME +++ alpha*) ;; #FIXME +++ ia64*) ;; #FIXME +++ *) +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking __builtin___clear_cache" >&5 ++ $as_echo_n "checking __builtin___clear_cache... " >&6; } ++ if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++@@ -6333,7 +5984,6 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- ++ int ++ main () ++ { ++@@ -6349,7 +5999,7 @@ if ac_fn_c_try_run "$LINENO"; then : ++ ++ $as_echo "#define HAVE_BUILTIN_CLEAR_CACHE 1" >>confdefs.h ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ $as_echo "yes" >&6; } ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++@@ -6414,13 +6064,10 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- ++- ++ int ++ main () ++ { ++ ++- ++ /* Are we little or big endian? Adapted from Harbison&Steele. */ ++ union {long l;char c[sizeof(long)];} u; ++ u.l = 1; ++@@ -6459,8 +6106,6 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- ++- ++ int ++ main () ++ { ++@@ -6494,8 +6139,8 @@ fi ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pagewidth" >&5 ++ $as_echo_n "checking for pagewidth... " >&6; } ++ case $use in ++- mips*) min_pagewidth=14;; ++- *) min_pagewidth=12;; +++ mips*) min_pagewidth=14;; +++ *) min_pagewidth=12;; ++ esac ++ if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++@@ -6506,23 +6151,21 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- ++- #include ++- #include ++- #ifdef __CYGWIN__ ++- #define getpagesize() 4096 ++- #endif +++ #include +++ #include +++ #ifdef __CYGWIN__ +++ #define getpagesize() 4096 +++ #endif ++ ++ int ++ main () ++ { ++ ++- size_t i=getpagesize(),j; ++- FILE *fp=fopen("conftest1","w"); ++- for (j=0;i>>=1;j++); ++- j=j<$min_pagewidth ? $min_pagewidth : j; ++- fprintf(fp,"%u",j); ++- return 0; +++ size_t i=getpagesize(),j; +++ FILE *fp=fopen("conftest1","w"); +++ for (j=0;i>>=1;j++); +++ j=j<$min_pagewidth ? $min_pagewidth : j; +++ fprintf(fp,"%u",j); ++ ++ ; ++ return 0; ++@@ -6557,27 +6200,27 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- #include ++- #define EXTER ++- #define INLINE ++- #include "$MP_INCLUDE" ++- #include "./h/enum.h" ++- #define OBJ_ALIGN ++- #include "./h/type.h" ++- #include "./h/lu.h" ++- #include "./h/object.h" +++ #include +++ #define EXTER +++ #define INLINE +++ #include "$MP_INCLUDE" +++ #include "./h/enum.h" +++ #define OBJ_ALIGN +++ #include "./h/type.h" +++ #include "./h/lu.h" +++ #include "./h/object.h" ++ ++ int ++ main () ++ { ++ ++- unsigned long i; ++- FILE *fp=fopen("conftest1","w"); ++- for (i=1;i && NOT_OBJECT_ALIGNED(i); i<<=1); ++- if (!i) return -1; ++- fprintf(fp,"%lu",i); ++- fclose(fp); ++- return 0; +++ unsigned long i; +++ FILE *fp=fopen("conftest1","w"); +++ for (i=1;i && NOT_OBJECT_ALIGNED(i); i<<=1); +++ if (!i) return -1; +++ fprintf(fp,"%lu",i); +++ fclose(fp); +++ return 0; ++ ++ ; ++ return 0; ++@@ -6585,7 +6228,7 @@ main () ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++ obj_align=`cat conftest1` ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $obj_align" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $obj_align" >&5 ++ $as_echo "$obj_align" >&6; } ++ ++ cat >>confdefs.h <<_ACEOF ++@@ -6615,8 +6258,8 @@ int ++ main () ++ { ++ ++- char *v __attribute__ ((aligned ($obj_align))); ++- return 0; +++ char *v __attribute__ ((aligned ($obj_align))); +++ ++ ; ++ return 0; ++ } ++@@ -6653,8 +6296,8 @@ int ++ main () ++ { ++ ++- extern int v() __attribute__ ((noreturn)); ++- return 0; +++ extern int v() __attribute__ ((noreturn)); +++ ++ ; ++ return 0; ++ } ++@@ -6679,68 +6322,43 @@ _ACEOF ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking sizeof struct contblock" >&5 ++ $as_echo_n "checking sizeof struct contblock... " >&6; } ++ ++-# work around MSYS pwd result incompatibility ++-if test "$use" = "mingw" ; then ++ if test "$cross_compiling" = yes; then : ++- echo Cannot find sizeof struct contblock;exit 1 +++ as_fn_error $? "Cannot find sizeof struct contblock" "$LINENO" 5 ++ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++-#include ++- #define EXTER ++- #define INLINE ++- #include "$MP_INCLUDE" ++- #include "h/enum.h" ++- #include "h/type.h" ++- #include "h/lu.h" ++- #include "h/object.h" ++- int main(int argc,char **argv,char **envp) { ++- FILE *f=fopen("conftest1","w"); ++- fprintf(f,"%u",sizeof(struct contblock)); ++- fclose(f); ++- return 0; ++- } ++-_ACEOF ++-if ac_fn_c_try_run "$LINENO"; then : ++- sizeof_contblock=`cat conftest1` ++-else ++- echo Cannot find sizeof struct contblock;exit 1 ++-fi ++-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++- conftest.$ac_objext conftest.beam conftest.$ac_ext ++-fi ++ ++-else ++-if test "$cross_compiling" = yes; then : ++- echo Cannot find sizeof struct contblock;exit 1 ++-else ++- cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++-/* end confdefs.h. */ ++-#include ++- #define EXTER ++- #define INLINE ++- #include "$MP_INCLUDE" ++- #include "`pwd`/h/enum.h" ++- #include "`pwd`/h/type.h" ++- #include "`pwd`/h/lu.h" ++- #include "`pwd`/h/object.h" ++- int main(int argc,char **argv,char **envp) { ++- FILE *f=fopen("conftest1","w"); ++- fprintf(f,"%u",sizeof(struct contblock)); ++- fclose(f); ++- return 0; ++- } +++ #include +++ #define EXTER +++ #define INLINE +++ #include "$MP_INCLUDE" +++ #include "h/enum.h" +++ #include "h/type.h" +++ #include "h/lu.h" +++ #include "h/object.h" +++ +++int +++main () +++{ +++ +++ FILE *f=fopen("conftest1","w"); +++ fprintf(f,"%u",sizeof(struct contblock)); +++ fclose(f); +++ +++ ; +++ return 0; +++} ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++ sizeof_contblock=`cat conftest1` ++ else ++- echo Cannot find sizeof struct contblock;exit 1 +++ as_fn_error $? "Cannot find sizeof struct contblock" "$LINENO" 5 ++ fi ++ rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++ fi ++ ++-fi +++ ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $sizeof_contblock" >&5 ++ $as_echo "$sizeof_contblock" >&6; } ++ ++@@ -6758,19 +6376,25 @@ $as_echo "no: WARNING you must be able t ++ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++-#include ++- #include ++- int main() { +++ +++ #include +++ #include +++ +++int +++main () +++{ +++ ++ FILE *f; ++ if (!(f=fopen("conftest1","w"))) ++- return -1; ++- fprintf(f,"%u",sbrk(0)); ++- return 0; ++- } +++ return -1; +++ fprintf(f,"%u",sbrk(0)); +++ +++ ; +++ return 0; +++} ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++- HAVE_SBRK=1 ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +++ HAVE_SBRK=1;{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ $as_echo "yes" >&6; } ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no: WARNING you must be able to emulate sbrk: as on mingw or macosx" >&5 ++@@ -6782,16 +6406,16 @@ fi ++ ++ ++ if test "$use" = "386-macosx" ; then ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: emulating sbrk for mac" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: emulating sbrk for mac" >&5 ++ $as_echo "emulating sbrk for mac" >&6; }; ++- HAVE_SBRK=0 +++ HAVE_SBRK=0 ++ fi ++ ++ if test "$HAVE_SBRK" = "1" ; then ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ADDR_NO_RANDOMIZE constant" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ADDR_NO_RANDOMIZE constant" >&5 ++ $as_echo_n "checking for ADDR_NO_RANDOMIZE constant... " >&6; } ++- if test "$cross_compiling" = yes; then : +++ if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++ $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++ as_fn_error $? "cannot run test program while cross compiling ++@@ -6800,18 +6424,16 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- ++- #include ++- #include +++ #include +++ #include ++ ++ int ++ main () ++ { ++ ++- FILE *f; ++- if (!(f=fopen("conftest1","w"))) return -1; ++- fprintf(f,"%x",ADDR_NO_RANDOMIZE); ++- return 0; +++ FILE *f; +++ if (!(f=fopen("conftest1","w"))) return -1; +++ fprintf(f,"%x",ADDR_NO_RANDOMIZE); ++ ++ ; ++ return 0; ++@@ -6819,11 +6441,11 @@ main () ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++ ADDR_NO_RANDOMIZE=`cat conftest1` ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes $ADDR_NO_RANDOMIZE" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes $ADDR_NO_RANDOMIZE" >&5 ++ $as_echo "yes $ADDR_NO_RANDOMIZE" >&6; } ++ else ++ ADDR_NO_RANDOMIZE=0 ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no assuming 0x40000" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no assuming 0x40000" >&5 ++ $as_echo "no assuming 0x40000" >&6; } ++ ++ cat >>confdefs.h <<_ACEOF ++@@ -6836,9 +6458,9 @@ rm -f core *.core core.conftest.* gmon.o ++ fi ++ ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ADDR_COMPAT_LAYOUT constant" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ADDR_COMPAT_LAYOUT constant" >&5 ++ $as_echo_n "checking for ADDR_COMPAT_LAYOUT constant... " >&6; } ++- if test "$cross_compiling" = yes; then : +++ if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++ $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++ as_fn_error $? "cannot run test program while cross compiling ++@@ -6847,18 +6469,16 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- ++- #include ++- #include +++ #include +++ #include ++ ++ int ++ main () ++ { ++ ++- FILE *f; ++- if (!(f=fopen("conftest1","w"))) return -1; ++- fprintf(f,"%x",ADDR_COMPAT_LAYOUT); ++- return 0; +++ FILE *f; +++ if (!(f=fopen("conftest1","w"))) return -1; +++ fprintf(f,"%x",ADDR_COMPAT_LAYOUT); ++ ++ ; ++ return 0; ++@@ -6866,11 +6486,11 @@ main () ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++ ADDR_COMPAT_LAYOUT=`cat conftest1` ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes $ADDR_COMPAT_LAYOUT" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes $ADDR_COMPAT_LAYOUT" >&5 ++ $as_echo "yes $ADDR_COMPAT_LAYOUT" >&6; } ++ else ++ ADDR_COMPAT_LAYOUT=0 ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++ $as_echo "no" >&6; } ++ ++ cat >>confdefs.h <<_ACEOF ++@@ -6883,9 +6503,9 @@ rm -f core *.core core.conftest.* gmon.o ++ fi ++ ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ADDR_LIMIT_3GB constant" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ADDR_LIMIT_3GB constant" >&5 ++ $as_echo_n "checking for ADDR_LIMIT_3GB constant... " >&6; } ++- if test "$cross_compiling" = yes; then : +++ if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++ $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++ as_fn_error $? "cannot run test program while cross compiling ++@@ -6894,18 +6514,16 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- ++- #include ++- #include +++ #include +++ #include ++ ++ int ++ main () ++ { ++ ++- FILE *f; ++- if (!(f=fopen("conftest1","w"))) return -1; ++- fprintf(f,"%x",ADDR_LIMIT_3GB); ++- return 0; +++ FILE *f; +++ if (!(f=fopen("conftest1","w"))) return -1; +++ fprintf(f,"%x",ADDR_LIMIT_3GB); ++ ++ ; ++ return 0; ++@@ -6913,11 +6531,11 @@ main () ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++ ADDR_LIMIT_3GB=`cat conftest1` ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes $ADDR_LIMIT_3GB" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes $ADDR_LIMIT_3GB" >&5 ++ $as_echo "yes $ADDR_LIMIT_3GB" >&6; } ++ else ++ ADDR_LIMIT_3GB=0 ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++ $as_echo "no" >&6; } ++ ++ cat >>confdefs.h <<_ACEOF ++@@ -6930,9 +6548,9 @@ rm -f core *.core core.conftest.* gmon.o ++ fi ++ ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for personality(ADDR_NO_RANDOMIZE) support" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for personality(ADDR_NO_RANDOMIZE) support" >&5 ++ $as_echo_n "checking for personality(ADDR_NO_RANDOMIZE) support... " >&6; } ++- if test "$cross_compiling" = yes; then : +++ if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++ $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++ as_fn_error $? "cannot run test program while cross compiling ++@@ -6941,12 +6559,13 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ +++ #include +++ #include +++ int main(int argc,char *argv[],char *envp[]) { +++ #include "h/unrandomize.h" +++ return 0; +++ } ++ ++- #include ++- #include ++- int main(int argc,char **argv,char **envp) { ++- #include "h/unrandomize.h" ++- return 0;} ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++@@ -6963,92 +6582,89 @@ rm -f core *.core core.conftest.* gmon.o ++ fi ++ ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking that sbrk is (now) non-random" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking that sbrk is (now) non-random" >&5 ++ $as_echo_n "checking that sbrk is (now) non-random... " >&6; } ++- if test "$cross_compiling" = yes; then : ++- SBRK=0 +++ SBRK=0 +++ if test "$cross_compiling" = yes; then : +++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +++as_fn_error $? "cannot run test program while cross compiling +++See \`config.log' for more details" "$LINENO" 5; } ++ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++-#include ++- #include +++ +++ #include +++ #include ++ int main(int argc,char * argv[],char * envp[]) { ++ FILE *f; ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++- if (!(f=fopen("conftest1","w"))) return -1; ++- fprintf(f,"%u",sbrk(0)); ++- return 0;} +++ if (!(f=fopen("conftest1","w"))) +++ return -1; +++ fprintf(f,"%u",sbrk(0)); +++ return 0; +++ } +++ ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++ SBRK=`cat conftest1` ++-else ++- SBRK=0 ++ fi ++ rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++ fi ++ ++- if test "$SBRK" = "0" ; then ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot trap sbrk" >&5 ++-$as_echo "cannot trap sbrk" >&6; } ++- exit 1 ++- fi ++- if test "$cross_compiling" = yes; then : ++- SBRK1=0 +++ if test "$SBRK" = "0" ; then +++ as_fn_error $? "cannot trap sbrk" "$LINENO" 5 +++ fi +++ +++ SBRK1=0 +++ if test "$cross_compiling" = yes; then : +++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +++as_fn_error $? "cannot run test program while cross compiling +++See \`config.log' for more details" "$LINENO" 5; } ++ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++-#include ++- #include +++ +++ #include +++ #include ++ int main(int argc,char * argv[],char * envp[]) { ++ FILE *f; ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ if (!(f=fopen("conftest1","w"))) return -1; ++- fprintf(f,"%u",sbrk(0)); ++- return 0;} +++ fprintf(f,"%u",sbrk(0)); +++ return 0; +++ } +++ ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++ SBRK1=`cat conftest1` ++-else ++- SBRK1=0 ++ fi ++ rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++ fi ++ ++- if test "$SBRK1" = "0" ; then ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot trap sbrk" >&5 ++-$as_echo "cannot trap sbrk" >&6; } ++- exit 1 ++- fi ++- if test "$SBRK" = "$SBRK1" ; then ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +++ if test "$SBRK1" = "0" ; then +++ as_fn_error $? "cannot trap sbrk" "$LINENO" 5 +++ fi +++ if test "$SBRK" = "$SBRK1" ; then +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ $as_echo "yes" >&6; } ++- else ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +++ else +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++ $as_echo "no" >&6; } ++- echo "Cannot build with randomized sbrk. Your options:" ++- echo " - upgrade to a kernel/libc that knows about personality(ADDR_NO_RANDOMIZE)" ++- echo " - recompile your kernel with CONFIG_COMPAT_BRK (if it has that option)" ++- echo " - run sysctl kernel.randomize_va_space=0 before using gcl" ++- exit 1 ++- fi +++ echo "Cannot build with randomized sbrk. Your options:" +++ echo " - upgrade to a kernel/libc that knows about personality(ADDR_NO_RANDOMIZE)" +++ echo " - recompile your kernel with CONFIG_COMPAT_BRK (if it has that option)" +++ echo " - run sysctl kernel.randomize_va_space=0 before using gcl" +++ as_fn_error $? "exiting" "$LINENO" 5 +++ fi ++ fi ++- ++- ++- ++- ++- ++- ++- ++- ++- ++- ++- ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking CSTACK_ADDRESS" >&5 ++ $as_echo_n "checking CSTACK_ADDRESS... " >&6; } ++ if test "$cross_compiling" = yes; then : ++@@ -7060,34 +6676,35 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- #include ++- #include ++- void * ++- foo() { ++- int i; ++- return (void *)&i; ++- } ++- ++- int main(int argc,char **argv,char **envp) { ++- void *v ; ++- FILE *fp = fopen("conftest1","w"); ++- unsigned long i,j; ++- ++- #ifdef CAN_UNRANDOMIZE_SBRK ++- #include "h/unrandomize.h" ++- #endif ++- j=1; ++- j<<=$PAGEWIDTH; ++- j<<=16; ++- i=(unsigned long)&v; ++- if (foo()>i) i-=j; ++- j--; ++- i+=j; ++- i&=~j; ++- fprintf(fp,"0x%lx",i-1); ++- fclose(fp); ++- return 0; ++-} +++ #include +++ #include +++ void * +++ foo() { +++ int i; +++ return (void *)&i; +++ } +++ +++ int +++ main(int argc,char **argv,char **envp) { +++ void *v ; +++ FILE *fp = fopen("conftest1","w"); +++ unsigned long i,j; +++ +++ #ifdef CAN_UNRANDOMIZE_SBRK +++ #include "h/unrandomize.h" +++ #endif +++ j=1; +++ j<<=$PAGEWIDTH; +++ j<<=16; +++ i=(unsigned long)&v; +++ if (foo()>i) i-=j; +++ j--; +++ i+=j; +++ i&=~j; +++ fprintf(fp,"0x%lx",i-1); +++ fclose(fp); +++ return 0; +++ } ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++ cstack_address=`cat conftest1` ++@@ -7117,35 +6734,36 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- #include ++- #include ++- void * ++- foo() { ++- int i; ++- return (void *)&i; ++- } ++- ++- int main(int argc,char **argv,char **envp) { ++- void *v ; ++- FILE *fp = fopen("conftest1","w"); ++- unsigned long i,j; ++- ++- #ifdef CAN_UNRANDOMIZE_SBRK ++- #include "h/unrandomize.h" ++- #endif ++- j=1; ++- j<<=$PAGEWIDTH; ++- j<<=16; ++- i=(unsigned long)&v; ++- if (foo()>i) i-=j; ++- j--; ++- i+=j; ++- i&=~j; ++- for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); ++- fprintf(fp,"%d",j); ++- fclose(fp); ++- return 0; ++-} +++ #include +++ #include +++ void * +++ foo() { +++ int i; +++ return (void *)&i; +++ } +++ +++ int +++ main(int argc,char **argv,char **envp) { +++ void *v ; +++ FILE *fp = fopen("conftest1","w"); +++ unsigned long i,j; +++ +++ #ifdef CAN_UNRANDOMIZE_SBRK +++ #include "h/unrandomize.h" +++ #endif +++ j=1; +++ j<<=$PAGEWIDTH; +++ j<<=16; +++ i=(unsigned long)&v; +++ if (foo()>i) i-=j; +++ j--; +++ i+=j; +++ i&=~j; +++ for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); +++ fprintf(fp,"%d",j); +++ fclose(fp); +++ return 0; +++ } ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++ cstack_bits=`cat conftest1` ++@@ -7175,33 +6793,33 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- #include ++- #include ++- int main(int argc,char **argv,char **envp) { ++- #ifdef CAN_UNRANDOMIZE_SBRK ++- #include "h/unrandomize.h" ++- #endif ++- return (long)$cstack_address<0 ? 0 : -1; ++-} +++ #include +++ #include +++ int +++ main(int argc,char **argv,char **envp) { +++ #ifdef CAN_UNRANDOMIZE_SBRK +++ #include "h/unrandomize.h" +++ #endif +++ return (long)$cstack_address<0 ? 0 : -1; +++ } ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ $as_echo "yes" >&6; } ++- neg_cstack_address=1 +++ neg_cstack_address=1 ++ ++ $as_echo "#define NEG_CSTACK_ADDRESS 1" >>confdefs.h ++ ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++ $as_echo "no" >&6; } ++- neg_cstack_address=0 +++ neg_cstack_address=0 ++ fi ++ rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++ fi ++ ++ ++- ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking finding CSTACK_ALIGNMENT" >&5 ++ $as_echo_n "checking finding CSTACK_ALIGNMENT... " >&6; } ++ if test "$cross_compiling" = yes; then : ++@@ -7213,23 +6831,23 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- #include ++- #include ++- int main(int argc,char **argv,char **envp) { ++- void *b,*c; ++- FILE *fp = fopen("conftest1","w"); ++- long n; ++- #ifdef CAN_UNRANDOMIZE_SBRK ++- #include "h/unrandomize.h" ++- #endif ++- b=alloca(sizeof(b)); ++- c=alloca(sizeof(c)); ++- n=b>c ? b-c : c-b; ++- n=n>sizeof(c) ? n : 1; ++- fprintf(fp,"%ld",n); ++- fclose(fp); ++- return 0; ++-} +++ #include +++ #include +++ int main(int argc,char **argv,char **envp) { +++ void *b,*c; +++ FILE *fp = fopen("conftest1","w"); +++ long n; +++ #ifdef CAN_UNRANDOMIZE_SBRK +++ #include "h/unrandomize.h" +++ #endif +++ b=alloca(sizeof(b)); +++ c=alloca(sizeof(c)); +++ n=b>c ? b-c : c-b; +++ n=n>sizeof(c) ? n : 1; +++ fprintf(fp,"%ld",n); +++ fclose(fp); +++ return 0; +++ } ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++ cstack_alignment=`cat conftest1` ++@@ -7259,24 +6877,25 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- #include ++- #include ++- void * ++- foo(void) { ++- int i; ++- return (void *)&i; ++- } ++- ++- int main(int argc,char **argv,char **envp) { ++- char *b; ++- FILE *fp = fopen("conftest1","w"); ++- #ifdef CAN_UNRANDOMIZE_SBRK ++- #include "h/unrandomize.h" ++- #endif ++- fprintf(fp,"%d",((long) &b) > ((long) foo()) ? -1 : 1); ++- fclose(fp); ++- return 0; ++-} +++ #include +++ #include +++ void * +++ foo(void) { +++ int i; +++ return (void *)&i; +++ } +++ +++ int +++ main(int argc,char **argv,char **envp) { +++ char *b; +++ FILE *fp = fopen("conftest1","w"); +++ #ifdef CAN_UNRANDOMIZE_SBRK +++ #include "h/unrandomize.h" +++ #endif +++ fprintf(fp,"%d",((long) &b) > ((long) foo()) ? -1 : 1); +++ fclose(fp); +++ return 0; +++ } ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++ cstack_direction=`cat conftest1` ++@@ -7295,62 +6914,74 @@ _ACEOF ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $cstack_direction" >&5 ++ $as_echo "$cstack_direction" >&6; } ++ +++# Check whether --enable-immfix was given. +++if test "${enable_immfix+set}" = set; then : +++ enableval=$enable_immfix; +++fi +++ +++ +++# Check whether --enable-fastimmfix was given. +++if test "${enable_fastimmfix+set}" = set; then : +++ enableval=$enable_fastimmfix; +++else +++ enable_fastimmfix=64 +++fi ++ ++ ++ ++ if test "$use" != "386-gnu" ; then #hurd can push .data below C stack, but sbrk(0) remains above, foiling unexec ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking finding default linker script" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking finding default linker script" >&5 ++ $as_echo_n "checking finding default linker script... " >&6; } ++- touch unixport/gcl.script ++- echo "int main() {return 0;}" >foo.c ++- $CC -Wl,--verbose foo.c -o foo 2>&1 | \ ++- $AWK '/\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=/ {i=1-i;next} {if (i) print}' >gcl.script ++- rm -rf foo.c foo +++ touch unixport/gcl.script +++ echo "int main() {return 0;}" >foo.c +++ $CC $TLDFLAGS -Wl,--verbose foo.c -o foo 2>&1 | \ +++ $AWK '/\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=/ {i=1-i;next} {if (i) print}' >gcl.script +++ rm -rf foo.c foo ++ ++- if test "`cat gcl.script | wc -l`" != "0" ; then ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: got it" >&5 +++ if test "`cat gcl.script | wc -l`" != "0" ; then +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: got it" >&5 ++ $as_echo "got it" >&6; } ++- { $as_echo "$as_me:${as_lineno-$LINENO}: trying to adjust text start" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: trying to adjust text start" >&5 ++ $as_echo "$as_me: trying to adjust text start" >&6;} ++- cp gcl.script gcl.script.def +++ cp gcl.script gcl.script.def ++ ++- n=-1; ++- k=0; ++- lim=`$AWK 'END {printf("%d\n",m*8-2)}' m=$ac_cv_sizeof_long`; ++- max=0; ++- min=$lim; ++- while test $n -lt $lim ; do ++- j=`$AWK 'END {for (i=j=0;j<=n;j++) i=i ? i*2 : 1;printf("%x\n",3*i)}' n=$n gcl.script ++-# diff -u gcl.script.def gcl.script ++- echo "int main() {return 0;}" >foo.c ++- if ( $CC -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then ++- if test $n -lt $min ; then min=$n; fi; ++- if test $n -gt $max; then max=$n; fi; ++- elif test $max -gt 0 ; then ++- break; ++- fi; ++- n=`$AWK 'END {print n+1}' n=$n gcl.script +++ # diff -u gcl.script.def gcl.script +++ echo "int main() {return 0;}" >foo.c +++ if ( $CC $TLDFLAGS -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then +++ if test $n -lt $min ; then min=$n; fi; +++ if test $n -gt $max; then max=$n; fi; +++ elif test $max -gt 0 ; then +++ break; +++ fi; +++ n=`$AWK 'END {print n+1}' n=$n &5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: min log text start $min" >&5 ++ $as_echo "$as_me: min log text start $min" >&6;} ++- { $as_echo "$as_me:${as_lineno-$LINENO}: max log text start $max" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: max log text start $max" >&5 ++ $as_echo "$as_me: max log text start $max" >&6;} ++ ++- if test $neg_cstack_address -eq 1 ; then #FIXME test this ++- if test $cstack_bits -lt $max ; then ++- max=$cstack_bits; ++- { $as_echo "$as_me:${as_lineno-$LINENO}: max log text start reduced to $max considering c stack address" >&5 +++ if test $neg_cstack_address -eq 1 ; then #FIXME test this +++ if test $cstack_bits -lt $max ; then +++ max=$cstack_bits; +++ { $as_echo "$as_me:${as_lineno-$LINENO}: max log text start reduced to $max considering c stack address" >&5 ++ $as_echo "$as_me: max log text start reduced to $max considering c stack address" >&6;} ++- fi ++- fi +++ fi +++ fi ++ ++- j=-1; ++- low_shft=""; ++- if test $min -le $max ; then ++- if test $max -ge $enable_fastimmfix && test "$enable_immfix" = "yes" ; then +++ j=-1; +++ low_shft=""; +++ if test $min -le $max ; then +++ if test $max -ge $enable_fastimmfix && test "$enable_immfix" != "no" ; then ++ j=`$AWK 'END {for (i=j=0;j<=n;j++) i=i ? i*2 : 1;printf("%x\n",3*i)}' n=$max &5 ++@@ -7360,9 +6991,9 @@ $as_echo "$as_me: raising log text to $j ++ { $as_echo "$as_me:${as_lineno-$LINENO}: lowering log text to $j to maximize data area" >&5 ++ $as_echo "$as_me: lowering log text to $j to maximize data area" >&6;} ++ fi ++- fi +++ fi ++ ++- if test "$low_shft" != "" ; then +++ if test "$low_shft" != "" ; then ++ ++ cat >>confdefs.h <<_ACEOF ++ #define LOW_SHFT $low_shft ++@@ -7373,34 +7004,34 @@ cat >>confdefs.h <<_ACEOF ++ #define OBJNULL (object)0x$j ++ _ACEOF ++ ++- else +++ else ++ ++ cat >>confdefs.h <<_ACEOF ++ #define OBJNULL NULL ++ _ACEOF ++ ++- fi +++ fi ++ ++-# echo $j; ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking our linker script" >&5 +++ # echo $j; +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking our linker script" >&5 ++ $as_echo_n "checking our linker script... " >&6; } ++- if test "$j" -ne "-1" ; then +++ if test "$j" -ne "-1" ; then ++ cat gcl.script.def | $AWK '/SIZEOF_HEADERS/ {gsub("0x[0-9]*","0x" j,$0);} {print}' j=$j >gcl.script ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: done" >&5 ++ $as_echo "done" >&6; } ++ rm -f gcl.script.def ++ LDFLAGS="$LDFLAGS -Wl,-T gcl.script " ++ cp gcl.script unixport ++- else ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: none found or not needed" >&5 +++ else +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: none found or not needed" >&5 ++ $as_echo "none found or not needed" >&6; } ++- rm -f gcl.script gcl.script.def ++- fi ++- rm -rf foo.c foo ++- else ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 +++ rm -f gcl.script gcl.script.def +++ fi +++ rm -rf foo.c foo +++ else +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 ++ $as_echo "not found" >&6; } ++- fi +++ fi ++ ++ else ++ ++@@ -7412,19 +7043,6 @@ _ACEOF ++ ++ fi ++ ++- ++- ++- ++- ++- ++- ++- ++- ++- ++- ++- ++- ++- ++ mem_top=0 ++ mem_range=0 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking mem top" >&5 ++@@ -7438,30 +7056,30 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- #include +++ #include ++ ++ int ++ main () ++ { ++ ++- void *v; ++- unsigned long i,j,k,l,m; ++- FILE *fp = fopen("conftest1","w"); ++- ++- for (i=2,k=1;i;k=i,i<<=1); ++- l=$cstack_address; ++- l=$cstack_direction==1 ? (l>=1,i|=j); ++- if (j<(k>>3)) i=0; ++- j=1; ++- j<<=$PAGEWIDTH; ++- j<<=4; ++- j--; ++- i+=j; ++- i&=~j; ++- fprintf(fp,"0x%lx",i); ++- fclose(fp); ++- return 0; +++ void *v; +++ unsigned long i,j,k,l,m; +++ FILE *fp = fopen("conftest1","w"); +++ +++ for (i=2,k=1;i;k=i,i<<=1); +++ l=$cstack_address; +++ l=$cstack_direction==1 ? (l>=1,i|=j); +++ if (j<(k>>3)) i=0; +++ j=1; +++ j<<=$PAGEWIDTH; +++ j<<=4; +++ j--; +++ i+=j; +++ i&=~j; +++ fprintf(fp,"0x%lx",i); +++ fclose(fp); +++ return 0; ++ ++ ; ++ return 0; ++@@ -7478,10 +7096,11 @@ fi ++ ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $mem_top" >&5 ++ $as_echo "$mem_top" >&6; } +++ ++ if test "$mem_top" != "0x0" ; then ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking finding upper mem half range" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking finding upper mem half range" >&5 ++ $as_echo_n "checking finding upper mem half range... " >&6; } ++- if test "$cross_compiling" = yes; then : +++ if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++ $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++ as_fn_error $? "cannot run test program while cross compiling ++@@ -7490,19 +7109,19 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- #include +++ #include ++ ++ int ++ main () ++ { ++ ++- unsigned long j; ++- FILE *fp = fopen("conftest1","w"); +++ unsigned long j; +++ FILE *fp = fopen("conftest1","w"); ++ ++- for (j=1;j && !(j& $mem_top);j<<=1); ++- fprintf(fp,"0x%lx",j>>1); ++- fclose(fp); ++- return 0; +++ for (j=1;j && !(j& $mem_top);j<<=1); +++ fprintf(fp,"0x%lx",j>>1); +++ fclose(fp); +++ return 0; ++ ++ ; ++ return 0; ++@@ -7517,9 +7136,9 @@ rm -f core *.core core.conftest.* gmon.o ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++ fi ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $mem_range" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $mem_range" >&5 ++ $as_echo "$mem_range" >&6; } ++- if test "$mem_range" != "0x0" ; then +++ if test "$mem_range" != "0x0" ; then ++ ++ cat >>confdefs.h <<_ACEOF ++ #define MEM_TOP $mem_top ++@@ -7530,12 +7149,12 @@ cat >>confdefs.h <<_ACEOF ++ #define MEM_RANGE $mem_range ++ _ACEOF ++ ++- fi +++ fi ++ fi ++ ++-if test "$enable_immfix" = "yes" ; then ++- if test "$mem_top" != "0x0" ; then ++- if test "$mem_range" != "0x0" ; then +++if test "$enable_immfix" != "no" ; then +++ if test "$mem_top" != "0x0" ; then +++ if test "$mem_range" != "0x0" ; then ++ ++ cat >>confdefs.h <<_ACEOF ++ #define IM_FIX_BASE $mem_top ++@@ -7546,24 +7165,10 @@ cat >>confdefs.h <<_ACEOF ++ #define IM_FIX_LIM $mem_range ++ _ACEOF ++ ++- fi ++- fi +++ fi +++ fi ++ fi ++ ++- ++- ++- ++-# On systems with execshield, brk is randomized. We need to catch ++-# this and restore the traditional behavior here ++- ++- ++- ++- ++- ++- ++- ++- ++- ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking sizeof long long int" >&5 ++ $as_echo_n "checking sizeof long long int... " >&6; } ++ if test "$cross_compiling" = yes; then : ++@@ -7575,14 +7180,14 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- #include +++ #include ++ ++ int ++ main () ++ { ++ ++- if (sizeof(long long int) == 2*sizeof(long)) return 0; ++- return 1; +++ if (sizeof(long long int) == 2*sizeof(long)) return 0; +++ return 1; ++ ++ ; ++ return 0; ++@@ -7604,7 +7209,6 @@ fi ++ ++ ++ ++- ++ for ac_header in dirent.h ++ do : ++ ac_fn_c_check_header_mongrel "$LINENO" "dirent.h" "ac_cv_header_dirent_h" "$ac_includes_default" ++@@ -7614,21 +7218,21 @@ if test "x$ac_cv_header_dirent_h" = xyes ++ _ACEOF ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for d_type" >&5 ++ $as_echo_n "checking for d_type... " >&6; } ++- if test "$cross_compiling" = yes; then : +++ if test "$cross_compiling" = yes; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++ $as_echo "no" >&6; } ++ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- #include +++ #include ++ ++ int ++ main () ++ { ++ ++- struct dirent d; ++- return d.d_type=0; +++ struct dirent d; +++ return d.d_type=0; ++ ++ ; ++ return 0; ++@@ -7652,32 +7256,18 @@ fi ++ done ++ ++ ++-# readline ++-# Check whether --enable-readline was given. ++-if test "${enable_readline+set}" = set; then : ++- enableval=$enable_readline; ++-else ++- enable_readline="yes" ++-fi ++- ++- ++ # ansi lisp +++SYSTEM=ansi_gcl +++CLSTANDARD=ANSI ++ # Check whether --enable-ansi was given. ++ if test "${enable_ansi+set}" = set; then : ++- enableval=$enable_ansi; ++-else ++- enable_ansi="yes" +++ enableval=$enable_ansi; if test "$enable_ansi" = "no" ; then +++ SYSTEM=gcl +++ CLSTANDARD=CLtL1 +++ fi ++ fi ++ ++ ++-if test "$enable_ansi" = "yes" ; then ++- SYSTEM=ansi_gcl ++- CLSTANDARD=ANSI ++-else ++- SYSTEM=gcl ++- CLSTANDARD=CLtL1 ++-fi ++- ++ FLISP="saved_$SYSTEM" ++ ++ ++@@ -7913,23 +7503,22 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- ++- #include +++ #include ++ ++ int ++ main () ++ { ++ ++- char *s= "2.7182818284590452353602874713526624977572470936999595749669676277240766303535475945713821785251664274274663919320030599218174135966290435729003342952605956307381323286279434907632338298807531952510190115738341879307021540891499348841675092447614606680822648001684774118537423454424371075390777449920695517027618386062613313845830007520449338265602976067371132007093287091274437470472306969772093101416928368190255151086574637721112523897844250569536967707854499699679468644549059879316368892300987931277361782154249992295763514822082698951936680331825288693984964651058209392398294887933203625094431173012381970684161404"; ++- int n, m; ++- double f; ++- char *endptr; ++- FILE *fp=fopen("conftest1","w"); +++ char *s= "2.7182818284590452353602874713526624977572470936999595749669676277240766303535475945713821785251664274274663919320030599218174135966290435729003342952605956307381323286279434907632338298807531952510190115738341879307021540891499348841675092447614606680822648001684774118537423454424371075390777449920695517027618386062613313845830007520449338265602976067371132007093287091274437470472306969772093101416928368190255151086574637721112523897844250569536967707854499699679468644549059879316368892300987931277361782154249992295763514822082698951936680331825288693984964651058209392398294887933203625094431173012381970684161404"; +++ int n, m; +++ double f; +++ char *endptr; +++ FILE *fp=fopen("conftest1","w"); ++ ++- n=sscanf(s,"%lf%n",&f,&m); ++- fprintf(fp,"%d",m); ++- fclose(fp); ++- return s[m]; +++ n=sscanf(s,"%lf%n",&f,&m); +++ fprintf(fp,"%d",m); +++ fclose(fp); +++ return s[m]; ++ ++ ; ++ return 0; ++@@ -7940,7 +7529,7 @@ if ac_fn_c_try_run "$LINENO"; then : ++ $as_echo "none" >&6; } ++ else ++ buggy_maximum_sscanf_length=`cat conftest1` ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $buggy_maximum_sscanf_length" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $buggy_maximum_sscanf_length" >&5 ++ $as_echo "$buggy_maximum_sscanf_length" >&6; } ++ ++ cat >>confdefs.h <<_ACEOF ++@@ -7955,8 +7544,10 @@ fi ++ ++ ++ EXTRA_LOBJS= ++-if test "$try_japi" = "yes" ; then ++- for ac_header in japi.h +++# Check whether --enable-japi was given. +++if test "${enable_japi+set}" = set; then : +++ enableval=$enable_japi; if test "$enable_japi" = "yes" ; then +++ for ac_header in japi.h ++ do : ++ ac_fn_c_check_header_mongrel "$LINENO" "japi.h" "ac_cv_header_japi_h" "$ac_includes_default" ++ if test "x$ac_cv_header_japi_h" = xyes; then : ++@@ -7965,14 +7556,16 @@ if test "x$ac_cv_header_japi_h" = xyes; ++ _ACEOF ++ $as_echo "#define HAVE_JAPI_H 1" >>confdefs.h ++ ++- EXTRA_LOBJS="${EXTRA_LOBJS} gcl_japi.o" ++- LIBS="${LIBS} -ljapi -lwsock32" +++ EXTRA_LOBJS="${EXTRA_LOBJS} gcl_japi.o" +++ LIBS="${LIBS} -ljapi -lwsock32" ++ fi ++ ++ done ++ +++ fi ++ fi ++ +++ ++ # Should really find a way to check for prototypes, but this ++ # basically works for now. CM ++ # ++@@ -8057,15 +7650,15 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- #define _GNU_SOURCE ++- #include +++ #define _GNU_SOURCE +++ #include ++ ++ int ++ main () ++ { ++ ++- float f; ++- return isnormal(f) || !isnormal(f) ? 0 : 1; +++ float f; +++ return isnormal(f) || !isnormal(f) ? 0 : 1; ++ ++ ; ++ return 0; ++@@ -8077,9 +7670,9 @@ $as_echo "#define HAVE_ISNORMAL 1" >>con ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ $as_echo "yes" >&6; } ++ else ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for fpclass in ieeefp.h" >&5 ++-$as_echo_n "checking for fpclass in ieeefp.h... " >&6; } ++- if test "$cross_compiling" = yes; then : +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for fpclass of ieeefp.h" >&5 +++$as_echo_n "checking for fpclass of ieeefp.h... " >&6; } +++ if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++ $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++ as_fn_error $? "cannot run test program while cross compiling ++@@ -8088,14 +7681,14 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- #include +++ #include ++ ++ int ++ main () ++ { ++ ++- float f; ++- return fpclass(f)>=FP_NZERO || fpclass(f)=FP_NZERO || fpclass(f)conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- #define _GNU_SOURCE ++- #include +++ #define _GNU_SOURCE +++ #include ++ ++ int ++ main () ++ { ++ ++- float f; ++- return isfinite(f) || !isfinite(f) ? 0 : 1; +++ float f; +++ return isfinite(f) || !isfinite(f) ? 0 : 1; ++ ++ ; ++ return 0; ++@@ -8153,7 +7746,7 @@ $as_echo "yes" >&6; } ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for finite()" >&5 ++ $as_echo_n "checking for finite()... " >&6; } ++- if test "$cross_compiling" = yes; then : +++ if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++ $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++ as_fn_error $? "cannot run test program while cross compiling ++@@ -8162,15 +7755,15 @@ else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++- #include ++- #include +++ #include +++ #include ++ ++ int ++ main () ++ { ++ ++- float f; ++- return finite(f) || !finite(f) ? 0 : 1; +++ float f; +++ return finite(f) || !finite(f) ? 0 : 1; ++ ++ ; ++ return 0; ++@@ -8194,8 +7787,6 @@ rm -f core *.core core.conftest.* gmon.o ++ fi ++ ++ ++- ++- ++ #-------------------------------------------------------------------- ++ # Check for the existence of the -lsocket and -lnsl libraries. ++ # The order here is important, so that they end up in the right ++@@ -8315,10 +7906,19 @@ fi ++ fi ++ ++ ++-RL_OBJS="" ++-RL_LIB="" ++-if test "$enable_readline" = "yes" ; then ++- for ac_header in readline/readline.h +++# readline +++# Check whether --enable-readline was given. +++if test "${enable_readline+set}" = set; then : +++ enableval=$enable_readline; +++fi +++ +++ +++if test "$use" = "mingw" ; then +++ enable_readline=no +++fi +++ +++if test "$enable_readline" != "no" ; then +++ for ac_header in readline/readline.h ++ do : ++ ac_fn_c_check_header_mongrel "$LINENO" "readline/readline.h" "ac_cv_header_readline_readline_h" "$ac_includes_default" ++ if test "x$ac_cv_header_readline_readline_h" = xyes; then : ++@@ -8365,12 +7965,8 @@ if test "x$ac_cv_lib_readline_rl_initial ++ ++ $as_echo "#define HAVE_READLINE 1" >>confdefs.h ++ ++- TLIBS="$TLIBS -lreadline" #some machines don't link this, e.g. Slackware ++- RL_OBJS=gcl_readline.o ++-# Readline support now initialized automatically when compiled in, this lisp ++-# object no longer needed -- 20040102 CM ++-# RL_LIB=lsp/gcl_readline.o ++- +++ TLIBS="$TLIBS -lreadline" #some machines don't link this, e.g. Slackware +++ RL_OBJS=gcl_readline.o ++ fi ++ ++ fi ++@@ -8378,8 +7974,8 @@ fi ++ done ++ ++ ++-# These tests discover differences between readline 4.1 and 4.3 ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for rl_completion_matches in -lreadline" >&5 +++ # These tests discover differences between readline 4.1 and 4.3 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for rl_completion_matches in -lreadline" >&5 ++ $as_echo_n "checking for rl_completion_matches in -lreadline... " >&6; } ++ if ${ac_cv_lib_readline_rl_completion_matches+:} false; then : ++ $as_echo_n "(cached) " >&6 ++@@ -8429,34 +8025,37 @@ fi ++ ++ ++ +++# sockets +++ ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking For network code for nsocket.c" >&5 ++ $as_echo_n "checking For network code for nsocket.c... " >&6; } ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++ ++-#include ++-#include ++-#include ++- ++-#include ++-#include ++-#include ++- ++-/************* for the sockets ******************/ ++-#include /* struct sockaddr, SOCK_STREAM, ... */ ++-#ifndef NO_UNAME ++-# include /* uname system call. */ ++-#endif ++-#include /* struct in_addr, struct sockaddr_in */ ++-#include /* inet_ntoa() */ ++-#include /* gethostbyname() */ +++ #include +++ #include +++ #include +++ +++ #include +++ #include +++ #include +++ +++ /************* for the sockets ******************/ +++ #include /* struct sockaddr, SOCK_STREAM, ... */ +++ #ifndef NO_UNAME +++ # include /* uname system call. */ +++ #endif +++ #include /* struct in_addr, struct sockaddr_in */ +++ #include /* inet_ntoa() */ +++ #include /* gethostbyname() */ ++ ++ int ++ main () ++ { ++- connect(0,(struct sockaddr *)0,0); ++- gethostbyname("jil"); ++- socket(AF_INET, SOCK_STREAM, 0); +++ +++ connect(0,(struct sockaddr *)0,0); +++ gethostbyname("jil"); +++ socket(AF_INET, SOCK_STREAM, 0); ++ ++ ; ++ return 0; ++@@ -8466,7 +8065,7 @@ if ac_fn_c_try_link "$LINENO"; then : ++ ++ $as_echo "#define HAVE_NSOCKET 1" >>confdefs.h ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ $as_echo "yes" >&6; } ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++@@ -8480,16 +8079,18 @@ rm -f core conftest.err conftest.$ac_obj ++ $as_echo_n "checking check for listen using fcntl... " >&6; } ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++-#include ++-#include +++ +++ #include +++ #include ++ ++ int ++ main () ++ { ++-FILE *fp=fopen("configure.in","r"); ++- int orig; ++- orig = fcntl(fileno(fp), F_GETFL); ++- if (! (orig & O_NONBLOCK )) return 0; +++ +++ FILE *fp=fopen("configure.in","r"); +++ int orig; +++ orig = fcntl(fileno(fp), F_GETFL); +++ if (! (orig & O_NONBLOCK )) return 0; ++ ++ ; ++ return 0; ++@@ -8499,7 +8100,7 @@ if ac_fn_c_try_compile "$LINENO"; then : ++ ++ $as_echo "#define LISTEN_USE_FCNTL 1" >>confdefs.h ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ $as_echo "yes" >&6; } ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++@@ -8508,8 +8109,6 @@ fi ++ rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ++ ++ ++- ++- ++ ac_fn_c_check_func "$LINENO" "profil" "ac_cv_func_profil" ++ if test "x$ac_cv_func_profil" = xyes; then : ++ ++@@ -8531,7 +8130,7 @@ fi ++ ++ ++ if test "$no_setenv" = "1" ; then ++-ac_fn_c_check_func "$LINENO" "putenv" "ac_cv_func_putenv" +++ ac_fn_c_check_func "$LINENO" "putenv" "ac_cv_func_putenv" ++ if test "x$ac_cv_func_putenv" = xyes; then : ++ ++ $as_echo "#define HAVE_PUTENV 1" >>confdefs.h ++@@ -8551,17 +8150,11 @@ fi ++ ++ gcl_ok=no ++ ++- ++- ++- ++- ++- ++-# if test "x$enable_machine" = "x" ; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5 ++ $as_echo_n "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O... " >&6; } ++ ++ case $system in ++- OSF*) +++ OSF*) ++ ++ $as_echo "#define USE_FIONBIO 1" >>confdefs.h ++ ++@@ -8593,8 +8186,9 @@ esac ++ $as_echo_n "checking check for SV_ONSTACK... " >&6; } ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++-#include ++-int joe=SV_ONSTACK; +++ +++ #include +++ int joe=SV_ONSTACK; ++ ++ int ++ main () ++@@ -8609,7 +8203,7 @@ if ac_fn_c_try_compile "$LINENO"; then : ++ $as_echo "#define HAVE_SV_ONSTACK 1" >>confdefs.h ++ ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ $as_echo "yes" >&6; } ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++@@ -8621,8 +8215,9 @@ rm -f core conftest.err conftest.$ac_obj ++ $as_echo_n "checking check for SIGSYS... " >&6; } ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++-#include ++-int joe=SIGSYS; +++ +++ #include +++ int joe=SIGSYS; ++ ++ int ++ main () ++@@ -8637,7 +8232,7 @@ if ac_fn_c_try_compile "$LINENO"; then : ++ $as_echo "#define HAVE_SIGSYS 1" >>confdefs.h ++ ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ $as_echo "yes" >&6; } ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++@@ -8650,8 +8245,9 @@ rm -f core conftest.err conftest.$ac_obj ++ $as_echo_n "checking check for SIGEMT... " >&6; } ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++-#include ++-int joe=SIGEMT; +++ +++ #include +++ int joe=SIGEMT; ++ ++ int ++ main () ++@@ -8666,7 +8262,7 @@ if ac_fn_c_try_compile "$LINENO"; then : ++ $as_echo "#define HAVE_SIGEMT 1" >>confdefs.h ++ ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ $as_echo "yes" >&6; } ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++@@ -8705,7 +8301,7 @@ if test "x$ac_cv_header_dis_asm_h" = xye ++ #define HAVE_DIS_ASM_H 1 ++ _ACEOF ++ MLIBS=$LIBS ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for init_disassemble_info in -lopcodes" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for init_disassemble_info in -lopcodes" >&5 ++ $as_echo_n "checking for init_disassemble_info in -lopcodes... " >&6; } ++ if ${ac_cv_lib_opcodes_init_disassemble_info+:} false; then : ++ $as_echo_n "(cached) " >&6 ++@@ -8750,7 +8346,7 @@ _ACEOF ++ ++ fi ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 ++ $as_echo_n "checking for dlopen in -ldl... " >&6; } ++ if ${ac_cv_lib_dl_dlopen+:} false; then : ++ $as_echo_n "(cached) " >&6 ++@@ -8788,7 +8384,7 @@ fi ++ $as_echo "$ac_cv_lib_dl_dlopen" >&6; } ++ if test "x$ac_cv_lib_dl_dlopen" = xyes; then : ++ #opcodes changes too quickly to link directly ++- for ac_func in print_insn_i386 +++ for ac_func in print_insn_i386 ++ do : ++ ac_fn_c_check_func "$LINENO" "print_insn_i386" "ac_cv_func_print_insn_i386" ++ if test "x$ac_cv_func_print_insn_i386" = xyes; then : ++@@ -8807,7 +8403,7 @@ done ++ ++ ++ #if test $use = "386-linux" ; then ++- for ac_header in asm/sigcontext.h +++for ac_header in asm/sigcontext.h ++ do : ++ ac_fn_c_check_header_mongrel "$LINENO" "asm/sigcontext.h" "ac_cv_header_asm_sigcontext_h" "$ac_includes_default" ++ if test "x$ac_cv_header_asm_sigcontext_h" = xyes; then : ++@@ -8819,7 +8415,7 @@ fi ++ ++ done ++ ++- for ac_header in asm/signal.h +++for ac_header in asm/signal.h ++ do : ++ ac_fn_c_check_header_mongrel "$LINENO" "asm/signal.h" "ac_cv_header_asm_signal_h" "$ac_includes_default" ++ if test "x$ac_cv_header_asm_signal_h" = xyes; then : ++@@ -8831,17 +8427,18 @@ fi ++ ++ done ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sigcontext..." >&5 +++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sigcontext..." >&5 ++ $as_echo_n "checking for sigcontext...... " >&6; } ++- cat confdefs.h - <<_ACEOF >conftest.$ac_ext +++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++-#include +++ +++ #include ++ ++ int ++ main () ++ { ++ ++- struct sigcontext foo; +++ struct sigcontext foo; ++ ++ ; ++ return 0; ++@@ -8849,38 +8446,31 @@ main () ++ _ACEOF ++ if ac_fn_c_try_compile "$LINENO"; then : ++ ++- sigcontext_works=1; ++- ++ $as_echo "#define SIGNAL_H_HAS_SIGCONTEXT 1" >>confdefs.h ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: sigcontext in signal.h" >&5 ++-$as_echo "sigcontext in signal.h" >&6; } ++- +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: sigcontext of signal.h" >&5 +++$as_echo "sigcontext of signal.h" >&6; } ++ else ++- sigcontext_works=0; ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: sigcontext NOT in signal.h" >&5 ++-$as_echo "sigcontext NOT in signal.h" >&6; } ++- ++-fi ++-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ++- if test "$sigcontext_works" = 0 ; then ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sigcontext..." >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: sigcontext NOT of signal.h" >&5 +++$as_echo "sigcontext NOT of signal.h" >&6; } +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sigcontext..." >&5 ++ $as_echo_n "checking for sigcontext...... " >&6; } ++- cat confdefs.h - <<_ACEOF >conftest.$ac_ext +++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ /* end confdefs.h. */ ++-#include ++- #ifdef HAVE_ASM_SIGCONTEXT_H ++- #include ++- #endif ++- #ifdef HAVE_ASM_SIGNAL_H ++- #include ++- #endif +++ +++ #include +++ #ifdef HAVE_ASM_SIGCONTEXT_H +++ #include +++ #endif +++ #ifdef HAVE_ASM_SIGNAL_H +++ #include +++ #endif ++ ++ int ++ main () ++ { ++ ++- struct sigcontext foo; +++ struct sigcontext foo; ++ ++ ; ++ return 0; ++@@ -8888,39 +8478,17 @@ main () ++ _ACEOF ++ if ac_fn_c_try_compile "$LINENO"; then : ++ ++- ++ $as_echo "#define HAVE_SIGCONTEXT 1" >>confdefs.h ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: sigcontext in asm files" >&5 ++-$as_echo "sigcontext in asm files" >&6; } ++- +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: sigcontext asm files" >&5 +++$as_echo "sigcontext asm files" >&6; } ++ else ++- ++- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no sigcontext found" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no sigcontext found" >&5 ++ $as_echo "no sigcontext found" >&6; } ++- ++ fi ++ rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ++- ++- ++- fi ++-# echo 'foo() {}' > conftest1.c ++-# $CC -S conftest1.c ++-# use_underscore=0 ++-# if fgrep _foo conftest1.s ; then use_underscore=1 ; fi ++-# if test $use_underscore = 0 ; then ++-# MPI_FILE=mpi-386_no_under.o ++-# else ++-# MPI_FILE=mpi-386d.o ++-# fi ++-# AC_SUBST(MPI_FILE) ++-# GCC=$CC ++-# if test -x /usr/bin/i386-glibc20-linux-gcc ; then ++-# GCC=/usr/bin/i386-glibc20-linux-gcc ++-# fi ++-# AC_SUBST(GCC) ++- ++-#fi +++fi +++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ++ ++ # Extract the first word of "emacs", so it can be a program name with args. ++ set dummy emacs; ac_word=$2 ++@@ -8980,11 +8548,11 @@ EOF ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking emacs site lisp directory" >&5 ++ $as_echo_n "checking emacs site lisp directory... " >&6; } ++ if [ "$EMACS_SITE_LISP" = "unknown" ] ; then ++- if [ "$EMACS" != "" ] ; then ++- EMACS_SITE_LISP=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` ++- else ++- EMACS_SITE_LISP="" ++- fi +++ if [ "$EMACS" != "" ] ; then +++ EMACS_SITE_LISP=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` +++ else +++ EMACS_SITE_LISP="" +++ fi ++ fi ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $EMACS_SITE_LISP" >&5 ++ $as_echo "$EMACS_SITE_LISP" >&6; } ++@@ -9005,14 +8573,14 @@ EOF ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking emacs default.el" >&5 ++ $as_echo_n "checking emacs default.el... " >&6; } ++ if [ "$EMACS" != "" ] ; then ++- EMACS_DEFAULT_EL=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` +++ EMACS_DEFAULT_EL=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` ++ else ++- EMACS_DEFAULT_EL="" +++ EMACS_DEFAULT_EL="" ++ fi ++ if test -f "${EMACS_DEFAULT_EL}" ; then true;else ++- if test -d $EMACS_SITE_LISP ; then ++- EMACS_DEFAULT_EL=${EMACS_SITE_LISP}/default.el ++- fi +++ if test -d $EMACS_SITE_LISP ; then +++ EMACS_DEFAULT_EL=${EMACS_SITE_LISP}/default.el +++ fi ++ fi ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $EMACS_DEFAULT_EL" >&5 ++ $as_echo "$EMACS_DEFAULT_EL" >&6; } ++@@ -9046,14 +8614,34 @@ fi ++ $as_echo "$INFO_DIR" >&6; } ++ ++ ++-if test "$enable_tcltk" = "yes" ; then +++# Check whether --enable-tcltk was given. +++if test "${enable_tcltk+set}" = set; then : +++ enableval=$enable_tcltk; +++fi +++ +++# Check whether --enable-tkconfig was given. +++if test "${enable_tkconfig+set}" = set; then : +++ enableval=$enable_tkconfig; TK_CONFIG_PREFIX=$enableval +++else +++ TK_CONFIG_PREFIX=unknown +++fi +++ +++# Check whether --enable-tclconfig was given. +++if test "${enable_tclconfig+set}" = set; then : +++ enableval=$enable_tclconfig; TCL_CONFIG_PREFIX=$enableval +++else +++ TCL_CONFIG_PREFIX=unknown +++fi +++ +++ +++if test "$enable_tcltk" != "no" ; then ++ ++- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tcl/tk" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tcl/tk" >&5 ++ $as_echo_n "checking for tcl/tk... " >&6; } ++ ++- if test -d "${TCL_CONFIG_PREFIX}" ; then true ; else +++ if test -d "${TCL_CONFIG_PREFIX}" ; then true ; else ++ ++- # Extract the first word of "tclsh", so it can be a program name with args. +++ # Extract the first word of "tclsh", so it can be a program name with args. ++ set dummy tclsh; ac_word=$2 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 ++ $as_echo_n "checking for $ac_word... " >&6; } ++@@ -9092,76 +8680,76 @@ fi ++ ++ ++ ++- if test "${TCLSH}" = "" ; then true ; else +++ if test "${TCLSH}" = "" ; then true ; else ++ ++- rm -f conftest.tcl ++- cat >> conftest.tcl <> conftest.tcl <&5 +++ TCL_VERSION_DOT_FREE=`echo ${TCL_VERSION} | tr -d .` +++ if test -f ${TK_CONFIG_PREFIX}/../bin/tcl${TCL_VERSION_DOT_FREE}.dll ; then +++ TCL_LIBS="-L${TK_CONFIG_PREFIX}/../bin -ltk${TCL_VERSION_DOT_FREE} -ltcl${TCL_VERSION_DOT_FREE}" +++ TCL_STUB_LIBS="-L${TK_CONFIG_PREFIX}/lib -ltkstub${TCL_VERSION_DOT_FREE} -ltclstub${TCL_VERSION_DOT_FREE}" +++ else +++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -llieee" >&5 ++ $as_echo_n "checking for main in -llieee... " >&6; } ++ if ${ac_cv_lib_lieee_main+:} false; then : ++ $as_echo_n "(cached) " >&6 ++@@ -9197,14 +8785,11 @@ else ++ have_ieee=0 ++ fi ++ ++- if test "$have_ieee" = "0" ; then ++- TCL_LIBS=`echo ${TCL_LIBS} | sed -e "s:-lieee::g" ` ++- fi ++- if test "$have_dl" = "0" ; then ++- TCL_LIBS=`echo ${TCL_LIBS} | sed -e "s:-ldl::g"` ++- fi ++- TCL_STUB_LIBS="" ++- fi +++ if test "$have_ieee" = "0" ; then +++ TCL_LIBS=`echo ${TCL_LIBS} | sed -e "s:-lieee::g" ` +++ fi +++ TCL_STUB_LIBS="" +++ fi ++ ++ fi ++ ++@@ -9229,16 +8814,18 @@ fi ++ ++ ++ if test -d "${TK_CONFIG_PREFIX}" ; then ++-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: using TK_VERSION=${TK_VERSION} in ${TK_CONFIG_PREFIX}" >&5 ++-$as_echo "using TK_VERSION=${TK_VERSION} in ${TK_CONFIG_PREFIX}" >&6; } +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: using TK_VERSION=${TK_VERSION} of ${TK_CONFIG_PREFIX}" >&5 +++$as_echo "using TK_VERSION=${TK_VERSION} of ${TK_CONFIG_PREFIX}" >&6; } ++ else ++-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 +++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 ++ $as_echo "not found" >&6; } ++ fi ++ ++-NOTIFY=$enable_notify ++- +++# Check whether --enable-notify was given. +++if test "${enable_notify+set}" = set; then : +++ enableval=$enable_notify; NOTIFY=$enable_notify ++ +++fi ++ ++ ++ ++@@ -9477,42 +9064,17 @@ _ACEOF ++ fi ++ ++ ++-# alloca ++- ++-# dlopen etc ++-# idea make it so you do something dlopen(libX.so,RTLD_GLOBAL) ++-# then dlload("foo.o") a lisp file can refer to things in libX.so ++-# ++- ++-# what machine this is, and include then a machine specific hdr. ++-# and machine specific defs. ++- ++-# check bzero, ++- ++-# check getcwd, getwd etc.. ++- ++ +++LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'` $TLDFLAGS" ++ +++LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $LIBS $TLIBS" ++ ++-# check socket stuff.. ++- ++-# getrlimit ++- ++-# fionread or block ++- ++-# redhat/cygnus released for some reason a buggy version of gcc, ++-# which no one else released. Catch that here. ++- ++-LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'`" ++- ++-LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $TLDFLAGS $LIBS $TLIBS" ++- ++-FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS $TCFLAGS $PROCESSOR_FLAGS" +++FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS $TCFLAGS" ++ ++ # Work around bug with gcc on ppc -- CM ++-NIFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TONIFLAGS $PROCESSOR_FLAGS -I\$(GCLDIR)/o" +++NIFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TONIFLAGS -I\$(GCLDIR)/o" ++ ++-CFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TO3FLAGS $PROCESSOR_FLAGS -I\$(GCLDIR)/o" +++CFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TO3FLAGS -I\$(GCLDIR)/o" ++ ++ O3FLAGS=$TO3FLAGS ++ ++@@ -9522,12 +9084,10 @@ O2FLAGS=$TO2FLAGS ++ ++ ++ ++- ++- ++ if test -f h/$use.defs ; then ++ ++ ++- ac_config_files="$ac_config_files makedefc windows/gcl.iss windows/sysdir.bat windows/install.lsp" +++ ac_config_files="$ac_config_files makedefc windows/gcl.iss windows/sysdir.bat windows/install.lsp" ++ ++ cat >confcache <<\_ACEOF ++ # This file is a shell script that caches the results of configure ++@@ -10804,13 +10364,13 @@ if test -n "$ac_unrecognized_opts" && te ++ $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} ++ fi ++ ++- echo makedefc ++- cat makedefc +++ echo makedefc +++ cat makedefc ++ ++- echo add-defs1 $use ++- CC=$CC ./add-defs1 $use +++ echo add-defs1 $use +++ CC=$CC ./add-defs1 $use ++ ++ else ++- echo "Unable to guess machine type" ++- echo use configure --enable-machine=XXX, for XXX such that h/XXX.defs exists, ie in h/*.defs +++ echo "Unable to guess machine type" +++ echo use configure --enable-machine=XXX, for XXX such that h/XXX.defs exists, ie in h/*.defs ++ fi ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -5,107 +5,6 @@ AC_CONFIG_HEADER(h/gclincl.h) ++ VERSION=`cat majvers`.`cat minvers` ++ AC_SUBST(VERSION) ++ ++-# some parts of this configure script are taken from the tcl configure.in ++- ++-# ++-# Arguments ++-# ++- ++-dnl help="--enable-maxpage=XXXX will compile in a page table of size XXX (default ${default_maxpage})" ++- ++-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++-dnl #include ++-dnl #include ++-dnl ]],[[ ++-dnl FILE *fp=fopen("conftest1","w"); ++-dnl fprintf(fp,"%u",262144*( SIZEOF_LONG >>2)/(1<<($PAGEWIDTH-12))); ++-dnl return 0;]])],[def_maxpage=`cat conftest1`],[def_maxpage=262144]) ++- ++-dnl AC_ARG_ENABLE(maxpage, ++-dnl [ --enable-maxpage=XXXX will compile in a page table of size XXX ++-dnl (eg '--enable-maxpage=64*1024' would produce ++-dnl 64K pages allowing 256 MB if pages are 4K each)], ++-dnl ,enable_maxpage=$def_maxpage) ++- ++-AC_ARG_ENABLE(widecons,[use a three word cons with simplified typing],[AC_DEFINE([WIDE_CONS],[1],[three word cons])]) ++- ++- ++-AC_ARG_ENABLE(safecdr,[protect cdr from immfix and speed up type processing],,[enable_safecdr="no"]) ++-if test "$enable_safecdr" = "yes" ; then ++- AC_DEFINE([USE_SAFE_CDR],[1],[protect cdr from immfix and speed up type processing]) ++-fi ++-AC_ARG_ENABLE(safecdrdbg,[debug safecdr code],[AC_DEFINE([DEBUG_SAFE_CDR],[1],[debug safecdr code])]) ++- ++-AC_ARG_ENABLE([prelink],[--enable-prelink will insist that the produced images may be prelinked],[PRELINK_CHECK=t],[PRELINK_CHECK=]) ++- ++-AC_ARG_ENABLE([fastimmfix],[--enable-fastimmfix=XXXX will reject low immediate fixnums unless 1<&1 | fgrep ming > /dev/null ; ++- then use=mingw ++- else use=gnuwin95 +++ sh4*linux*) use=sh4-linux;; +++ *x86_64*linux*) use=amd64-linux;; +++ *x86_64*kfreebsd*) use=amd64-kfreebsd;; +++ *86*linux*) use=386-linux;; +++ *86*kfreebsd*) use=386-kfreebsd;; +++ *86*gnu*) use=386-gnu;; +++ m68k*linux*) use=m68k-linux;; +++ alpha*linux*) use=alpha-linux;; +++ mips*linux*) use=mips-linux;; +++ mipsel*linux*) use=mipsel-linux;; +++ sparc*linux*) use=sparc-linux;; +++ aarch64*linux*) use=aarch64-linux;; +++ arm*linux*) use=arm-linux;; +++ s390*linux*) use=s390-linux;; +++ ia64*linux*) use=ia64-linux;; +++ hppa*linux*) use=hppa-linux;; +++ powerpc*linux*) use=powerpc-linux;; +++ powerpc-*-darwin*) use=powerpc-macosx;; +++ *86*darwin*) use=386-macosx;; +++ i*mingw*|i*msys*) use=mingw;; +++ i*cygwin*) +++ if $CC -v 2>&1 | fgrep ming > /dev/null ; +++ then use=mingw +++ else use=gnuwin95 ++ fi;; ++- ++- *openbsd*) ++- # 'ld -Z' means disable W^X ++- TLDFLAGS="$TLDFLAGS -Z" ++- use=FreeBSD;; ++- +++ *openbsd*) use=FreeBSD;; +++ sparc-sun-solaris*) use=solaris;; +++ i?86-pc-solaris*) use=solaris-i386;; ++ esac ++ ++-AC_SUBST(PROCESSOR_FLAGS) +++AC_ARG_ENABLE([machine],[ --enable-machine=XXXX will force the use of one of the definitions in h/XXXX.defs], +++ [echo enable_machine=$enableval ; use=$enableval]) ++ ++-echo enable_machine=$enable_machine ++-if test "x$enable_machine" != "x" ; then ++- use=$enable_machine ++-fi +++AC_MSG_RESULT([use=$use]) ++ ++ def_dlopen="no" ++ def_statsysbfd="no" ++ def_custreloc="yes" ++-#def_statsysbfd="yes" ++-#def_custreloc="no" ++-def_locbfd="no" ++ def_oldgmp="no" ++ def_pic="no"; ++ def_static="no"; ++ def_debug="no"; ++ case $use in ++- *kfreebsd) +++ *kfreebsd) ++ ln -snf linux.defs h/$use.defs;; ++- *gnu) +++ *gnu) ++ ln -snf linux.defs h/$use.defs;; ++- *linux) +++ *linux) ++ ln -snf linux.defs h/$use.defs; ++ case $use in ++-# def_static -- Function descriptors are currently realized at runtime in a non-reproducible fashion ++-# on these architectures -- CM ++- powerpc*) ++-# if test "$host_cpu" = "powerpc64" ; then def_dlopen="yes" ; def_custreloc="no" ; fi ++- ;; ++- ia64*) ++- def_dlopen="yes" ; def_custreloc="no" ;; ++- hppa*) ++- def_pic="yes" ;; ++-# def_dlopen="yes" ; def_custreloc="no" ; def_pic="yes" ;; +++ ia64*) +++ def_dlopen="yes" ; def_custreloc="no" ;; +++ hppa*) +++ def_pic="yes" ;; ++ esac;; ++ esac ++ ++-AC_ARG_ENABLE(dlopen, ++- [ --enable-dlopen uses dlopen for loading objects, which can then not be retained in saved images ] ++- ,,enable_dlopen="$def_dlopen") ++-AC_ARG_ENABLE(statsysbfd, ++- [ --enable-statsysbfd uses a static sytem bfd library for loading and relocationing object files ] ++- ,,enable_statsysbfd="$def_statsysbfd") ++-AC_ARG_ENABLE(dynsysbfd, ++- [ --enable-dynsysbfd uses a dynamic shared sytem bfd library for loading and relocationing object files ] ++- ,,enable_dynsysbfd="no") ++-#AC_ARG_ENABLE(locbfd, ++-# [ --enable-locbfd uses a static bfd library built from this source tree for loading and relocationing object files ] ++-# ,,enable_locbfd="$def_locbfd") ++-AC_ARG_ENABLE(custreloc, ++- [ --enable-custreloc uses custom gcl code if available for loading and relocationing object files ] ++- ,,enable_custreloc="$def_custreloc") ++-AC_ARG_ENABLE(debug, ++- [ --enable-debug builds gcl with -g in CFLAGS to enable running under gdb ] ++- ,,enable_debug="$def_debug") ++-AC_ARG_ENABLE(gprof, ++- [ --enable-gprof builds gcl with -pg in CFLAGS to enable profiling with gprof ] ++- ,,enable_gprof="no") ++-AC_ARG_ENABLE(static,[ --enable-static will link your GCL against static as opposed to shared system libraries ] , ++- [enable_static=$enableval],[enable_static="$def_static"]) ++-AC_ARG_ENABLE(pic, ++- [ --enable-pic builds gcl with -fPIC in CFLAGS ] ++- ,,enable_pic="$def_pic") ++- ++-AC_ARG_ENABLE(oldgmp, ++- [ --enable-oldgmp will link against gmp2 instead of gmp3 ] ++- ,,enable_oldgmp="$def_oldgmp") ++- ++-AC_ARG_ENABLE(dynsysgmp, ++- [ --enable-dynsysgmp will link against the system libgmp3 overriding certain functions with patched versions from the local source ] ++- ,,enable_dynsysgmp="yes") +++AC_ARG_ENABLE([widecons],[ --enable-widecons will use a three word cons with simplified typing], +++ [if test "$enableval" = "yes" ; then AC_DEFINE([WIDE_CONS],[1],[three word cons]) fi]) +++ +++AC_ARG_ENABLE([safecdr],[ --enable-safecdr will protect cdr from immfix and speed up type processing], +++ [if test "$enableval" = "yes" ; then +++ AC_DEFINE([USE_SAFE_CDR],[1],[protect cdr from immfix and speed up type processing]) +++ AC_ARG_ENABLE([safecdrdbg],[ --enable-safecdrdbg will debug safecdr code], +++ [if test "$enableval" = "yes" ; then AC_DEFINE([DEBUG_SAFE_CDR],[1],[debug safecdr code]) fi]) +++ fi]) +++ +++AC_ARG_ENABLE([prelink],[ --enable-prelink will insist that the produced images may be prelinked], +++ [if test "$enable_prelink" = "yes" ; then PRELINK_CHECK=t; fi]) +++AC_SUBST(PRELINK_CHECK) +++ +++AC_ARG_ENABLE([vssize],[ --enable-vssize=XXXX will compile in a value stack of size XXX], +++ [AC_DEFINE_UNQUOTED(VSSIZE,$enableval,[value stack size])]) +++AC_ARG_ENABLE([bdssize],[ --enable-bdssize=XXXX will compile in a binding stack of size XXX], +++ [AC_DEFINE_UNQUOTED(BDSSIZE,$enableval,[binding stack size])]) +++AC_ARG_ENABLE([ihssize],[ --enable-ihssize=XXXX will compile in a invocation history stack of size XXX], +++ [AC_DEFINE_UNQUOTED(IHSSIZE,$enableval,[invocation history stack size])]) +++AC_ARG_ENABLE([frssize],[ --enable-frssize=XXXX will compile in a frame stack of size XXX], +++ [AC_DEFINE_UNQUOTED(FRSSIZE,$enableval,[frame stack size])]) +++ +++AC_ARG_ENABLE([infodir],[ --enable-infodir=XXXX will force the use of a INFO_DIR=XXXXX as place to look for info], +++ [INFO_DIR=$enableval],[INFO_DIR=$prefix/share/info]) +++INFO_DIR=`eval echo $INFO_DIR/` +++ +++AC_ARG_ENABLE([emacsdir],[ --enable-emacsdir=XXXX will manually specify the location for elisp files], +++ [EMACS_SITE_LISP=$enableval],[EMACS_SITE_LISP=$prefix/share/emacs/site-lisp]) +++EMACS_SITE_LISP=`eval echo $EMACS_SITE_LISP/` +++ +++AC_ARG_ENABLE([xgcl],[ --enable-xgcl=yes will compile in support for XGCL],,[enable_xgcl=yes]) ++ ++-load_opt="0" +++AC_ARG_ENABLE([dlopen],[ --enable-dlopen uses dlopen for loading objects, which can then not be retained in saved images], +++ ,[enable_dlopen=$def_dlopen]) +++AC_ARG_ENABLE([statsysbfd],[ --enable-statsysbfd uses a static sytem bfd library for loading and relocationing object files], +++ ,[enable_statsysbfd=$def_statsysbfd]) +++AC_ARG_ENABLE([dynsysbfd],[ --enable-dynsysbfd uses a dynamic shared sytem bfd library for loading and relocationing object files], +++ ,[enable_dynsysbfd=no]) +++AC_ARG_ENABLE([custreloc],[ --enable-custreloc uses custom gcl code if available for loading and relocationing object files], +++ ,[enable_custreloc=$def_custreloc]) +++ +++AC_ARG_ENABLE([debug],[ --enable-debug builds gcl with -g in CFLAGS to enable running under gdb], +++ ,[enable_debug=$def_debug]) +++AC_ARG_ENABLE([static],[ --enable-static will link your GCL against static as opposed to shared system libraries], +++ ,[enable_static=$def_static]) +++AC_ARG_ENABLE([pic],[ --enable-pic builds gcl with -fPIC in CFLAGS],,[enable_pic=$def_pic]) +++ +++load_opt=0 ++ if test "$enable_dlopen" = "yes" ; then ++- load_opt=1 +++ load_opt=1 ++ fi ++ if test "$enable_statsysbfd" = "yes" ; then ++- case $load_opt in ++- 0) load_opt=1;; ++- 1) load_opt=2;; ++- esac +++ case $load_opt in +++ 0) load_opt=1;; +++ 1) load_opt=2;; +++ esac ++ fi ++ if test "$enable_dynsysbfd" = "yes" ; then ++- case $load_opt in ++- 0) load_opt=1;; ++- 1) load_opt=2;; ++- 2) load_opt=3;; ++- esac ++-fi ++-if test "$enable_locbfd" = "yes" ; then ++- case $load_opt in ++- 0) load_opt=1;; ++- 1) load_opt=2;; ++- 2) load_opt=3;; ++- 3) load_opt=4;; ++- esac +++ case $load_opt in +++ 0) load_opt=1;; +++ 1) load_opt=2;; +++ 2) load_opt=3;; +++ esac ++ fi ++ if test "$enable_custreloc" = "yes" ; then ++- case $load_opt in ++- 0) load_opt=1;; ++- 1) load_opt=2;; ++- 2) load_opt=3;; ++- 3) load_opt=4;; ++- 4) load_opt=5;; ++- esac +++ case $load_opt in +++ 0) load_opt=1;; +++ 1) load_opt=2;; +++ 2) load_opt=3;; +++ 3) load_opt=4;; +++ 4) load_opt=5;; +++ esac ++ fi ++ ++ if test "$load_opt" != "1" ; then ++- echo "Exactly one loader option must be chosen: dlopen=$enable_dlopen statsysbfd=$enable_statsysbfd dynsysbfd=$enable_dynsysbfd locbfd=$enable_locbfd custreloc=$enable_custreloc" ++- exit 1 +++ echo "Exactly one loader option must be chosen: dlopen=$enable_dlopen statsysbfd=$enable_statsysbfd dynsysbfd=$enable_dynsysbfd custreloc=$enable_custreloc" +++ AC_MSG_ERROR([loader option failure]) ++ fi ++ ++-TLDFLAGS="" ++-if test "$enable_static" = "yes" ; then ++- TLDFLAGS="-static -Wl,-zmuldefs $TLDFLAGS"; #FIXME should be in unixport/makefile ++- AC_DEFINE(STATIC_LINKING,1,[staticly linked images]) ++-fi ++-case $use in ++- *gnuwin*) ++- TLDFLAGS="$TLDFLAGS -Wl,--stack,8000000";; ++-esac ++- ++-## finally warn if we did not find a recognized machine.s ++-## ++-#if test "$use" = "unknown" ; then ++-#types=`echo h/*.defs` | sed -e "s:h/::g" -e "s:\.defs:g"` ++-#echo got canonical=$canonical, but was not recognized. ++-#echo Unable to guess type to use. Try one of ++-#exit(1) ++-#fi ++- ++-AC_MSG_RESULT([use=$use]) ++- ++ ++ # ++ # System programs ++@@ -462,221 +170,250 @@ AC_MSG_RESULT([use=$use]) ++ # We set the default CFLAGS below, and don't want the autoconf default ++ # CM 20040106 ++ if test "$CFLAGS" = "" ; then ++- CFLAGS=" " +++ CFLAGS=" " ++ fi ++ if test "$LDFLAGS" = "" ; then ++- LDFLAGS=" " +++ LDFLAGS=" " ++ fi ++ ++ AC_PROG_CC ++ AC_PROG_CPP ++ AC_SUBST(CC) +++GCL_CC=`basename $CC` +++if echo $GCL_CC |grep gcc |grep -q win; then +++ GCL_CC=gcc +++fi +++AC_SUBST(GCL_CC) ++ +++add_arg_to_tcflags() { +++ +++ local i=1 +++ AC_MSG_CHECKING([for CFLAG $1]) +++ CFLAGS_ORI=$CFLAGS +++ CFLAGS="$CFLAGS -Werror $1 `echo $1|sed 's,-Wno-,-W,1'`" +++ AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM([[]],[[]])], +++ [TCFLAGS="$TCFLAGS $1";AC_MSG_RESULT([yes]);i=0], +++ [AC_MSG_RESULT([no])], +++ [AC_MSG_RESULT([no])]) +++ CFLAGS=$CFLAGS_ORI +++ return $i +++ +++} ++ ++-# can only test for numbers -- CM ++-# if test "${GCC}" -eq "yes" ; then ++-#if [[ "${GCC}" = "yes" ]] ; then ++-# Allog for environment variable overrides on compiler selection -- CM ++-#GCC=$CC ++-#else ++-#GCC="" ++-#fi ++-# subst GCC not only under 386-linux, but where available -- CM ++- ++-TCFLAGS="-fsigned-char -fno-builtin-malloc -fno-builtin-free" ++- ++-if test "$GCC" = "yes" ; then ++- ++- TCFLAGS="$TCFLAGS -Wall" ++- ++- AC_MSG_CHECKING([for clang]) ++- AC_RUN_IFELSE([ ++- AC_LANG_SOURCE([[ ++- int main() { ++- return ++- #ifdef __clang__ ++- 0 ++- #else ++- 1 ++- #endif ++- ;}]])], ++- [AC_MSG_RESULT([yes]) ++- clang="yes" ++- TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign" ++- AC_DEFINE([CLANG],[1],[running clang compiler])], ++- [AC_MSG_RESULT([no]) ++- #FIXME -Wno-unused-but-set-variable when time ++- TMPF=-Wno-unused-but-set-variable ++- AC_MSG_CHECKING([for CFLAG $TMPF]) ++- CFLAGS_ORI=$CFLAGS ++- CFLAGS="$CFLAGS $TMPF" ++- AC_TRY_RUN([int main() {return 0;}],TCFLAGS="$TCFLAGS $TMPF";AC_MSG_RESULT(yes),AC_MSG_RESULT(no),AC_MSG_RESULT(no)) ++- CFLAGS=$CFLAGS_ORI]) ++-fi +++assert_arg_to_tcflags() { +++ if ! add_arg_to_tcflags $1 ; then AC_MSG_RESULT([cannot add $1 to CFLAGS]); exit 1 ; fi +++ return 0 +++} ++ ++-if test "$GCC" = "yes" ; then ++- TCFLAGS="$TCFLAGS -pipe" ++- case $use in ++- *mingw*) ++-# echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." ++-# echo " It is otherwise needed for the Unexec stuff to work." ++-# if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi ++- TCFLAGS="$TCFLAGS -fno-zero-initialized-in-bss -mms-bitfields";; ++- *gnuwin*) ++-# echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." ++-# echo " It is otherwise needed for the Unexec stuff to work." ++-# if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi ++- TCFLAGS="$TCFLAGS -fno-zero-initialized-in-bss -mms-bitfields";; ++- esac ++-fi ++-#if test -f /proc/sys/kernel/exec-shield ; then ++-# exec_stat=`cat /proc/sys/kernel/exec-shield` ++-# if test "$exec_stat" != "0" ; then ++-# # CFLAGS here to hopefully cover the DBEGIN routine below ++-# CFLAGS="$CFLAGS -Wa,--execstack" ++-# fi ++-#fi +++add_args_to_tcflags() { +++ +++ while test "$#" -ge 1 ; do +++ add_arg_to_tcflags $1 +++ shift +++ done +++} +++ +++add_arg_to_tldflags() { +++ +++ local i=1 +++ AC_MSG_CHECKING([for LDFLAG $1]) +++ LDFLAGS_ORI=$LDFLAGS +++ LDFLAGS="$LDFLAGS -Werror $1" +++ AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM([[]],[[]])], +++ [TLDFLAGS="$TLDFLAGS $1";AC_MSG_RESULT([yes]);i=0], +++ [AC_MSG_RESULT([no])], +++ [AC_MSG_RESULT([no])]) +++ LDFLAGS=$LDFLAGS_ORI +++ return $i +++ +++} +++ +++assert_arg_to_tldflags() { +++ if ! add_arg_to_tldflags $1 ; then AC_MSG_RESULT([cannot add $1 to LDFLAGS]); exit 1 ; fi +++ return 0 +++} +++ +++add_args_to_tldflags() { +++ +++ while test "$#" -ge 1 ; do +++ add_arg_to_tldflags $1 +++ shift +++ done +++} +++ +++remove_arg_from_ldflags() { +++ +++ NEW_LDFLAGS="" +++ for i in $LDFLAGS; do +++ if ! test "$i" = "$1" ; then +++ NEW_LDFLAGS="$NEW_LDFLAGS $i" +++ else +++ AC_MSG_RESULT([removing $1 from LDFLAGS]) +++ fi +++ done +++ LDFLAGS=$NEW_LDFLAGS +++ +++ return 0 +++ +++} +++ +++TCFLAGS="" +++add_args_to_tcflags -fsigned-char -pipe \ +++ -fno-builtin-malloc -fno-builtin-free \ +++ -fno-PIE -fno-pie -fno-PIC -fno-pic \ +++ -Wall \ +++ -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign \ +++ -Wno-unused-but-set-variable -Wno-misleading-indentation +++ +++TLDFLAGS="" +++add_args_to_tldflags -Wl,-no_pie -no-pie -Wl,-z,lazy +++ +++AC_MSG_CHECKING([for clang]) +++AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM([[ +++ #ifdef __clang__ +++ #define RET 0 +++ #else +++ #define RET 1 +++ #endif +++ ]], +++ [[ +++ return RET; +++ ]])], +++ [AC_MSG_RESULT([yes]) +++ clang="yes" +++ remove_arg_from_ldflags -pie +++ AC_DEFINE([CLANG],[1],[running clang compiler])], +++ [AC_MSG_RESULT([no])]) +++ +++case $use in +++ *mingw*) +++ assert_arg_to_tcflags -fno-zero-initialized-in-bss +++ assert_arg_to_tcflags -mms-bitfields;; +++ *gnuwin*) +++ assert_arg_to_tcflags -fno-zero-initialized-in-bss +++ assert_arg_to_tcflags -mms-bitfields +++ assert_arg_to_tldflags -Wl,--stack,8000000;; +++ 386-macosx) +++ assert_arg_to_tldflags -Wl,-no_pie +++ if test "$build_cpu" = "x86_64" ; then +++ assert_arg_to_tcflags -m64 +++ assert_arg_to_tldflags -m64 +++ assert_arg_to_tldflags -Wl,-headerpad,72 +++ else +++ assert_arg_to_tcflags -m32 +++ assert_arg_to_tldflags -m32 +++ assert_arg_to_tldflags -Wl,-headerpad,56 +++ fi;; +++ FreeBSD) assert_arg_to_tldflags -Z;; +++esac +++ +++if test "$enable_static" = "yes" ; then +++ assert_arg_to_tldflags -static +++ assert_arg_to_tldflags -Wl,-zmuldefs +++ AC_DEFINE(STATIC_LINKING,1,[staticly linked images]) +++fi ++ ++ TO3FLAGS="" ++ TO2FLAGS="" ++ ++-#TFPFLAG="-fomit-frame-pointer" ++-# FIXME -- remove when mingw compiler issues are fixed ++ case "$use" in ++- *mingw*) +++ *mingw*) ++ TFPFLAG="";; ++- m68k*)#FIXME gcc 4.x bug workaround +++ m68k*)#FIXME gcc 4.x bug workaround ++ TFPFLAG="";; ++- *) +++ *) ++ TFPFLAG="-fomit-frame-pointer";; ++ esac ++ ++ AC_CHECK_PROGS(AWK,[gawk nawk awk]) ++ ++-# Work around system/gprof mips/hppa hang ++-AC_MSG_CHECKING([working gprof]) ++-old_enable_gprof=$enable_gprof ++-case $use in ++- powerpc*) if test "$host_cpu" = "powerpc64le" ; then enable_gprof="no"; fi;; ++- sh4*) enable_gprof="no";; ++- ia64*) enable_gprof="no";; ++-# mips*) enable_gprof="no";; ++- hppa*) enable_gprof="no";; ++- arm*) enable_gprof="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++- *gnu) enable_gprof="no";; ++-esac ++-if test "$enable_gprof" = "$old_enable_gprof" ; then ++- AC_MSG_RESULT([ok]) ++-else ++- AC_MSG_RESULT([disabled]) ++-fi ++- ++-if test "$enable_gprof" = "yes" ; then ++- AC_MSG_CHECKING(for text start) ++- echo 'int main () {return(0);}' >foo.c ++- $CC foo.c -o foo ++- GCL_GPROF_START=`nm foo | $AWK '/ *[[TD]] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc ++- rm -f foo.c foo ++- if test "$GCL_GPROF_START" != "" ; then ++- AC_MSG_RESULT($GCL_GPROF_START) ++- AC_DEFINE_UNQUOTED(GCL_GPROF_START,$GCL_GPROF_START,[starting address for gprof]) ++- case "$use" in ++- arm*) ++- #FIXME report and remove this when done ++- AC_MSG_RESULT(Reducing optimization on profiling arm build to workaround gcc bug) ++- enable_debug=yes;; ++- esac ++- TCFLAGS="$TCFLAGS -pg"; ++- case $use in ++- s390*) ;; # relocation truncation bug in gcc ++- *) TLIBS="$TLIBS -pg";; ++- esac ++- TFPFLAG="" ++- AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) ++- else ++- enable_gprof="no"; ++- fi ++-fi ++- ++-if $CC -v 2>&1 | tail -1 | grep "gcc version 4.6.1" >/dev/null ; then ++- case "$use" in ++- arm*) ++- #FIXME report and remove this when done ++- AC_MSG_RESULT(Reducing optimization on arm build to workaround gcc 4.6 bug) ++- enable_debug=yes;; ++- esac ++-fi ++- +++AC_ARG_ENABLE([gprof],[ --enable-gprof builds gcl with -pg in CFLAGS to enable profiling with gprof], +++ [if test "$enableval" = "yes" ; then +++ AC_MSG_CHECKING([working gprof]) +++ case $use in +++ powerpc*) if test "$host_cpu" = "powerpc64le" ; then enableval="no"; fi;; +++ sh4*) enableval="no";; +++ ia64*) enableval="no";; +++ hppa*) enableval="no";; +++ arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible +++ *gnu) enableval="no";; +++ esac +++ if test "$enableval" != "yes" ; then +++ AC_MSG_RESULT([disabled]) +++ else +++ AC_MSG_RESULT([ok]) +++ AC_MSG_CHECKING([for text start]) +++ echo 'int main () {return(0);}' >foo.c +++ $CC foo.c -o foo +++ GCL_GPROF_START=`nm foo | $AWK '/ *[[TD]] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc +++ rm -f foo.c foo +++ if test "$GCL_GPROF_START" != "" ; then +++ AC_MSG_RESULT($GCL_GPROF_START) +++ AC_DEFINE_UNQUOTED(GCL_GPROF_START,$GCL_GPROF_START,[starting address for gprof]) +++ assert_arg_to_tcflags -pg +++ case $use in +++ s390*) ;; # relocation truncation bug in gcc +++ *) TLIBS="$TLIBS -pg";; +++ esac +++ TFPFLAG="" +++ AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) +++ fi +++ fi +++ fi]) ++ ++ if test "$enable_debug" = "yes" ; then ++- TCFLAGS="$TCFLAGS -g" ++- # for subconfigurations ++- CFLAGS="$CFLAGS -g" +++ assert_arg_to_tcflags -g +++ # for subconfigurations +++ CFLAGS="$CFLAGS -g" ++ else ++- TO3FLAGS="-O3 $TFPFLAG" ++- TO2FLAGS="-O" +++ TO3FLAGS="-O3 $TFPFLAG" +++ TO2FLAGS="-O" ++ fi ++ ++ # gcc on ppc cannot compile our new_init.c with full opts --CM ++ TONIFLAGS="" ++ case $use in ++- powerpc*macosx) ++- TCFLAGS="$TCFLAGS -mlongcall";; ++- *linux) +++ powerpc*macosx) assert_arg_to_tcflags -mlongcall;; +++ *linux) ++ case $use in ++-# amd64*) # stack-boundary option does not work ++-# TCFLAGS="$TCFLAGS -m64 -mpreferred-stack-boundary=8";; ++- alpha*) ++- TCFLAGS="$TCFLAGS -mieee" ++- if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1 ++- ;; ++-# m68k*) ++-# TCFLAGS="$TCFLAGS -ffloat-store";; ++- aarch64*) ++- TLIBS="$TLIBS -lgcc_s";; ++- hppa*) ++- TCFLAGS="$TCFLAGS -mlong-calls " ++- TLIBS="$TLIBS -lgcc_s" # workaround hppa __moddi3 local func symbols with default linker flags ++- if test "$enable_debug" != "yes" ; then TO3FLAGS="-O2" ; TFPFLAG=""; fi #FIXME needed asof gcc 4.8.1 ++-# TCFLAGS="$TCFLAGS -ffunction-sections" ++-# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O $TFPFLAG" ; fi ++-# if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi ++- ;; ++- mips*) ++- case $canonical in ++- mips64*linux*) ++- TLIBS="$TLIBS -Wl,-z -Wl,now";; ++- esac ++-# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 ++- ;; ++- ia64*) ++- if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 ++- ;; ++- arm*) ++- TCFLAGS="$TCFLAGS -mlong-calls -fdollars-in-identifiers -g " ++-# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.6.2 ++-# if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi ++- ;; ++- powerpc*) ++- TCFLAGS="$TCFLAGS -mlongcall" ++- ;; ++-# if $CC -v 2>&1 | grep -q "gcc version 3.2" ; then ++-# echo Reducing optimization for buggy gcc-3.2 ++-# if test "$enable_debug" != "yes" ; then TONIFLAGS="-O $TFPFLAG" ; fi ++-# fi; ++-# echo Probing for longcall ++-# if ! $CC -v 2>&1 | $AWK '/^gcc version / {split($3,A,".");if (A[[1]]+0>3 || (A[[1]]+0>=3 && A[[2]]+0>=3)) exit 1;}'; then ++-# echo Enabling longcall on gcc 3.3 or later ++-# TCFLAGS="$TCFLAGS -mlongcall" ++-# echo Reducing optimization for buggy gcc 3.3 or later ++-# if test "$enable_debug" != "yes" ; then TONIFLAGS="-O $TFPFLAG" ; fi ++-# fi;; +++ alpha*) +++ assert_arg_to_tcflags -mieee +++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1 +++ ;; +++ aarch64*) +++ TLIBS="$TLIBS -lgcc_s";; +++ hppa*) +++ assert_arg_to_tcflags -mlong-calls +++ TLIBS="$TLIBS -lgcc_s" # workaround hppa __moddi3 local func symbols with default linker flags +++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O2" ; TFPFLAG=""; fi #FIXME needed asof gcc 4.8.1 +++ ;; +++ mips*) +++ case $canonical in +++ mips64*linux*) +++ assert_arg_to_tldflags -Wl,-z,now;; +++ esac +++ ;; +++ ia64*) +++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 +++ ;; +++ arm*) +++ assert_arg_to_tcflags -mlong-calls +++ assert_arg_to_tcflags -fdollars-in-identifiers +++ assert_arg_to_tcflags -g #? +++ ;; +++ powerpc*) +++ assert_arg_to_tcflags -mlongcall +++ ;; ++ esac;; ++ esac ++ if test "$enable_pic" = "yes" ; then ++- TCFLAGS="$TCFLAGS -fPIC" +++ assert_arg_to_tcflags -fPIC ++ fi ++ +++ ++ FDEBUG=`echo $CFLAGS | tr ' ' '\012' |grep "^\-g$"|tr '\012' ' '` ++ #CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-g$"` ++ FOMITF=`echo $CFLAGS | tr ' ' '\012' |grep "^\-fomit-frame-pointer$"|tr '\012' ' '` ++@@ -693,27 +430,27 @@ FOOPT0=`echo $CFLAGS | tr ' ' '\012' |gr ++ CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-O0$"|tr '\012' ' '` ++ ++ if test "$FOOPT0" != "" ; then ++- TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[[123 ]],-O0 ,g' | sed 's,\-O$,-O0 ,g'` ++- TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[[123 ]],-O0 ,g' | sed 's,\-O$,-O0 ,g'` ++-else ++-if test "$FOOPT1" != "" ; then ++- TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[[2-3]],-O1,g'` ++- TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[[2-3]],-O1,g'` +++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[[123 ]],-O0 ,g' | sed 's,\-O$,-O0 ,g'` +++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[[123 ]],-O0 ,g' | sed 's,\-O$,-O0 ,g'` ++ else ++-if test "$FOOPT2" != "" ; then ++- TO3FLAGS=`echo "$TO3FLAGS" | sed 's,\-O3,-O2,g'` ++- TO2FLAGS=`echo "$TO2FLAGS" | sed 's,\-O3,-O2,g'` ++-fi ++-fi +++ if test "$FOOPT1" != "" ; then +++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[[2-3]],-O1,g'` +++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[[2-3]],-O1,g'` +++ else +++ if test "$FOOPT2" != "" ; then +++ TO3FLAGS=`echo "$TO3FLAGS" | sed 's,\-O3,-O2,g'` +++ TO2FLAGS=`echo "$TO2FLAGS" | sed 's,\-O3,-O2,g'` +++ fi +++ fi ++ fi ++ ++ if test "$FDEBUG" != "" ; then ++- TO3FLAGS=`echo $TO3FLAGS | sed 's,\-fomit-frame-pointer,,g'` ++- TO2FLAGS=`echo $TO2FLAGS | sed 's,\-fomit-frame-pointer,,g'` +++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-fomit-frame-pointer,,g'` +++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-fomit-frame-pointer,,g'` ++ fi ++ ++ if test "$FOMITF" != "" ; then ++- TO3FLAGS="$TO3FLAGS $FOMITF" +++ TO3FLAGS="$TO3FLAGS $FOMITF" ++ fi ++ ++ # Step 1: set the variable "system" to hold the name and version number ++@@ -731,12 +468,12 @@ if test -f /usr/lib/NextStep/software_ve ++ else ++ system=`uname -s`-`uname -r` ++ if test "$?" -ne 0 ; then ++- AC_MSG_RESULT([unknown (can't find uname command)]) +++ AC_MSG_RESULT([unknown (cannot find uname command)]) ++ system=unknown ++ else ++ # Special check for weird MP-RAS system (uname returns weird ++ # results, and the version is kept in special file). ++- +++ ++ if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then ++ system="MP-RAS-`${AWK} '{print $3}' '/etc/.relid'`" ++ fi ++@@ -748,156 +485,130 @@ else ++ fi ++ ++ case $use in ++- *macosx) +++ *macosx) ++ AC_CHECK_HEADERS(malloc/malloc.h,,[AC_MSG_ERROR([need malloc.h on macosx])]) ++ AC_CHECK_MEMBER([struct _malloc_zone_t.memalign], ++- AC_DEFINE(HAVE_MALLOC_ZONE_MEMALIGN,1,[memalign element present]), [], ++- [ ++- #include ++- ]) +++ AC_DEFINE(HAVE_MALLOC_ZONE_MEMALIGN,1,[memalign element present]), [], +++ [ +++ #include +++ ]) ++ AC_SUBST(HAVE_MALLOC_ZONE_MEMALIGN) ++ ;; ++ esac ++ ++- ++-AC_CHECK_HEADERS(setjmp.h, ++- AC_MSG_CHECKING([sizeof jmp_buf]) ++- AC_RUN_IFELSE([ ++- AC_LANG_SOURCE([[ ++- #include ++- #include ++- int main() { ++- FILE *fp=fopen("conftest1","w"); ++- fprintf(fp,"%lu\n",sizeof(jmp_buf)); ++- fclose(fp); ++- return 0; ++- }]])], ++- [sizeof_jmp_buf=`cat conftest1` ++- AC_MSG_RESULT($sizeof_jmp_buf) ++- AC_DEFINE_UNQUOTED(SIZEOF_JMP_BUF,$sizeof_jmp_buf,[sizeof jmp_buf])], ++- [AC_MSG_RESULT(no)])) +++AC_CHECK_HEADERS( +++ [setjmp.h], +++ [AC_MSG_CHECKING([sizeof jmp_buf]) +++ AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ #include +++ ]], +++ [[ +++ FILE *fp=fopen("conftest1","w"); +++ fprintf(fp,"%lu\n",sizeof(jmp_buf)); +++ fclose(fp); +++ ]])], +++ [sizeof_jmp_buf=`cat conftest1` +++ AC_MSG_RESULT($sizeof_jmp_buf) +++ AC_DEFINE_UNQUOTED(SIZEOF_JMP_BUF,$sizeof_jmp_buf,[sizeof jmp_buf])], +++ [AC_MSG_RESULT([no])])]) ++ ++ # sysconf +++AC_CHECK_HEADERS( +++ [unistd.h], +++ [AC_CHECK_LIB( +++ [c],[sysconf], +++ [AC_MSG_CHECKING([_SC_CLK_TCK]) +++ hz=0 +++ AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ #include +++ ]], +++ [[ +++ FILE *fp=fopen("conftest1","w"); +++ fprintf(fp,"%lu\n",sysconf(_SC_CLK_TCK)); +++ fclose(fp); +++ ]], +++ [hz=`cat conftest1` +++ AC_DEFINE_UNQUOTED(HZ,$hz,[time system constant])])]) +++ AC_MSG_RESULT($hz)])]) ++ ++-AC_CHECK_HEADERS(unistd.h, ++- AC_CHECK_LIB(c,sysconf, ++- AC_MSG_CHECKING(_SC_CLK_TCK) ++- AC_TRY_RUN([#include ++- #include ++- int ++- main() { ++- FILE *fp=fopen("conftest1","w"); ++- fprintf(fp,"%lu\n",sysconf(_SC_CLK_TCK)); ++- fclose(fp); ++- return 0; ++- }], ++- hz=`cat conftest1` ++- AC_DEFINE_UNQUOTED(HZ,$hz,[time system constant]) ++- ,hz=0,hz=0) ++- [AC_MSG_RESULT($hz)] ++- dnl AC_MSG_CHECKING(_SC_PHYS_PAGES) ++- dnl AC_RUN_IFELSE([ ++- dnl AC_LANG_SOURCE([[ ++- dnl #include ++- dnl #include ++- dnl int main() { ++- dnl FILE *fp=fopen("conftest1","w"); ++- dnl fprintf(fp,"%lu\n",sysconf(_SC_PHYS_PAGES)); ++- dnl fclose(fp); ++- dnl return 0; ++- dnl }]])], ++- dnl [phys=`cat conftest1` ++- dnl AC_MSG_RESULT($phys) ++- dnl AC_DEFINE(HAVE_SYSCONF_PHYS_PAGES,$phys,[probe runtime phys pages for gc performance])], ++- dnl [AC_MSG_RESULT(no)]) ++- )) ++- ++- ++-#MY_SUBDIRS= ++- ++-# ++-# GMP ++-# ++ ++ rm -f makedefsafter ++ ++-MP_INCLUDE="" ++-if test $use_gmp = yes ; then +++AC_ARG_ENABLE([dynsysgmp], +++ [ --enable-dynsysgmp will link against the system libgmp3 overriding certain functions with patched versions from the local source]) ++ ++- PATCHED_SYMBOLS="" ++- if test "$enable_dynsysgmp" = "yes" ; then ++- AC_CHECK_HEADERS(gmp.h, ++- AC_CHECK_LIB(gmp,__gmpz_init, ++- AC_MSG_CHECKING("for external gmp version") ++- AC_TRY_RUN([#include ++- int main() { ++- #if __GNU_MP_VERSION > 3 ++- return 0; ++- #else ++- return -1; ++- #endif ++- }], ++-# MPFILES=$GMPDIR/mpn/mul_n.o ++-# PATCHED_SYMBOLS=__gmpn_toom3_mul_n ++- MPFILES= ++- PATCHED_SYMBOLS= ++-# if test "$use" = "m68k-linux" ; then ++-# MPFILES="$MPFILES $GMPDIR/mpn/lshift.o $GMPDIR/mpn/rshift.o" ++-# PATCHED_SYMBOLS="$PATCHED_SYMBOLS __gmpn_lshift __gmpn_rshift" ++-# fi ++- TLIBS="$TLIBS -lgmp" ++- echo "#include \"gmp.h\"" >foo.c ++- echo "int main() {return 0;}" >>foo.c ++- MP_INCLUDE=`cpp foo.c | $AWK '/(\/|\\\\)gmp.h/ {if (!i) print $3;i=1}' | tr -d '"'` ++- rm -f foo.c, ++- echo "Cannot use dynamic gmp lib" , echo "Cannot use dynamic gmp lib" ), ++- echo "Cannot use dynamic gmp lib" ,), ++- echo "Cannot use dynamic gmp lib" ,) ++-fi ++- ++-NEED_LOCAL_GMP='' ++-if test "$MP_INCLUDE" = "" ; then ++- NEED_LOCAL_GMP=1; ++-fi ++-if test "$PATCHED_SYMBOLS" != "" ; then ++- NEED_LOCAL_GMP=1; +++if test "$enable_dynsysgmp" != "no" ; then +++ AC_CHECK_HEADERS( +++ [gmp.h], +++ [AC_CHECK_LIB( +++ [gmp],[__gmpz_init], +++ [AC_MSG_CHECKING([for external gmp version]) +++ AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ ]], +++ [[ +++ #if __GNU_MP_VERSION > 3 +++ return 0; +++ #else +++ return -1; +++ #endif +++ ]])], +++ [AC_MSG_RESULT([good]) +++ TLIBS="$TLIBS -lgmp" +++ echo "#include \"gmp.h\"" >foo.c +++ echo "int main() {return 0;}" >>foo.c +++ MP_INCLUDE=`cpp foo.c | $AWK '/(\/|\\\\)gmp.h/ {if (!i) print $3;i=1}' | tr -d '"'` +++ rm -f foo.c])])]) +++ +++ if test "$MP_INCLUDE" = "" ; then +++ AC_MSG_RESULT([Cannot use dynamic gmp lib]) +++ fi +++ ++ fi ++ ++-if test "$NEED_LOCAL_GMP" != "" ; then ++- ++- GMPDIR=gmp4 ++- AC_MSG_CHECKING([use_gmp=yes, doing configure in gmp directory]) ++- echo ++- echo "#" ++- echo "#" ++- echo "# -------------------" ++- echo "# Subconfigure of GMP" ++- echo "#" ++- echo "#" ++- ++- if test "$use_common_binary" = "yes"; then ++- cd $GMPDIR && ./configure --build=$host && cd .. ++- else ++- cd $GMPDIR && ./configure && cd .. ++- fi ++- #MY_SUBDIRS="$MY_SUBDIRS $GMPDIR" ++- ++- echo "#" ++- echo "#" ++- echo "#" ++- echo "# Subconfigure of GMP done" ++- echo "# ------------------------" ++- echo "#" ++- ++- if test "$MP_INCLUDE" = "" ; then ++- cp $GMPDIR/gmp.h h/gmp.h ++- MP_INCLUDE=h/gmp.h ++- MPFILES=gmp_all ++- fi ++ +++if test "$MP_INCLUDE" = "" ; then +++ +++ GMPDIR=gmp4 +++ AC_MSG_CHECKING([doing configure in gmp directory]) +++ echo +++ echo "#" +++ echo "#" +++ echo "# -------------------" +++ echo "# Subconfigure of GMP" +++ echo "#" +++ echo "#" +++ +++ if test "$use_common_binary" = "yes"; then +++ cd $GMPDIR && ./configure --build=$host && cd .. +++ else +++ cd $GMPDIR && ./configure --host=$host --build=$build && cd .. +++ fi +++ #MY_SUBDIRS="$MY_SUBDIRS $GMPDIR" +++ +++ echo "#" +++ echo "#" +++ echo "#" +++ echo "# Subconfigure of GMP done" +++ echo "# ------------------------" +++ echo "#" +++ +++ if test "$MP_INCLUDE" = "" ; then +++ cp $GMPDIR/gmp.h h/gmp.h +++ MP_INCLUDE=h/gmp.h +++ MPFILES=gmp_all +++ fi ++ fi ++ ++-AC_MSG_CHECKING("for leading underscore in object symbols") +++AC_MSG_CHECKING([for leading underscore in object symbols]) ++ cat>foo.c < ++ #include ++@@ -905,12 +616,12 @@ int main() {FILE *f;double d=0.0;getc(f) ++ EOFF ++ $CC -c foo.c -o foo.o ++ if nm foo.o |grep " U " | grep "_cos" >/dev/null || nm foo.o |grep " U " | grep " _getc" >/dev/null ; then ++- LEADING_UNDERSCORE=1 ++- AC_DEFINE(LEADING_UNDERSCORE,1,[symbol name mangling convention]) ++- AC_MSG_RESULT("yes") +++ LEADING_UNDERSCORE=1 +++ AC_DEFINE(LEADING_UNDERSCORE,1,[symbol name mangling convention]) +++ AC_MSG_RESULT("yes") ++ else ++- LEADING_UNDERSCORE="" ++- AC_MSG_RESULT("no") +++ LEADING_UNDERSCORE="" +++ AC_MSG_RESULT("no") ++ fi ++ ++ ++@@ -918,61 +629,63 @@ AC_MSG_CHECKING("for GNU ld option -Map" ++ touch map ++ $CC -o foo [ -Wl,-Map ] map foo.o >/dev/null 2>&1 ++ if test `cat map | wc -l` != "0" ; then ++- AC_MSG_RESULT("yes") ++- AC_DEFINE(HAVE_GNU_LD,1,[gnu linker present]) ++- GNU_LD=1 +++ AC_MSG_RESULT("yes") +++ AC_DEFINE(HAVE_GNU_LD,1,[gnu linker present]) +++ GNU_LD=1 ++ else ++- AC_MSG_RESULT("no") ++- GNU_LD= +++ AC_MSG_RESULT("no") +++ GNU_LD= ++ fi ++ rm -f foo.c foo.o foo map ++ ++ AC_MSG_CHECKING([for size of gmp limbs]) ++ AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++- #include ++- #include "$MP_INCLUDE" ++- ]],[[ ++- FILE *fp=fopen("conftest1","w"); ++- fprintf(fp,"%u",sizeof(mp_limb_t)); ++- fclose(fp); ++- return 0; ++- ]])],[mpsize=`cat conftest1`],[AC_MSG_ERROR([Cannot determine mpsize])]) +++ #include +++ #include "$MP_INCLUDE" +++ ]], +++ [[ +++ FILE *fp=fopen("conftest1","w"); +++ fprintf(fp,"%u",sizeof(mp_limb_t)); +++ fclose(fp); +++ ]])],[mpsize=`cat conftest1`],[AC_MSG_ERROR([Cannot determine mpsize])]) ++ AC_DEFINE_UNQUOTED(MP_LIMB_BYTES,$mpsize,[sizeof mp_limb in gmp library]) ++ AC_MSG_RESULT($mpsize) ++ ++ AC_MSG_CHECKING([_SHORT_LIMB]) ++ AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++- #include ++- #include "$MP_INCLUDE" ++- ]],[[ ++- #ifdef _SHORT_LIMB ++- return 0; ++- #else ++- return 1; ++- #endif ++- ]])],[AC_DEFINE(__SHORT_LIMB,1,[short gmp3 limbs]) AC_MSG_RESULT(yes)],[AC_MSG_RESULT(no)]) +++ #include +++ #include "$MP_INCLUDE" +++ ]], +++ [[ +++ #ifdef _SHORT_LIMB +++ return 0; +++ #else +++ return 1; +++ #endif +++ ]])],[AC_DEFINE(__SHORT_LIMB,1,[short gmp3 limbs]) AC_MSG_RESULT(yes)],[AC_MSG_RESULT(no)]) ++ ++ AC_MSG_CHECKING([_LONG_LONG_LIMB]) ++ AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++- #include ++- #include "$MP_INCLUDE" ++- ]],[[ ++- #ifdef _LONG_LONG_LIMB ++- return 0; ++- #else ++- return 1; ++- #endif ++- ]])],[AC_DEFINE(__LONG_LONG_LIMB,1,[long gmp3 limbs]) AC_MSG_RESULT(yes)],[AC_MSG_RESULT(no)]) ++- ++- GMP=1 ++- AC_DEFINE(GMP,1,[using gmp]) ++- AC_SUBST(GMP) ++- AC_SUBST(GMPDIR) ++- echo > makedefsafter ++- echo "MPFILES=$MPFILES" >> makedefsafter ++- echo "PATCHED_SYMBOLS=$PATCHED_SYMBOLS" >> makedefsafter ++- echo >> makedefsafter ++-fi +++ #include +++ #include "$MP_INCLUDE" +++ ]], +++ [[ +++ #ifdef _LONG_LONG_LIMB +++ return 0; +++ #else +++ return 1; +++ #endif +++ ]])],[AC_DEFINE(__LONG_LONG_LIMB,1,[long gmp3 limbs]) AC_MSG_RESULT(yes)],[AC_MSG_RESULT(no)]) +++ +++GMP=1 +++AC_DEFINE(GMP,1,[using gmp]) +++AC_SUBST(GMP) +++AC_SUBST(GMPDIR) +++echo > makedefsafter +++echo "MPFILES=$MPFILES" >> makedefsafter +++echo "PATCHED_SYMBOLS=$PATCHED_SYMBOLS" >> makedefsafter +++echo >> makedefsafter +++ ++ ++ ++ # ++@@ -980,30 +693,13 @@ fi ++ # ++ ++ if test "$enable_xgcl" = "yes" ; then ++- ++- AC_PATH_X ++-# AC_PATH_XTRA ++-# echo $X_CFLAGS ++-# echo $X_LIBS ++-# echo $X_EXTRA_LIBS ++-# echo $X_PRE_LIBS ++- ++- miss=0 ++-# AC_CHECK_LIB(Xmu,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS)#FIXME remove these ++-# AC_CHECK_LIB(Xt,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS) ++-# AC_CHECK_LIB(Xext,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS) ++-# AC_CHECK_LIB(Xaw,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS)#until here ++- AC_CHECK_LIB(X11,main,X_LIBS="$X_LIBS -lX11",miss=1,$X_LIBS) ++- ++- if test "$miss" = "1" ; then ++- X_CFLAGS= ++- X_LIBS= ++- X_EXTRA_LIBS= ++- X_PRE_LIBS= ++- echo missing x libraries -- cannot compile xgcl ++- else ++- AC_DEFINE(HAVE_XGCL,1,[using xgcl]) ++- fi +++ +++ AC_PATH_X +++ +++ AC_CHECK_LIB(X11,main, +++ [X_LIBS="$X_LIBS -lX11" AC_DEFINE(HAVE_XGCL,1,[using xgcl])], +++ [AC_MSG_RESULT([missing x libraries -- cannot compile xgcl])]) +++ ++ fi ++ ++ ++@@ -1015,225 +711,194 @@ AC_SUBST(X_CFLAGS) ++ # ++ ++ if test "$enable_dlopen" = "yes" ; then +++ +++ AC_CHECK_LIB([dl],[dlopen],,AC_MSG_ERROR([Cannot find dlopen])) +++ +++ TLIBS="$TLIBS -ldl -rdynamic" +++ assert_arg_to_tcflags -fPIC +++ AC_DEFINE(USE_DLOPEN,1,[link compiled objects via libdl]) ++ ++- AC_CHECK_LIB(dl,dlopen,have_dl=1,have_dl=0) ++- if test "$have_dl" = "0" ; then ++- echo "Cannot find dlopen in -dl" ++- exit 1 ++- fi ++-dnl AC_SEARCH_LIBS(dlopen, dl, have_dl=1, AC_ERROR(dlopen not found)) ++-dnl LIBS and TLIBS - why not merged from the beginning? ++- ++- TLIBS="$TLIBS -ldl -rdynamic" ++- TCFLAGS="-fPIC $TCFLAGS" ++-dnl TLIBS="$TLIBS -rdynamic" ++- AC_DEFINE(USE_DLOPEN,1,[link compiled objects via libdl]) ++ fi ++ ++ if test "$enable_statsysbfd" = "yes" || test "$enable_dynsysbfd" = "yes" ; then ++- AC_CHECK_HEADERS(bfd.h, ++- AC_CHECK_LIB(bfd,bfd_init, ++- # ++- # Old binutils appear to need CONST defined to const ++- # ++- AC_MSG_CHECKING(if need to define CONST for bfd) ++- AC_TRY_RUN([#define IN_GCC ++- #include ++- int main() { symbol_info t; return 0;}], ++- AC_MSG_RESULT(no), ++- AC_TRY_RUN([#define CONST const ++- #define IN_GCC ++- #include ++- int main() {symbol_info t; return 0;}], ++- AC_MSG_RESULT(yes) ++- AC_DEFINE(NEED_CONST,1,[binutils requires CONST definition]), ++- AC_MSG_ERROR([cannot use bfd]), ++- AC_MSG_ERROR([cannot use bfd])), ++- AC_MSG_ERROR([cannot use bfd])) ++- ,,-liberty)) ++- ++- AC_DEFINE(HAVE_LIBBFD,1,[use libbfd]) ++- ++-# ++-# BFD boolean syntax ++-# ++- ++- AC_MSG_CHECKING(for useable bfd_boolean) ++- AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++- #define IN_GCC ++- #include ++- bfd_boolean foo() {return FALSE;} ++- ]],[[return 0;]])], ++- [AC_MSG_RESULT(yes) ++- AC_DEFINE(HAVE_BFD_BOOLEAN,1,[bfd_boolean defined])], ++- [AC_MSG_RESULT(no)]) ++- ++-# ++-# bfd_link_info.output_bfd minimal configure change check ++-# ++- ++- AC_CHECK_MEMBER([struct bfd_link_info.output_bfd], ++- AC_DEFINE(HAVE_OUTPUT_BFD,1,[output_bfd element present]), [], ++- [ ++- #include ++- #include ++- ]) ++- AC_SUBST(HAVE_OUTPUT_BFD) ++- ++-# ++-# FIXME: Need to workaround mingw before this point -- CM ++-# ++- if test "$enable_statsysbfd" = "yes" && ! $CC -v 2>&1 | fgrep ming > /dev/null ; then ++- echo 'int main() {bfd_init();bfd_openr("/dev/null",0);return 0;}' >foo.c ++- MP=`$CC [ -Wl,-M ] -static -o foo foo.c -lbfd -liberty -ldl 2>&1 | grep -v : | tr '()' '\012\012' | $AWK '{print $NF}' | sort | uniq` ++- rm -f foo.c foo ++- if echo $MP | tr ' ' '\012' | grep libbfd.a >/dev/null; then ++- LIBBFD="`echo $MP | tr ' ' '\012' | grep libbfd.a | $AWK '{i=split($1,A,"/");for (j=1;j<=i;j++) if (j>1 && A[[j]]=="..") {j--;i-=2;for (k=j;k<=i;k++) A[[k]]=A[[k+2]];j--;}} END {for (j=1;j<=i;j++) printf("%s%s",A[[j]],j!=i ? "/" : "")}'`" ++- else ++- AC_MSG_ERROR([cannot locate external libbfd.a]) ++- fi ++- if echo $MP | tr ' ' '\012' | grep libiberty.a >/dev/null ; then ++- LIBIBERTY="`echo $MP | tr ' ' '\012' | grep libiberty.a | $AWK '{i=split($1,A,"/");for (j=1;j<=i;j++) if (j>1 && A[[j]]=="..") {j--;i-=2;for (k=j;k<=i;k++) A[[k]]=A[[k+2]];j--;}} END {for (j=1;j<=i;j++) printf("%s%s",A[[j]],j!=i ? "/" : "")}'`" ++- else ++- AC_MSG_ERROR([cannot locate external libiberty.a]) ++- fi ++- BUILD_BFD=copy_bfd ++- AC_CHECK_LIB(z,inflate, ++- [TLIBS="$TLIBS -lz"], ++- AC_MSG_ERROR([Need zlib for bfd linking]),[]) ++- AC_CHECK_LIB(dl,dlsym, ++- [TLIBS="$TLIBS -ldl"], ++- AC_MSG_ERROR([Need libdl for bfd linking]),[]) ++- AC_SUBST(BUILD_BFD) ++- AC_SUBST(LIBBFD) ++- AC_SUBST(LIBIBERTY) ++- +++ AC_CHECK_HEADERS( +++ [bfd.h], +++ AC_CHECK_LIB( +++ [bfd],[bfd_init], +++ # +++ # Old binutils appear to need CONST defined to const +++ # +++ AC_MSG_CHECKING([need to define CONST for bfd]) +++ AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #define IN_GCC +++ #include +++ ]], +++ [[ +++ symbol_info t; +++ ]])], +++ AC_MSG_RESULT([no]), +++ AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #define CONST const +++ #define IN_GCC +++ #include +++ ]], +++ [[ +++ symbol_info t; +++ ]])], +++ AC_MSG_RESULT([yes]) +++ AC_DEFINE(NEED_CONST,1,[binutils requires CONST definition]), +++ AC_MSG_ERROR([cannot use bfd]), +++ AC_MSG_ERROR([cannot use bfd])), +++ AC_MSG_ERROR([cannot use bfd])) +++ ,,-liberty)) +++ +++ AC_DEFINE(HAVE_LIBBFD,1,[use libbfd]) +++ +++ # +++ # BFD boolean syntax +++ # +++ +++ AC_MSG_CHECKING(for useable bfd_boolean) +++ AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #define IN_GCC +++ #include +++ bfd_boolean foo() {return FALSE;} +++ ]], +++ [[]])], +++ [AC_MSG_RESULT(yes) +++ AC_DEFINE(HAVE_BFD_BOOLEAN,1,[bfd_boolean defined])], +++ [AC_MSG_RESULT(no)]) +++ +++ # +++ # bfd_link_info.output_bfd minimal configure change check +++ # +++ +++ AC_CHECK_MEMBER([struct bfd_link_info.output_bfd], +++ AC_DEFINE(HAVE_OUTPUT_BFD,1,[output_bfd element present]), [], +++ [[ +++ #include +++ #include +++ ]]) +++ AC_SUBST(HAVE_OUTPUT_BFD) +++ +++ # +++ # FIXME: Need to workaround mingw before this point -- CM +++ # +++ if test "$enable_statsysbfd" = "yes" && ! $CC -v 2>&1 | fgrep ming > /dev/null ; then +++ echo 'int main() {bfd_init();bfd_openr("/dev/null",0);return 0;}' >foo.c +++ MP=`$CC [ -Wl,-M ] -static -o foo foo.c -lbfd -liberty -ldl 2>&1 | grep -v : | tr '()' '\012\012' | $AWK '{print $NF}' | sort | uniq` +++ rm -f foo.c foo +++ if echo $MP | tr ' ' '\012' | grep libbfd.a >/dev/null; then +++ LIBBFD="`echo $MP | tr ' ' '\012' | grep libbfd.a | $AWK '{i=split($1,A,\"/\");for (j=1;j<=i;j++) if (j>1 && A[[j]]==\"..\") {j--;i-=2;for (k=j;k<=i;k++) A[[k]]=A[[k+2]];j--;}} END {for (j=1;j<=i;j++) printf(\"%s%s\",A[[j]],j!=i ? \"/\" : \"\")}'`" ++ else ++- TLIBS="$TLIBS -lbfd -liberty -ldl" ++- fi ++-fi ++- ++-if test "$enable_locbfd" = "yes" ; then ++- ++- # check for gettext. It is part of glibc, but others ++- # need GNU gettext separately. ++-# AC_CHECK_HEADERS(libintl.h, true, ++-# AC_MSG_ERROR(libintl.h (gettext) not found)) ++-# AC_SEARCH_LIBS(dgettext, intl, true, AC_MSG_ERROR(gettext library not found)) ++- ++- echo "#" ++- echo "#" ++- echo "# -------------------------" ++- echo "# Subconfigure of LIBINTL" ++- echo "#" ++- echo "#" ++- cd binutils/intl && chmod +x configure && ./configure --disable-nls && cd ../.. ++-# MY_SUBDIRS="$MY_SUBDIRS binutils/libiberty " ++- echo "#" ++- echo "#" ++- echo "#" ++- echo "# Subconfigure of LIBINTL done" ++- echo "# ------------------------------" ++- echo "#" ++- echo "#" ++- echo "#" ++- echo "# -------------------------" ++- echo "# Subconfigure of LIBIBERTY" ++- echo "#" ++- echo "#" ++- cd binutils/libiberty && chmod +x configure && ./configure --disable-nls && cd ../.. ++-# MY_SUBDIRS="$MY_SUBDIRS binutils/libiberty " ++- echo "#" ++- echo "#" ++- echo "#" ++- echo "# Subconfigure of LIBIBERTY done" ++- echo "# ------------------------------" ++- echo "#" ++- echo "#" ++- echo "#" ++- echo "# -------------------" ++- echo "# Subconfigure of BFD" ++- echo "#" ++- echo "#" ++- cd binutils/bfd && chmod +x configure && ./configure --with-included-gettext --disable-nls && cd ../.. ++-# MY_SUBDIRS="$MY_SUBDIRS binutils/bfd " ++- echo "#" ++- echo "#" ++- echo "#" ++- echo "# Subconfigure of BFD done" ++- echo "# ------------------------" ++- echo "#" ++-# TLIBS="$TLIBS `pwd`/binutils/bfd/libbfd.a `pwd`/binutils/libiberty/libiberty.a" ++- AC_DEFINE(HAVE_LIBBFD,1,[use libbfd]) ++- BUILD_BFD="h/bfd.h h/bfdlink.h h/ansidecl.h h/symcat.h" +++ AC_MSG_ERROR([cannot locate external libbfd.a]) +++ fi +++ if echo $MP | tr ' ' '\012' | grep libiberty.a >/dev/null ; then +++ LIBIBERTY="`echo $MP | tr ' ' '\012' | grep libiberty.a | $AWK '{i=split($1,A,\"/\");for (j=1;j<=i;j++) if (j>1 && A[[j]]==\"..\") {j--;i-=2;for (k=j;k<=i;k++) A[[k]]=A[[k+2]];j--;}} END {for (j=1;j<=i;j++) printf(\"%s%s\",A[[j]],j!=i ? \"/\" : \"\")}'`" +++ else +++ AC_MSG_ERROR([cannot locate external libiberty.a]) +++ fi +++ BUILD_BFD=copy_bfd +++ AC_CHECK_LIB(z,inflate, +++ [TLIBS="$TLIBS -lz"], +++ AC_MSG_ERROR([Need zlib for bfd linking]),[]) +++ AC_CHECK_LIB(dl,dlsym, +++ [TLIBS="$TLIBS -ldl"], +++ AC_MSG_ERROR([Need libdl for bfd linking]),[]) ++ AC_SUBST(BUILD_BFD) +++ AC_SUBST(LIBBFD) +++ AC_SUBST(LIBIBERTY) +++ +++ else +++ TLIBS="$TLIBS -lbfd -liberty -ldl" +++ fi ++ fi ++ +++AC_ARG_ENABLE([xdr],[ --enable-xdr=yes will compile in support for XDR]) ++ ++-if test "$enable_xdr" = "yes" ; then ++- AC_CHECK_FUNC(xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]), ++- AC_CHECK_LIB(tirpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) ++- TLIBS="$TLIBS -ltirpc" TCFLAGS="$TCFLAGS -I/usr/include/tirpc", ++- AC_CHECK_LIB(gssrpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) ++- TLIBS="$TLIBS -lgssrpc" TCFLAGS="$TCFLAGS -I/usr/include/gssrpc", ++- AC_CHECK_LIB(rpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) ++- TLIBS="$TLIBS -lrpc" TCFLAGS="$TCFLAGS -I/usr/include/rpc", ++- AC_CHECK_LIB(oncrpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) ++- TLIBS="$TLIBS -loncrpc" TCFLAGS="$TCFLAGS -I/usr/include/oncrpc"))))) +++if test "$enable_xdr" != "no" ; then +++ XDR_LIB="" +++ AC_CHECK_FUNC([xdr_double],XDR_LIB=" ", +++ [AC_CHECK_LIB([tirpc],[xdr_double],[XDR_LIB=tirpc], +++ [AC_CHECK_LIB([gssrpc],[xdr_double],[XDR_LIB=gssrpc], +++ [AC_CHECK_LIB([rpc],[xdr_double],[XDR_LIB=rpc], +++ [AC_CHECK_LIB([oncrpc],[xdr_double],[XDR_LIB=oncrpc])])])])]) +++ +++ if test "$XDR_LIB" != ""; then +++ AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) +++ if test "$XDR_LIB" != " "; then +++ TLIBS="$TLIBS -l$XDR_LIB" +++ add_arg_to_tcflags -I/usr/include/$XDR_LIB +++ fi +++ fi ++ fi ++ ++ ++ AC_MSG_CHECKING([__builtin_clzl]) ++-AC_RUN_IFELSE([AC_LANG_SOURCE([[ ++- #include ++- #include ++- int main() { ++- unsigned long u; ++- long j; ++- if (__builtin_clzl(0)!=sizeof(long)*8) ++- return -1; ++- for (u=1,j=sizeof(long)*8-1;j>=0;j--,u<<=1) ++- if (__builtin_clzl(u)!=j) ++- return -1; ++- return 0; ++- }]])],[AC_MSG_RESULT([yes]) ++- AC_DEFINE(HAVE_CLZL,[1],[clzl instruction])], ++- [AC_MSG_RESULT([no])]) +++AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ #include +++ ]], +++ [[ +++ unsigned long u; +++ long j; +++ if (__builtin_clzl(0)!=sizeof(long)*8) +++ return -1; +++ for (u=1,j=sizeof(long)*8-1;j>=0;j--,u<<=1) +++ if (__builtin_clzl(u)!=j) +++ return -1; +++ ]])], +++ [AC_MSG_RESULT([yes]) +++ AC_DEFINE(HAVE_CLZL,[1],[clzl instruction])], +++ [AC_MSG_RESULT([no])]) ++ ++ AC_MSG_CHECKING([__builtin_ctzl]) ++-AC_RUN_IFELSE([AC_LANG_SOURCE([[ ++- #include ++- #include ++- int main() { ++- unsigned long u; ++- long j; ++- if (__builtin_ctzl(0)!=sizeof(long)*8) ++- return -1; ++- for (u=1,j=0;j +++ #include +++ ]], +++ [[ +++ unsigned long u; +++ long j; +++ if (__builtin_ctzl(0)!=sizeof(long)*8) +++ return -1; +++ for (u=1,j=0;j ++- #include ++- #ifdef __CYGWIN__ ++- #define getpagesize() 4096 ++- #endif ++- ]],[[ ++- size_t i=getpagesize(),j; ++- FILE *fp=fopen("conftest1","w"); ++- for (j=0;i>>=1;j++); ++- j=j<$min_pagewidth ? $min_pagewidth : j; ++- fprintf(fp,"%u",j); ++- return 0; ++- ]])], ++- [PAGEWIDTH=`cat conftest1`], ++- [PAGEWIDTH=0]) +++AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ #include +++ #ifdef __CYGWIN__ +++ #define getpagesize() 4096 +++ #endif +++ ]], +++ [[ +++ size_t i=getpagesize(),j; +++ FILE *fp=fopen("conftest1","w"); +++ for (j=0;i>>=1;j++); +++ j=j<$min_pagewidth ? $min_pagewidth : j; +++ fprintf(fp,"%u",j); +++ ]])], +++ [PAGEWIDTH=`cat conftest1`], +++ [PAGEWIDTH=0]) ++ AC_MSG_RESULT($PAGEWIDTH) ++ AC_DEFINE_UNQUOTED(PAGEWIDTH,$PAGEWIDTH,[system pagewidth]) ++ AC_SUBST(PAGEWIDTH) ++ ++ AC_MSG_CHECKING([for required object alignment]) ++-AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++- #include ++- #define EXTER ++- #define INLINE ++- #include "$MP_INCLUDE" ++- #include "./h/enum.h" ++- #define OBJ_ALIGN ++- #include "./h/type.h" ++- #include "./h/lu.h" ++- #include "./h/object.h" ++- ]],[[ ++- unsigned long i; ++- FILE *fp=fopen("conftest1","w"); ++- for (i=1;i && NOT_OBJECT_ALIGNED(i); i<<=1); ++- if (!i) return -1; ++- fprintf(fp,"%lu",i); ++- fclose(fp); ++- return 0; ++- ]])], ++- [obj_align=`cat conftest1` ++- AC_MSG_RESULT($obj_align) ++- AC_DEFINE_UNQUOTED(OBJ_ALIGNMENT,$obj_align,[needed object alignment in bytes])], ++- [AC_MSG_ERROR([Cannot find object alignent])]) +++AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ #define EXTER +++ #define INLINE +++ #include "$MP_INCLUDE" +++ #include "./h/enum.h" +++ #define OBJ_ALIGN +++ #include "./h/type.h" +++ #include "./h/lu.h" +++ #include "./h/object.h" +++ ]], +++ [[ +++ unsigned long i; +++ FILE *fp=fopen("conftest1","w"); +++ for (i=1;i && NOT_OBJECT_ALIGNED(i); i<<=1); +++ if (!i) return -1; +++ fprintf(fp,"%lu",i); +++ fclose(fp); +++ return 0; +++ ]])], +++ [obj_align=`cat conftest1` +++ AC_MSG_RESULT($obj_align) +++ AC_DEFINE_UNQUOTED(OBJ_ALIGNMENT,$obj_align,[needed object alignment bytes])], +++ [AC_MSG_ERROR([Cannot find object alignent])]) ++ ++ AC_MSG_CHECKING([for C extension variable alignment]) ++-AC_RUN_IFELSE([AC_LANG_PROGRAM([[]],[[ ++- char *v __attribute__ ((aligned ($obj_align))); ++- return 0;]])],[obj_align="__attribute__ ((aligned ($obj_align)))"],[AC_MSG_ERROR([Need alignment attributes])]) +++AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM([[]], +++ [[ +++ char *v __attribute__ ((aligned ($obj_align))); +++ ]])],[obj_align="__attribute__ ((aligned ($obj_align)))"],[AC_MSG_ERROR([Need alignment attributes])]) ++ AC_MSG_RESULT($obj_align) ++ AC_DEFINE_UNQUOTED(OBJ_ALIGN,$obj_align,[can use C extension for object alignment]) ++ ++ AC_MSG_CHECKING([for C extension noreturn function attribute]) ++-AC_RUN_IFELSE([AC_LANG_PROGRAM([[]],[[ ++- extern int v() __attribute__ ((noreturn)); ++- return 0;]])],[no_return="__attribute__ ((noreturn))"],[no_return=]) +++AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM([[]], +++ [[ +++ extern int v() __attribute__ ((noreturn)); +++ ]])], +++ [no_return="__attribute__ ((noreturn))"],[no_return=]) ++ AC_MSG_RESULT($no_return) ++ AC_DEFINE_UNQUOTED(NO_RETURN,$no_return,[can use C extension for functions that do not return]) ++ ++-AC_MSG_CHECKING(sizeof struct contblock) +++AC_MSG_CHECKING([sizeof struct contblock]) +++ +++AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ #define EXTER +++ #define INLINE +++ #include "$MP_INCLUDE" +++ #include "h/enum.h" +++ #include "h/type.h" +++ #include "h/lu.h" +++ #include "h/object.h" +++ ]], +++ [[ +++ FILE *f=fopen("conftest1","w"); +++ fprintf(f,"%u",sizeof(struct contblock)); +++ fclose(f); +++ ]])], +++ [sizeof_contblock=`cat conftest1`], +++ [AC_MSG_ERROR([Cannot find sizeof struct contblock])], +++ [AC_MSG_ERROR([Cannot find sizeof struct contblock])]) ++ ++-# work around MSYS pwd result incompatibility ++-if test "$use" = "mingw" ; then ++-AC_TRY_RUN([#include ++- #define EXTER ++- #define INLINE ++- #include "$MP_INCLUDE" ++- #include "h/enum.h" ++- #include "h/type.h" ++- #include "h/lu.h" ++- #include "h/object.h" ++- int main(int argc,char **argv,char **envp) { ++- FILE *f=fopen("conftest1","w"); ++- fprintf(f,"%u",sizeof(struct contblock)); ++- fclose(f); ++- return 0; ++- }],sizeof_contblock=`cat conftest1`, ++- echo Cannot find sizeof struct contblock;exit 1, ++- echo Cannot find sizeof struct contblock;exit 1) ++-else ++-AC_TRY_RUN([#include ++- #define EXTER ++- #define INLINE ++- #include "$MP_INCLUDE" ++- #include "`pwd`/h/enum.h" ++- #include "`pwd`/h/type.h" ++- #include "`pwd`/h/lu.h" ++- #include "`pwd`/h/object.h" ++- int main(int argc,char **argv,char **envp) { ++- FILE *f=fopen("conftest1","w"); ++- fprintf(f,"%u",sizeof(struct contblock)); ++- fclose(f); ++- return 0; ++- }],sizeof_contblock=`cat conftest1`, ++- echo Cannot find sizeof struct contblock;exit 1, ++- echo Cannot find sizeof struct contblock;exit 1) ++-fi ++ AC_MSG_RESULT($sizeof_contblock) ++ AC_DEFINE_UNQUOTED(SIZEOF_CONTBLOCK,$sizeof_contblock,[sizeof linked list for contiguous pages]) ++ ++ AC_MSG_CHECKING([for sbrk]) ++ HAVE_SBRK="" ++-AC_TRY_RUN([#include ++- #include ++- int main() { +++AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ #include +++ ]], +++ [[ ++ FILE *f; ++ if (!(f=fopen("conftest1","w"))) ++- return -1; ++- fprintf(f,"%u",sbrk(0)); ++- return 0; ++- }], ++- HAVE_SBRK=1 ++- AC_MSG_RESULT(yes), ++- AC_MSG_RESULT([no: WARNING you must be able to emulate sbrk: as on mingw or macosx]), ++- AC_MSG_RESULT([no: WARNING you must be able to emulate sbrk: as on mingw or macosx])) +++ return -1; +++ fprintf(f,"%u",sbrk(0)); +++ ]])], +++ [HAVE_SBRK=1;AC_MSG_RESULT([yes])], +++ AC_MSG_RESULT([no: WARNING you must be able to emulate sbrk: as on mingw or macosx]), +++ AC_MSG_RESULT([no: WARNING you must be able to emulate sbrk: as on mingw or macosx])) ++ ++ if test "$use" = "386-macosx" ; then ++- AC_MSG_RESULT(emulating sbrk for mac); ++- HAVE_SBRK=0 +++ AC_MSG_RESULT([emulating sbrk for mac]); +++ HAVE_SBRK=0 ++ fi ++ ++ if test "$HAVE_SBRK" = "1" ; then ++- ++- AC_MSG_CHECKING([for ADDR_NO_RANDOMIZE constant]) ++- AC_RUN_IFELSE([ ++- AC_LANG_PROGRAM([[ ++- #include ++- #include ++- ]],[[ ++- FILE *f; ++- if (!(f=fopen("conftest1","w"))) return -1; ++- fprintf(f,"%x",ADDR_NO_RANDOMIZE); ++- return 0; ++- ]])], +++ +++ AC_MSG_CHECKING([for ADDR_NO_RANDOMIZE constant]) +++ AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ #include +++ ]], +++ [[ +++ FILE *f; +++ if (!(f=fopen("conftest1","w"))) return -1; +++ fprintf(f,"%x",ADDR_NO_RANDOMIZE); +++ ]])], ++ [ADDR_NO_RANDOMIZE=`cat conftest1` ++- AC_MSG_RESULT([yes $ADDR_NO_RANDOMIZE])], +++ AC_MSG_RESULT([yes $ADDR_NO_RANDOMIZE])], ++ [ADDR_NO_RANDOMIZE=0 ++- AC_MSG_RESULT([no assuming 0x40000]) ++- AC_DEFINE_UNQUOTED(ADDR_NO_RANDOMIZE,0x40000,[punt guess for no randomize value])]) ++- ++- AC_MSG_CHECKING([for ADDR_COMPAT_LAYOUT constant]) ++- AC_RUN_IFELSE([ ++- AC_LANG_PROGRAM([[ ++- #include ++- #include ++- ]],[[ ++- FILE *f; ++- if (!(f=fopen("conftest1","w"))) return -1; ++- fprintf(f,"%x",ADDR_COMPAT_LAYOUT); ++- return 0; ++- ]])], +++ AC_MSG_RESULT([no assuming 0x40000]) +++ AC_DEFINE_UNQUOTED(ADDR_NO_RANDOMIZE,0x40000,[punt guess for no randomize value])]) +++ +++ AC_MSG_CHECKING([for ADDR_COMPAT_LAYOUT constant]) +++ AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ #include +++ ]], +++ [[ +++ FILE *f; +++ if (!(f=fopen("conftest1","w"))) return -1; +++ fprintf(f,"%x",ADDR_COMPAT_LAYOUT); +++ ]])], ++ [ADDR_COMPAT_LAYOUT=`cat conftest1` ++- AC_MSG_RESULT([yes $ADDR_COMPAT_LAYOUT])], +++ AC_MSG_RESULT([yes $ADDR_COMPAT_LAYOUT])], ++ [ADDR_COMPAT_LAYOUT=0 ++- AC_MSG_RESULT([no])] +++ AC_MSG_RESULT([no])] ++ AC_DEFINE_UNQUOTED(ADDR_COMPAT_LAYOUT,0,[constant to reserve upper 3Gb for C stack])) ++- ++- AC_MSG_CHECKING([for ADDR_LIMIT_3GB constant]) ++- AC_RUN_IFELSE([ ++- AC_LANG_PROGRAM([[ ++- #include ++- #include ++- ]],[[ ++- FILE *f; ++- if (!(f=fopen("conftest1","w"))) return -1; ++- fprintf(f,"%x",ADDR_LIMIT_3GB); ++- return 0; ++- ]])], +++ +++ AC_MSG_CHECKING([for ADDR_LIMIT_3GB constant]) +++ AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ #include +++ ]], +++ [[ +++ FILE *f; +++ if (!(f=fopen("conftest1","w"))) return -1; +++ fprintf(f,"%x",ADDR_LIMIT_3GB); +++ ]])], ++ [ADDR_LIMIT_3GB=`cat conftest1` ++- AC_MSG_RESULT([yes $ADDR_LIMIT_3GB])], +++ AC_MSG_RESULT([yes $ADDR_LIMIT_3GB])], ++ [ADDR_LIMIT_3GB=0 ++- AC_MSG_RESULT([no])] +++ AC_MSG_RESULT([no])] ++ AC_DEFINE_UNQUOTED(ADDR_LIMIT_3GB,0,[only 3Gb of address space])) ++- ++- AC_MSG_CHECKING([for personality(ADDR_NO_RANDOMIZE) support]) ++- AC_RUN_IFELSE([ ++- AC_LANG_SOURCE([[ ++- #include ++- #include ++- int main(int argc,char **argv,char **envp) { ++- #include "h/unrandomize.h" ++- return 0;}]])], +++ +++ AC_MSG_CHECKING([for personality(ADDR_NO_RANDOMIZE) support]) +++ AC_RUN_IFELSE( +++ [AC_LANG_SOURCE( +++ [[ +++ #include +++ #include +++ int main(int argc,char *argv[],char *envp[]) { +++ #include "h/unrandomize.h" +++ return 0; +++ } +++ ]])], ++ [AC_MSG_RESULT(yes) ++- AC_DEFINE(CAN_UNRANDOMIZE_SBRK,1,[can prevent sbrk from returning random values])], +++ AC_DEFINE(CAN_UNRANDOMIZE_SBRK,1,[can prevent sbrk from returning random values])], ++ [AC_MSG_RESULT(no)]) ++ ++- AC_MSG_CHECKING([that sbrk is (now) non-random]) ++- AC_TRY_RUN([#include ++- #include +++ AC_MSG_CHECKING([that sbrk is (now) non-random]) +++ SBRK=0 +++ AC_RUN_IFELSE( +++ [AC_LANG_SOURCE( +++ [[ +++ #include +++ #include ++ int main(int argc,char * argv[],char * envp[]) { ++ FILE *f; ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++- if (!(f=fopen("conftest1","w"))) return -1; ++- fprintf(f,"%u",sbrk(0)); ++- return 0;}],SBRK=`cat conftest1`,SBRK=0,SBRK=0) ++- if test "$SBRK" = "0" ; then ++- AC_MSG_RESULT(cannot trap sbrk) ++- exit 1 ++- fi ++- AC_TRY_RUN([#include ++- #include +++ if (!(f=fopen("conftest1","w"))) +++ return -1; +++ fprintf(f,"%u",sbrk(0)); +++ return 0; +++ } +++ ]])],[SBRK=`cat conftest1`]) +++ if test "$SBRK" = "0" ; then +++ AC_MSG_ERROR([cannot trap sbrk]) +++ fi +++ +++ SBRK1=0 +++ AC_RUN_IFELSE( +++ [AC_LANG_SOURCE( +++ [[ +++ #include +++ #include ++ int main(int argc,char * argv[],char * envp[]) { ++ FILE *f; ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ if (!(f=fopen("conftest1","w"))) return -1; ++- fprintf(f,"%u",sbrk(0)); ++- return 0;}],SBRK1=`cat conftest1`,SBRK1=0,SBRK1=0) ++- if test "$SBRK1" = "0" ; then ++- AC_MSG_RESULT(cannot trap sbrk) ++- exit 1 ++- fi ++- if test "$SBRK" = "$SBRK1" ; then ++- AC_MSG_RESULT(yes) ++- else ++- AC_MSG_RESULT(no) ++- echo "Cannot build with randomized sbrk. Your options:" ++- echo " - upgrade to a kernel/libc that knows about personality(ADDR_NO_RANDOMIZE)" ++- echo " - recompile your kernel with CONFIG_COMPAT_BRK (if it has that option)" ++- echo " - run sysctl kernel.randomize_va_space=0 before using gcl" ++- exit 1 ++- fi +++ fprintf(f,"%u",sbrk(0)); +++ return 0; +++ } +++ ]])],[SBRK1=`cat conftest1`]) +++ if test "$SBRK1" = "0" ; then +++ AC_MSG_ERROR([cannot trap sbrk]) +++ fi +++ if test "$SBRK" = "$SBRK1" ; then +++ AC_MSG_RESULT([yes]) +++ else +++ AC_MSG_RESULT([no]) +++ echo "Cannot build with randomized sbrk. Your options:" +++ echo " - upgrade to a kernel/libc that knows about personality(ADDR_NO_RANDOMIZE)" +++ echo " - recompile your kernel with CONFIG_COMPAT_BRK (if it has that option)" +++ echo " - run sysctl kernel.randomize_va_space=0 before using gcl" +++ AC_MSG_ERROR([exiting]) +++ fi ++ fi ++- ++-dnl AC_MSG_CHECKING(DBEGIN) ++-dnl AC_RUN_IFELSE([AC_LANG_SOURCE([[ ++-dnl #include ++-dnl #include ++-dnl #include ++-dnl void gprof_cleanup() {}; ++- ++-dnl int main(int argc,char **argv,char **envp) { ++- ++-dnl void *b; ++-dnl FILE *fp; ++- ++-dnl #ifdef CAN_UNRANDOMIZE_SBRK ++-dnl #include "h/unrandomize.h" ++-dnl #endif ++- ++-dnl fp = fopen("conftest1","w"); ++- ++-dnl #ifdef _WIN32 ++-dnl fprintf ( fp,"0x%lx", 0x3000000 ); /* Windows custom allocation from this point up */ ++-dnl #else ++-dnl #if defined (__APPLE__) && defined (__MACH__) ++-dnl fprintf(fp,"0x0"); ++-dnl #else ++-dnl b = sbrk(0); ++-dnl fprintf(fp,"0x%lx",((unsigned long) b) & ~(unsigned long)((1< ++-dnl #include ++-dnl ]],[[ ++-dnl FILE *fp=fopen("conftest1","w"); ++-dnl fprintf(fp,"%u",262144*( SIZEOF_LONG >>2)/(1<<($PAGEWIDTH-12))); ++-dnl return 0;]])],[def_maxpage=`cat conftest1`],[def_maxpage=262144]) ++- ++-dnl AC_ARG_ENABLE(maxpage, ++-dnl [ --enable-maxpage=XXXX will compile in a page table of size XXX ++-dnl (eg '--enable-maxpage=64*1024' would produce ++-dnl 64K pages allowing 256 MB if pages are 4K each)], ++-dnl ,enable_maxpage=$def_maxpage) ++- ++- ++ AC_MSG_CHECKING(CSTACK_ADDRESS) ++-AC_RUN_IFELSE([AC_LANG_SOURCE([[ ++- #include ++- #include ++- void * ++- foo() { ++- int i; ++- return (void *)&i; ++- } ++- ++- int main(int argc,char **argv,char **envp) { ++- void *v ; ++- FILE *fp = fopen("conftest1","w"); ++- unsigned long i,j; ++- ++- #ifdef CAN_UNRANDOMIZE_SBRK ++- #include "h/unrandomize.h" ++- #endif ++- j=1; ++- j<<=$PAGEWIDTH; ++- j<<=16; ++- i=(unsigned long)&v; ++- if (foo()>i) i-=j; ++- j--; ++- i+=j; ++- i&=~j; ++- fprintf(fp,"0x%lx",i-1); ++- fclose(fp); ++- return 0; ++-}]])],[cstack_address=`cat conftest1`],[cstack_address=0]) +++AC_RUN_IFELSE( +++ [AC_LANG_SOURCE( +++ [[ +++ #include +++ #include +++ void * +++ foo() { +++ int i; +++ return (void *)&i; +++ } +++ +++ int +++ main(int argc,char **argv,char **envp) { +++ void *v ; +++ FILE *fp = fopen("conftest1","w"); +++ unsigned long i,j; +++ +++ #ifdef CAN_UNRANDOMIZE_SBRK +++ #include "h/unrandomize.h" +++ #endif +++ j=1; +++ j<<=$PAGEWIDTH; +++ j<<=16; +++ i=(unsigned long)&v; +++ if (foo()>i) i-=j; +++ j--; +++ i+=j; +++ i&=~j; +++ fprintf(fp,"0x%lx",i-1); +++ fclose(fp); +++ return 0; +++ }]])], +++ [cstack_address=`cat conftest1`],[cstack_address=0]) ++ AC_DEFINE_UNQUOTED(CSTACK_ADDRESS,$cstack_address,[starting C stack address]) ++ AC_MSG_RESULT($cstack_address) ++ ++ AC_MSG_CHECKING([cstack bits]) ++-AC_RUN_IFELSE([AC_LANG_SOURCE([[ ++- #include ++- #include ++- void * ++- foo() { ++- int i; ++- return (void *)&i; ++- } ++- ++- int main(int argc,char **argv,char **envp) { ++- void *v ; ++- FILE *fp = fopen("conftest1","w"); ++- unsigned long i,j; ++- ++- #ifdef CAN_UNRANDOMIZE_SBRK ++- #include "h/unrandomize.h" ++- #endif ++- j=1; ++- j<<=$PAGEWIDTH; ++- j<<=16; ++- i=(unsigned long)&v; ++- if (foo()>i) i-=j; ++- j--; ++- i+=j; ++- i&=~j; ++- for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); ++- fprintf(fp,"%d",j); ++- fclose(fp); ++- return 0; ++-}]])],[cstack_bits=`cat conftest1`],[cstack_bits=0]) +++AC_RUN_IFELSE( +++ [AC_LANG_SOURCE( +++ [[ +++ #include +++ #include +++ void * +++ foo() { +++ int i; +++ return (void *)&i; +++ } +++ +++ int +++ main(int argc,char **argv,char **envp) { +++ void *v ; +++ FILE *fp = fopen("conftest1","w"); +++ unsigned long i,j; +++ +++ #ifdef CAN_UNRANDOMIZE_SBRK +++ #include "h/unrandomize.h" +++ #endif +++ j=1; +++ j<<=$PAGEWIDTH; +++ j<<=16; +++ i=(unsigned long)&v; +++ if (foo()>i) i-=j; +++ j--; +++ i+=j; +++ i&=~j; +++ for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); +++ fprintf(fp,"%d",j); +++ fclose(fp); +++ return 0; +++ }]])], +++ [cstack_bits=`cat conftest1`],[cstack_bits=0]) ++ AC_DEFINE_UNQUOTED(CSTACK_BITS,$cstack_bits,[log starting C stack address]) ++ AC_MSG_RESULT($cstack_bits) ++ ++ AC_MSG_CHECKING(NEG_CSTACK_ADDRESS) ++-AC_RUN_IFELSE([AC_LANG_SOURCE([[ ++- #include ++- #include ++- int main(int argc,char **argv,char **envp) { ++- #ifdef CAN_UNRANDOMIZE_SBRK ++- #include "h/unrandomize.h" ++- #endif ++- return (long)$cstack_address<0 ? 0 : -1; ++-}]])],[AC_MSG_RESULT(yes) ++- neg_cstack_address=1 ++- AC_DEFINE(NEG_CSTACK_ADDRESS,1,[C stack address is negative])], ++- [AC_MSG_RESULT(no) ++- neg_cstack_address=0]) ++- +++AC_RUN_IFELSE( +++ [AC_LANG_SOURCE( +++ [[ +++ #include +++ #include +++ int +++ main(int argc,char **argv,char **envp) { +++ #ifdef CAN_UNRANDOMIZE_SBRK +++ #include "h/unrandomize.h" +++ #endif +++ return (long)$cstack_address<0 ? 0 : -1; +++ }]])], +++ [AC_MSG_RESULT(yes) +++ neg_cstack_address=1 +++ AC_DEFINE(NEG_CSTACK_ADDRESS,1,[C stack address is negative])], +++ [AC_MSG_RESULT(no) +++ neg_cstack_address=0]) ++ ++ AC_MSG_CHECKING([finding CSTACK_ALIGNMENT]) ++-AC_RUN_IFELSE([AC_LANG_SOURCE([[ ++- #include ++- #include ++- int main(int argc,char **argv,char **envp) { ++- void *b,*c; ++- FILE *fp = fopen("conftest1","w"); ++- long n; ++- #ifdef CAN_UNRANDOMIZE_SBRK ++- #include "h/unrandomize.h" ++- #endif ++- b=alloca(sizeof(b)); ++- c=alloca(sizeof(c)); ++- n=b>c ? b-c : c-b; ++- n=n>sizeof(c) ? n : 1; ++- fprintf(fp,"%ld",n); ++- fclose(fp); ++- return 0; ++-}]])],[cstack_alignment=`cat conftest1`],[cstack_alignment=0]) +++AC_RUN_IFELSE( +++ [AC_LANG_SOURCE( +++ [[ +++ #include +++ #include +++ int main(int argc,char **argv,char **envp) { +++ void *b,*c; +++ FILE *fp = fopen("conftest1","w"); +++ long n; +++ #ifdef CAN_UNRANDOMIZE_SBRK +++ #include "h/unrandomize.h" +++ #endif +++ b=alloca(sizeof(b)); +++ c=alloca(sizeof(c)); +++ n=b>c ? b-c : c-b; +++ n=n>sizeof(c) ? n : 1; +++ fprintf(fp,"%ld",n); +++ fclose(fp); +++ return 0; +++ }]])], +++ [cstack_alignment=`cat conftest1`],[cstack_alignment=0]) ++ AC_DEFINE_UNQUOTED(CSTACK_ALIGNMENT,$cstack_alignment,[C stack alignment]) ++ AC_MSG_RESULT($cstack_alignment) ++ ++ AC_MSG_CHECKING(CSTACK_DIRECTION) ++-AC_RUN_IFELSE([AC_LANG_SOURCE([[ ++- #include ++- #include ++- void * ++- foo(void) { ++- int i; ++- return (void *)&i; ++- } ++- ++- int main(int argc,char **argv,char **envp) { ++- char *b; ++- FILE *fp = fopen("conftest1","w"); ++- #ifdef CAN_UNRANDOMIZE_SBRK ++- #include "h/unrandomize.h" ++- #endif ++- fprintf(fp,"%d",((long) &b) > ((long) foo()) ? -1 : 1); ++- fclose(fp); ++- return 0; ++-}]])],[cstack_direction=`cat conftest1`],[cstack_direction=0]) +++AC_RUN_IFELSE( +++ [AC_LANG_SOURCE( +++ [[ +++ #include +++ #include +++ void * +++ foo(void) { +++ int i; +++ return (void *)&i; +++ } +++ +++ int +++ main(int argc,char **argv,char **envp) { +++ char *b; +++ FILE *fp = fopen("conftest1","w"); +++ #ifdef CAN_UNRANDOMIZE_SBRK +++ #include "h/unrandomize.h" +++ #endif +++ fprintf(fp,"%d",((long) &b) > ((long) foo()) ? -1 : 1); +++ fclose(fp); +++ return 0; +++ }]])], +++ [cstack_direction=`cat conftest1`],[cstack_direction=0]) ++ AC_DEFINE_UNQUOTED(CSTACK_DIRECTION,$cstack_direction,[whether C stack grows up or down]) ++ AC_MSG_RESULT($cstack_direction) ++ +++AC_ARG_ENABLE([immfix],[ --enable-immfix will enable an immediate fixnum table above the C stack]) ++ ++-dnl AC_MSG_CHECKING(for shared library/C stack ceiling to heap) ++-dnl if test "$use" = "mingw" ; then ++-dnl heap_ceiling=2000000000 ++-dnl else ++-dnl if test "$use" = "solaris-i386" ; then ++-dnl heap_ceiling=0x0 ++-dnl else ++-dnl if test "$enable_static" = "yes" ; then ++-dnl heap_ceiling=0x0 ++-dnl else ++-dnl if ! test -x `which ldd` && ! test -f /proc/self/maps ; then ++-dnl heap_ceiling=0x0 ++-dnl else ++-dnl if test -f /proc/self/maps ; then ++-dnl heap_ceiling=0x`/bin/cat /proc/self/maps | grep "/lib.*/ld-" | cut -f1 -d- | head -1` ++-dnl else ++-dnl if test "`which ldd`" = "" ; then ++-dnl heap_ceiling=0x0 ++-dnl else ++-dnl #echo -e "#include \n int main() {printf(\"foo\");return 0;}" >foo.c ++-dnl #$CC foo.c -o foo ++-dnl AAWK=`which awk` ++-dnl # | grep -v ld-kfreebsd needed on some strange bsd amd64 boxes ++-dnl heap_ceiling=`ldd $AAWK | tail -n 1 | $AWK '{print $NF}' | tr -d '()'` ++-dnl fi ++-dnl fi ++-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++-dnl #include ++-dnl ]],[[ ++-dnl FILE *fp=fopen("conftest1","w"); ++-dnl unsigned long h=$heap_ceiling,d=$dbegin,c=$cstack_address; ++-dnl h=hd && cfoo.c ++-dnl else ++-dnl echo "int main() {return !($heap_ceiling && (unsigned long)$dbegin < (unsigned long)$cstack_address);}" >foo.c ++-dnl fi ++-dnl $CC foo.c -o foo ++-dnl if ./foo ; then +++AC_ARG_ENABLE([fastimmfix],[ --enable-fastimmfix=XXXX will reject low immediate fixnums unless 2^XXX can be attained],,[enable_fastimmfix=64]) ++ ++-if test "$use" != "386-gnu" ; then #hurd can push .data below C stack, but sbrk(0) remains above, foiling unexec ++ ++- AC_MSG_CHECKING([finding default linker script]) ++- touch unixport/gcl.script ++- echo "int main() {return 0;}" >foo.c ++- $CC -Wl,--verbose foo.c -o foo 2>&1 | \ ++- $AWK '/\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=/ {i=1-i;next} {if (i) print}' >gcl.script ++- rm -rf foo.c foo ++- ++- if test "`cat gcl.script | wc -l`" != "0" ; then ++- AC_MSG_RESULT(got it) ++- AC_MSG_NOTICE([trying to adjust text start]) ++- cp gcl.script gcl.script.def ++- ++- n=-1; ++- k=0; ++- lim=`$AWK 'END {printf("%d\n",m*8-2)}' m=$ac_cv_sizeof_long`; ++- max=0; ++- min=$lim; ++- while test $n -lt $lim ; do ++- j=`$AWK 'END {for (i=j=0;j<=n;j++) i=i ? i*2 : 1;printf("%x\n",3*i)}' n=$n gcl.script ++-# diff -u gcl.script.def gcl.script ++- echo "int main() {return 0;}" >foo.c ++- if ( $CC -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then ++- if test $n -lt $min ; then min=$n; fi; ++- if test $n -gt $max; then max=$n; fi; ++- elif test $max -gt 0 ; then ++- break; ++- fi; ++- n=`$AWK 'END {print n+1}' n=$n foo.c +++ $CC $TLDFLAGS -Wl,--verbose foo.c -o foo 2>&1 | \ +++ $AWK '/\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=/ {i=1-i;next} {if (i) print}' >gcl.script +++ rm -rf foo.c foo +++ +++ if test "`cat gcl.script | wc -l`" != "0" ; then +++ AC_MSG_RESULT(got it) +++ AC_MSG_NOTICE([trying to adjust text start]) +++ cp gcl.script gcl.script.def +++ +++ n=-1; +++ k=0; +++ lim=`$AWK 'END {printf("%d\n",m*8-2)}' m=$ac_cv_sizeof_long`; +++ max=0; +++ min=$lim; +++ while test $n -lt $lim ; do +++ j=`$AWK 'END {for (i=j=0;j<=n;j++) i=i ? i*2 : 1;printf("%x\n",3*i)}' n=$n gcl.script +++ # diff -u gcl.script.def gcl.script +++ echo "int main() {return 0;}" >foo.c +++ if ( $CC $TLDFLAGS -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then +++ if test $n -lt $min ; then min=$n; fi; +++ if test $n -gt $max; then max=$n; fi; +++ elif test $max -gt 0 ; then +++ break; +++ fi; +++ n=`$AWK 'END {print n+1}' n=$n gcl.script ++ AC_MSG_RESULT([done]) ++ rm -f gcl.script.def ++ LDFLAGS="$LDFLAGS -Wl,-T gcl.script " ++ cp gcl.script unixport ++- else ++- AC_MSG_RESULT([none found or not needed]) ++- rm -f gcl.script gcl.script.def ++- fi ++- rm -rf foo.c foo ++- else ++- AC_MSG_RESULT([not found]) ++- fi ++- +++ else +++ AC_MSG_RESULT([none found or not needed]) +++ rm -f gcl.script gcl.script.def +++ fi +++ rm -rf foo.c foo +++ else +++ AC_MSG_RESULT([not found]) +++ fi +++ ++ else ++- ++- AC_DEFINE_UNQUOTED(OBJNULL,NULL,[lowest address non-object]) ++- +++ +++ AC_DEFINE_UNQUOTED(OBJNULL,NULL,[lowest address non-object]) +++ ++ fi ++ ++- dnl old_LDFLAGS="$LDFLAGS" ++- dnl LDFLAGS="$LDFLAGS $TLDFLAGS" ++- dnl AC_MSG_CHECKING([revised DBEGIN]) ++- dnl AC_RUN_IFELSE([AC_LANG_SOURCE([[ ++- dnl #include ++- dnl #include ++- dnl #include ++- ++- dnl int main(int argc,char **argv,char **envp) { ++- ++- dnl void *b; ++- dnl FILE *fp; ++- ++- dnl #ifdef CAN_UNRANDOMIZE_SBRK ++- dnl #include "h/unrandomize.h" ++- dnl #endif ++- dnl fp = fopen("conftest1","w"); ++- ++- dnl #ifdef _WIN32 ++- dnl fprintf ( fp,"0x%lx", 0x1a000000 ); /* Windows custom allocation from this point up */ ++- dnl #else ++- dnl #if defined (__APPLE__) && defined (__MACH__) ++- dnl fprintf(fp,"((unsigned long)get_dbegin())"); ++- dnl #else ++- dnl b = sbrk(0); ++- dnl fprintf(fp,"0x%lx",((unsigned long) b) & ~(unsigned long)0xffffff); ++- dnl #endif ++- dnl #endif ++- dnl fclose(fp); ++- dnl return 0;}]])],[dbegin=`cat conftest1`],[dbegin=0]) ++- dnl AC_MSG_RESULT($dbegin) ++- dnl LDFLAGS="$old_LDFLAGS" ++-dnl fi ++-dnl dnl AC_DEFINE_UNQUOTED(DBEGIN,$dbegin,[down-rounded beginning address of lisp data]) ++-dnl rm -rf foo* ++- ++-dnl AC_MSG_CHECKING(for maxpage revision) ++-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++-dnl #include ++-dnl ]],[[ ++-dnl char *b; ++-dnl unsigned long i,j; ++-dnl FILE *fp = fopen("conftest1","w"); ++-dnl j=((unsigned long)$enable_maxpage <<$PAGEWIDTH) + $dbegin; ++-dnl j=$heap_ceiling && j>$heap_ceiling ? $heap_ceiling : j; ++-dnl j-=$dbegin; ++-dnl /* for (i=1;i<<1 && i<=j;i<<=1); */ ++-dnl /* if (i>j) i>>=1; */ ++-dnl i=j; ++-dnl fprintf(fp,"%ld",i>>$PAGEWIDTH); ++-dnl fclose(fp); ++-dnl return 0; ++-dnl ]])],[tmp_maxpage=`cat conftest1`],[tmp_maxpage=0]) ++-dnl if test "$tmp_maxpage" != "$enable_maxpage" ; then ++-dnl enable_maxpage=$tmp_maxpage ++-dnl AC_MSG_RESULT($enable_maxpage) ++-dnl else ++-dnl AC_MSG_RESULT($enable_maxpage is OK) ++-dnl fi ++-dnl AC_DEFINE_UNQUOTED(MAXPAGE,$enable_maxpage,[maximum number of pages to be allocated]) ++- ++-dnl AC_MSG_CHECKING(for C stack size floor from heap) ++-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++-dnl #include ++-dnl ]],[[ ++-dnl char *b; ++-dnl FILE *fp = fopen("conftest1","w"); ++-dnl unsigned long j,k; ++- ++-dnl j=$cstack_address + $cstack_direction * $enable_cssize; ++-dnl k=($dbegin + ((unsigned long)$enable_maxpage << $PAGEWIDTH)); ++-dnl j=abs(j-$cstack_address)!=$enable_cssize || (j ++-dnl ]],[[ ++-dnl char *b; ++-dnl FILE *fp = fopen("conftest1","w"); ++-dnl unsigned long j,k; ++- ++-dnl j=$cstack_address + $cstack_direction * $enable_cssize; ++-dnl if ($cstack_direction>0) { ++-dnl k=$cstack_address + ((-(unsigned long)$cstack_address)>>1); ++-dnl j=j<$cstack_address || j > k ? k : j; ++-dnl j=$cstack_address < $dbegin && j > $dbegin ? $dbegin : j; ++-dnl } ++-dnl j-=$cstack_address; ++-dnl j*=$cstack_direction; ++-dnl fprintf(fp,"%lu",j); ++-dnl fclose(fp); ++-dnl return 0; ++-dnl ]])],[tmp_cssize=`cat conftest1`],[tmp_cssize=0]) ++-dnl if test "$tmp_cssize" != "$enable_cssize" ; then ++-dnl enable_cssize=$tmp_cssize; ++-dnl AC_MSG_RESULT($enable_cssize) ++-dnl else ++-dnl AC_MSG_RESULT($enable_cssize is OK) ++-dnl fi ++- ++-dnl AC_MSG_CHECKING(for C stack size limit from address wrap) ++-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++-dnl #include ++-dnl ]],[[ ++-dnl char *b; ++-dnl FILE *fp = fopen("conftest1","w"); ++-dnl unsigned long j,k; ++- ++-dnl j=-$cstack_address * $cstack_direction; ++-dnl j=j>$enable_cssize ? $enable_cssize : j; ++-dnl fprintf(fp,"%lu",j); ++-dnl fclose(fp); ++-dnl return 0; ++-dnl ]])],[tmp_cssize=`cat conftest1`],[tmp_cssize=0]) ++-dnl if test "$tmp_cssize" != "$enable_cssize" ; then ++-dnl enable_cssize=$tmp_cssize; ++-dnl AC_MSG_RESULT($enable_cssize) ++-dnl else ++-dnl AC_MSG_RESULT($enable_cssize is OK) ++-dnl fi ++-dnl AC_DEFINE_UNQUOTED(CSSIZE,$enable_cssize,[maximum C stack size]) ++- ++-dnl AC_MSG_CHECKING(for fast NULL_OR_ON_CSTACK macro) ++-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++-dnl #include ++-dnl ]],[[ ++-dnl return ((long)$dbegin>=0 && ++-dnl ((long)$dbegin+(long)($enable_maxpage<<$PAGEWIDTH)) >=0 && ++-dnl ((long)$cstack_address<0)) ? 0 : 1; ++-dnl ]])],[tmp_fnocm=yes],[tmp_fnocm=no]) ++-dnl if test "$tmp_fnocm" = "yes" ; then ++-dnl AC_MSG_RESULT(yes) ++-dnl AC_DEFINE(USE_FAST_NULL_OR_ON_CSTACK_MACRO,1,[whether one instruction heap address check can be used]) ++-dnl else ++-dnl AC_MSG_RESULT(no) ++-dnl fi ++- ++ mem_top=0 ++ mem_range=0 ++ AC_MSG_CHECKING(mem top) ++-AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++- #include ++- ]],[[ ++- void *v; ++- unsigned long i,j,k,l,m; ++- FILE *fp = fopen("conftest1","w"); ++- ++- for (i=2,k=1;i;k=i,i<<=1); ++- l=$cstack_address; ++- l=$cstack_direction==1 ? (l>=1,i|=j); ++- if (j<(k>>3)) i=0; ++- j=1; ++- j<<=$PAGEWIDTH; ++- j<<=4; ++- j--; ++- i+=j; ++- i&=~j; ++- fprintf(fp,"0x%lx",i); ++- fclose(fp); ++- return 0; ++-]])],[mem_top=`cat conftest1`],[mem_top="0x0"]) +++AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ ]], +++ [[ +++ void *v; +++ unsigned long i,j,k,l,m; +++ FILE *fp = fopen("conftest1","w"); +++ +++ for (i=2,k=1;i;k=i,i<<=1); +++ l=$cstack_address; +++ l=$cstack_direction==1 ? (l>=1,i|=j); +++ if (j<(k>>3)) i=0; +++ j=1; +++ j<<=$PAGEWIDTH; +++ j<<=4; +++ j--; +++ i+=j; +++ i&=~j; +++ fprintf(fp,"0x%lx",i); +++ fclose(fp); +++ return 0; +++ ]])], +++ [mem_top=`cat conftest1`],[mem_top="0x0"]) ++ AC_MSG_RESULT($mem_top) +++ ++ if test "$mem_top" != "0x0" ; then ++- AC_MSG_CHECKING(finding upper mem half range) ++- AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++- #include ++- ]],[[ ++- unsigned long j; ++- FILE *fp = fopen("conftest1","w"); ++- ++- for (j=1;j && !(j& $mem_top);j<<=1); ++- fprintf(fp,"0x%lx",j>>1); ++- fclose(fp); ++- return 0; ++- ]])],[mem_range=`cat conftest1`],[mem_range="0x0"]) ++- AC_MSG_RESULT($mem_range) ++- if test "$mem_range" != "0x0" ; then +++ AC_MSG_CHECKING(finding upper mem half range) +++ AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ ]], +++ [[ +++ unsigned long j; +++ FILE *fp = fopen("conftest1","w"); +++ +++ for (j=1;j && !(j& $mem_top);j<<=1); +++ fprintf(fp,"0x%lx",j>>1); +++ fclose(fp); +++ return 0; +++ ]])], +++ [mem_range=`cat conftest1`],[mem_range="0x0"]) +++ AC_MSG_RESULT($mem_range) +++ if test "$mem_range" != "0x0" ; then ++ AC_DEFINE_UNQUOTED(MEM_TOP,$mem_top,[beginning address for immediate fixnum range]) ++ AC_DEFINE_UNQUOTED(MEM_RANGE,$mem_range,[size of immediate fixnum address space]) ++- fi +++ fi ++ fi ++ ++-if test "$enable_immfix" = "yes" ; then ++- if test "$mem_top" != "0x0" ; then ++- if test "$mem_range" != "0x0" ; then ++- AC_DEFINE_UNQUOTED(IM_FIX_BASE,$mem_top,[beginning address for immediate fixnum range]) ++- AC_DEFINE_UNQUOTED(IM_FIX_LIM,$mem_range,[size of immediate fixnum address space]) ++- fi ++- fi ++-fi ++- ++- ++-dnl AC_MSG_CHECKING(for word order) ++-dnl AC_TRY_RUN([int main () { ++-dnl /* Are we little or big endian? Adapted from Harbison&Steele. */ ++-dnl union ++-dnl { ++-dnl double d; ++-dnl int l[sizeof(double)/sizeof(int)]; ++-dnl } u; ++-dnl u.d = 1.0; ++-dnl return u.l[sizeof(double)/sizeof(int)-1] ? 0 : 1; ++-dnl }],AC_MSG_RESULT(little) ++-dnl AC_DEFINE(LITTLE_END), ++-dnl AC_MSG_RESULT(big), ++-dnl AC_MSG_RESULT([WARNING: ASSUMING LITTLE ENDIAN FOR CROSS COMPILING !!!] ++-dnl AC_DEFINE(LITTLE_END))) ++-dnl AC_SUBST(LITTLE_END) ++- ++- ++-# On systems with execshield, brk is randomized. We need to catch ++-# this and restore the traditional behavior here ++- ++-dnl old_LDFLAGS="$LDFLAGS" ++-dnl LDFLAGS="$TLDFLAGS" ++-dnl AC_MSG_CHECKING("finding DBEGIN") ++-dnl AC_TRY_RUN([#include ++-dnl #include ++- ++-dnl void gprof_cleanup() {}; ++-dnl int ++-dnl main(int argc,char * argv[],char *envp[]) ++-dnl { ++-dnl char *b,*b1; ++-dnl FILE *fp; ++- ++-dnl #ifdef CAN_UNRANDOMIZE_SBRK ++-dnl #include "h/unrandomize.h" ++-dnl #endif ++-dnl b = (void *) malloc(1000); ++-dnl fp = fopen("conftest1","w"); ++- ++-dnl #ifdef _WIN32 ++-dnl fprintf(fp,"_dbegin"); ++-dnl #else ++-dnl #if defined (__APPLE__) && defined (__MACH__) ++-dnl fprintf(fp,"mach_mapstart"); ++-dnl #else ++-dnl b1=((unsigned long) b) & ~(unsigned long)0xffffff;b=(void *)b1<(void *)&b1 && (void *)b>(void *)&b ? ((unsigned long) b) & ~(unsigned long)((1< ++-dnl main() ++-dnl { ++-dnl char *b ; ++-dnl FILE *fp = fopen("conftest1","w"); ++-dnl fprintf(fp,"%ld",((long) &b)); ++-dnl fclose(fp); ++-dnl return 0; ++-dnl }],cstack_address=`cat conftest1`,cstack_address=0,cstack_address=0) ++-dnl AC_DEFINE_UNQUOTED(CSTACK_ADDRESS,$cstack_address \ ++-dnl ) ++-dnl AC_MSG_RESULT(got $cstack_address) ++- ++- +++if test "$enable_immfix" != "no" ; then +++ if test "$mem_top" != "0x0" ; then +++ if test "$mem_range" != "0x0" ; then +++ AC_DEFINE_UNQUOTED(IM_FIX_BASE,$mem_top,[beginning address for immediate fixnum range]) +++ AC_DEFINE_UNQUOTED(IM_FIX_LIM,$mem_range,[size of immediate fixnum address space]) +++ fi +++ fi +++fi ++ ++ AC_MSG_CHECKING([sizeof long long int]) ++-AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++- #include ++- ]],[[ ++- if (sizeof(long long int) == 2*sizeof(long)) return 0; ++- return 1; ++-]])],[AC_DEFINE(HAVE_LONG_LONG,1,[long long is available]) AC_MSG_RESULT(yes)], +++AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ ]], +++ [[ +++ if (sizeof(long long int) == 2*sizeof(long)) return 0; +++ return 1; +++ ]])], +++ [AC_DEFINE(HAVE_LONG_LONG,1,[long long is available]) AC_MSG_RESULT(yes)], ++ [AC_MSG_RESULT(no)]) ++ ++ AC_SUBST(HAVE_LONG_LONG) ++ ++- ++-AC_CHECK_HEADERS(dirent.h, ++- AC_MSG_CHECKING([for d_type]) ++- AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++- #include ++- ]],[[ ++- struct dirent d; ++- return d.d_type=0; ++- ]])], ++- [AC_MSG_RESULT([yes]) AC_DEFINE(HAVE_D_TYPE,1,[have struct dirent d_type field])], ++- AC_MSG_RESULT([no]),AC_MSG_RESULT([no]))) ++- ++-# readline ++-AC_ARG_ENABLE(readline, ++- [--enable-readline enables command line completion via the readline library ],, ++- enable_readline="yes") +++AC_CHECK_HEADERS([dirent.h], +++ AC_MSG_CHECKING([for d_type]) +++ AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ ]], +++ [[ +++ struct dirent d; +++ return d.d_type=0; +++ ]])], +++ [AC_MSG_RESULT([yes]) AC_DEFINE(HAVE_D_TYPE,1,[have struct dirent d_type field])], +++ AC_MSG_RESULT([no]),AC_MSG_RESULT([no]))) ++ ++ # ansi lisp ++-AC_ARG_ENABLE(ansi,[--enable-ansi builds a large gcl aiming for ansi compliance, ++- --disable-ansi builds the smaller traditional CLtL1 image],,enable_ansi="yes") ++- ++-if test "$enable_ansi" = "yes" ; then ++- SYSTEM=ansi_gcl ++- CLSTANDARD=ANSI ++-else ++- SYSTEM=gcl ++- CLSTANDARD=CLtL1 ++-fi +++SYSTEM=ansi_gcl +++CLSTANDARD=ANSI +++AC_ARG_ENABLE([ansi],[ --enable-ansi builds a large gcl aiming for ansi compliance], +++ [if test "$enable_ansi" = "no" ; then +++ SYSTEM=gcl +++ CLSTANDARD=CLtL1 +++ fi]) ++ ++ FLISP="saved_$SYSTEM" ++ AC_SUBST(FLISP) ++@@ -2192,51 +1574,44 @@ AC_EGREP_HEADER([gettimeofday], ++ [sys/time.h], ++ [AC_MSG_RESULT([present])], ++ [AC_MSG_RESULT([missing]) ++- AC_DEFINE(GETTOD_NOT_DECLARED,1,[No gettimeofday call -- fixme])]) +++ AC_DEFINE(GETTOD_NOT_DECLARED,1,[No gettimeofday call -- fixme])]) ++ ++ ++ AC_CHECK_LIB(m,sin,LIBS="${LIBS} -lm",true) ++ AC_CHECK_LIB(mingwex,main,LIBS="${LIBS} -lmingwex",true) ++ ++ AC_MSG_CHECKING([for buggy maximum sscanf length]) ++-AC_RUN_IFELSE([ ++- AC_LANG_PROGRAM([[ ++- #include ++- ]],[[ ++- char *s= "2.7182818284590452353602874713526624977572470936999595749669676277240766303535475945713821785251664274274663919320030599218174135966290435729003342952605956307381323286279434907632338298807531952510190115738341879307021540891499348841675092447614606680822648001684774118537423454424371075390777449920695517027618386062613313845830007520449338265602976067371132007093287091274437470472306969772093101416928368190255151086574637721112523897844250569536967707854499699679468644549059879316368892300987931277361782154249992295763514822082698951936680331825288693984964651058209392398294887933203625094431173012381970684161404"; ++- int n, m; ++- double f; ++- char *endptr; ++- FILE *fp=fopen("conftest1","w"); ++- ++- n=sscanf(s,"%lf%n",&f,&m); ++- fprintf(fp,"%d",m); ++- fclose(fp); ++- return s[m]; ++- ]])], ++- [AC_MSG_RESULT([none])], ++- [buggy_maximum_sscanf_length=`cat conftest1` ++- AC_MSG_RESULT([$buggy_maximum_sscanf_length]) ++- AC_DEFINE_UNQUOTED(BUGGY_MAXIMUM_SSCANF_LENGTH,$buggy_maximum_sscanf_length,[sscanf terminates prematurely (Windows XP)])]) +++AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ ]], +++ [[ +++ char *s= "2.7182818284590452353602874713526624977572470936999595749669676277240766303535475945713821785251664274274663919320030599218174135966290435729003342952605956307381323286279434907632338298807531952510190115738341879307021540891499348841675092447614606680822648001684774118537423454424371075390777449920695517027618386062613313845830007520449338265602976067371132007093287091274437470472306969772093101416928368190255151086574637721112523897844250569536967707854499699679468644549059879316368892300987931277361782154249992295763514822082698951936680331825288693984964651058209392398294887933203625094431173012381970684161404"; +++ int n, m; +++ double f; +++ char *endptr; +++ FILE *fp=fopen("conftest1","w"); +++ +++ n=sscanf(s,"%lf%n",&f,&m); +++ fprintf(fp,"%d",m); +++ fclose(fp); +++ return s[m]; +++ ]])], +++ [AC_MSG_RESULT([none])], +++ [buggy_maximum_sscanf_length=`cat conftest1` +++ AC_MSG_RESULT([$buggy_maximum_sscanf_length]) +++ AC_DEFINE_UNQUOTED(BUGGY_MAXIMUM_SSCANF_LENGTH,$buggy_maximum_sscanf_length,[sscanf terminates prematurely (Windows XP)])]) ++ ++ ++ EXTRA_LOBJS= ++-if test "$try_japi" = "yes" ; then ++- AC_CHECK_HEADERS(japi.h,[AC_DEFINE(HAVE_JAPI_H) ++- EXTRA_LOBJS="${EXTRA_LOBJS} gcl_japi.o" ++- LIBS="${LIBS} -ljapi -lwsock32"] ) ++-fi ++-dnl if test "$use" = "mingw" ; then ++-dnl if test "$try_xdr" = "yes" ; then ++-dnl AC_CHECK_HEADERS(rpc/rpc.h,[AC_DEFINE(HAVE_XDR) ++-dnl LIBS="${LIBS} -loncrpc"] ) ++-dnl fi ++-dnl else ++-dnl if test "$try_xdr" = "yes" ; then ++-dnl AC_CHECK_HEADERS(rpc/rpc.h,[AC_DEFINE(HAVE_XDR) ++-dnl LIBS="${LIBS} -lrpc"] ) ++-dnl fi ++-dnl fi +++AC_ARG_ENABLE([japi],[ --enable-japi=yes will compile in support for the JAPI graphical interface if present on your system], +++ [if test "$enable_japi" = "yes" ; then +++ AC_CHECK_HEADERS([japi.h], +++ [AC_DEFINE(HAVE_JAPI_H) +++ EXTRA_LOBJS="${EXTRA_LOBJS} gcl_japi.o" +++ LIBS="${LIBS} -ljapi -lwsock32"]) +++ fi]) ++ ++ # Should really find a way to check for prototypes, but this ++ # basically works for now. CM ++@@ -2260,76 +1635,53 @@ AC_CHECK_HEADERS(float.h,AC_DEFINE(HAVE_ ++ # test makes sense. CM ++ # ++ AC_MSG_CHECKING([for isnormal]) ++-AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++- #define _GNU_SOURCE ++- #include ++- ]],[[ ++- float f; ++- return isnormal(f) || !isnormal(f) ? 0 : 1; +++AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #define _GNU_SOURCE +++ #include +++ ]], +++ [[ +++ float f; +++ return isnormal(f) || !isnormal(f) ? 0 : 1; ++ ]])], ++- [AC_DEFINE(HAVE_ISNORMAL,1,[Have isnormal function]) AC_MSG_RESULT(yes)], ++- [AC_MSG_CHECKING([for fpclass in ieeefp.h]) ++- AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++- #include ++- ]],[[ ++- float f; ++- return fpclass(f)>=FP_NZERO || fpclass(f) +++ ]], +++ [[ +++ float f; +++ return fpclass(f)>=FP_NZERO || fpclass(f) ++- ]],[[ ++- float f; ++- return isfinite(f) || !isfinite(f) ? 0 : 1; ++- ]])],[AC_DEFINE(HAVE_ISFINITE,1,[Have isfinite function]) AC_MSG_RESULT(yes)], ++- [AC_MSG_CHECKING([for finite()]) ++- AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +++AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #define _GNU_SOURCE ++ #include ++- #include ++- ]],[[ +++ ]], +++ [[ ++ float f; ++- return finite(f) || !finite(f) ? 0 : 1; ++- ]])],[AC_DEFINE(HAVE_FINITE,1,[Have finite function]) AC_MSG_RESULT(yes)], ++- [AC_MSG_ERROR(no)])]) ++- ++-dnl AC_MSG_CHECKING([for INFINITY]) ++-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++-dnl #define _GNU_SOURCE ++-dnl #include ++-dnl ]],[[ ++-dnl double d=INFINITY; ++-dnl return 0; ++-dnl ]])],[AC_MSG_RESULT(yes)], ++-dnl [AC_MSG_CHECKING([for builtin_inf()]) ++-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++-dnl #include ++-dnl #include ++-dnl ]],[[ ++-dnl double d=__builtin_inf(); ++-dnl return 0; ++-dnl ]])],[AC_DEFINE_UNQUOTED(INFINITY,__builtin_inf(),[Have builtin_inf]) AC_MSG_RESULT(yes)], ++-dnl [AC_MSG_ERROR(no)])]) ++- ++-dnl AC_MSG_CHECKING([for NAN]) ++-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++-dnl #define _GNU_SOURCE ++-dnl #include ++-dnl ]],[[ ++-dnl double d=NAN; ++-dnl return 0; ++-dnl ]])],[AC_MSG_RESULT(yes)], ++-dnl [AC_MSG_CHECKING([for builtin_nan()]) ++-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++-dnl #include ++-dnl #include ++-dnl ]],[[ ++-dnl double d=__builtin_nan("0x0"); ++-dnl return 0; ++-dnl ]])],[AC_DEFINE_UNQUOTED(NAN,__builtin_nan("0x0"),[Have builtin_nan]) AC_MSG_RESULT(yes)], ++-dnl [AC_MSG_ERROR(no)])]) +++ return isfinite(f) || !isfinite(f) ? 0 : 1; +++ ]])],[AC_DEFINE(HAVE_ISFINITE,1,[Have isfinite function]) AC_MSG_RESULT(yes)], +++ [AC_MSG_CHECKING([for finite()]) +++ AC_RUN_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ #include +++ ]], +++ [[ +++ float f; +++ return finite(f) || !finite(f) ? 0 : 1; +++ ]])], +++ [AC_DEFINE(HAVE_FINITE,1,[Have finite function]) AC_MSG_RESULT(yes)], +++ [AC_MSG_ERROR(no)])]) ++ ++ #-------------------------------------------------------------------- ++ # Check for the existence of the -lsocket and -lnsl libraries. ++@@ -2363,69 +1715,78 @@ if test "$tcl_checkBoth" = 1; then ++ fi ++ AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [TLIBS="$TLIBS -lnsl"])) ++ ++-RL_OBJS="" ++-RL_LIB="" ++-if test "$enable_readline" = "yes" ; then ++- AC_CHECK_HEADERS(readline/readline.h, ++- AC_CHECK_LIB(readline,rl_initialize, ++- AC_DEFINE(HAVE_READLINE,1,[have readline library]) ++- TLIBS="$TLIBS -lreadline" #some machines don't link this, e.g. Slackware ++- RL_OBJS=gcl_readline.o ++-# Readline support now initialized automatically when compiled in, this lisp ++-# object no longer needed -- 20040102 CM ++-# RL_LIB=lsp/gcl_readline.o ++- )) ++- ++-# These tests discover differences between readline 4.1 and 4.3 ++- AC_CHECK_LIB(readline,rl_completion_matches, ++- AC_DEFINE(HAVE_DECL_RL_COMPLETION_MATCHES,1,[have readline completion matches]) ++- AC_DEFINE(HAVE_RL_COMPENTRY_FUNC_T,1,[have readline completion matches]),,) +++# readline +++AC_ARG_ENABLE(readline,[ --enable-readline enables command line completion via the readline library ]) +++ +++if test "$use" = "mingw" ; then +++ enable_readline=no +++fi +++ +++if test "$enable_readline" != "no" ; then +++ AC_CHECK_HEADERS([readline/readline.h], +++ AC_CHECK_LIB([readline],[rl_initialize], +++ [AC_DEFINE(HAVE_READLINE,1,[have readline library]) +++ TLIBS="$TLIBS -lreadline" #some machines don't link this, e.g. Slackware +++ RL_OBJS=gcl_readline.o])) +++ +++ # These tests discover differences between readline 4.1 and 4.3 +++ AC_CHECK_LIB([readline],[rl_completion_matches], +++ [AC_DEFINE(HAVE_DECL_RL_COMPLETION_MATCHES,1,[have readline completion matches]) +++ AC_DEFINE(HAVE_RL_COMPENTRY_FUNC_T,1,[have readline completion matches])]) ++ fi ++ ++ AC_SUBST(RL_OBJS) ++ AC_SUBST(RL_LIB) ++ ++-AC_MSG_CHECKING(For network code for nsocket.c) ++-AC_TRY_LINK([ ++-#include ++-#include ++-#include ++- ++-#include ++-#include ++-#include ++- ++-/************* for the sockets ******************/ ++-#include /* struct sockaddr, SOCK_STREAM, ... */ ++-#ifndef NO_UNAME ++-# include /* uname system call. */ ++-#endif ++-#include /* struct in_addr, struct sockaddr_in */ ++-#include /* inet_ntoa() */ ++-#include /* gethostbyname() */ ++-],[ connect(0,(struct sockaddr *)0,0); ++- gethostbyname("jil"); ++- socket(AF_INET, SOCK_STREAM, 0); ++- ], ++-[AC_DEFINE(HAVE_NSOCKET,1,[can use nsocket library]) ++- AC_MSG_RESULT(yes)], ++-AC_MSG_RESULT(no)) ++- ++- ++-AC_MSG_CHECKING(check for listen using fcntl) ++-AC_TRY_COMPILE([#include ++-#include ++-], ++-[FILE *fp=fopen("configure.in","r"); ++- int orig; ++- orig = fcntl(fileno(fp), F_GETFL); ++- if (! (orig & O_NONBLOCK )) return 0; ++-], ++-[AC_DEFINE(LISTEN_USE_FCNTL,1,[can use fcntl for listen function]) ++- AC_MSG_RESULT(yes)], ++-AC_MSG_RESULT(no)) ++- +++# sockets ++ +++AC_MSG_CHECKING([For network code for nsocket.c]) +++AC_LINK_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ #include +++ #include +++ +++ #include +++ #include +++ #include +++ +++ /************* for the sockets ******************/ +++ #include /* struct sockaddr, SOCK_STREAM, ... */ +++ #ifndef NO_UNAME +++ # include /* uname system call. */ +++ #endif +++ #include /* struct in_addr, struct sockaddr_in */ +++ #include /* inet_ntoa() */ +++ #include /* gethostbyname() */ +++ ]], +++ [[ +++ connect(0,(struct sockaddr *)0,0); +++ gethostbyname("jil"); +++ socket(AF_INET, SOCK_STREAM, 0); +++ ]])], +++ [AC_DEFINE(HAVE_NSOCKET,1,[can use nsocket library]) +++ AC_MSG_RESULT([yes])], +++ [AC_MSG_RESULT([no])]) +++ +++ +++AC_MSG_CHECKING([check for listen using fcntl]) +++AC_COMPILE_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ #include +++ ]], +++ [[ +++ FILE *fp=fopen("configure.in","r"); +++ int orig; +++ orig = fcntl(fileno(fp), F_GETFL); +++ if (! (orig & O_NONBLOCK )) return 0; +++ ]])], +++ [AC_DEFINE(LISTEN_USE_FCNTL,1,[can use fcntl for listen function]) +++ AC_MSG_RESULT([yes])], +++ [AC_MSG_RESULT([no])]) ++ ++ ++ AC_CHECK_FUNC(profil, ,[AC_DEFINE(NO_PROFILE,1,[no profil system call])]) ++@@ -2433,29 +1794,18 @@ AC_SUBST(NO_PROFILE) ++ AC_CHECK_FUNC(setenv,[AC_DEFINE(HAVE_SETENV,1,[have setenv call])],no_setenv=1 ) ++ AC_SUBST(HAVE_SETENV) ++ if test "$no_setenv" = "1" ; then ++-AC_CHECK_FUNC(putenv,[AC_DEFINE(HAVE_PUTENV,1,[have putenv call])],) ++-AC_SUBST(HAVE_PUTENV) +++ AC_CHECK_FUNC(putenv,[AC_DEFINE(HAVE_PUTENV,1,[have putenv call])],) +++ AC_SUBST(HAVE_PUTENV) ++ fi ++ ++ AC_CHECK_FUNC(_cleanup, [AC_DEFINE(USE_CLEANUP,1,[have _cleanup function])],) ++ AC_SUBST(USE_CLEANUP) ++ gcl_ok=no ++ ++-dnl AC_HEADER_EGREP(LITTLE_ENDIAN, ctype.h, gcl_ok=yes, gcl_ok=noo) ++-dnl if test $gcl_ok = yes ; then ++-dnl AC_DEFINE(ENDIAN_ALREADY_DEFINED) ++-dnl fi ++- ++-dnl AC_SUBST(ENDIAN_ALREADY_DEFINED) ++- ++- ++- ++- ++-# if test "x$enable_machine" = "x" ; then ++ AC_MSG_CHECKING([FIONBIO vs. O_NONBLOCK for nonblocking I/O]) ++ ++ case $system in ++- OSF*) +++ OSF*) ++ AC_DEFINE(USE_FIONBIO,1,[use fionbio for non-blocking io]) ++ AC_MSG_RESULT(FIONBIO) ++ ;; ++@@ -2474,103 +1824,85 @@ esac ++ ++ ++ AC_MSG_CHECKING(check for SV_ONSTACK) ++-AC_TRY_COMPILE([#include ++-int joe=SV_ONSTACK; ++-], ++-[], ++-[AC_DEFINE(HAVE_SV_ONSTACK,1,[have sv_onstack]) ++- AC_SUBST(HAVE_SV_ONSTACK) ++- AC_MSG_RESULT(yes)], ++-AC_MSG_RESULT(no)) +++AC_COMPILE_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ int joe=SV_ONSTACK; +++ ]], +++ [[]])], +++ [AC_DEFINE(HAVE_SV_ONSTACK,1,[have sv_onstack]) +++ AC_SUBST(HAVE_SV_ONSTACK) +++ AC_MSG_RESULT([yes])], +++ [AC_MSG_RESULT([no])]) ++ ++ AC_MSG_CHECKING(check for SIGSYS) ++-AC_TRY_COMPILE([#include ++-int joe=SIGSYS; ++-], ++-[], ++-[AC_DEFINE(HAVE_SIGSYS,1,[have SIGSYS signal]) ++- AC_SUBST(HAVE_SIGSYS) ++- AC_MSG_RESULT(yes)], ++-AC_MSG_RESULT(no)) +++AC_COMPILE_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ int joe=SIGSYS; +++ ]],[[]])], +++ [AC_DEFINE(HAVE_SIGSYS,1,[have SIGSYS signal]) +++ AC_SUBST(HAVE_SIGSYS) +++ AC_MSG_RESULT([yes])], +++ [AC_MSG_RESULT([no])]) ++ ++ ++ AC_MSG_CHECKING(check for SIGEMT) ++-AC_TRY_COMPILE([#include ++-int joe=SIGEMT; ++-], ++-[], ++-[AC_DEFINE(HAVE_SIGEMT,1,[have SIGEMT signal]) ++- AC_SUBST(HAVE_SIGEMT) ++- AC_MSG_RESULT(yes)], ++-AC_MSG_RESULT(no)) +++AC_COMPILE_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ int joe=SIGEMT; +++ ]],[[]])], +++ [AC_DEFINE(HAVE_SIGEMT,1,[have SIGEMT signal]) +++ AC_SUBST(HAVE_SIGEMT) +++ AC_MSG_RESULT([yes])], +++ [AC_MSG_RESULT([no])]) ++ ++ AC_CHECK_FUNCS(sigaltstack) ++ AC_CHECK_FUNCS(feenableexcept) ++ ++ AC_CHECK_HEADERS(dis-asm.h, ++- MLIBS=$LIBS ++- AC_CHECK_LIB(opcodes,init_disassemble_info) ++- AC_CHECK_LIB(dl,dlopen,#opcodes changes too quickly to link directly ++- AC_CHECK_FUNCS(print_insn_i386,LIBS="$MLIBS -ldl"))) +++ MLIBS=$LIBS +++ AC_CHECK_LIB(opcodes,init_disassemble_info) +++ AC_CHECK_LIB(dl,dlopen,#opcodes changes too quickly to link directly +++ AC_CHECK_FUNCS(print_insn_i386,LIBS="$MLIBS -ldl"))) ++ ++ #if test $use = "386-linux" ; then ++- AC_CHECK_HEADERS(asm/sigcontext.h) ++- AC_CHECK_HEADERS(asm/signal.h) ++- AC_MSG_CHECKING([for sigcontext...]) ++- AC_TRY_COMPILE([#include ++- ], ++- [ ++- struct sigcontext foo; ++- ], ++- [ ++- sigcontext_works=1; ++- AC_DEFINE(SIGNAL_H_HAS_SIGCONTEXT,1,[have sigcontext in signal.h]) ++- AC_MSG_RESULT(sigcontext in signal.h) ++- ], ++- ++- [sigcontext_works=0; ++- AC_MSG_RESULT(sigcontext NOT in signal.h)] ++- ) ++- if test "$sigcontext_works" = 0 ; then ++- AC_MSG_CHECKING([for sigcontext...]) ++- AC_TRY_COMPILE([#include ++- #ifdef HAVE_ASM_SIGCONTEXT_H ++- #include ++- #endif ++- #ifdef HAVE_ASM_SIGNAL_H ++- #include ++- #endif ++- ], ++- [ ++- struct sigcontext foo; ++- ], ++- [ ++- AC_DEFINE(HAVE_SIGCONTEXT,1,[have sigcontext]) ++- AC_MSG_RESULT(sigcontext in asm files) ++- ], ++- [ ++- AC_MSG_RESULT(no sigcontext found) ++- ]) ++- ++- ++- fi ++-# echo 'foo() {}' > conftest1.c ++-# $CC -S conftest1.c ++-# use_underscore=0 ++-# if fgrep _foo conftest1.s ; then use_underscore=1 ; fi ++-# if test $use_underscore = 0 ; then ++-# MPI_FILE=mpi-386_no_under.o ++-# else ++-# MPI_FILE=mpi-386d.o ++-# fi ++-# AC_SUBST(MPI_FILE) ++-# GCC=$CC ++-# if test -x /usr/bin/i386-glibc20-linux-gcc ; then ++-# GCC=/usr/bin/i386-glibc20-linux-gcc ++-# fi ++-# AC_SUBST(GCC) ++- ++-#fi +++AC_CHECK_HEADERS(asm/sigcontext.h) +++AC_CHECK_HEADERS(asm/signal.h) +++AC_MSG_CHECKING([for sigcontext...]) +++AC_COMPILE_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ ]], +++ [[ +++ struct sigcontext foo; +++ ]])], +++ [AC_DEFINE(SIGNAL_H_HAS_SIGCONTEXT,1,[have sigcontext of signal.h]) +++ AC_MSG_RESULT([sigcontext of signal.h])], +++ [AC_MSG_RESULT([sigcontext NOT of signal.h]) +++ AC_MSG_CHECKING([for sigcontext...]) +++ AC_COMPILE_IFELSE( +++ [AC_LANG_PROGRAM( +++ [[ +++ #include +++ #ifdef HAVE_ASM_SIGCONTEXT_H +++ #include +++ #endif +++ #ifdef HAVE_ASM_SIGNAL_H +++ #include +++ #endif +++ ]], +++ [[ +++ struct sigcontext foo; +++ ]])], +++ [AC_DEFINE(HAVE_SIGCONTEXT,1,[have sigcontext]) +++ AC_MSG_RESULT(sigcontext asm files)], +++ [AC_MSG_RESULT([no sigcontext found])])]) ++ ++ AC_PATH_PROG(EMACS,emacs) ++ ++@@ -2590,11 +1922,11 @@ EOF ++ ++ AC_MSG_CHECKING([emacs site lisp directory]) ++ if [[ "$EMACS_SITE_LISP" = "unknown" ]] ; then ++- if [[ "$EMACS" != "" ]] ; then ++- EMACS_SITE_LISP=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` ++- else ++- EMACS_SITE_LISP="" ++- fi +++ if [[ "$EMACS" != "" ]] ; then +++ EMACS_SITE_LISP=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` +++ else +++ EMACS_SITE_LISP="" +++ fi ++ fi ++ AC_MSG_RESULT($EMACS_SITE_LISP) ++ AC_SUBST(EMACS_SITE_LISP) ++@@ -2613,14 +1945,14 @@ EOF ++ ++ AC_MSG_CHECKING([emacs default.el]) ++ if [[ "$EMACS" != "" ]] ; then ++- EMACS_DEFAULT_EL=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` +++ EMACS_DEFAULT_EL=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` ++ else ++- EMACS_DEFAULT_EL="" +++ EMACS_DEFAULT_EL="" ++ fi ++ if test -f "${EMACS_DEFAULT_EL}" ; then true;else ++- if test -d $EMACS_SITE_LISP ; then ++- EMACS_DEFAULT_EL=${EMACS_SITE_LISP}/default.el ++- fi +++ if test -d $EMACS_SITE_LISP ; then +++ EMACS_DEFAULT_EL=${EMACS_SITE_LISP}/default.el +++ fi ++ fi ++ AC_MSG_RESULT($EMACS_DEFAULT_EL) ++ AC_SUBST(EMACS_DEFAULT_EL) ++@@ -2651,93 +1983,98 @@ fi ++ AC_MSG_RESULT($INFO_DIR) ++ AC_SUBST(INFO_DIR) ++ ++-if test "$enable_tcltk" = "yes" ; then +++AC_ARG_ENABLE([tcltk],[ --enable-tcltk will try to build gcl-tk]) +++AC_ARG_ENABLE([tkconfig], +++ [ --enable-tkconfig=XXXX will force the use of a TK_CONFIG_PREFIX=XXXXX as place to look for tkConfig.sh and tclConfig.sh], +++ [TK_CONFIG_PREFIX=$enableval],[TK_CONFIG_PREFIX=unknown]) +++AC_ARG_ENABLE([tclconfig], +++ [ --enable-tclconfig=XXXX will force the use of a TCL_CONFIG_PREFIX=XXXXX as place to look for tclConfig.sh and tclConfig.sh], +++ [TCL_CONFIG_PREFIX=$enableval],[TCL_CONFIG_PREFIX=unknown]) ++ ++- AC_MSG_CHECKING([for tcl/tk]) +++if test "$enable_tcltk" != "no" ; then ++ ++- if test -d "${TCL_CONFIG_PREFIX}" ; then true ; else +++ AC_MSG_CHECKING([for tcl/tk]) ++ ++- AC_CHECK_PROG(TCLSH,tclsh,tclsh,${TCLSH}) ++- ++- if test "${TCLSH}" = "" ; then true ; else ++- ++- rm -f conftest.tcl ++- cat >> conftest.tcl <> conftest.tcl <&1 $CC -v | fgrep "gcc version 2.96" > /dev/null ++-dnl then ++-dnl BROKEN_O4_OPT=1 ++-dnl AC_DEFINE(BROKEN_O4_OPT) ++-dnl AC_SUBST(BROKEN_O4_OPT) ++-dnl echo ODIR_DEBUG=-O >> makedefsafter ++-dnl echo >> makedefsafter ++-dnl AC_MSG_RESULT([yes .. turning off -O4]) ++-dnl else ++-dnl AC_MSG_RESULT([no]) ++-dnl fi ++- ++-LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'`" +++LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'` $TLDFLAGS" ++ AC_SUBST(LDFLAGS) ++-LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $TLDFLAGS $LIBS $TLIBS" +++LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $LIBS $TLIBS" ++ AC_SUBST(LIBS) ++-FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS $TCFLAGS $PROCESSOR_FLAGS" +++FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS $TCFLAGS" ++ AC_SUBST(FINAL_CFLAGS) ++ # Work around bug with gcc on ppc -- CM ++-NIFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TONIFLAGS $PROCESSOR_FLAGS -I\$(GCLDIR)/o" +++NIFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TONIFLAGS -I\$(GCLDIR)/o" ++ AC_SUBST(NIFLAGS) ++-CFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TO3FLAGS $PROCESSOR_FLAGS -I\$(GCLDIR)/o" +++CFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TO3FLAGS -I\$(GCLDIR)/o" ++ AC_SUBST(CFLAGS) ++ O3FLAGS=$TO3FLAGS ++ AC_SUBST(O3FLAGS) ++ O2FLAGS=$TO2FLAGS ++ AC_SUBST(O2FLAGS) ++ ++-AC_SUBST(PRELINK_CHECK) ++- ++ AC_SUBST(EXTRA_LOBJS) ++ AC_SUBST(LEADING_UNDERSCORE) ++ AC_SUBST(GNU_LD) ++ if test -f h/$use.defs ; then ++- ++- AC_SUBST(use) ++- AC_OUTPUT(makedefc windows/gcl.iss windows/sysdir.bat windows/install.lsp ) ++- echo makedefc ++- cat makedefc ++- ++- echo add-defs1 $use ++- CC=$CC ./add-defs1 $use ++- +++ +++ AC_SUBST(use) +++ AC_OUTPUT(makedefc windows/gcl.iss windows/sysdir.bat windows/install.lsp ) +++ echo makedefc +++ cat makedefc +++ +++ echo add-defs1 $use +++ CC=$CC ./add-defs1 $use +++ ++ else ++- echo "Unable to guess machine type" ++- echo use configure --enable-machine=XXX, for XXX such that h/XXX.defs exists, ie in h/*.defs +++ echo "Unable to guess machine type" +++ echo use configure --enable-machine=XXX, for XXX such that h/XXX.defs exists, ie in h/*.defs ++ fi ++--- gcl-2.6.12.orig/gcl-tk/sheader.h +++++ gcl-2.6.12/gcl-tk/sheader.h ++@@ -45,7 +45,7 @@ struct message_header { ++ ++ ++ #define BYTE_S 8 ++-#define BYTE_MASK (~(~0 << BYTE_S)) +++#define BYTE_MASK (~(~0UL << BYTE_S)) ++ ++ #define GET_3BYTES(p,ans) do{ unsigned char* __p = (unsigned char *) p; \ ++ ans = BYTE_MASK&(*__p++); \ ++--- gcl-2.6.12.orig/h/compprotos.h +++++ gcl-2.6.12/h/compprotos.h ++@@ -170,6 +170,7 @@ int gcl_putc(int,void *); ++ #ifdef CMPINCLUDE ++ int setjmp(); ++ int _setjmp(); +++int _setjmp3(); ++ #endif ++ void vfun_wrong_number_of_args(object); ++ void ihs_overflow (void); ++@@ -179,4 +180,3 @@ char *gcl_gets(char *,int); ++ int gcl_puts(const char *); ++ int endp_error(object); ++ object Icall_gen_error_handler(object,object,object,object,ufixnum,...); ++- ++--- gcl-2.6.12.orig/h/funlink.h +++++ gcl-2.6.12/h/funlink.h ++@@ -54,7 +54,7 @@ enum F_arg_types ++ }; ++ ++ /* Make a mask for bits i < j, masking j-i bits */ ++-#define MASK_RANGE(i,j) ((~(~0 << (j-i)))<< i) +++#define MASK_RANGE(i,j) ((~(~0UL << (j-i)))<< i) ++ ++ #define F_PLAIN(x) (((x) & MASK_RANGE( F_START_TYPES_POS,31)) == 0) ++ #define ARG_LIMIT 63 ++--- gcl-2.6.12.orig/h/mingw.defs +++++ gcl-2.6.12/h/mingw.defs ++@@ -54,7 +54,7 @@ TCL_LIB_SPEC= ++ TCL_DL_LIBS= ++ TCL_LIBS= ++ ++-PWD_CMD=pwd -W +++#PWD_CMD=pwd -W ++ ++ # ++ # End h/mingw.defs ++--- gcl-2.6.12.orig/h/mingw.h +++++ gcl-2.6.12/h/mingw.h ++@@ -26,21 +26,6 @@ ++ #define f_nsyms NumberOfSymbols ++ #define NO_PWD_H ++ ++-#define MAXPATHLEN 512 ++- ++-/* alter pathToAlter to fit in with the Clibrary of the system. ++- and report error using name 'x' if you cant do it. ++- The result in pathToAlter should be less ++-*/ ++-#define FIX_FILENAME(x,pathToAlter) fix_filename(x,pathToAlter) ++- ++-#define MEMORY_SAVE(self,filename) \ ++- do { char buf[MAXPATHLEN]; \ ++- strcpy(buf,self); \ ++- fix_filename(Cnil,buf); \ ++- memory_save(buf,filename); \ ++- } while (0) ++- ++ #define signals_pending *signalsPendingPtr ++ ++ #undef DBEGIN_TY ++--- gcl-2.6.12.orig/h/object.h +++++ gcl-2.6.12/h/object.h ++@@ -371,6 +371,9 @@ emsg(const char *s,...) { ++ va_list args; ++ ufixnum n=0; ++ void *v=NULL; +++#ifndef vsnprintf +++ extern int vsnprintf(); +++#endif ++ va_start(args,s); ++ n=vsnprintf(v,n,s,args)+1; ++ va_end(args); ++--- gcl-2.6.12.orig/h/protoize.h +++++ gcl-2.6.12/h/protoize.h ++@@ -1777,6 +1777,7 @@ void gcl_init_shared_memory ( void ); ++ void fix_filename ( object pathname, char *filename1 ); ++ void alarm ( int n ); ++ void *sbrk ( ptrdiff_t increment ); +++#define sigset_t int ++ void sigemptyset( sigset_t *set); ++ void sigaddset ( sigset_t *set, int n); ++ int sigismember ( sigset_t *set, int n ); ++@@ -1798,19 +1799,12 @@ msystem(const char *); ++ void ++ assert_error(const char *,unsigned,const char *,const char *); ++ ++-#ifdef _WIN32 ++-void ++-detect_wine(void); ++- +++#ifdef __MINGW32__ ++ void ++ init_shared_memory(void); ++ ++-void * ++-alloca(size_t); ++- ++ object ++ find_init_string(const char *); ++- ++ #endif ++ ++ void * ++@@ -1964,3 +1958,6 @@ gcl_cleanup(int); ++ ++ void ++ do_gcl_abort(void); +++ +++int +++vsystem(const char *); ++--- gcl-2.6.12.orig/h/wincoff.h +++++ gcl-2.6.12/h/wincoff.h ++@@ -10,6 +10,7 @@ ++ in this */ ++ #undef va_start ++ +++#include "winsock2.h" ++ #include "windows.h" ++ #ifdef __MINGW32__ ++ #include "minglacks.h" ++--- gcl-2.6.12.orig/lsp/gcl_auto_new.lsp +++++ gcl-2.6.12/lsp/gcl_auto_new.lsp ++@@ -206,14 +206,8 @@ ++ ;; So to stop users from invoking this ++ #+sun ++ (defun user-homedir-pathname () ++- (let* ((tem (si::getenv "HOME")) ++- (l (- (length tem) 1))) ++- (cond ((null tem) nil) ++- (t ++- (or (and (>= l 0) ++- (eql (aref tem l) #\/)) ++- (setq tem (concatenate 'string tem "/"))) ++- (pathname tem))))) ++- +++ (let* ((tem (si::getenv "HOME"))) +++ (when tem +++ (pathname (coerce-slash-terminated tem))))) ++ ++ (AUTOLOAD 'init-readline '|gcl_readline|) ++--- gcl-2.6.12.orig/lsp/gcl_directory.lsp +++++ gcl-2.6.12/lsp/gcl_directory.lsp ++@@ -34,9 +34,9 @@ ++ (defun make-frame (s &aux (l (length s))) ++ (replace (make-array l :element-type 'character :adjustable t :fill-pointer l) s)) ++ ++-(defun expand-wild-directory (l f zz &optional (yy (make-frame zz))) +++(defun expand-wild-directory (d l f zz &optional (yy (make-frame zz))) ++ (let* ((x (member-if 'wild-dir-element-p l)) ++- (s (namestring (make-pathname :directory (ldiff l x)))) +++ (s (namestring (make-pathname :device d :directory (ldiff l x)))) ++ (z (vector-push-string zz s)) ++ (l (length yy)) ++ (y (link-expand (vector-push-string yy s) l)) ++@@ -45,19 +45,15 @@ ++ (cond ((eq (car x) :wild-inferiors) (recurse-dir z y f)) ++ (x (walk-dir z y (lambda (q e l) ++ (declare (ignore l)) ++- (expand-wild-directory (cons :relative (cdr x)) f q e)) :directory));FIXME +++ (expand-wild-directory d (cons :relative (cdr x)) f q e)) :directory));FIXME ++ ((funcall f z y)))))) ++ ++-(defun chdir (s) ++- (when (chdir1 (namestring (pathname s)));to expand ~/ ++- (setq *current-directory* (current-directory-pathname)))) ++- ++ (defun directory (p &key &aux (p (translate-logical-pathname p))(d (pathname-directory p)) ++ (c (unless (eq (car d) :absolute) (make-frame (namestring *current-directory*)))) ++ (lc (when c (length c))) ++ (filesp (or (pathname-name p) (pathname-type p))) ++ (v (compile-regexp (to-regexp p)))(*up-key* :back) r) ++- (expand-wild-directory d +++ (expand-wild-directory (pathname-device p) d ++ (lambda (dir exp &aux (pexp (pathname (if c (vector-push-string c exp 0 lc) exp)))) ++ (if filesp ++ (walk-dir dir exp ++@@ -67,5 +63,15 @@ ++ (push (merge-pathnames (parse-namestring dir nil *default-pathname-defaults* :start pos) pexp nil) r))) ++ :file) ++ (when (pathname-match-p dir v) (push pexp r)))) ++- (make-frame (if c "./" ""))) +++ (make-frame "")) ++ r) +++ +++(defun chdir (s) +++ (when (chdir1 (namestring (pathname s)));to expand ~/ +++ (setq *current-directory* (current-directory-pathname)))) +++ +++(defun which (s) +++ (let ((r (with-open-file (s (apply 'string-concatenate "|" #-winnt "which " +++ #+winnt "for %i in (" s #+winnt ".exe) do @echo.%~$PATH:i" nil)) +++ (read-line s nil 'eof)))) +++ (if (eq r 'eof) s (string-downcase r)))) ++--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp +++++ gcl-2.6.12/lsp/gcl_iolib.lsp ++@@ -451,7 +451,7 @@ ++ (let* ((*load-pathname* pp)(*load-truename* epp)) ++ (with-open-file ++ (s epp :external-format external-format) ++- (if (member (peek-char nil s nil 'eof) '#.(mapcar 'code-char (list 127 #xfe #xff #x4c))) +++ (if (member (peek-char nil s nil 'eof) '#.(mapcar 'code-char (list 127 #xcf #xce #x4c))) ++ (load-fasl s print) ++ (let ((*standard-input* s)) (load-stream s print))))) ++ (when if-does-not-exist ++--- gcl-2.6.12.orig/lsp/gcl_make_pathname.lsp +++++ gcl-2.6.12/lsp/gcl_make_pathname.lsp ++@@ -4,29 +4,58 @@ ++ ;; (declare (optimize (safety 1))) ++ ;; (when (typep x 'pathname) t)) ++ +++ +++(eval-when (compile eval) +++ (defun add-dir-sep (s &optional (i 0) (bp 0) (l (length s))) +++ (when (< i l) +++ (let ((x (aref s i))) +++ (append +++ (if (eql x #\/) +++ (if (zerop bp) (list #\[ x #\\ #\]) (list x #\\)) +++ (list x)) +++ (add-dir-sep s (1+ i) (case x (#\[ (1+ bp))(#\] (1- bp))(otherwise bp)) l))))) +++ +++ (defun ads (s) #+winnt (coerce (add-dir-sep s) 'string) #-winnt s)) +++ +++(defconstant +dirsep+ (compile-regexp #.(ads "/"))) +++ +++(defconstant +glob-to-regexp-alist+ (list (cons #v"{[^}]*}" (lambda (x) (msub '((#\| . #\,)(#\( . #\{)(#\) . #\})) x))) +++ (cons #v"\\[[^\\]*\\]" +++ (lambda (x) +++ (string-concatenate "(" (substitute #\^ #\! (subseq x 0 2)) (subseq x 2) ")"))) +++ (cons #v"\\*" (lambda (x) #.(ads "([^/.]*)"))) +++ (cons #v"\\?" (lambda (x) #.(ads "([^/.])"))) +++ (cons #v"\\." (lambda (x) "\\.")))) +++ +++(defconstant +physical-pathname-defaults+ '(("" "" "") +++ #+winnt("" "([A-Za-z]:)?" ":") #-winnt("" "()" "") +++ ("" #.(ads "(/?([^/]+/)*)") "" "" #.(ads "([^/]+/)") "/") +++ ("" #.(ads "([^/.]*)") "") +++ ("." #.(ads "(\\.[^/]*)?") "") +++ ("" "" ""))) +++ +++(defconstant +logical-pathname-defaults+ '(("" "([-0-9A-Z]+:)?" ":") +++ ("" "" "") +++ ("" "(;?((\\*?([-0-9A-Z]+\\*?)+|\\*|\\*\\*);)*)" "" "" "((\\*?([-0-9A-Z]+\\*?)+|\\*);)" ";") +++ ("" "(\\*?([-0-9A-Z]+\\*?)+|\\*)?" "") +++ ("." "(\\.(\\*?([-0-9A-Z]+\\*?)+|\\*))?" "") +++ ("." "(\\.([1-9][0-9]*|newest|NEWEST|\\*))?" ""))) +++ ++ (defun msub (a x) (if a (msub (cdr a) (substitute (caar a) (cdar a) x)) x)) ++ ++-(defvar *glob-to-regexp-alist* (list (cons #v"{[^}]*}" (lambda (x) (msub '((#\| . #\,)(#\( . #\{)(#\) . #\})) x))) ++- (cons #v"\\[[^\\]*\\]" (lambda (x) ++- (concatenate 'string "(" ++- (substitute #\^ #\! (subseq x 0 2)) ++- (subseq x 2) ")"))) ++- (cons #v"\\*" (lambda (x) "([^/.]*)")) ++- (cons #v"\\?" (lambda (x) "([^/.])")) ++- (cons #v"\\." (lambda (x) "\\.")))) ++ ++ (defun mglist (x &optional (b 0)) ++ (let* ((y (mapcan (lambda (z &aux (w (string-match (car z) x b))) ++ (unless (eql w -1) ++ (list (list w (match-end 0) z)))) ++- *glob-to-regexp-alist*)) +++ +glob-to-regexp-alist+)) ++ (z (when y (reduce (lambda (y x) (if (< (car x) (car y)) x y)) y)))) ++ (when z ++ (cons z (mglist x (cadr z)))))) ++ ++ (defun mgsub (x &optional (l (mglist x)) (b 0) &aux (w (pop l))) ++ (if w ++- (concatenate 'string +++ (string-concatenate ++ (subseq x b (car w)) ++ (funcall (cdaddr w) (subseq x (car w) (cadr w))) ++ (mgsub x l (cadr w))) ++@@ -49,21 +78,10 @@ ++ ; ) ++ ) ++ ++-(defconstant +physical-pathname-defaults+ '(("" "" "") ++- ("" "" "") ++- ("" "(/?([^/]+/)*)" "" "" "([^/]+/)" "/") ++- ("" "([^/.]*)" "") ++- ("." "(\\.[^/]*)?" "") ++- ("" "" ""))) ++-(defconstant +logical-pathname-defaults+ '(("" "([-0-9A-Z]+:)?" ":") ++- ("" "" "") ++- ("" "(;?((\\*?([-0-9A-Z]+\\*?)+|\\*|\\*\\*);)*)" "" "" "((\\*?([-0-9A-Z]+\\*?)+|\\*);)" ";") ++- ("" "(\\*?([-0-9A-Z]+\\*?)+|\\*)?" "") ++- ("." "(\\.(\\*?([-0-9A-Z]+\\*?)+|\\*))?" "") ++- ("." "(\\.([1-9][0-9]*|newest|NEWEST|\\*))?" ""))) +++ ++ ++ (defun to-regexp-or-namestring (x rp lp) ++- (apply 'concatenate 'string +++ (apply 'string-concatenate ++ (mapcan (lambda (x y) (elsub x y rp lp)) ++ x (if lp +logical-pathname-defaults+ +physical-pathname-defaults+)))) ++ ++@@ -101,14 +119,14 @@ ++ (eval-when (compile eval) ++ (defun strsym (p &rest r) ++ (declare (:dynamic-extent r)) ++- (intern (apply 'concatenate 'string (mapcar 'string-upcase r)) p))) +++ (intern (apply 'string-concatenate (mapcar 'string-upcase r)) p))) ++ ++ #.`(defun make-pathname (&key (host nil hostp) (device nil devicep) (directory nil directoryp) ++ (name nil namep) (type nil typep) (version nil versionp) ++ defaults (case :local) namestring &aux defaulted (def (when defaults (pathname defaults)))) ++ (declare (optimize (safety 1))) ++ (check-type host (or (member nil :unspecific) string)) ++- (check-type device (member nil :unspecific)) +++ (check-type device (or (member nil :unspecific) string)) ++ (check-type directory (or (member nil :unspecific :wild) string list)) ++ (check-type name (or string (member nil :unspecific :wild))) ++ (check-type type (or string (member nil :unspecific :wild))) ++@@ -116,7 +134,8 @@ ++ (check-type defaults (or null pathname-designator)) ++ (check-type case (member :common :local)) ++ ,(flet ((def? (k) `(let* (,@(when (eq k 'host) `((def (or def *default-pathname-defaults*)))) ++- (nk (if ,(strsym :si k "P") ,k (progn (setq defaulted t) (when def (,(strsym :si "C-PATHNAME-" k) def))))) +++ (nk (if ,(strsym :si k "P") ,k (when def (,(strsym :si "C-PATHNAME-" k) def)))) +++ (nk (progn (unless (eq ,k nk) (setq defaulted t)) nk)) ++ (nk (if (eq case :local) nk (progn (setq defaulted t) (toggle-case nk))))) ++ nk))) ++ `(let* ((h ,(def? 'host)) ++--- gcl-2.6.12.orig/lsp/gcl_parse_namestring.lsp +++++ gcl-2.6.12/lsp/gcl_parse_namestring.lsp ++@@ -14,6 +14,7 @@ ++ (defun dir-conj (x) (if (eq x :relative) :absolute :relative)) ++ ++ (defvar *up-key* :up) +++(defvar *canonicalized* nil) ++ ++ (defun mfr (x b i) (subseq x b i)); (make-array (- i b) :element-type 'character :displaced-to x :displaced-index-offset b) ++ ++@@ -30,15 +31,15 @@ ++ (z (if w (cdr w) z))) ++ (if (eq z :up) *up-key* z))) ++ ++-(defun dir-parse (x sep sepfirst &optional (b 0)) +++(defun dir-parse (x &optional lp (b 0)) ++ (when (stringp x) ++- (let ((i (search sep x :start2 b)));string-match spoils outer match results ++- (when i ++- (let* ((y (dir-parse x sep sepfirst (1+ i))) +++ (let ((i (string-match (if lp #v";" +dirsep+) x b))) +++ (unless (minusp i) +++ (let* ((y (dir-parse x lp (1+ i))) ++ (z (element x b i :directory)) ++- (y (if z (cons z y) y))) +++ (y (if z (cons z y) (progn (when (> i b) (setq *canonicalized* t)) y)))) ++ (if (zerop b) ++- (cons (if (zerop i) sepfirst (dir-conj sepfirst)) y) +++ (cons (if (if lp (plusp i) (zerop i)) :absolute :relative) y) ++ y)))))) ++ ++ (defun match-component (x i k &optional (boff 0) (eoff 0)) ++@@ -52,40 +53,37 @@ ++ ++ (defconstant +generic-logical-pathname-regexp+ (compile-regexp (to-regexp-or-namestring (make-list (length +logical-pathname-defaults+)) t t))) ++ ++-(defun expand-home-dir (dir) ++- (cond ((and (eq (car dir) :relative) (stringp (cadr dir)) (eql #\~ (aref (cadr dir) 0))) ++- (append (dir-parse (home-namestring (cadr dir)) "/" :absolute) (cddr dir))) ++- (dir))) ++- ++ (defun logical-pathname-parse (x &optional host def (b 0) (e (length x))) ++- (when (and (eql b (string-match +generic-logical-pathname-regexp+ x b e)) (eql (match-end 0) e)) ++- (let ((mhost (match-component x 1 :host 0 -1))) ++- (when (and host mhost) ++- (unless (string-equal host mhost) +++ (when *pathname-logical* ;;accelerator +++ (when (and (eql b (string-match +generic-logical-pathname-regexp+ x b e)) (eql (match-end 0) e)) +++ (let ((mhost (match-component x 1 :host 0 -1))) +++ (when (and host mhost) +++ (unless (string-equal host mhost) ++ (error 'error :format-control "Host part of ~s does not match ~s" :format-arguments (list x host)))) ++- (let ((host (or host mhost (pathname-host def)))) ++- (when (logical-pathname-host-p host) ++- (let* ((dir (dir-parse (match-component x 2 :none) ";" :relative)) ++- (edir (expand-home-dir dir))) ++- (make-pathname :host host ++- :device :unspecific ++- :directory edir ++- :name (match-component x 6 :name) ++- :type (match-component x 8 :type 1) ++- :version (version-parse (match-component x 11 :version 1)) ++- :namestring (when (and mhost (eql b 0) (eql e (length x)) (eq dir edir)) x)))))))) ++- +++ (let ((host (or host mhost (pathname-host def)))) +++ (when (logical-pathname-host-p host) +++ (make-pathname :host host +++ :device :unspecific +++ :name (match-component x 6 :name) +++ :type (match-component x 8 :type 1) +++ :version (version-parse (match-component x 11 :version 1)) +++ :directory (dir-parse (match-component x 2 :none) t);must be last +++ :namestring (when (and mhost (eql b 0) (eql e (length x))) x)))))))) +++ ++ (defconstant +generic-physical-pathname-regexp+ (compile-regexp (to-regexp-or-namestring (make-list (length +physical-pathname-defaults+)) t nil))) ++ ++-(defun pathname-parse (x b e) ++- (when (and (eql b (string-match +generic-physical-pathname-regexp+ x b e)) (eql (match-end 0) e)) ++- (let* ((dir (dir-parse (match-component x 1 :none) "/" :absolute)) ++- (edir (expand-home-dir dir))) ++- (make-pathname :directory edir ++- :name (match-component x 3 :name) ++- :type (match-component x 4 :type 1) ++- :namestring (when (and (eql b 0) (eql e (length x)) (eq dir edir)) x))))) +++(defun expand-home-dir (dir) +++ (if (and (eq (car dir) :relative) (stringp (cadr dir)) (eql #\~ (aref (cadr dir) 0))) +++ (prog1 (append (dir-parse (home-namestring (cadr dir))) (cddr dir)) (setq *canonicalized* t)) +++ dir)) ++ +++(defun pathname-parse (x b e &aux (*canonicalized* nil)) +++ (when (and (eql b (string-match +generic-physical-pathname-regexp+ x b e)) (eql (match-end 0) e)) +++ (make-pathname :device (match-component x 1 :none 0 -1) +++ :name (match-component x 4 :name) +++ :type (match-component x 5 :type 1) +++ :directory (expand-home-dir (dir-parse (match-component x 2 :none)));must be last +++ :namestring (unless *canonicalized* (when (and (eql b 0) (eql e (length x))) x))))) ++ ++ (defun path-stream-name (x) ++ (check-type x pathname-designator) ++--- gcl-2.6.12.orig/lsp/gcl_top.lsp +++++ gcl-2.6.12/lsp/gcl_top.lsp ++@@ -581,27 +581,20 @@ First directory is checked for first nam ++ ++ (defvar *tmp-dir*) ++ ++-(defun wine-tmp-redirect () ++- (let* ((s (find-symbol "*WINE-DETECTED*" (find-package "SYSTEM")))) ++- (when (and s (symbol-value s)) ++- (list *system-directory*)))) ++- ++ (defun ensure-dir-string (str) ++ (if (eq (stat str) :directory) ++ (coerce-slash-terminated str) ++ str)) ++ ++ (defun get-temp-dir () ++- (dolist (x `(,@(wine-tmp-redirect) ,@(mapcar 'si::getenv '("TMPDIR" "TMP" "TEMP")) "/tmp" "")) +++ (dolist (x `(,@(mapcar 'si::getenv '("TMPDIR" "TMP" "TEMP")) "/tmp" "")) ++ (when x ++ (let ((x (coerce-slash-terminated x))) ++ (when (eq (stat x) :directory) ++ (return-from get-temp-dir x)))))) ++ ++-(defun get-path (s &aux (m (string-match "([^/ ]*)( |$)" s))(b (match-beginning 1))(e (match-end 1)) ++- (r (with-open-file (s (concatenate 'string "|which " (subseq s b e))) (read s nil 'eof)))) ++- (if (eq r 'eof) s (concatenate 'string (string-downcase r) (subseq s e)))) ++- +++(defun get-path (s &aux (m (string-match "([^ ]*)( |$)" s))(b (match-beginning 1))(e (match-end 1))) +++ (string-concatenate (which (pathname-name (subseq s b e))) (subseq s e))) ++ ++ (defvar *cc* "cc") ++ (defvar *ld* "ld") ++@@ -609,7 +602,7 @@ First directory is checked for first nam ++ ++ (defvar *current-directory* *system-directory*) ++ ++-(defun current-directory-pathname nil (pathname (concatenate 'string (getcwd) "/"))) +++(defun current-directory-pathname nil (pathname (coerce-slash-terminated (getcwd)))) ++ ++ (defun set-up-top-level (&aux (i (argc)) tem) ++ (declare (fixnum i)) ++@@ -627,9 +620,7 @@ First directory is checked for first nam ++ (when dir ++ (setq *lib-directory* (coerce-slash-terminated dir))))) ++ (unless (and *load-path* (equal tem *lib-directory*)) ++- (setq *load-path* (cons (string-concatenate *lib-directory* "lsp/") *load-path*)) ++- (setq *load-path* (cons (string-concatenate *lib-directory* "gcl-tk/") *load-path*)) ++- (setq *load-path* (cons (string-concatenate *lib-directory* "xgcl-2/") *load-path*))) +++ (mapc (lambda (x) (push (string-concatenate *lib-directory* x) *load-path*)) '("lsp/" "gcl-tk/" "xgcl-2/"))) ++ (unless (boundp '*system-directory*) ++ (setq *system-directory* (namestring (truename (make-pathname :name nil :type nil :defaults (argv 0)))))))) ++ ++--- gcl-2.6.12.orig/lsp/gcl_truename.lsp +++++ gcl-2.6.12/lsp/gcl_truename.lsp ++@@ -4,11 +4,11 @@ ++ (labels ((frame (b e) (make-array (- n b) :element-type 'character ++ :displaced-to str :displaced-index-offset b :fill-pointer (- e b))) ++ (set-fr (fr e &aux (fr (or fr (frame 0 b)))) (setf (fill-pointer fr) e) fr)) ++- (let* ((i (string-match #v"/" str b)) +++ (let* ((i (string-match +dirsep+ str b)) ++ (fr (set-fr fr (if (eql i -1) n i))) ++ (l (when (eq (stat fr) :link) (readlinkat 0 fr)))) ++ (cond (l (let ((b (if (eql #\/ (aref l 0)) 0 b))) ++- (link-expand (concatenate 'string (set-fr fr b) l (frame (if (eql i -1) n i) n)) b))) +++ (link-expand (string-concatenate (set-fr fr b) l (frame (if (eql i -1) n i) n)) b))) ++ ((eql i -1) str) ++ ((link-expand str (1+ i) n fr)))))) ++ ++--- gcl-2.6.12.orig/makedefc.in +++++ gcl-2.6.12/makedefc.in ++@@ -45,6 +45,7 @@ PRELINK_CHECK=@PRELINK_CHECK@ ++ ++ NOTIFY=@NOTIFY@ ++ CC=@CC@ +++GCL_CC=@GCL_CC@ ++ CFLAGS=@CFLAGS@ ++ LDFLAGS=@LDFLAGS@ ++ FINAL_CFLAGS=@FINAL_CFLAGS@ ++--- gcl-2.6.12.orig/o/bind.c +++++ gcl-2.6.12/o/bind.c ++@@ -23,6 +23,8 @@ Foundation, 675 Mass Ave, Cambridge, MA ++ bind.c ++ */ ++ +++#include +++ ++ #include "include.h" ++ ++ static void ++--- gcl-2.6.12.orig/o/fasdump.c +++++ gcl-2.6.12/o/fasdump.c ++@@ -149,7 +149,7 @@ enum dump_type { ++ ++ /* given SHORT extract top code (say 4 bits) and bottom byte */ ++ #define TOP(i) (i >> SIZE_BYTE) ++-#define BOTTOM(i) (i & ~(~0 << SIZE_BYTE)) +++#define BOTTOM(i) (i & ~(~0UL << SIZE_BYTE)) ++ ++ #define FASD_VERSION 2 ++ ++@@ -328,7 +328,7 @@ getd(str) ++ ++ ++ #define D_TYPE_OF(byt) \ ++- ((enum dump_type )((unsigned int) byt & ~(~0 << SIZE_D_CODE))) +++ ((enum dump_type )((unsigned int) byt & ~(~0UL << SIZE_D_CODE))) ++ ++ /* this field may be the top of a short for length, or part of an extended ++ code */ ++@@ -379,7 +379,7 @@ getd(str) ++ ++ ++ ++-#define MASK ~(~0 << 8) +++#define MASK ~(~0UL << 8) ++ #define WRITE_BYTEI(x,i) putc((((x) >> (i*SIZE_BYTE)) & MASK),fas_stream) ++ ++ #define PUTFIX(v_) Join(PUT,SIZEOF_LONG)(v_) ++@@ -398,7 +398,7 @@ getd(str) ++ WRITE_BYTEI(var,7);} while(0) ++ ++ #define PUT4(varx ) \ ++- do{int var= varx ; \ +++ do{unsigned long var= varx ; \ ++ DPRINTF("{4byte:varx= %d}", var); \ ++ WRITE_BYTEI(var,0); \ ++ WRITE_BYTEI(var,1); \ ++@@ -406,14 +406,14 @@ getd(str) ++ WRITE_BYTEI(var,3);} while(0) ++ ++ #define PUT2(var ) \ ++- do{int v=var; \ +++ do{unsigned long v=var; \ ++ DPRINTF("{2byte:var= %d}", v); \ ++ WRITE_BYTEI(v,0); \ ++ WRITE_BYTEI(v,1); \ ++ } while(0) ++ ++ #define PUT3(var ) \ ++- do{int v=var; \ +++ do{unsigned long v=var; \ ++ DPRINTF("{3byte:var= %d}", v); \ ++ WRITE_BYTEI(v,0); \ ++ WRITE_BYTEI(v,1); \ ++--- gcl-2.6.12.orig/o/file.d +++++ gcl-2.6.12/o/file.d ++@@ -89,8 +89,8 @@ Foundation, 675 Mass Ave, Cambridge, MA ++ # include ++ # include ++ #else ++-# include ++ # include +++# include ++ #endif ++ #include ++ ++@@ -400,7 +400,8 @@ open_stream(object fn,enum smmode smm, o ++ fclose(fp); ++ if (if_exists==sKerror) FILE_ERROR(fn,"File exists"); ++ else if (if_exists==sKrename) { ++- massert(snprintf(FN2,sizeof(FN2),"%s.BAK",FN1)>=0); +++ massert(snprintf(FN2,sizeof(FN2),"%-*.*s~",(int)strlen(FN1)-1,(int)strlen(FN1)-1,FN1)>=0); +++ massert(!unlink(FN2));/*MinGW*/ ++ massert(!rename(FN1,FN2)); ++ if (!(fp=fopen(FN1,smm==smm_output ? "w" : "w+"))) cannot_create(fn); ++ } else if (if_exists==sKrename_and_delete || ++--- gcl-2.6.12.orig/o/funlink.c +++++ gcl-2.6.12/o/funlink.c ++@@ -322,10 +322,11 @@ call_proc(object sym, void **link, int a ++ ++ } else if (type_of(fun)==t_afun) { ++ ++- ufixnum at=F_TYPES(fun->sfn.sfn_argd)>>F_TYPE_WIDTH; ++- ufixnum ma=F_MIN_ARGS(fun->sfn.sfn_argd); ++- ufixnum xa=F_MAX_ARGS(fun->sfn.sfn_argd); ++- ufixnum rt=F_RESULT_TYPE(fun->sfn.sfn_argd); +++ ufixnum ad=fun->sfn.sfn_argd; +++ ufixnum at=F_TYPES(ad)>>F_TYPE_WIDTH; +++ ufixnum ma=F_MIN_ARGS(ad); +++ ufixnum xa=F_MAX_ARGS(ad); +++ ufixnum rt=F_RESULT_TYPE(ad); ++ ++ nargs=SFUN_NARGS(argd); ++ if (nargs xa || ((argd>>8)&0x3)!=rt || (argd>>12)!=at) ++--- gcl-2.6.12.orig/o/hash.d +++++ gcl-2.6.12/o/hash.d ++@@ -48,7 +48,7 @@ typedef unsigned char uchar; ++ ++ static ufixnum rtb[256]; ++ ++-#define MASK(n) (~(~0L << (n))) +++#define MASK(n) (~(~0UL << (n))) ++ ++ static ufixnum ++ ufixhash(ufixnum g) { ++--- gcl-2.6.12.orig/o/main.c +++++ gcl-2.6.12/o/main.c ++@@ -148,7 +148,7 @@ mbrk(void *v) { ++ ++ #if defined(__CYGWIN__)||defined(__MINGW32__) ++ ++-#include +++#include ++ ++ static ufixnum ++ get_phys_pages_no_malloc(char n) { ++@@ -470,12 +470,6 @@ main(int argc, char **argv, char **envp) ++ kcl_self = argv[0]; ++ #endif ++ ++-#ifdef __MINGW32__ ++- { ++- char *s=kcl_self; ++- for (;*s;s++) if (*s=='\\') *s='/'; ++- } ++-#endif ++ *argv=kcl_self; ++ ++ #ifdef CAN_UNRANDOMIZE_SBRK ++@@ -537,10 +531,6 @@ main(int argc, char **argv, char **envp) ++ ++ } ++ ++-#ifdef _WIN32 ++- detect_wine(); ++-#endif ++- ++ sSAlisp_maxpagesA->s.s_dbind = make_fixnum(real_maxpage); ++ ++ ihs_push(Cnil); ++--- gcl-2.6.12.orig/o/mingfile.c +++++ gcl-2.6.12/o/mingfile.c ++@@ -1,57 +1,6 @@ ++ #include "include.h" ++-#include "windows.h" ++ #include "winsock2.h" ++- ++-extern object truename(object); ++-extern object make_pathname(); ++-void Ldirectory ( void ) ++-{ ++- char filename[MAXPATHLEN]; ++- object *top=vs_top; ++- object path; ++- check_arg(1); ++- check_type_or_pathname_string_symbol_stream(&vs_base[0]); ++- path = vs_base[0] = coerce_to_pathname(vs_base[0]); ++- ++- if (vs_base[0]->pn.pn_name==Cnil && vs_base[0]->pn.pn_type==Cnil) { ++- coerce_to_filename(vs_base[0], filename); ++- strcat(filename, "*.*"); ++- } else if (vs_base[0]->pn.pn_name==Cnil) { ++- vs_base[0]->pn.pn_name = sKwild; ++- coerce_to_filename(vs_base[0], filename); ++- vs_base[0]->pn.pn_name = Cnil; ++- } else if (vs_base[0]->pn.pn_type==Cnil) { ++- coerce_to_filename(vs_base[0], filename); ++- strcat(filename, ".*"); ++- } else ++- coerce_to_filename(vs_base[0], filename); ++- { WIN32_FIND_DATA data; ++- HANDLE dirHandle = FindFirstFile(filename,&data); ++- ++- if (dirHandle== INVALID_HANDLE_VALUE) { ++- vs_base[0]=Cnil; return; ++- } else { ++- do { ++- if (strcmp(data.cFileName,"..") != 0 && strcmp(data.cFileName,".") != 0 ) { ++- object name = make_simple_string(data.cFileName); ++- object new = coerce_to_pathname(name); ++- vs_push(make_pathname(path->pn.pn_host, ++- path->pn.pn_device, ++- path->pn.pn_directory, ++- new->pn.pn_name, ++- new->pn.pn_type, ++- new->pn.pn_version)); ++- } ++- } while (FindNextFile(dirHandle,&data)); ++- FindClose(dirHandle); ++- } ++- vs_push(Cnil); ++- while (vs_top > top + 1) ++- stack_cons(); ++- vs_base = top; ++- ++- } ++-} +++#include "windows.h" ++ ++ int ++ mingwlisten(FILE *fp) { ++--- gcl-2.6.12.orig/o/mingwin.c +++++ gcl-2.6.12/o/mingwin.c ++@@ -2,6 +2,7 @@ ++ ++ ++ +++#include "winsock2.h" ++ #include "windows.h" ++ #include "errno.h" ++ #include "signal.h" ++@@ -923,20 +924,6 @@ sigprocmask (int how , const sigset_t *s ++ return 0; ++ } ++ ++-void ++-fix_filename(object pathname, char *filename1) { ++- ++- char *filename=filename1,*p=filename; ++- extern char *getwd(); ++- ++- while (*p) { ++- if (*p=='\\') *p='/'; ++- p++; ++- } ++- ++-} ++- ++- ++ char *GCLExeName ( void ) ++ { ++ static char module_name_buf[128]; ++@@ -948,3 +935,35 @@ char *GCLExeName ( void ) ++ } ++ return ( (char *) rv ); ++ } +++ +++int +++vsystem(const char *command) { +++ +++ STARTUPINFO s={0}; +++ PROCESS_INFORMATION p={0}; +++ long unsigned int e; +++ char *cmd=NULL,*r; +++ +++ if (!strpbrk(command,"\"'$<>")) { +++ +++ cmd=FN1; +++ massert((r=strpbrk(command," \n\t"))-command=0); +++ command=FN1; +++ +++ } +++ +++ massert(CreateProcess(cmd,(void *)command,NULL,NULL,FALSE,NORMAL_PRIORITY_CLASS|CREATE_NO_WINDOW,NULL,NULL,&s,&p)); +++ massert(!WaitForSingleObject(p.hProcess,INFINITE)); +++ massert(GetExitCodeProcess(p.hProcess,&e)); +++ massert(CloseHandle(p.hProcess)); +++ massert(CloseHandle(p.hThread)); +++ +++ return e; +++ +++} ++--- gcl-2.6.12.orig/o/sfaslcoff.c +++++ gcl-2.6.12/o/sfaslcoff.c ++@@ -47,7 +47,16 @@ struct scnhdr { ++ #define ALLOC_SEC(sec) (sec->s_flags&(SEC_CODE|SEC_DATA|SEC_BSS)) ++ #define LOAD_SEC(sec) (sec->s_flags&(SEC_CODE|SEC_DATA)) ++ ++-#define STOP(s_,op_) ({char *_s=s_,_c=_s[8];_s[8]=0;op_;_s[8]=_c;}) +++#define NM(sym_,tab_,nm_,op_) \ +++ ({char _c=0,*nm_; \ +++ if ((sym_)->n.n.n_zeroes) \ +++ {(nm_)=(sym_)->n.n_name;_c=(nm_)[8];(nm_)[8]=0;} \ +++ else \ +++ (nm_)=(tab_)+(sym_)->n.n.n_offset; \ +++ op_; \ +++ if (_c) (nm_)[8]=_c; \ +++ }) +++ ++ ++ struct reloc { ++ union { ++@@ -164,7 +173,7 @@ get_sym_value(const char *name) { ++ static void ++ relocate_symbols(struct syment *sym,struct syment *sye,struct scnhdr *sec1,char *st1) { ++ ++- struct node *answ; +++ long value; ++ ++ for (;symn_scnum) { ++ ++- if (sym->n.n.n_zeroes) ++- STOP(sym->n.n_name,sym->n_value=get_sym_value(sym->n.n_name)); ++- else ++- sym->n_value=get_sym_value(st1+sym->n.n.n_offset); +++ NM(sym,st1,s,value=get_sym_value(s)); +++ +++ sym->n_value=value; ++ ++ } ++ ++@@ -256,10 +264,7 @@ load_self_symbols() { ++ ++ ns++; ++ ++- if (sym->n.n.n_zeroes) ++- STOP(sym->n.n_name,sl+=strlen(sym->n.n_name)+1); ++- else ++- sl+=strlen(st1+sym->n.n.n_offset)+1; +++ NM(sym,st1,s,sl+=strlen(s)+1); ++ ++ sym+=sym->n_numaux; ++ ++@@ -274,10 +279,7 @@ load_self_symbols() { ++ if (sym->n_sclass!=2 || sym->n_scnum<1) ++ continue; ++ ++- if (sym->n.n.n_zeroes) ++- STOP(sym->n.n_name,strcpy(st,sym->n.n_name)); ++- else ++- strcpy(st,st1+sym->n.n.n_offset); +++ NM(sym,st1,s,strcpy(st,s)); ++ ++ sec=sec1+sym->n_scnum-1; ++ jj=sym->n_value+sec->s_vaddr+h->h_ibase; ++@@ -343,7 +345,7 @@ find_init_string(const char *s) { ++ struct syment *sy1,*sym,*sye; ++ char *st1,*ste; ++ void *st,*est; ++- object o; +++ object o=OBJNULL; ++ ++ massert(f=fopen(s,"r")); ++ massert(st=get_mmap(f,&est)); ++@@ -358,13 +360,9 @@ find_init_string(const char *s) { ++ ++ for (sym=sy1;symn.n.n_zeroes ? sym->n.n_name : st1+sym->n.n.n_offset; ++- ++- if (!strncmp(s,"_init_",6)) { ++- if (sym->n.n.n_zeroes) ++- STOP((char *)s,o=make_simple_string(s)); ++- else ++- o=make_simple_string(s); +++ NM(sym,st1,s,if (!strncmp(s,"_init_",6)) o=make_simple_string(s)); +++ +++ if (o!=OBJNULL) { ++ massert(!un_mmap(st,&est)); ++ massert(!fclose(f)); ++ return o; ++--- gcl-2.6.12.orig/o/sockets.c +++++ gcl-2.6.12/o/sockets.c ++@@ -33,8 +33,8 @@ Foundation, 675 Mass Ave, Cambridge, MA ++ # include ++ # include ++ #else ++-# include ++ # include +++# include ++ #endif ++ ++ #ifdef __STDC__ ++--- gcl-2.6.12.orig/o/unexnt.c +++++ gcl-2.6.12/o/unexnt.c ++@@ -780,7 +780,7 @@ map_in_heap (char *filename) ++ } ++ ++ size = get_committed_heap_size (); ++- file_base = MapViewOfFileEx (file_mapping, FILE_MAP_COPY, 0, +++ file_base = MapViewOfFileEx (file_mapping, FILE_MAP_COPY|FILE_MAP_EXECUTE, 0, ++ heap_index_in_executable, size, ++ get_heap_start ()); ++ if (file_base != 0) ++@@ -794,7 +794,7 @@ map_in_heap (char *filename) ++ CloseHandle (file_mapping); ++ ++ if (VirtualAlloc (get_heap_start (), get_committed_heap_size (), ++- MEM_RESERVE | MEM_COMMIT, PAGE_READWRITE) == NULL) +++ MEM_RESERVE | MEM_COMMIT, PAGE_EXECUTE_READWRITE) == NULL) ++ { ++ i = GetLastError (); ++ do_gcl_abort(); ++@@ -1057,7 +1057,7 @@ sbrk (ptrdiff_t increment) ++ ++ /* Commit more of our heap. */ ++ if (VirtualAlloc (data_region_end, size, MEM_COMMIT, ++- PAGE_READWRITE) == NULL) +++ PAGE_EXECUTE_READWRITE) == NULL) ++ return NULL; ++ data_region_end += size; ++ ++--- gcl-2.6.12.orig/o/unixfsys.c +++++ gcl-2.6.12/o/unixfsys.c ++@@ -21,6 +21,7 @@ Foundation, 675 Mass Ave, Cambridge, MA ++ ++ #include ++ #include +++#include ++ ++ #define IN_UNIXFSYS ++ #include "include.h" ++@@ -72,39 +73,43 @@ coerce_to_filename1(object spec, char *p ++ memcpy(p,namestring->st.st_self,namestring->st.st_fillp); ++ p[namestring->st.st_fillp]=0; ++ ++-#ifdef FIX_FILENAME ++- FIX_FILENAME(spec,p); ++-#endif ++- ++ } ++ +++#ifndef __MINGW32__ +++static char GETPW_BUF[4096]; +++#endif +++ ++ DEFUN_NEW("UID-TO-NAME",object,fSuid_to_name,SI,1,1,NONE,OI,OO,OO,OO,(fixnum uid),"") { +++#ifndef __MINGW32__ ++ struct passwd *pwent,pw; ++ long r; ++ ++ massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); ++- massert(r<=sizeof(FN1));/*FIXME maybe once at image startup*/ +++ massert(r<=sizeof(GETPW_BUF));/*FIXME maybe once at image startup*/ ++ ++- massert(!getpwuid_r(uid,&pw,FN1,r,&pwent)); +++ massert(!getpwuid_r(uid,&pw,GETPW_BUF,r,&pwent)); ++ ++ RETURN1(make_simple_string(pwent->pw_name)); ++- +++#else +++ RETURN1(Cnil); +++#endif ++ } ++ ++ DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") { ++ +++#ifndef __MINGW32__ ++ struct passwd *pwent,pw; ++ long r; ++ ++ massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); ++- massert(r<=sizeof(FN1));/*FIXME maybe once at image startup*/ +++ massert(r<=sizeof(GETPW_BUF));/*FIXME maybe once at image startup*/ ++ ++ if (nm->st.st_fillp==1) ++ ++ if ((pw.pw_dir=getenv("HOME"))) ++ pwent=&pw; ++ else ++- massert(!getpwuid_r(getuid(),&pw,FN1,r,&pwent) && pwent); +++ massert(!getpwuid_r(getuid(),&pw,GETPW_BUF,r,&pwent) && pwent); ++ ++ else { ++ ++@@ -112,15 +117,19 @@ DEFUN_NEW("HOME-NAMESTRING",object,fShom ++ memcpy(FN2,nm->st.st_self+1,nm->st.st_fillp-1); ++ FN2[nm->st.st_fillp-1]=0; ++ ++- massert(!getpwnam_r(FN2,&pw,FN1,r,&pwent) && pwent); +++ massert(!getpwnam_r(FN2,&pw,GETPW_BUF,r,&pwent) && pwent); ++ ++ } ++ ++- massert(strlen(pwent->pw_dir)+2pw_dir,strlen(pwent->pw_dir)); ++- FN3[strlen(pwent->pw_dir)]='/'; ++- FN3[strlen(pwent->pw_dir)+1]=0; +++ massert((r=strlen(pwent->pw_dir))+2pw_dir,r); +++ FN3[r]='/'; +++ FN3[r+1]=0; ++ RETURN1(make_simple_string(FN3)); +++#else +++ massert(snprintf(FN1,sizeof(FN1)-1,"%s%s",getenv("SystemDrive"),getenv("HOMEPATH"))>=0); +++ RETURN1(make_simple_string(FN1)); +++#endif ++ ++ } ++ ++@@ -160,28 +169,61 @@ DEF_ORDINARY("DIRECTORY",sKdirectory,KEY ++ DEF_ORDINARY("LINK",sKlink,KEYWORD,""); ++ DEF_ORDINARY("FILE",sKfile,KEYWORD,""); ++ +++object +++file_stream(object x) { +++ if (type_of(x)==t_stream) +++ switch(x->sm.sm_mode) { +++ case smm_input: +++ case smm_output: +++ case smm_io: +++ case smm_probe: +++ return x; +++ case smm_synonym: +++ return file_stream(x->sm.sm_object0->s.s_dbind); +++ default: +++ break; +++ } +++ return Cnil; +++} +++ +++ ++ DEFUNM_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ ++ struct stat ss; ++ ++- check_type_string(&x); ++- coerce_to_filename(x,FN1); +++ if (type_of(x)==t_string) { +++ +++ coerce_to_filename(x,FN1); ++ ++ #ifdef __MINGW32__ ++- { ++- char *p=FN1+strlen(FN1)-1; ++- for (;p>FN1 && *p=='/';p--) ++- *p=0; ++- } +++ {char *p=FN1+strlen(FN1)-1;for (;p>FN1 && *p=='/';p--) *p=0;} ++ #endif ++- if (lstat(FN1,&ss)) +++ if (lstat(FN1,&ss)) +++ RETURN1(Cnil); +++ } else if ((x=file_stream(x))!=Cnil&&x->sm.sm_fp) { +++ if (fstat(fileno(x->sm.sm_fp),&ss)) +++ RETURN1(Cnil); +++ } else ++ RETURN1(Cnil); ++- else ++- RETURN4(S_ISDIR(ss.st_mode) ? sKdirectory : ++- (S_ISLNK(ss.st_mode) ? sKlink : sKfile), ++- make_fixnum(ss.st_size), ++- make_fixnum(ss.st_mtime), ++- make_fixnum(ss.st_uid)); +++ +++ RETURN4(S_ISDIR(ss.st_mode) ? sKdirectory : +++ (S_ISLNK(ss.st_mode) ? sKlink : sKfile), +++ make_fixnum(ss.st_size), +++ make_fixnum(ss.st_mtime), +++ make_fixnum(ss.st_uid)); +++ +++} +++ +++DEFUN_NEW("FTELL",object,fSftell,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") { +++ +++ RETURN1((x=file_stream(x))!=Cnil&&x->sm.sm_fp ? (object)ftell(x->sm.sm_fp) : (object)0); +++ +++} +++ +++DEFUN_NEW("FSEEK",object,fSfseek,SI,2,2,NONE,OO,IO,OO,OO,(object x,fixnum pos),"") { +++ +++ RETURN1((x=file_stream(x))!=Cnil&&x->sm.sm_fp&&!fseek(x->sm.sm_fp,pos,SEEK_SET) ? Ct : Cnil); +++ ++ } ++ ++ #include ++@@ -198,7 +240,11 @@ DEFUN_NEW("READLINKAT",object,fSreadlink ++ massert(z1st.st_self,z1); ++ FN1[z1]=0; +++#ifndef __MINGW32__ ++ massert((l=readlinkat(d ? dirfd((DIR *)d) : AT_FDCWD,FN1,FN2,sizeof(FN2)))>=0 && ld_type +++#else +++#define get_d_type(e,s) \ +++ ({struct stat ss;\ +++ massert(snprintf(FN1,sizeof(FN1),"%-*.*s%s",s->st.st_fillp,s->st.st_fillp,s->st.st_self,e->d_name)>=0);\ +++ lstat(FN1,&ss);S_ISDIR(ss.st_mode) ? DT_DIR : DT_REG;}) +++#endif ++ ++ if (!x) RETURN1(Cnil); ++ ++ tl=telldir((DIR *)x); ++ ++-#ifndef HAVE_D_TYPE ++- y=DT_UNKNOWN; ++-#endif ++- for (;(e=readdir((DIR *)x)) && y!=DT_UNKNOWN && e->d_type!=y;); +++ for (;(e=readdir((DIR *)x)) && y!=DT_UNKNOWN && y!=(d_type=get_d_type(e,s));); ++ if (!e) RETURN1(Cnil); ++ ++ if (s==Cnil) ++@@ -290,9 +354,7 @@ DEFUN_NEW("READDIR",object,fSreaddir,SI, ++ } ++ } ++ ++-#ifdef HAVE_D_TYPE ++- if (y==DT_UNKNOWN) z=MMcons(z,make_fixnum(e->d_type)); ++-#endif +++ if (y==DT_UNKNOWN) z=MMcons(z,make_fixnum(d_type)); ++ ++ RETURN1(z); ++ ++--- gcl-2.6.12.orig/o/unixsys.c +++++ gcl-2.6.12/o/unixsys.c ++@@ -24,10 +24,14 @@ Foundation, 675 Mass Ave, Cambridge, MA ++ #include ++ #include ++ #include +++#ifndef __MINGW32__ ++ #include +++#endif ++ ++ #include "include.h" ++ +++#ifndef __MINGW32__ +++ ++ int ++ vsystem(const char *command) { ++ ++@@ -43,12 +47,13 @@ vsystem(const char *command) { ++ ++ else { ++ ++- z=alloca(n); ++- memcpy(z,command,n); +++ massert(ns.s_dbind=Cnil; ++- ++- if (stat(s,&ss)) ++- return; ++- ++- massert(f=fopen(s,"r")); ++- massert(fscanf(f,"%s",b)==1); ++- massert(fscanf(f,"%s",b)==1); ++- massert(!fclose(f)); ++- ++- if (strncmp("wineserver",b,9)) ++- return; ++- ++- massert(o=sSAsystem_directoryA->s.s_dbind); ++- massert(o!=Cnil); ++- mpid=getpid(); ++- ++- massert(snprintf(b,sizeof(b),"%-.*smsys /tmp/ out%0d tmp%0d log%0d", ++- o->st.st_fillp,o->st.st_self,mpid,mpid,mpid)>0); ++- massert(!psystem(b)); ++- ++- sSAwine_detectedA->s.s_dbind=Ct; ++- ++- massert(!atexit(close_msys)); ++- ++-} ++-#endif ++- ++ int ++ msystem(const char *s) { ++ ++- int r; ++- ++-#ifdef _WIN32 ++- ++- if (sSAwine_detectedA->s.s_dbind==Ct) { ++- ++- char b[4096],b1[4096],c; ++- FILE *fp; ++- ++- massert(snprintf(b,sizeof(b),"/tmp/out%0d",mpid)>0); ++- massert(snprintf(b1,sizeof(b1),"%s1",b)>0); ++- ++- massert(fp=fopen(b1,"w")); ++- massert(fprintf(fp,"%s",s)>=0); ++- massert(!fclose(fp)); ++- ++- massert(MoveFileEx(b1,b,MOVEFILE_REPLACE_EXISTING)); ++- ++- if (!*s) ++- return 0; ++- ++- for (;;Sleep(100)) { ++- ++- massert(fp=fopen(b,"r")); ++- massert((c=fgetc(fp))!=EOF); ++- if (c!=s[0]) { ++- massert(ungetc(c,fp)!=EOF); ++- break; ++- } ++- massert(!fclose(fp)); ++- ++- } ++- ++- massert(fscanf(fp,"%d",&r)==1); ++- massert(!fclose(fp)); ++- ++- } else ++- ++-#endif ++- ++- r=psystem(s); ++- ++- return r; +++ return psystem(s); ++ ++ } ++ ++--- gcl-2.6.12.orig/unixport/makefile +++++ gcl-2.6.12/unixport/makefile ++@@ -77,8 +77,8 @@ sys_init.lsp: sys_init.lsp.in ++ -e "s#@LI-MINVERS@#`cat ../minvers | cut -f1 -d.`#1" \ ++ -e "s#@LI-MAJVERS@#`cat ../majvers`#1" \ ++ -e "s#@LI-RELEASE@#`cat ../release`#1" \ ++- -e "s#@LI-CC@#\"$(CC) -c $(FINAL_CFLAGS)\"#1" \ ++- -e "s#@LI-LD@#\"$(CC) $(LD_FLAGS) -o \"#1" \ +++ -e "s#@LI-CC@#\"$(GCL_CC) -c $(FINAL_CFLAGS)\"#1" \ +++ -e "s#@LI-LD@#\"$(GCL_CC) $(LD_FLAGS) -o \"#1" \ ++ -e "s#@LI-LD-LIBS@#\" $(LD_LIBS_PRE) -l$* $(LD_LIBS_POST)\"#1" \ ++ -e "s#@LI-OPT-THREE@#\"$(O3FLAGS)\"#1" \ ++ -e "s#@LI-OPT-TWO@#\"$(O2FLAGS)\"#1" \ ++@@ -92,7 +92,7 @@ saved_%:raw_% $(RSYM) sys_init.lsp raw_% ++ ++ cp sys_init.lsp foo ++ echo "(unless si::*quit-tags* (in-package \"USER\")(system:save-system \"$@\"))" >>foo ++- ar x lib$*.a $$(ar t lib$*.a |grep ^gcl_) +++ j=$$(ar t lib$*.a |grep ^gcl_);[ "$$j" = "" ] || ar x lib$*.a $$j #accelerator ++ $(PORTDIR)/raw_$*$(EXE) $(PORTDIR)/ -libdir $(GCLDIR)/ < foo ++ # check that saved image can be prelinked ++ [ "$(PRELINK_CHECK)" = "" ] || \ ++--- gcl-2.6.12.orig/unixport/sys.c +++++ gcl-2.6.12/unixport/sys.c ++@@ -15,16 +15,6 @@ ar_init_fn(void (fn)(void),const char *s ++ if (stat(s,&ss)) { ++ assert(snprintf(b,sizeof(b),"ar x %-.*slib%sgcl.a %s",sysd->st.st_fillp,sysd->st.st_self,FLAVOR,s)>0); ++ assert(!msystem(b)); ++-#ifdef _WIN32 ++- if (sSAwine_detectedA->s.s_dbind!=Cnil) { ++- char *n; ++- unsigned l; ++- l=strlen(s)+6; ++- n=alloca(l); ++- snprintf(n,l,"/tmp/%s",s); ++- s=(void *)n; ++- } ++-#endif ++ } ++ gcl_init_or_load1(fn,s); ++ assert(!unlink(s)); diff --cc debian/patches/pathnames1.6 index 00000000,00000000..a5aab6c5 new file mode 100644 --- /dev/null +++ b/debian/patches/pathnames1.6 @@@ -1,0 -1,0 +1,42 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-42) unstable; urgency=medium ++ . ++ * pathnames1.6 ++ * Bug fix: "FTBFS with bindnow and PIE enabled", thanks to Balint Reczey ++ (Closes: #837481). ++ * Bug fix: "FTBFS with compilers that default to -fPIE (patch ++ attached)", thanks to Adam Conrad (Closes: #822820). ++Author: Camm Maguire ++Bug-Debian: https://bugs.debian.org/822820 ++Bug-Debian: https://bugs.debian.org/837481 ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2016-10-26 ++ ++--- gcl-2.6.12.orig/o/makefile +++++ gcl-2.6.12/o/makefile ++@@ -34,7 +34,7 @@ boot.o: boot.c $(DECL) boot.h ++ $(CC) -c $(CFLAGS) $(DEFS) -fPIC $*.c $(AUX_INFO) ++ ++ prelink.o: prelink.c $(DECL) ++- $(CC) -fPIE -c $(filter-out -pg,$(CFLAGS)) $(DEFS) $*.c $(AUX_INFO) +++ $(CC) -c $(filter-out -pg,$(CFLAGS)) -fPIE $(DEFS) $*.c $(AUX_INFO) ++ ++ %.o: %.c $(DECL) ++ $(CC) -c $(CFLAGS) $(DEFS) $*.c $(AUX_INFO) diff --cc debian/patches/pathnames1.7 index 00000000,00000000..64d424ab new file mode 100644 --- /dev/null +++ b/debian/patches/pathnames1.7 @@@ -1,0 -1,0 +1,601 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-42) unstable; urgency=medium ++ . ++ * pathnames1.6 ++ * Bug fix: "FTBFS with bindnow and PIE enabled", thanks to Balint Reczey ++ (Closes: #837481). ++ * Bug fix: "FTBFS with compilers that default to -fPIE (patch ++ attached)", thanks to Adam Conrad (Closes: #822820). ++Author: Camm Maguire ++Bug-Debian: https://bugs.debian.org/822820 ++Bug-Debian: https://bugs.debian.org/837481 ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2016-10-27 ++ ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -3853,9 +3853,8 @@ if echo $GCL_CC |grep gcc |grep -q win; ++ fi ++ ++ ++-add_arg_to_tcflags() { +++add_arg_to_cflags() { ++ ++- local i=1 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFLAG $1" >&5 ++ $as_echo_n "checking for CFLAG $1... " >&6; } ++ CFLAGS_ORI=$CFLAGS ++@@ -3877,8 +3876,8 @@ main () ++ } ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++- TCFLAGS="$TCFLAGS $1";{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++-$as_echo "yes" >&6; };i=0 +++ CFLAGS="$CFLAGS_ORI $1";{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +++$as_echo "yes" >&6; };return 0 ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++ $as_echo "no" >&6; } ++@@ -3888,27 +3887,26 @@ rm -f core *.core core.conftest.* gmon.o ++ fi ++ ++ CFLAGS=$CFLAGS_ORI ++- return $i +++ return 1 ++ ++ } ++ ++-assert_arg_to_tcflags() { ++- if ! add_arg_to_tcflags $1 ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot add $1 to CFLAGS" >&5 +++assert_arg_to_cflags() { +++ if ! add_arg_to_cflags $1 ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot add $1 to CFLAGS" >&5 ++ $as_echo "cannot add $1 to CFLAGS" >&6; }; exit 1 ; fi ++ return 0 ++ } ++ ++-add_args_to_tcflags() { +++add_args_to_cflags() { ++ ++ while test "$#" -ge 1 ; do ++- add_arg_to_tcflags $1 +++ add_arg_to_cflags $1 ++ shift ++ done ++ } ++ ++-add_arg_to_tldflags() { +++add_arg_to_ldflags() { ++ ++- local i=1 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for LDFLAG $1" >&5 ++ $as_echo_n "checking for LDFLAG $1... " >&6; } ++ LDFLAGS_ORI=$LDFLAGS ++@@ -3929,8 +3927,8 @@ main () ++ } ++ _ACEOF ++ if ac_fn_c_try_run "$LINENO"; then : ++- TLDFLAGS="$TLDFLAGS $1";{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++-$as_echo "yes" >&6; };i=0 +++ LDFLAGS="$LDFLAGS_ORI $1";{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +++$as_echo "yes" >&6; };return 0 ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++ $as_echo "no" >&6; } ++@@ -3940,20 +3938,20 @@ rm -f core *.core core.conftest.* gmon.o ++ fi ++ ++ LDFLAGS=$LDFLAGS_ORI ++- return $i +++ return 1 ++ ++ } ++ ++-assert_arg_to_tldflags() { ++- if ! add_arg_to_tldflags $1 ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot add $1 to LDFLAGS" >&5 +++assert_arg_to_ldflags() { +++ if ! add_arg_to_ldflags $1 ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot add $1 to LDFLAGS" >&5 ++ $as_echo "cannot add $1 to LDFLAGS" >&6; }; exit 1 ; fi ++ return 0 ++ } ++ ++-add_args_to_tldflags() { +++add_args_to_ldflags() { ++ ++ while test "$#" -ge 1 ; do ++- add_arg_to_tldflags $1 +++ add_arg_to_ldflags $1 ++ shift ++ done ++ } ++@@ -3975,16 +3973,14 @@ $as_echo "removing $1 from LDFLAGS" >&6; ++ ++ } ++ ++-TCFLAGS="" ++-add_args_to_tcflags -fsigned-char -pipe \ +++add_args_to_cflags -fsigned-char -pipe \ ++ -fno-builtin-malloc -fno-builtin-free \ ++ -fno-PIE -fno-pie -fno-PIC -fno-pic \ ++ -Wall \ ++ -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign \ ++ -Wno-unused-but-set-variable -Wno-misleading-indentation ++ ++-TLDFLAGS="" ++-add_args_to_tldflags -Wl,-no_pie -no-pie -Wl,-z,lazy +++add_args_to_ldflags -Wl,-no_pie -no-pie -Wl,-z,lazy ++ ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for clang" >&5 ++ $as_echo_n "checking for clang... " >&6; } ++@@ -4032,29 +4028,29 @@ fi ++ ++ case $use in ++ *mingw*) ++- assert_arg_to_tcflags -fno-zero-initialized-in-bss ++- assert_arg_to_tcflags -mms-bitfields;; +++ assert_arg_to_cflags -fno-zero-initialized-in-bss +++ assert_arg_to_cflags -mms-bitfields;; ++ *gnuwin*) ++- assert_arg_to_tcflags -fno-zero-initialized-in-bss ++- assert_arg_to_tcflags -mms-bitfields ++- assert_arg_to_tldflags -Wl,--stack,8000000;; +++ assert_arg_to_cflags -fno-zero-initialized-in-bss +++ assert_arg_to_cflags -mms-bitfields +++ assert_arg_to_ldflags -Wl,--stack,8000000;; ++ 386-macosx) ++- assert_arg_to_tldflags -Wl,-no_pie +++ assert_arg_to_ldflags -Wl,-no_pie ++ if test "$build_cpu" = "x86_64" ; then ++- assert_arg_to_tcflags -m64 ++- assert_arg_to_tldflags -m64 ++- assert_arg_to_tldflags -Wl,-headerpad,72 +++ assert_arg_to_cflags -m64 +++ assert_arg_to_ldflags -m64 +++ assert_arg_to_ldflags -Wl,-headerpad,72 ++ else ++- assert_arg_to_tcflags -m32 ++- assert_arg_to_tldflags -m32 ++- assert_arg_to_tldflags -Wl,-headerpad,56 +++ assert_arg_to_cflags -m32 +++ assert_arg_to_ldflags -m32 +++ assert_arg_to_ldflags -Wl,-headerpad,56 ++ fi;; ++- FreeBSD) assert_arg_to_tldflags -Z;; +++ FreeBSD) assert_arg_to_ldflags -Z;; ++ esac ++ ++ if test "$enable_static" = "yes" ; then ++- assert_arg_to_tldflags -static ++- assert_arg_to_tldflags -Wl,-zmuldefs +++ assert_arg_to_ldflags -static +++ assert_arg_to_ldflags -Wl,-zmuldefs ++ ++ $as_echo "#define STATIC_LINKING 1" >>confdefs.h ++ ++@@ -4148,7 +4144,7 @@ cat >>confdefs.h <<_ACEOF ++ #define GCL_GPROF_START $GCL_GPROF_START ++ _ACEOF ++ ++- assert_arg_to_tcflags -pg +++ assert_arg_to_cflags -pg ++ case $use in ++ s390*) ;; # relocation truncation bug in gcc ++ *) TLIBS="$TLIBS -pg";; ++@@ -4164,7 +4160,7 @@ fi ++ ++ ++ if test "$enable_debug" = "yes" ; then ++- assert_arg_to_tcflags -g +++ assert_arg_to_cflags -g ++ # for subconfigurations ++ CFLAGS="$CFLAGS -g" ++ else ++@@ -4175,41 +4171,41 @@ fi ++ # gcc on ppc cannot compile our new_init.c with full opts --CM ++ TONIFLAGS="" ++ case $use in ++- powerpc*macosx) assert_arg_to_tcflags -mlongcall;; +++ powerpc*macosx) assert_arg_to_cflags -mlongcall;; ++ *linux) ++ case $use in ++ alpha*) ++- assert_arg_to_tcflags -mieee +++ assert_arg_to_cflags -mieee ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1 ++ ;; ++ aarch64*) ++ TLIBS="$TLIBS -lgcc_s";; ++ hppa*) ++- assert_arg_to_tcflags -mlong-calls +++ assert_arg_to_cflags -mlong-calls ++ TLIBS="$TLIBS -lgcc_s" # workaround hppa __moddi3 local func symbols with default linker flags ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O2" ; TFPFLAG=""; fi #FIXME needed asof gcc 4.8.1 ++ ;; ++ mips*) ++ case $canonical in ++ mips64*linux*) ++- assert_arg_to_tldflags -Wl,-z,now;; +++ assert_arg_to_ldflags -Wl,-z,now;; ++ esac ++ ;; ++ ia64*) ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 ++ ;; ++ arm*) ++- assert_arg_to_tcflags -mlong-calls ++- assert_arg_to_tcflags -fdollars-in-identifiers ++- assert_arg_to_tcflags -g #? +++ assert_arg_to_cflags -mlong-calls +++ assert_arg_to_cflags -fdollars-in-identifiers +++ assert_arg_to_cflags -g #? ++ ;; ++ powerpc*) ++- assert_arg_to_tcflags -mlongcall +++ assert_arg_to_cflags -mlongcall ++ ;; ++ esac;; ++ esac ++ if test "$enable_pic" = "yes" ; then ++- assert_arg_to_tcflags -fPIC +++ assert_arg_to_cflags -fPIC ++ fi ++ ++ ++@@ -5385,7 +5381,7 @@ fi ++ ++ ++ TLIBS="$TLIBS -ldl -rdynamic" ++- assert_arg_to_tcflags -fPIC +++ assert_arg_to_cflags -fPIC ++ ++ $as_echo "#define USE_DLOPEN 1" >>confdefs.h ++ ++@@ -5869,7 +5865,7 @@ $as_echo "#define HAVE_XDR 1" >>confdefs ++ ++ if test "$XDR_LIB" != " "; then ++ TLIBS="$TLIBS -l$XDR_LIB" ++- add_arg_to_tcflags -I/usr/include/$XDR_LIB +++ add_arg_to_cflags -I/usr/include/$XDR_LIB ++ fi ++ fi ++ fi ++@@ -6935,7 +6931,7 @@ if test "$use" != "386-gnu" ; then #hurd ++ $as_echo_n "checking finding default linker script... " >&6; } ++ touch unixport/gcl.script ++ echo "int main() {return 0;}" >foo.c ++- $CC $TLDFLAGS -Wl,--verbose foo.c -o foo 2>&1 | \ +++ $CC $LDFLAGS -Wl,--verbose foo.c -o foo 2>&1 | \ ++ $AWK '/\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=/ {i=1-i;next} {if (i) print}' >gcl.script ++ rm -rf foo.c foo ++ ++@@ -6956,7 +6952,7 @@ $as_echo "$as_me: trying to adjust text ++ cat gcl.script.def | $AWK '/SIZEOF_HEADERS/ {gsub("0x[0-9]*","0x" j,$0);} {print}' j=$j >gcl.script ++ # diff -u gcl.script.def gcl.script ++ echo "int main() {return 0;}" >foo.c ++- if ( $CC $TLDFLAGS -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then +++ if ( $CC $LDFLAGS -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then ++ if test $n -lt $min ; then min=$n; fi; ++ if test $n -gt $max; then max=$n; fi; ++ elif test $max -gt 0 ; then ++@@ -7020,7 +7016,7 @@ $as_echo_n "checking our linker script.. ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: done" >&5 ++ $as_echo "done" >&6; } ++ rm -f gcl.script.def ++- LDFLAGS="$LDFLAGS -Wl,-T gcl.script " +++ assert_arg_to_ldflags -Wl,-T,gcl.script ++ cp gcl.script unixport ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: none found or not needed" >&5 ++@@ -9065,16 +9061,16 @@ fi ++ ++ ++ ++-LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'` $TLDFLAGS" +++LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'`" ++ ++ LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $LIBS $TLIBS" ++ ++-FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS $TCFLAGS" +++FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS" ++ ++ # Work around bug with gcc on ppc -- CM ++-NIFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TONIFLAGS -I\$(GCLDIR)/o" +++NIFLAGS="$CFLAGS $CPPFLAGS $TONIFLAGS -I\$(GCLDIR)/o" ++ ++-CFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TO3FLAGS -I\$(GCLDIR)/o" +++CFLAGS="$CFLAGS $CPPFLAGS $TO3FLAGS -I\$(GCLDIR)/o" ++ ++ O3FLAGS=$TO3FLAGS ++ ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -185,60 +185,58 @@ if echo $GCL_CC |grep gcc |grep -q win; ++ fi ++ AC_SUBST(GCL_CC) ++ ++-add_arg_to_tcflags() { +++add_arg_to_cflags() { ++ ++- local i=1 ++ AC_MSG_CHECKING([for CFLAG $1]) ++ CFLAGS_ORI=$CFLAGS ++ CFLAGS="$CFLAGS -Werror $1 `echo $1|sed 's,-Wno-,-W,1'`" ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM([[]],[[]])], ++- [TCFLAGS="$TCFLAGS $1";AC_MSG_RESULT([yes]);i=0], +++ [CFLAGS="$CFLAGS_ORI $1";AC_MSG_RESULT([yes]);return 0], ++ [AC_MSG_RESULT([no])], ++ [AC_MSG_RESULT([no])]) ++ CFLAGS=$CFLAGS_ORI ++- return $i +++ return 1 ++ ++ } ++ ++-assert_arg_to_tcflags() { ++- if ! add_arg_to_tcflags $1 ; then AC_MSG_RESULT([cannot add $1 to CFLAGS]); exit 1 ; fi +++assert_arg_to_cflags() { +++ if ! add_arg_to_cflags $1 ; then AC_MSG_RESULT([cannot add $1 to CFLAGS]); exit 1 ; fi ++ return 0 ++ } ++ ++-add_args_to_tcflags() { +++add_args_to_cflags() { ++ ++ while test "$#" -ge 1 ; do ++- add_arg_to_tcflags $1 +++ add_arg_to_cflags $1 ++ shift ++ done ++ } ++ ++-add_arg_to_tldflags() { +++add_arg_to_ldflags() { ++ ++- local i=1 ++ AC_MSG_CHECKING([for LDFLAG $1]) ++ LDFLAGS_ORI=$LDFLAGS ++ LDFLAGS="$LDFLAGS -Werror $1" ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM([[]],[[]])], ++- [TLDFLAGS="$TLDFLAGS $1";AC_MSG_RESULT([yes]);i=0], +++ [LDFLAGS="$LDFLAGS_ORI $1";AC_MSG_RESULT([yes]);return 0], ++ [AC_MSG_RESULT([no])], ++ [AC_MSG_RESULT([no])]) ++ LDFLAGS=$LDFLAGS_ORI ++- return $i +++ return 1 ++ ++ } ++ ++-assert_arg_to_tldflags() { ++- if ! add_arg_to_tldflags $1 ; then AC_MSG_RESULT([cannot add $1 to LDFLAGS]); exit 1 ; fi +++assert_arg_to_ldflags() { +++ if ! add_arg_to_ldflags $1 ; then AC_MSG_RESULT([cannot add $1 to LDFLAGS]); exit 1 ; fi ++ return 0 ++ } ++ ++-add_args_to_tldflags() { +++add_args_to_ldflags() { ++ ++ while test "$#" -ge 1 ; do ++- add_arg_to_tldflags $1 +++ add_arg_to_ldflags $1 ++ shift ++ done ++ } ++@@ -259,16 +257,14 @@ remove_arg_from_ldflags() { ++ ++ } ++ ++-TCFLAGS="" ++-add_args_to_tcflags -fsigned-char -pipe \ +++add_args_to_cflags -fsigned-char -pipe \ ++ -fno-builtin-malloc -fno-builtin-free \ ++ -fno-PIE -fno-pie -fno-PIC -fno-pic \ ++ -Wall \ ++ -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign \ ++ -Wno-unused-but-set-variable -Wno-misleading-indentation ++ ++-TLDFLAGS="" ++-add_args_to_tldflags -Wl,-no_pie -no-pie -Wl,-z,lazy +++add_args_to_ldflags -Wl,-no_pie -no-pie -Wl,-z,lazy ++ ++ AC_MSG_CHECKING([for clang]) ++ AC_RUN_IFELSE( ++@@ -290,29 +286,29 @@ AC_RUN_IFELSE( ++ ++ case $use in ++ *mingw*) ++- assert_arg_to_tcflags -fno-zero-initialized-in-bss ++- assert_arg_to_tcflags -mms-bitfields;; +++ assert_arg_to_cflags -fno-zero-initialized-in-bss +++ assert_arg_to_cflags -mms-bitfields;; ++ *gnuwin*) ++- assert_arg_to_tcflags -fno-zero-initialized-in-bss ++- assert_arg_to_tcflags -mms-bitfields ++- assert_arg_to_tldflags -Wl,--stack,8000000;; +++ assert_arg_to_cflags -fno-zero-initialized-in-bss +++ assert_arg_to_cflags -mms-bitfields +++ assert_arg_to_ldflags -Wl,--stack,8000000;; ++ 386-macosx) ++- assert_arg_to_tldflags -Wl,-no_pie +++ assert_arg_to_ldflags -Wl,-no_pie ++ if test "$build_cpu" = "x86_64" ; then ++- assert_arg_to_tcflags -m64 ++- assert_arg_to_tldflags -m64 ++- assert_arg_to_tldflags -Wl,-headerpad,72 +++ assert_arg_to_cflags -m64 +++ assert_arg_to_ldflags -m64 +++ assert_arg_to_ldflags -Wl,-headerpad,72 ++ else ++- assert_arg_to_tcflags -m32 ++- assert_arg_to_tldflags -m32 ++- assert_arg_to_tldflags -Wl,-headerpad,56 +++ assert_arg_to_cflags -m32 +++ assert_arg_to_ldflags -m32 +++ assert_arg_to_ldflags -Wl,-headerpad,56 ++ fi;; ++- FreeBSD) assert_arg_to_tldflags -Z;; +++ FreeBSD) assert_arg_to_ldflags -Z;; ++ esac ++ ++ if test "$enable_static" = "yes" ; then ++- assert_arg_to_tldflags -static ++- assert_arg_to_tldflags -Wl,-zmuldefs +++ assert_arg_to_ldflags -static +++ assert_arg_to_ldflags -Wl,-zmuldefs ++ AC_DEFINE(STATIC_LINKING,1,[staticly linked images]) ++ fi ++ ++@@ -353,7 +349,7 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof ++ if test "$GCL_GPROF_START" != "" ; then ++ AC_MSG_RESULT($GCL_GPROF_START) ++ AC_DEFINE_UNQUOTED(GCL_GPROF_START,$GCL_GPROF_START,[starting address for gprof]) ++- assert_arg_to_tcflags -pg +++ assert_arg_to_cflags -pg ++ case $use in ++ s390*) ;; # relocation truncation bug in gcc ++ *) TLIBS="$TLIBS -pg";; ++@@ -365,7 +361,7 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof ++ fi]) ++ ++ if test "$enable_debug" = "yes" ; then ++- assert_arg_to_tcflags -g +++ assert_arg_to_cflags -g ++ # for subconfigurations ++ CFLAGS="$CFLAGS -g" ++ else ++@@ -376,41 +372,41 @@ fi ++ # gcc on ppc cannot compile our new_init.c with full opts --CM ++ TONIFLAGS="" ++ case $use in ++- powerpc*macosx) assert_arg_to_tcflags -mlongcall;; +++ powerpc*macosx) assert_arg_to_cflags -mlongcall;; ++ *linux) ++ case $use in ++ alpha*) ++- assert_arg_to_tcflags -mieee +++ assert_arg_to_cflags -mieee ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1 ++ ;; ++ aarch64*) ++ TLIBS="$TLIBS -lgcc_s";; ++ hppa*) ++- assert_arg_to_tcflags -mlong-calls +++ assert_arg_to_cflags -mlong-calls ++ TLIBS="$TLIBS -lgcc_s" # workaround hppa __moddi3 local func symbols with default linker flags ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O2" ; TFPFLAG=""; fi #FIXME needed asof gcc 4.8.1 ++ ;; ++ mips*) ++ case $canonical in ++ mips64*linux*) ++- assert_arg_to_tldflags -Wl,-z,now;; +++ assert_arg_to_ldflags -Wl,-z,now;; ++ esac ++ ;; ++ ia64*) ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 ++ ;; ++ arm*) ++- assert_arg_to_tcflags -mlong-calls ++- assert_arg_to_tcflags -fdollars-in-identifiers ++- assert_arg_to_tcflags -g #? +++ assert_arg_to_cflags -mlong-calls +++ assert_arg_to_cflags -fdollars-in-identifiers +++ assert_arg_to_cflags -g #? ++ ;; ++ powerpc*) ++- assert_arg_to_tcflags -mlongcall +++ assert_arg_to_cflags -mlongcall ++ ;; ++ esac;; ++ esac ++ if test "$enable_pic" = "yes" ; then ++- assert_arg_to_tcflags -fPIC +++ assert_arg_to_cflags -fPIC ++ fi ++ ++ ++@@ -715,7 +711,7 @@ if test "$enable_dlopen" = "yes" ; then ++ AC_CHECK_LIB([dl],[dlopen],,AC_MSG_ERROR([Cannot find dlopen])) ++ ++ TLIBS="$TLIBS -ldl -rdynamic" ++- assert_arg_to_tcflags -fPIC +++ assert_arg_to_cflags -fPIC ++ AC_DEFINE(USE_DLOPEN,1,[link compiled objects via libdl]) ++ ++ fi ++@@ -834,7 +830,7 @@ if test "$enable_xdr" != "no" ; then ++ AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) ++ if test "$XDR_LIB" != " "; then ++ TLIBS="$TLIBS -l$XDR_LIB" ++- add_arg_to_tcflags -I/usr/include/$XDR_LIB +++ add_arg_to_cflags -I/usr/include/$XDR_LIB ++ fi ++ fi ++ fi ++@@ -1345,7 +1341,7 @@ if test "$use" != "386-gnu" ; then #hurd ++ AC_MSG_CHECKING([finding default linker script]) ++ touch unixport/gcl.script ++ echo "int main() {return 0;}" >foo.c ++- $CC $TLDFLAGS -Wl,--verbose foo.c -o foo 2>&1 | \ +++ $CC $LDFLAGS -Wl,--verbose foo.c -o foo 2>&1 | \ ++ $AWK '/\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=/ {i=1-i;next} {if (i) print}' >gcl.script ++ rm -rf foo.c foo ++ ++@@ -1364,7 +1360,7 @@ if test "$use" != "386-gnu" ; then #hurd ++ cat gcl.script.def | $AWK '/SIZEOF_HEADERS/ {gsub("0x[[0-9]]*","0x" j,$0);} {print}' j=$j >gcl.script ++ # diff -u gcl.script.def gcl.script ++ echo "int main() {return 0;}" >foo.c ++- if ( $CC $TLDFLAGS -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then +++ if ( $CC $LDFLAGS -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then ++ if test $n -lt $min ; then min=$n; fi; ++ if test $n -gt $max; then max=$n; fi; ++ elif test $max -gt 0 ; then ++@@ -1409,7 +1405,7 @@ if test "$use" != "386-gnu" ; then #hurd ++ cat gcl.script.def | $AWK '/SIZEOF_HEADERS/ {gsub("0x[[0-9]]*","0x" j,$0);} {print}' j=$j >gcl.script ++ AC_MSG_RESULT([done]) ++ rm -f gcl.script.def ++- LDFLAGS="$LDFLAGS -Wl,-T gcl.script " +++ assert_arg_to_ldflags -Wl,-T,gcl.script ++ cp gcl.script unixport ++ else ++ AC_MSG_RESULT([none found or not needed]) ++@@ -2116,16 +2112,16 @@ AC_CHECK_HEADERS(alloca.h) ++ AC_FUNC_ALLOCA ++ ++ ++-LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'` $TLDFLAGS" +++LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'`" ++ AC_SUBST(LDFLAGS) ++ LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $LIBS $TLIBS" ++ AC_SUBST(LIBS) ++-FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS $TCFLAGS" +++FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS" ++ AC_SUBST(FINAL_CFLAGS) ++ # Work around bug with gcc on ppc -- CM ++-NIFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TONIFLAGS -I\$(GCLDIR)/o" +++NIFLAGS="$CFLAGS $CPPFLAGS $TONIFLAGS -I\$(GCLDIR)/o" ++ AC_SUBST(NIFLAGS) ++-CFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TO3FLAGS -I\$(GCLDIR)/o" +++CFLAGS="$CFLAGS $CPPFLAGS $TO3FLAGS -I\$(GCLDIR)/o" ++ AC_SUBST(CFLAGS) ++ O3FLAGS=$TO3FLAGS ++ AC_SUBST(O3FLAGS) diff --cc debian/patches/pathnames1.9 index 00000000,00000000..71ee3bd1 new file mode 100644 --- /dev/null +++ b/debian/patches/pathnames1.9 @@@ -1,0 -1,0 +1,5609 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-43) unstable; urgency=medium ++ . ++ * pathnames1.7 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2016-10-28 ++ ++--- gcl-2.6.12.orig/ansi-tests/ansi-aux.lsp +++++ gcl-2.6.12/ansi-tests/ansi-aux.lsp ++@@ -1635,3 +1635,6 @@ the condition to go uncaught if it canno ++ ++ (defmacro expand-in-current-env (macro-form &environment env) ++ (macroexpand macro-form env)) +++ +++(defun typep* (element type) +++ (not (not (typep element type)))) ++--- gcl-2.6.12.orig/clcs/sys-proclaim.lisp +++++ gcl-2.6.12/clcs/sys-proclaim.lisp ++@@ -2,30 +2,14 @@ ++ (COMMON-LISP::IN-PACKAGE "CONDITIONS") ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++- CONDITIONS::IS-WARNING CONDITIONS::DEFAULT-REPORT ++- CONDITIONS::IS-CONDITION CONDITIONS::CONDITIONP)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ CONDITIONS::COERCE-TO-FN CONDITIONS::SLOT-SYM)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ARITHMETIC-ERROR T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PACKAGE-ERROR T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-CONDITION T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNDEFINED-FUNCTION T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-SLOT T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-VARIABLE T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CASE-FAILURE T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PRINT-NOT-READABLE T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (SIMPLE-CONDITION T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ABORT-FAILURE T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (TYPE-ERROR T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CELL-ERROR T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (FILE-ERROR T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (END-OF-FILE T))| ++- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (STREAM-ERROR T))|)) +++ COMMON-LISP::MAKE-CONDITION)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++@@ -36,11 +20,27 @@ ++ CONDITIONS::|(PCL::FAST-METHOD MAKE-LOAD-FORM (CONDITION))|)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::T) ++- CONDITIONS::COERCE-TO-FN CONDITIONS::SLOT-SYM)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +++ CONDITIONS::IS-CONDITION CONDITIONS::DEFAULT-REPORT +++ CONDITIONS::IS-WARNING CONDITIONS::CONDITIONP)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) ++ COMMON-LISP::*) ++- COMMON-LISP::MAKE-CONDITION)) ++\ No newline at end of file +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PACKAGE-ERROR T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CASE-FAILURE T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ABORT-FAILURE T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (FILE-ERROR T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-VARIABLE T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ARITHMETIC-ERROR T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (END-OF-FILE T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (STREAM-ERROR T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CELL-ERROR T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (SIMPLE-CONDITION T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-SLOT T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNDEFINED-FUNCTION T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-CONDITION T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PRINT-NOT-READABLE T))| +++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (TYPE-ERROR T))|)) ++\ No newline at end of file ++--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp +++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp ++@@ -430,7 +430,7 @@ Cannot compile ~a.~%" ++ (si::copy-stream st *standard-output*)) ++ (with-open-file (st hn) ++ (si::copy-stream st *standard-output*)) ++- (when (eql (aref *objdump* 0) #\/);program found at startup in path +++ (when *objdump* ++ (safe-system (si::string-concatenate *objdump* (namestring on)))) ++ (mdelete-file cn) ++ (mdelete-file dn) ++--- gcl-2.6.12.orig/cmpnew/gcl_lfun_list.lsp +++++ gcl-2.6.12/cmpnew/gcl_lfun_list.lsp ++@@ -43,7 +43,6 @@ ++ (DEFSYSFUN 'RASSOC "Lrassoc" '(T T *) 'T NIL NIL) ++ (DEFSYSFUN 'PPRINT "Lpprint" '(T *) 'T NIL NIL) ++ (DEFSYSFUN 'NSUBST-IF-NOT "Lnsubst_if_not" '(T T T *) 'T NIL NIL) ++-(DEFSYSFUN 'FILE-POSITION "Lfile_position" '(T *) 'T NIL NIL) ++ (DEFSYSFUN 'STRING< "Lstring_l" '(T T *) 'T NIL NIL) ++ (DEFSYSFUN 'REVERSE "Lreverse" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'STREAMP "Lstreamp" '(T) 'T NIL T) ++@@ -67,7 +66,6 @@ ++ (DEFSYSFUN 'CONS "Lcons" '(T T) 'T NIL NIL) ++ (DEFSYSFUN 'LIST "Llist" '(*) 'T NIL NIL) ++ (DEFSYSFUN 'USE-PACKAGE "Luse_package" '(T *) 'T NIL NIL) ++-(DEFSYSFUN 'FILE-LENGTH "Lfile_length" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'MAKE-SYMBOL "Lmake_symbol" '(T) 'T NIL NIL) ++ (DEFSYSFUN 'STRING-RIGHT-TRIM "Lstring_right_trim" '(T T) 'STRING NIL ++ NIL) ++--- gcl-2.6.12.orig/cmpnew/sys-proclaim.lisp +++++ gcl-2.6.12/cmpnew/sys-proclaim.lisp ++@@ -2,376 +2,394 @@ ++ (COMMON-LISP::IN-PACKAGE "COMPILER") ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::STRING COMMON-LISP::*) ++- COMMON-LISP::T) ++- COMPILER::TS)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++- COMPILER::C1MULTIPLE-VALUE-BIND COMPILER::C1VALUES ++- COMPILER::C1RPLACA COMPILER::FUN-P ++- COMPILER::FUNCTION-ARG-TYPES COMPILER::C1STRUCTURE-REF ++- COMPILER::GET-RETURN-TYPE COMPILER::WT-FUNCALL-C ++- COMPILER::MACRO-DEF-P COMPILER::T1DEFUN COMPILER::C1ASSOC ++- COMPILER::SET-UP-VAR-CVS COMPILER::C2FUNCTION ++- COMPILER::C1DM-BAD-KEY COMPILER::ADD-OBJECT ++- COMPILER::WT-SWITCH-CASE COMPILER::VARARG-P ++- COMPILER::C1TAGBODY COMPILER::C2GET COMPILER::VAR-REF ++- COMPILER::SCH-LOCAL-FUN COMPILER::ADD-SYMBOL ++- COMPILER::TAG-UNWIND-EXIT COMPILER::C1MULTIPLE-VALUE-SETQ ++- COMPILER::C1PRINC COMPILER::WT-VAR-DECL COMPILER::C1QUOTE ++- COMPILER::C2RPLACD COMPILER::CHECK-VREF ++- COMPILER::PUSH-ARGS-LISPCALL COMPILER::C1MAPLIST ++- COMPILER::ADD-REG1 COMPILER::C1OR COMPILER::WT-SYMBOL-FUNCTION ++- COMPILER::TAG-P COMPILER::SAFE-SYSTEM COMPILER::C1ECASE ++- COMPILER::LTVP COMPILER::GET-INCLUDED COMPILER::INFO-P ++- COMPILER::FUN-INFO COMPILER::C1LOAD-TIME-VALUE ++- COMPILER::GET-LOCAL-ARG-TYPES COMPILER::BLK-P ++- COMPILER::BLK-EXIT COMPILER::C2VAR-KIND COMPILER::C2LOCATION ++- COMPILER::WT1 COMPILER::WT-CCB-VS ++- COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::BLK-REF-CCB ++- COMPILER::UNDEFINED-VARIABLE COMPILER::C1MULTIPLE-VALUE-CALL ++- COMPILER::VAR-LOC COMPILER::C1SETQ COMPILER::C1NTH-CONDITION ++- COMPILER::C2RPLACA COMPILER::FUN-REF COMPILER::C2VAR ++- COMPILER::WT-CAR COMPILER::WT-LIST COMPILER::WRITE-BLOCK-OPEN ++- COMPILER::INFO-VOLATILE COMPILER::GET-LOCAL-RETURN-TYPE ++- COMPILER::AET-C-TYPE COMPILER::PUSH-ARGS COMPILER::TAG-REF-CLB ++- COMPILER::BLK-REF COMPILER::VAR-P COMPILER::C1ADD-GLOBALS ++- COMPILER::T3ORDINARY COMPILER::ADD-OBJECT2 COMPILER::SET-TOP ++- COMPILER::T1DEFLA COMPILER::C1FUNCTION COMPILER::T3CLINES ++- COMPILER::T1DEFCFUN COMPILER::C1VREF COMPILER::C1ASH ++- COMPILER::BLK-NAME COMPILER::WT-CADR COMPILER::WT-DOWN ++- COMPILER::C1TERPRI COMPILER::C2GETHASH COMPILER::C2GO-CCB ++- COMPILER::SAVE-FUNOB COMPILER::T2DECLARE COMPILER::FUN-REF-CCB ++- COMPILER::C1MAPCAR COMPILER::T1DEFMACRO ++- COMPILER::C2TAGBODY-LOCAL COMPILER::C1STACK-LET ++- COMPILER::INFO-TYPE COMPILER::T1MACROLET COMPILER::C1LET* ++- COMPILER::C1RPLACD COMPILER::DECLARATION-TYPE ++- COMPILER::T1ORDINARY COMPILER::C2EXPR* COMPILER::C1LOCAL-FUN ++- COMPILER::WT-DATA-PACKAGE-OPERATION ++- COMPILER::C1BOOLE-CONDITION SYSTEM::UNDEF-COMPILER-MACRO ++- COMPILER::C2TAGBODY-BODY COMPILER::C1NTHCDR COMPILER::C1VAR ++- COMPILER::C1MULTIPLE-VALUE-PROG1 COMPILER::C1NTHCDR-CONDITION ++- COMPILER::CONSTANT-FOLD-P COMPILER::C1UNWIND-PROTECT ++- COMPILER::PROCLAMATION COMPILER::C1NTH COMPILER::C1RETURN-FROM ++- COMPILER::INFO-SP-CHANGE COMPILER::C1LENGTH ++- COMPILER::CMP-MACRO-FUNCTION COMPILER::BLK-REF-CLB ++- COMPILER::NAME-TO-SD COMPILER::CTOP-WRITE COMPILER::C1MAPCON ++- COMPILER::C1FUNOB COMPILER::FIX-OPT COMPILER::C1RPLACA-NTHCDR ++- COMPILER::C1FLET COMPILER::RESULT-TYPE COMPILER::C1CATCH ++- COMPILER::C2DM-RESERVE-V COMPILER::VAR-NAME ++- COMPILER::CMP-MACROEXPAND COMPILER::VERIFY-DATA-VECTOR ++- COMPILER::T1CLINES COMPILER::C1MAPL COMPILER::T1DEFENTRY ++- COMPILER::TAG-REF-CCB COMPILER::WT-VS ++- COMPILER::LONG-FLOAT-LOC-P COMPILER::C1MAPCAN ++- COMPILER::OBJECT-TYPE COMPILER::ADD-ADDRESS ++- COMPILER::RESET-INFO-TYPE COMPILER::C1BOOLE3 COMPILER::C1MEMQ ++- COMPILER::C1DEFINE-STRUCTURE COMPILER::TYPE-FILTER ++- COMPILER::UNWIND-NO-EXIT COMPILER::C1FMLA-CONSTANT ++- COMPILER::C2DM-RESERVE-VL COMPILER::C1FSET COMPILER::LTVP-EVAL ++- COMPILER::C1GO COMPILER::WT-VV COMPILER::INFO-CHANGED-ARRAY ++- COMPILER::C1FUNCALL COMPILER::C2TAGBODY-CCB ++- COMPILER::TAG-LABEL COMPILER::VAR-KIND COMPILER::WT-VS* ++- COMPILER::VAR-TYPE COMPILER::C2GO-LOCAL COMPILER::REGISTER ++- COMPILER::T1PROGN COMPILER::C1BLOCK COMPILER::TAG-SWITCH ++- COMPILER::VAR-REP-LOC COMPILER::C2BIND ++- COMPILER::SET-PUSH-CATCH-FRAME COMPILER::COPY-INFO ++- COMPILER::C1LIST-NTH COMPILER::CONS-TO-LISTA ++- COMPILER::FUN-LEVEL COMPILER::C1DOWNWARD-FUNCTION ++- COMPILER::THE-PARAMETER COMPILER::C2VALUES COMPILER::C1LABELS ++- COMPILER::MAXARGS COMPILER::VAR-REF-CCB COMPILER::MDELETE-FILE ++- COMPILER::WT-FUNCTION-LINK COMPILER::SAVE-AVMA ++- COMPILER::VOLATILE COMPILER::ADD-CONSTANT COMPILER::C1APPLY ++- COMPILER::C1GETHASH COMPILER::FUN-NAME COMPILER::DEFAULT-INIT ++- COMPILER::CLINK COMPILER::WT-CDR COMPILER::PARSE-CVSPECS ++- COMPILER::REP-TYPE COMPILER::C2GO-CLB ++- COMPILER::ARGS-CAUSE-SIDE-EFFECT COMPILER::PUSH-DATA-INCF ++- COMPILER::SCH-GLOBAL COMPILER::C1STRUCTURE-SET ++- COMPILER::TAG-NAME COMPILER::INFO-REFERRED-ARRAY ++- COMPILER::C1EXPR COMPILER::C1GET COMPILER::BLK-VAR ++- COMPILER::TAG-REF COMPILER::C1MAPC COMPILER::SET-RETURN ++- COMPILER::SHORT-FLOAT-LOC-P COMPILER::C1DECLARE ++- COMPILER::WT-DATA1 COMPILER::FLAGS-POS ++- COMPILER::BLK-VALUE-TO-GO COMPILER::NAME-SD1 ++- COMPILER::C2DOWNWARD-FUNCTION COMPILER::C1SHARP-COMMA ++- COMPILER::INLINE-POSSIBLE COMPILER::WT-H1 ++- COMPILER::FIXNUM-LOC-P COMPILER::C1LET COMPILER::C1IF ++- COMPILER::C1THE COMPILER::FUNCTION-RETURN-TYPE ++- COMPILER::GET-ARG-TYPES COMPILER::INLINE-TYPE ++- COMPILER::FUN-CFUN COMPILER::TAG-VAR COMPILER::CHARACTER-LOC-P ++- COMPILER::CHECK-DOWNWARD COMPILER::C1PSETQ ++- COMPILER::INLINE-BOOLE3-STRING COMPILER::C1THROW ++- COMPILER::FSET-FN-NAME COMPILER::T1DEFINE-STRUCTURE ++- COMPILER::NEED-TO-SET-VS-POINTERS COMPILER::C1PROGN ++- COMPILER::C2FUNCALL-AUX COMPILER::C1MACROLET COMPILER::C1AND ++- COMPILER::WT-VS-BASE COMPILER::ADD-LOOP-REGISTERS ++- COMPILER::VAR-REGISTER COMPILER::C1PROGV COMPILER::C1SWITCH ++- COMPILER::C1MEMBER COMPILER::C2TAGBODY-CLB ++- COMPILER::CMP-MACROEXPAND-1 COMMON-LISP::PROCLAIM ++- COMPILER::C1ASH-CONDITION COMPILER::C1EVAL-WHEN ++- COMPILER::C1LOCAL-CLOSURE COMPILER::REPLACE-CONSTANT)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++- COMPILER::INLINE-BOOLE3)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T) ++- COMMON-LISP::*) ++- COMPILER::C2DM COMPILER::C1DM-V COMPILER::C1DM-VL ++- COMPILER::C2RETURN-FROM COMPILER::C2APPLY-OPTIMIZE)) +++ ((COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807) +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807)) +++ COMMON-LISP::T) +++ COMPILER::MLIN)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::*) ++- COMPILER::WT-INLINE COMPILER::C2IF COMPILER::C2LABELS ++- COMPILER::C2FLET)) +++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER +++ COMMON-LISP::*) +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807) +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807)) +++ COMMON-LISP::T) +++ COMPILER::DASH-TO-UNDERSCORE-INT)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::*) ++- COMPILER::T3DEFUN-AUX)) +++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER +++ COMMON-LISP::*)) +++ COMMON-LISP::T) +++ COMPILER::TS COMPILER::DASH-TO-UNDERSCORE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++- COMPILER::F-TYPE)) +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +++ COMPILER::C1NIL COMPILER::WT-DATA-FILE +++ COMPILER::CLOSE-INLINE-BLOCKS COMPILER::WT-NEXT-VAR-ARG +++ COMPILER::RESET-TOP COMPILER::VS-PUSH COMPILER::BABOON +++ COMPILER::GAZONK-NAME COMPILER::PRINT-COMPILER-INFO +++ COMPILER::ADD-LOAD-TIME-SHARP-COMMA COMPILER::INIT-ENV +++ COMPILER::PRINT-CURRENT-FORM COMPILER::WT-C-PUSH COMPILER::C1T +++ COMPILER::WT-FIRST-VAR-ARG COMPILER::CCB-VS-PUSH +++ COMPILER::INC-INLINE-BLOCKS COMPILER::WT-CVARS +++ COMPILER::WT-FASD-DATA-FILE COMPILER::WFS-ERROR +++ COMPILER::WT-DATA-END COMPILER::TAIL-RECURSION-POSSIBLE +++ COMPILER::CVS-PUSH COMPILER::WT-DATA-BEGIN)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::STRING) COMMON-LISP::T) ++- COMPILER::DASH-TO-UNDERSCORE)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::FIXNUM) +++ COMPILER::ANALYZE-REGS1 COMPILER::ANALYZE-REGS +++ COMPILER::PROCLAIMED-ARGD)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- COMPILER::INIT-NAME COMPILER::ADD-INIT COMPILER::C1LAMBDA-EXPR ++- COMPILER::WT-CVAR COMPILER::C1CASE COMPILER::WT-COMMENT ++- COMPILER::CMPERR COMPILER::WT-INTEGER-LOC COMPILER::CMPNOTE ++- COMPILER::FAST-LINK-PROCLAIMED-TYPE-P COMPILER::UNWIND-EXIT ++- COMPILER::CMPWARN)) +++ COMPILER::CHECK-FNAME-ARGS COMPILER::COERCE-LOC +++ COMPILER::TYPE>= COMPILER::C2BIND-LOC +++ COMPILER::RESULT-TYPE-FROM-ARGS COMPILER::ADD-DEBUG-INFO +++ COMPILER::MAKE-USER-INIT COMPILER::CO1EQL COMPILER::C2ASSOC!2 +++ COMPILER::WT-VAR COMPILER::CFAST-WRITE COMPILER::C2STACK-LET +++ COMPILER::C2DM-BIND-INIT COMPILER::IS-REP-REFERRED +++ COMPILER::CO1CONS COMPILER::SHIFT<< +++ COMPILER::C2MULTIPLE-VALUE-SETQ COMPILER::C2CALL-LOCAL +++ COMPILER::CO1SCHAR COMPILER::C1CONSTANT-VALUE +++ COMPILER::WT-CHARACTER-VALUE COMPILER::CONVERT-CASE-TO-SWITCH +++ COMPILER::C2MULTIPLE-VALUE-CALL COMPILER::C2EXPR-TOP +++ COMPILER::CO1READ-BYTE COMPILER::PRIN1-CMP +++ COMPILER::STRUCT-TYPE-OPT COMPILER::C1DECL-BODY +++ COMPILER::COERCE-LOC-STRUCTURE-REF +++ COMPILER::CO1STRUCTURE-PREDICATE COMPILER::WT-MAKE-DCLOSURE +++ COMPILER::ARGS-INFO-CHANGED-VARS +++ COMPILER::C2LIST-NTH-IMMEDIATE COMPILER::CO1LDB +++ COMPILER::CO1WRITE-BYTE COMPILER::C1PROGN* +++ COMPILER::CO1CONSTANT-FOLD COMPILER::SET-JUMP-TRUE +++ COMPILER::C1SETQ1 COMPILER::CO1READ-CHAR COMPILER::C2BIND-INIT +++ COMPILER::CO1TYPEP COMPILER::WT-FIXNUM-VALUE +++ COMPILER::MULTIPLE-VALUE-CHECK COMPILER::SHIFT>> +++ COMPILER::CO1SUBLIS COMPILER::DO-MACRO-EXPANSION +++ COMPILER::C2UNWIND-PROTECT COMPILER::C2CALL-LAMBDA +++ COMPILER::C2MEMBER!2 COMPILER::GET-INLINE-LOC +++ COMPILER::C1LAMBDA-FUN COMPILER::JUMPS-TO-P COMPILER::C1EXPR* +++ COMPILER::C2SETQ COMPILER::C2APPLY COMPILER::UNWIND-BDS +++ COMPILER::SET-BDS-BIND COMPILER::NEED-TO-PROTECT +++ COMPILER::C1FMLA COMPILER::TYPE-AND COMPILER::CMPFIX-ARGS +++ COMPILER::MAYBE-EVAL COMPILER::C2BLOCK-CLB COMPILER::SET-DBIND +++ COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY +++ COMPILER::WT-LONG-FLOAT-VALUE COMPILER::C2DM-BIND-VL +++ COMPILER::WT-SHORT-FLOAT-VALUE COMPILER::T3SHARP-COMMA +++ COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES COMPILER::C2CATCH +++ COMPILER::C2EXPR-TOP* COMPILER::SET-JUMP-FALSE +++ COMPILER::CO1VECTOR-PUSH COMPILER::WT-V*-MACROS +++ COMPILER::ARGS-INFO-REFERRED-VARS COMPILER::SET-VS +++ COMPILER::WT-REQUIREDS COMPILER::C2RETURN-CCB +++ COMPILER::C2THROW COMPILER::CHECK-END +++ COMPILER::PUSH-CHANGED-VARS COMPILER::C2BLOCK-CCB +++ SYSTEM::ADD-DEBUG COMPILER::C2PSETQ COMPILER::C1ARGS +++ COMPILER::COMPILER-CC COMPILER::INLINE-PROC +++ COMPILER::CO1WRITE-CHAR COMPILER::COMPILER-DEF-HOOK +++ COMPILER::CAN-BE-REPLACED COMPILER::C2MULTIPLE-VALUE-PROG1 +++ COMPILER::C2DM-BIND-LOC COMPILER::ADD-INFO +++ COMPILER::CO1SPECIAL-FIX-DECL COMPILER::C2LAMBDA-EXPR-WITH-KEY +++ COMPILER::FAST-READ COMPILER::C2RETURN-CLB +++ COMPILER::PROCLAIM-VAR)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++- COMPILER::C2RETURN-LOCAL COMPILER::C2BLOCK-LOCAL ++- COMPILER::NCONC-FILES COMPILER::C1SYMBOL-FUN COMPILER::C2BLOCK ++- COMPILER::C1BODY COMPILER::COMPILER-BUILD ++- COMPILER::C2DECL-BODY COMPILER::WT-INLINE-LOC)) ++-(COMMON-LISP::MAPC ++- (COMMON-LISP::LAMBDA (COMPILER::X) ++- (COMMON-LISP::SETF ++- (COMMON-LISP::GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE) ++- COMMON-LISP::T)) ++- '(COMPILER::CMP-ANON COMMON-LISP::COMPILE COMPILER::CMP-TMP-MACRO ++- COMMON-LISP::DISASSEMBLE)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T (COMMON-LISP::VECTOR COMMON-LISP::T) ++- COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM ++- COMMON-LISP::T) ++- COMMON-LISP::FIXNUM) ++- COMPILER::BSEARCHLEQ)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T (COMMON-LISP::VECTOR COMMON-LISP::T) ++- COMMON-LISP::FIXNUM COMMON-LISP::T) ++- COMMON-LISP::FIXNUM) ++- COMPILER::PUSH-ARRAY)) +++ COMPILER::COMPILE-FILE1)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- COMPILER::AND-FORM-TYPE COMPILER::SET-VAR COMPILER::C2LET* ++- COMPILER::COMPILER-PASS2 COMPILER::ADD-FUNCTION-DECLARATION ++- COMPILER::BOOLE3 COMPILER::C1MAP-FUNCTIONS ++- COMPILER::TOO-MANY-ARGS COMPILER::CHECK-FORM-TYPE ++- COMPILER::C2LET COMPILER::C-FUNCTION-NAME ++- COMPILER::WT-INLINE-SHORT-FLOAT COMPILER::FIX-DOWN-ARGS ++- COMPILER::C2PRINC COMPILER::WT-IF-PROCLAIMED ++- COMPILER::ADD-FAST-LINK COMPILER::C2MULTIPLE-VALUE-BIND ++- COMPILER::C2MAPCAN COMPILER::CJT COMPILER::CHECK-VDECL ++- COMPILER::INLINE-TYPE-MATCHES COMPILER::WT-INLINE-LONG-FLOAT ++- COMPILER::C2GO COMPILER::CAN-BE-REPLACED* COMPILER::MYSUB ++- COMPILER::ASSIGN-DOWN-VARS COMPILER::C2MAPC ++- COMPILER::WT-INLINE-INTEGER COMPILER::GET-INLINE-INFO ++- COMPILER::CJF COMPILER::TOO-FEW-ARGS COMPILER::T3DEFCFUN ++- COMPILER::CMP-EXPAND-MACRO COMPILER::WT-MAKE-CCLOSURE ++- COMPILER::C2FUNCALL-SFUN COMPILER::C1DM ++- COMPILER::WT-INLINE-COND COMPILER::C2TAGBODY ++- COMPILER::WT-INLINE-CHARACTER COMPILER::C2PROGV ++- COMPILER::C2MAPCAR COMPILER::C1STRUCTURE-REF1 COMPILER::C2CASE ++- COMPILER::ADD-FUNCTION-PROCLAMATION ++- COMPILER::MAKE-INLINE-STRING COMPILER::SUBLIS1-INLINE ++- COMPILER::WT-INLINE-FIXNUM)) +++ COMPILER::MAKE-INLINE-STRING COMPILER::GET-INLINE-INFO +++ COMPILER::C1STRUCTURE-REF1 COMPILER::CJF COMPILER::SET-VAR +++ COMPILER::CHECK-FORM-TYPE COMPILER::AND-FORM-TYPE +++ COMPILER::SUBLIS1-INLINE COMPILER::T3DEFCFUN +++ COMPILER::WT-INLINE-INTEGER COMPILER::C-FUNCTION-NAME +++ COMPILER::FIX-DOWN-ARGS COMPILER::ASSIGN-DOWN-VARS +++ COMPILER::WT-INLINE-FIXNUM COMPILER::C2GO COMPILER::CJT +++ COMPILER::TOO-FEW-ARGS COMPILER::C2PRINC COMPILER::C2CASE +++ COMPILER::C2LET* COMPILER::BOOLE3 COMPILER::COMPILER-PASS2 +++ COMPILER::C1DM COMPILER::CHECK-VDECL COMPILER::C2LET +++ COMPILER::MYSUB COMPILER::CAN-BE-REPLACED* +++ COMPILER::ADD-FUNCTION-PROCLAMATION COMPILER::WT-IF-PROCLAIMED +++ COMPILER::C1MAP-FUNCTIONS COMPILER::ADD-FAST-LINK +++ COMPILER::WT-INLINE-LONG-FLOAT COMPILER::TOO-MANY-ARGS +++ COMPILER::C2MULTIPLE-VALUE-BIND COMPILER::C2PROGV +++ COMPILER::WT-INLINE-CHARACTER +++ COMPILER::ADD-FUNCTION-DECLARATION COMPILER::CMP-EXPAND-MACRO +++ COMPILER::C2MAPCAR COMPILER::INLINE-TYPE-MATCHES +++ COMPILER::C2FUNCALL-SFUN COMPILER::WT-MAKE-CCLOSURE +++ COMPILER::C2MAPCAN COMPILER::C2TAGBODY +++ COMPILER::WT-INLINE-COND COMPILER::C2MAPC +++ COMPILER::WT-INLINE-SHORT-FLOAT)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++- COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL COMPILER::LINK ++- COMPILER::INLINE-ARGS)) +++ COMPILER::T3LOCAL-FUN COMPILER::T3LOCAL-DCFUN)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T) +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- COMPILER::C2STRUCTURE-REF COMPILER::WT-GLOBAL-ENTRY ++- COMPILER::T3DEFUN-VARARG COMPILER::T3DEFUN-NORMAL ++- COMPILER::C2CALL-GLOBAL COMPILER::C1MAKE-VAR ++- COMPILER::C2CALL-UNKNOWN-GLOBAL COMPILER::C2SWITCH ++- COMPILER::T3INIT-FUN COMPILER::MY-CALL)) +++ COMPILER::T3DEFMACRO COMPILER::T3DEFENTRY COMPILER::T2DEFENTRY +++ COMPILER::DEFSYSFUN COMPILER::T2DEFMACRO)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- COMPILER::DEFSYSFUN COMPILER::T2DEFMACRO COMPILER::T2DEFENTRY ++- COMPILER::T3DEFMACRO COMPILER::T3DEFENTRY)) +++ COMPILER::T3DEFUN COMPILER::T3DEFUN-LOCAL-ENTRY +++ COMPILER::C2STRUCTURE-SET COMPILER::T2DEFUN +++ COMPILER::C1APPLY-OPTIMIZE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T) +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++- COMPILER::T2DEFUN COMPILER::C1APPLY-OPTIMIZE COMPILER::T3DEFUN ++- COMPILER::C2STRUCTURE-SET COMPILER::T3DEFUN-LOCAL-ENTRY)) +++ COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL +++ COMPILER::INLINE-ARGS COMPILER::LINK)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::*) +++ COMMON-LISP::T) ++ COMMON-LISP::T) ++- COMPILER::WT-SIMPLE-CALL COMPILER::GET-OUTPUT-PATHNAME)) +++ COMPILER::T3INIT-FUN COMPILER::C2STRUCTURE-REF +++ COMPILER::WT-GLOBAL-ENTRY COMPILER::T3DEFUN-NORMAL +++ COMPILER::T3DEFUN-VARARG COMPILER::C1MAKE-VAR +++ COMPILER::C2SWITCH COMPILER::MY-CALL COMPILER::C2CALL-GLOBAL +++ COMPILER::C2CALL-UNKNOWN-GLOBAL)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) ++ COMMON-LISP::T) ++- COMPILER::T3LOCAL-FUN COMPILER::T3LOCAL-DCFUN)) +++ COMPILER::GET-OUTPUT-PATHNAME COMPILER::WT-SIMPLE-CALL)) +++(COMMON-LISP::MAPC +++ (COMMON-LISP::LAMBDA (COMPILER::X) +++ (COMMON-LISP::SETF +++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) +++ COMMON-LISP::T)) +++ '(COMPILER::CMP-ANON COMMON-LISP::COMPILE COMPILER::CMP-TMP-MACRO +++ COMMON-LISP::DISASSEMBLE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +++ COMPILER::MAKE-VAR COMPILER::COMPILER-COMMAND +++ COMPILER::LIST*-INLINE COMMON-LISP::COMPILE-FILE +++ COMPILER::CS-PUSH COMPILER::MAKE-INFO COMPILER::FCALLN-INLINE +++ COMPILER::C2FSET COMPILER::MAKE-TAG COMPILER::WT-CLINK +++ COMPILER::LIST-INLINE COMPILER::MAKE-FUN COMPILER::MAKE-BLK)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++- COMPILER::C2PROGN COMPILER::WT-LONG-FLOAT-LOC COMPILER::C2EXPR ++- COMPILER::WT-FIXNUM-LOC COMPILER::WT-CHARACTER-LOC ++- COMPILER::C2AND COMPILER::T1EXPR COMPILER::CMP-TOPLEVEL-EVAL ++- COMPILER::WT-SHORT-FLOAT-LOC COMPILER::C2OR COMPILER::WT-LOC ++- COMPILER::CMP-EVAL COMPILER::T1EVAL-WHEN COMPILER::SET-LOC ++- COMPILER::VV-STR COMPILER::WT-TO-STRING)) +++ COMPILER::T1EVAL-WHEN COMPILER::T1EXPR +++ COMPILER::WT-CHARACTER-LOC COMPILER::SET-LOC +++ COMPILER::CMP-TOPLEVEL-EVAL COMPILER::C2PROGN +++ COMPILER::WT-TO-STRING COMPILER::MEXPAND-DEFTYPE +++ COMPILER::WT-SHORT-FLOAT-LOC COMPILER::CMP-EVAL +++ COMPILER::WT-LOC COMPILER::C2AND COMPILER::C2EXPR +++ COMPILER::WT-LONG-FLOAT-LOC COMPILER::C2OR +++ COMPILER::WT-FIXNUM-LOC)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++- COMPILER::MAKE-FUN COMPILER::MAKE-BLK ++- COMMON-LISP::COMPILE-FILE COMPILER::FCALLN-INLINE ++- COMPILER::MAKE-INFO COMPILER::CS-PUSH COMPILER::MAKE-VAR ++- COMPILER::LIST-INLINE COMPILER::C2FSET COMPILER::WT-CLINK ++- COMPILER::COMPILER-COMMAND COMPILER::MAKE-TAG ++- COMPILER::LIST*-INLINE)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +++ COMPILER::LTVP-EVAL COMPILER::FSET-FN-NAME COMPILER::C1MAPCON +++ COMPILER::FUNCTION-ARG-TYPES COMPILER::C1SHARP-COMMA +++ COMPILER::SAVE-AVMA COMPILER::C2TAGBODY-CCB COMPILER::VAR-LOC +++ COMPILER::WT-DOWN COMPILER::C1SETQ COMPILER::TAG-REF-CCB +++ COMPILER::T1DEFINE-STRUCTURE COMPILER::SAVE-FUNOB +++ COMPILER::C1VAR COMPILER::VV-STR COMPILER::C1RPLACA +++ COMPILER::INFO-SP-CHANGE COMPILER::BLK-REF-CCB +++ COMPILER::T1ORDINARY COMPILER::FIXNUM-LOC-P +++ COMPILER::FUN-REF-CCB COMPILER::C2GET COMPILER::FUN-NAME +++ COMPILER::FUN-P COMPILER::SCH-GLOBAL COMPILER::C1LET +++ COMPILER::C2TAGBODY-CLB COMPILER::C1UNWIND-PROTECT +++ COMPILER::SET-RETURN COMPILER::WT-VAR-DECL +++ COMPILER::VAR-REGISTER COMPILER::C1DEFINE-STRUCTURE +++ COMPILER::LTVP COMPILER::INLINE-POSSIBLE COMPILER::CHECK-VREF +++ COMPILER::TAG-NAME COMPILER::C2DM-RESERVE-VL +++ COMPILER::VAR-TYPE COMPILER::WT-LIST COMPILER::C1LET* +++ COMPILER::VARARG-P COMPILER::C1LOAD-TIME-VALUE +++ COMPILER::C2FUNCALL-AUX COMPILER::INFO-TYPE COMPILER::C1GET +++ COMPILER::C1NTHCDR-CONDITION COMPILER::C1AND +++ COMPILER::C1MULTIPLE-VALUE-CALL COMPILER::C1RPLACA-NTHCDR +++ COMPILER::INFO-VOLATILE COMPILER::INLINE-TYPE +++ COMPILER::LONG-FLOAT-LOC-P COMPILER::INFO-CHANGED-ARRAY +++ SYSTEM::UNDEF-COMPILER-MACRO COMPILER::DECL-BODY-SAFETY +++ COMPILER::TAG-VAR COMPILER::CHARACTER-LOC-P COMPILER::C2BIND +++ COMPILER::C1DECLARE COMPILER::CONS-TO-LISTA +++ COMPILER::C1MULTIPLE-VALUE-SETQ COMPILER::NAME-SD1 +++ COMPILER::BLK-NAME COMPILER::PARSE-CVSPECS COMPILER::C1MAPL +++ COMPILER::AET-C-TYPE COMPILER::C2VAR COMPILER::COPY-INFO +++ COMPILER::C1PSETQ COMPILER::C1VREF COMPILER::FUN-REF +++ COMPILER::WT-H1 COMPILER::T1DEFCFUN COMPILER::T1PROGN +++ COMPILER::C1EVAL-WHEN COMPILER::FLAGS-POS COMPILER::WT-VS +++ COMPILER::C2VAR-KIND COMPILER::C1LENGTH +++ COMPILER::C1MULTIPLE-VALUE-BIND COMPILER::C2LOCATION +++ COMPILER::C2DM-RESERVE-V COMPILER::C2FUNCTION +++ COMPILER::WT-SWITCH-CASE COMPILER::C2TAGBODY-LOCAL +++ COMPILER::CONSTANT-FOLD-P COMPILER::NEED-TO-SET-VS-POINTERS +++ COMPILER::C1MAPCAN COMPILER::WT-FUNCALL-C COMPILER::WT-CCB-VS +++ COMPILER::C1RETURN-FROM COMPILER::GET-INCLUDED +++ COMPILER::C1BLOCK COMPILER::ADD-CONSTANT COMPILER::WT-VS-BASE +++ COMPILER::C1NTH-CONDITION COMPILER::FUN-LEVEL +++ COMPILER::UNWIND-NO-EXIT COMMON-LISP::PROCLAIM +++ COMPILER::C1PRINC COMPILER::C2EXPR* COMPILER::RESULT-TYPE +++ COMPILER::TAG-REF COMPILER::C1FUNCALL COMPILER::C1PROGN +++ COMPILER::MAXARGS COMPILER::UNDEFINED-VARIABLE COMPILER::C1THE +++ COMPILER::CMP-MACROEXPAND COMPILER::C1MAPCAR +++ COMPILER::DEFAULT-INIT COMPILER::C1STRUCTURE-SET +++ COMPILER::WT-SYMBOL-FUNCTION COMPILER::T1DEFUN +++ COMPILER::WT-DATA1 COMPILER::PUSH-DATA-INCF COMPILER::C1IF +++ COMPILER::C1NTHCDR COMPILER::ADD-SYMBOL +++ COMPILER::C1MULTIPLE-VALUE-PROG1 COMPILER::BLK-REF +++ COMPILER::WT-FUNCTION-LINK COMPILER::INFO-P COMPILER::C1FSET +++ COMPILER::C1PROGV COMPILER::C1ASSOC COMPILER::VAR-REF +++ COMPILER::ARGS-CAUSE-SIDE-EFFECT COMPILER::MDELETE-FILE +++ COMPILER::CMP-MACRO-FUNCTION COMPILER::C2DOWNWARD-FUNCTION +++ COMPILER::C2GO-LOCAL COMPILER::T1DEFLA COMPILER::VAR-REF-CCB +++ COMPILER::C1FLET COMPILER::C1LIST-NTH +++ COMPILER::ADD-LOOP-REGISTERS COMPILER::INFO-REFERRED-ARRAY +++ COMPILER::BLK-VALUE-TO-GO COMPILER::WT-VS* +++ COMPILER::NAME-TO-SD COMPILER::C1RPLACD +++ COMPILER::WT-DATA-PACKAGE-OPERATION COMPILER::C1SWITCH +++ COMPILER::C1CATCH COMPILER::WT-CAR COMPILER::C1MACROLET +++ COMPILER::OBJECT-TYPE COMPILER::C1MAPC COMPILER::T1CLINES +++ COMPILER::C1COMPILER-LET COMPILER::CMP-MACROEXPAND-1 +++ COMPILER::C1TAGBODY COMPILER::C1MAPLIST COMPILER::PUSH-ARGS +++ COMPILER::T3ORDINARY COMPILER::C1MEMBER COMPILER::T1MACROLET +++ COMPILER::WT-CDR COMPILER::C1BOOLE3 COMPILER::PROCLAMATION +++ COMPILER::GET-LOCAL-RETURN-TYPE COMPILER::C1LOCAL-FUN +++ COMPILER::VAR-KIND COMPILER::WT1 COMPILER::TAG-SWITCH +++ COMPILER::C1OR COMPILER::C1STRUCTURE-REF +++ COMPILER::THE-PARAMETER COMPILER::VAR-REP-LOC +++ COMPILER::DECLARATION-TYPE COMPILER::TAG-P COMPILER::C2GETHASH +++ COMPILER::C1EXPR COMPILER::REPLACE-CONSTANT COMPILER::C1ECASE +++ COMPILER::FUN-CFUN COMPILER::SET-TOP COMPILER::TAG-LABEL +++ COMPILER::C1DM-BAD-KEY COMPILER::C1THROW COMPILER::C2GO-CCB +++ COMPILER::REP-TYPE COMPILER::C2VALUES +++ COMPILER::SHORT-FLOAT-LOC-P COMPILER::FUNCTION-RETURN-TYPE +++ COMPILER::ADD-OBJECT COMPILER::CTOP-WRITE COMPILER::C1MEMQ +++ COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::C1TERPRI +++ COMPILER::T1DEFMACRO COMPILER::T3CLINES COMPILER::ADD-REG1 +++ COMPILER::C1NTH COMPILER::C1ASH COMPILER::C1FMLA-CONSTANT +++ COMPILER::C2GO-CLB COMPILER::WT-CADR +++ COMPILER::C1BOOLE-CONDITION COMPILER::CLINK COMPILER::VAR-NAME +++ COMPILER::PUSH-ARGS-LISPCALL COMPILER::GET-ARG-TYPES +++ COMPILER::BLK-VAR COMPILER::C1APPLY COMPILER::CHECK-DOWNWARD +++ COMPILER::C1QUOTE COMPILER::TAG-REF-CLB +++ COMPILER::GET-LOCAL-ARG-TYPES COMPILER::REGISTER +++ COMPILER::BLK-P COMPILER::FUN-INFO COMPILER::C2RPLACD +++ COMPILER::ADD-OBJECT2 COMPILER::C2TAGBODY-BODY +++ COMPILER::T1DEFENTRY COMPILER::C1FUNCTION +++ COMPILER::C1DOWNWARD-FUNCTION COMPILER::SAFE-SYSTEM +++ COMPILER::C1GO COMPILER::BLK-EXIT COMPILER::VERIFY-DATA-VECTOR +++ COMPILER::C2RPLACA COMPILER::T2DECLARE COMPILER::MACRO-DEF-P +++ COMPILER::C1LABELS COMPILER::C1GETHASH COMPILER::FIX-OPT +++ COMPILER::SCH-LOCAL-FUN COMPILER::C1FUNOB +++ COMPILER::SET-PUSH-CATCH-FRAME COMPILER::GET-RETURN-TYPE +++ COMPILER::SET-UP-VAR-CVS COMPILER::TAG-UNWIND-EXIT +++ COMPILER::VAR-P COMPILER::C1ADD-GLOBALS COMPILER::TYPE-FILTER +++ COMPILER::WT-VV COMPILER::C1ASH-CONDITION COMPILER::VOLATILE +++ COMPILER::INLINE-BOOLE3-STRING COMPILER::C1LOCAL-CLOSURE +++ COMPILER::WRITE-BLOCK-OPEN COMPILER::ADD-ADDRESS +++ COMPILER::RESET-INFO-TYPE COMPILER::C1VALUES +++ COMPILER::BLK-REF-CLB COMPILER::C1STACK-LET)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) +++ COMPILER::INLINE-BOOLE3)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ((COMMON-LISP::VECTOR COMMON-LISP::T)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807)) ++ COMMON-LISP::T) ++- COMPILER::COPY-ARRAY)) +++ COMPILER::MEMOIZED-HASH-EQUAL)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ COMPILER::WT-INLINE-LOC COMPILER::NCONC-FILES +++ COMPILER::COMPILER-BUILD COMPILER::C2BLOCK-LOCAL +++ COMPILER::C2DECL-BODY COMPILER::C1SYMBOL-FUN COMPILER::C2BLOCK +++ COMPILER::C1BODY COMPILER::C2RETURN-LOCAL)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++- COMPILER::C2EXPR-TOP COMPILER::CO1SUBLIS ++- COMPILER::C2CALL-LAMBDA COMPILER::GET-INLINE-LOC ++- COMPILER::CHECK-END COMPILER::C2PSETQ COMPILER::TYPE-AND ++- COMPILER::TYPE>= COMPILER::C2MULTIPLE-VALUE-PROG1 ++- COMPILER::CO1SCHAR SYSTEM::ADD-DEBUG COMPILER::C2BLOCK-CCB ++- COMPILER::C2DM-BIND-VL COMPILER::MAKE-USER-INIT ++- COMPILER::NEED-TO-PROTECT COMPILER::FAST-READ ++- COMPILER::RESULT-TYPE-FROM-ARGS COMPILER::C2BIND-INIT ++- COMPILER::JUMPS-TO-P COMPILER::C2MEMBER!2 ++- COMPILER::C2CALL-LOCAL COMPILER::C2BLOCK-CLB ++- COMPILER::ARGS-INFO-CHANGED-VARS COMPILER::INLINE-PROC ++- COMPILER::C2THROW COMPILER::C1DECL-BODY ++- COMPILER::WT-MAKE-DCLOSURE COMPILER::CO1WRITE-CHAR ++- COMPILER::C1SETQ1 COMPILER::SET-JUMP-FALSE COMPILER::CO1CONS ++- COMPILER::CO1VECTOR-PUSH COMPILER::SET-VS COMPILER::SHIFT>> ++- COMPILER::COERCE-LOC-STRUCTURE-REF COMPILER::WT-FIXNUM-VALUE ++- COMPILER::C2CATCH COMPILER::C2RETURN-CCB COMPILER::MAYBE-EVAL ++- COMPILER::C2ASSOC!2 COMPILER::C2DM-BIND-INIT ++- COMPILER::C2STACK-LET COMPILER::C2LAMBDA-EXPR-WITH-KEY ++- COMPILER::ARGS-INFO-REFERRED-VARS ++- COMPILER::C2MULTIPLE-VALUE-SETQ COMPILER::C1PROGN* ++- COMPILER::WT-LONG-FLOAT-VALUE COMPILER::C2MULTIPLE-VALUE-CALL ++- COMPILER::WT-SHORT-FLOAT-VALUE COMPILER::CO1CONSTANT-FOLD ++- COMPILER::C1CONSTANT-VALUE COMPILER::C1EXPR* ++- COMPILER::CO1SPECIAL-FIX-DECL COMPILER::C2RETURN-CLB ++- COMPILER::CMPFIX-ARGS COMPILER::PROCLAIM-VAR COMPILER::C2APPLY ++- COMPILER::DO-MACRO-EXPANSION COMPILER::CFAST-WRITE ++- COMPILER::PRIN1-CMP COMPILER::SHIFT<< COMPILER::WT-REQUIREDS ++- COMPILER::C2EXPR-TOP* COMPILER::UNWIND-BDS ++- COMPILER::MULTIPLE-VALUE-CHECK COMPILER::COERCE-LOC ++- COMPILER::STRUCT-TYPE-OPT COMPILER::CO1READ-CHAR ++- COMPILER::ADD-DEBUG-INFO COMPILER::C2LIST-NTH-IMMEDIATE ++- COMPILER::WT-VAR COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY ++- COMPILER::CHECK-FNAME-ARGS COMPILER::CAN-BE-REPLACED ++- COMPILER::WT-CHARACTER-VALUE COMPILER::C2UNWIND-PROTECT ++- COMPILER::SET-DBIND COMPILER::T3SHARP-COMMA ++- COMPILER::IS-REP-REFERRED COMPILER::C1FMLA ++- COMPILER::WT-V*-MACROS COMPILER::C2DM-BIND-LOC ++- COMPILER::C2BIND-LOC ++- COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES ++- COMPILER::ADD-INFO COMPILER::C2SETQ ++- COMPILER::PUSH-CHANGED-VARS COMPILER::CO1STRUCTURE-PREDICATE ++- COMPILER::SET-BDS-BIND COMPILER::SET-JUMP-TRUE ++- COMPILER::CO1READ-BYTE COMPILER::C1LAMBDA-FUN ++- COMPILER::CO1TYPEP COMPILER::CONVERT-CASE-TO-SWITCH ++- COMPILER::COMPILER-DEF-HOOK COMPILER::CO1LDB COMPILER::C1ARGS ++- COMPILER::CO1WRITE-BYTE COMPILER::CO1EQL ++- COMPILER::COMPILER-CC)) +++ COMPILER::C1LAMBDA-EXPR COMPILER::CMPWARN COMPILER::ADD-INIT +++ COMPILER::UNWIND-EXIT COMPILER::CMPNOTE COMPILER::CMPERR +++ COMPILER::C1CASE COMPILER::WT-COMMENT COMPILER::INIT-NAME +++ COMPILER::FAST-LINK-PROCLAIMED-TYPE-P COMPILER::WT-INTEGER-LOC +++ COMPILER::WT-CVAR)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM) COMMON-LISP::T) ++- COMPILER::MLIN)) +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ COMPILER::C2IF COMPILER::WT-INLINE COMPILER::C2COMPILER-LET +++ COMPILER::C2FLET COMPILER::C2LABELS)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) ++ COMMON-LISP::*) ++- COMPILER::COMPILE-FILE1)) +++ COMPILER::C2RETURN-FROM COMPILER::C2APPLY-OPTIMIZE +++ COMPILER::C2DM COMPILER::C1DM-V COMPILER::C1DM-VL)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++- COMPILER::WT-DATA-BEGIN COMPILER::WT-C-PUSH COMPILER::WT-CVARS ++- COMPILER::C1T COMPILER::CVS-PUSH COMPILER::WT-DATA-FILE ++- COMPILER::ADD-LOAD-TIME-SHARP-COMMA ++- COMPILER::CLOSE-INLINE-BLOCKS COMPILER::WT-FASD-DATA-FILE ++- COMPILER::GAZONK-NAME COMPILER::WFS-ERROR ++- COMPILER::WT-NEXT-VAR-ARG COMPILER::WT-FIRST-VAR-ARG ++- COMPILER::C1NIL COMPILER::WT-DATA-END COMPILER::RESET-TOP ++- COMPILER::TAIL-RECURSION-POSSIBLE ++- COMPILER::PRINT-COMPILER-INFO COMPILER::CCB-VS-PUSH ++- COMPILER::BABOON COMPILER::INIT-ENV ++- COMPILER::PRINT-CURRENT-FORM COMPILER::VS-PUSH ++- COMPILER::INC-INLINE-BLOCKS)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ COMPILER::T3DEFUN-AUX)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::FIXNUM) +++ (COMMON-LISP::FUNCTION +++ ((COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*))) ++ COMMON-LISP::T) ++- COMPILER::MEMOIZED-HASH-EQUAL)) +++ COMPILER::COPY-ARRAY)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T +++ (COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*)) +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807) +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807) +++ COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++- COMPILER::PROCLAIMED-ARGD COMPILER::ANALYZE-REGS1 ++- COMPILER::ANALYZE-REGS)) +++ COMPILER::BSEARCHLEQ)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::STRING COMMON-LISP::FIXNUM ++- COMMON-LISP::FIXNUM) ++- COMMON-LISP::T) ++- COMPILER::DASH-TO-UNDERSCORE-INT)) ++\ No newline at end of file +++ (COMMON-LISP::T +++ (COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*)) +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807) +++ COMMON-LISP::T) +++ COMMON-LISP::FIXNUM) +++ COMPILER::PUSH-ARRAY)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) +++ COMPILER::F-TYPE)) ++\ No newline at end of file ++--- gcl-2.6.12.orig/configure +++++ gcl-2.6.12/configure ++@@ -3980,7 +3980,7 @@ add_args_to_cflags -fsigned-char -pipe \ ++ -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign \ ++ -Wno-unused-but-set-variable -Wno-misleading-indentation ++ ++-add_args_to_ldflags -Wl,-no_pie -no-pie -Wl,-z,lazy +++add_args_to_ldflags -no-pie -Wl,-z,lazy ++ ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for clang" >&5 ++ $as_echo_n "checking for clang... " >&6; } ++--- gcl-2.6.12.orig/configure.in +++++ gcl-2.6.12/configure.in ++@@ -264,7 +264,7 @@ add_args_to_cflags -fsigned-char -pipe \ ++ -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign \ ++ -Wno-unused-but-set-variable -Wno-misleading-indentation ++ ++-add_args_to_ldflags -Wl,-no_pie -no-pie -Wl,-z,lazy +++add_args_to_ldflags -no-pie -Wl,-z,lazy ++ ++ AC_MSG_CHECKING([for clang]) ++ AC_RUN_IFELSE( ++--- gcl-2.6.12.orig/gcl-tk/socketsl.lisp +++++ gcl-2.6.12/gcl-tk/socketsl.lisp ++@@ -12,10 +12,6 @@ ++ (defentry our-write (int object int ) (int "our_write_object")) ++ (defentry print-to-string1 (object object object) (object print_to_string1)) ++ ++-(clines "#define reset_string_input_stream1(strm,string,start,end) reset_string_input_stream(strm,string,fix(start),fix(end))") ++-(defentry reset-string-input-stream (object object object object) (object "reset_string_input_stream1")) ++- ++- ++ ;(clines "#define symbol_value_any(x) ((x)->s.s_dbind)") ++ ;(defentry symbol-value-any (object) (object symbol_value_any)) ++ ++--- gcl-2.6.12.orig/gcl-tk/tkl.lisp +++++ gcl-2.6.12/gcl-tk/tkl.lisp ++@@ -293,6 +293,9 @@ ++ (let () ++ (send-tcl-cmd *tk-connection* tk-command nil)))) ++ +++(defun fsubseq (s &optional (b 0) (e (length s))) +++ (make-array (- e b) :element-type (array-element-type s) :displaced-to s :displaced-index-offset b :fill-pointer (- e b))) +++ ++ (defun send-tcl-cmd (c str send-and-wait ) ++ ;(notice-text-variables) ++ (or send-and-wait (setq send-and-wait *send-and-wait*)) ++@@ -308,7 +311,7 @@ ++ ++ (cond (send-and-wait ++ (if *debugging* ++- (store-circle *requests* (subseq str #.(length *header*)) +++ (store-circle *requests* (fsubseq str #.(length *header*)) ++ msg-id)) ++ (store-circle *replies* nil msg-id) ++ (execute-tcl-cmd c str)) ++@@ -932,7 +935,7 @@ ++ #.(+ 1 (length *header*)) ++ 3)) ++ (values ++- (subseq str #.(+ 4 (length *header*))) +++ (fsubseq str #.(+ 4 (length *header*))) ++ (eql (aref str #.(+ 1 (length *header*))) #\0) ++ reply-from ++ (get-circle *requests* reply-from))) ++@@ -1082,7 +1085,7 @@ ++ (store-circle *replies* ++ (cons success ++ (if (eql (length tk-command) #.(+ 4 (length *header*))) "" ++- (subseq tk-command #.(+ 4 (length *header*))))) +++ (fsubseq tk-command #.(+ 4 (length *header*))))) ++ from-id)) ++ (#.(pos m_call *mtypes*) ++ ;; Can play a game of if read-and-act called with request-id: ++@@ -1114,7 +1117,7 @@ ++ (var (aref *text-variable-locations* lisp-var-id)) ++ (type (get var 'linked-variable-type)) ++ val) ++- (setq val (coerce-result (subseq tk-command #.(+ 3 (length *header*))) type)) +++ (setq val (coerce-result (fsubseq tk-command #.(+ 3 (length *header*))) type)) ++ (setf (aref *text-variable-locations* (the fixnum ++ ( + lisp-var-id 1))) ++ val) ++@@ -1130,7 +1133,9 @@ ++ (let* ((s (car *string-streams*)) ++ (*string-streams* (cdr *string-streams*))) ++ (or s (setq s (make-string-input-stream ""))) ++- (si::reset-string-input-stream s string start (length string)) +++ (assert (array-has-fill-pointer-p string)) +++ (setf (fill-pointer string) start) +++ (si::c-set-stream-object0 s string) ++ (read s nil nil))) ++ ++ ++@@ -1196,7 +1201,7 @@ ++ (cond (skipping nil) ++ ((eql brace-level 0) ++ (if (> i beg) ++- (setq ans (cons (subseq x beg i) ans))) +++ (setq ans (cons (fsubseq x beg i) ans))) ++ ++ (setq beg (+ i 1)) ++ ))) ++@@ -1207,12 +1212,12 @@ ++ (setq beg (+ i 1)))) ++ (incf brace-level)) ++ (#\} (cond ((eql brace-level 1) ++- (setq ans (cons (subseq x beg i) ans)) +++ (setq ans (cons (fsubseq x beg i) ans)) ++ (setq skipping t))) ++ (incf brace-level -1))))) ++ finally ++ (unless skipping ++- (setq ans (cons (subseq x beg i) ans))) +++ (setq ans (cons (fsubseq x beg i) ans))) ++ (return (nreverse ans)) ++ )) ++ ++@@ -1394,7 +1399,7 @@ ++ (cond (start (pp v no_leading_space) (setq start nil)) ++ (t (pp v normal))) ++ (setf x (cdr x))) ++- (subseq tk-command #.(length *header*)))) +++ (fsubseq tk-command #.(length *header*)))) ++ ++ ++ ++@@ -1409,7 +1414,6 @@ ++ (setq gcltksrv ++ (cond (host "gcltksrv") ++ ((si::getenv "GCL_TK_SERVER")) ++- ((probe-file (tk-conc si::*lib-directory* "/gcl-tk/gcltksrv"))) ++ ((probe-file (tk-conc si::*lib-directory* "gcl-tk/gcltksrv"))) ++ (t (error "Must setenv GCL_TK_SERVER "))))) ++ (let ((pid (if host -1 (si::getpid))) ++@@ -1427,9 +1431,9 @@ ++ args ++ ))) ++ (print command) ++- (cond ((not host) (system command)) +++ (cond ((not host) (si::system command)) ++ (can-rsh ++- (system (tk-conc "rsh " host " " command +++ (si::system (tk-conc "rsh " host " " command ++ " < /dev/null &"))) ++ (t (format t "Waiting for you to invoke GCL_TK_SERVER, ++ on ~a as in: ~s~%" host command ))) ++--- gcl-2.6.12.orig/h/compprotos.h +++++ gcl-2.6.12/h/compprotos.h ++@@ -180,3 +180,4 @@ char *gcl_gets(char *,int); ++ int gcl_puts(const char *); ++ int endp_error(object); ++ object Icall_gen_error_handler(object,object,object,object,ufixnum,...); +++object file_stream(object); ++--- gcl-2.6.12.orig/h/lu.h +++++ gcl-2.6.12/h/lu.h ++@@ -271,15 +271,14 @@ struct structure { ++ ++ struct stream { ++ FIRSTWORD; ++- void *sm_fp; ++- object sm_object0; ++- object sm_object1; ++- int sm_int0; ++- int sm_int1; ++- char *sm_buffer; ++- char sm_mode; ++- unsigned char sm_flags; ++- short sm_fd; +++ void *sm_fp; +++ object sm_object0; +++ object sm_object1; +++ char *sm_buffer; +++ ufixnum sm_mode:4; +++ ufixnum sm_flags:6; +++ ufixnum sm_fd:6; +++ ufixnum sm_int:LM(16); ++ }; ++ ++ struct random { ++--- gcl-2.6.12.orig/h/object.h +++++ gcl-2.6.12/h/object.h ++@@ -166,18 +166,18 @@ enum aelttype { /* array element type ++ /* for any stream that takes writec_char, directly (not two_way or echo) ++ ie. smm_output,smm_io, smm_string_output, smm_socket ++ */ ++-#define STREAM_FILE_COLUMN(str) ((str)->sm.sm_int1) +++#define STREAM_FILE_COLUMN(str) ((str)->sm.sm_int) ++ ++ /* for smm_echo */ ++-#define ECHO_STREAM_N_UNREAD(strm) ((strm)->sm.sm_int0) +++#define ECHO_STREAM_N_UNREAD(strm) ((strm)->sm.sm_int) ++ ++ /* file fd for socket */ ++ #define SOCKET_STREAM_FD(strm) ((strm)->sm.sm_fd) ++ #define SOCKET_STREAM_BUFFER(strm) ((strm)->sm.sm_object1) ++ ++ /* for smm_string_input */ ++-#define STRING_INPUT_STREAM_NEXT(strm) ((strm)->sm.sm_int0) ++-#define STRING_INPUT_STREAM_END(strm) ((strm)->sm.sm_int1) +++#define STRING_INPUT_STREAM_NEXT(strm) ((strm)->sm.sm_object0->st.st_fillp) +++#define STRING_INPUT_STREAM_END(strm) ((strm)->sm.sm_object0->st.st_dim) ++ ++ /* for smm_two_way and smm_echo */ ++ #define STREAM_OUTPUT_STREAM(strm) ((strm)->sm.sm_object1) ++--- gcl-2.6.12.orig/h/type.h +++++ gcl-2.6.12/h/type.h ++@@ -41,7 +41,6 @@ enum smmode { /* stream mode */ ++ smm_output, /* output */ ++ smm_io, /* input-output */ ++ smm_probe, /* probe */ ++- smm_file_synonym, /* synonym stream to file_stream */ ++ smm_synonym, /* synonym */ ++ smm_broadcast, /* broadcast */ ++ smm_concatenated, /* concatenated */ ++@@ -152,5 +151,4 @@ enum smmode { /* stream mode */ ++ #define pathname_string_symbol_streamp(a_) ({enum type _tp=type_of(a_); _tp==t_pathname || _tp == t_string\ ++ || _tp == t_symbol || _tp==t_stream;}) ++ ++-#define pathname_designatorp(a_) ({object _a=(a_);enum type _tp=type_of(a_);\ ++- _tp==t_pathname||_tp==t_string||(_tp==t_stream && _a->sm.sm_mode>=smm_input && _a->sm.sm_mode<=smm_file_synonym);}) +++#define pathname_designatorp(a_) ({object _a=(a_);enum type _tp=type_of(a_);_tp==t_pathname||_tp==t_string||file_stream(_a)!=Cnil;}) ++--- gcl-2.6.12.orig/lsp/gcl_directory.lsp +++++ gcl-2.6.12/lsp/gcl_directory.lsp ++@@ -74,4 +74,12 @@ ++ (let ((r (with-open-file (s (apply 'string-concatenate "|" #-winnt "which " ++ #+winnt "for %i in (" s #+winnt ".exe) do @echo.%~$PATH:i" nil)) ++ (read-line s nil 'eof)))) ++- (if (eq r 'eof) s (string-downcase r)))) +++ (unless (eq r 'eof) +++ (string-downcase r)))) +++ +++(defun get-path (s &aux +++ (e (unless (minusp (string-match #v"([^\n\t\r ]+)([\n\t\r ]|$)" s))(match-end 1))) +++ (w (when e (which (pathname-name (subseq s (match-beginning 1) e)))))) +++ (when w +++ (string-concatenate w (subseq s e)))) +++ ++--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp +++++ gcl-2.6.12/lsp/gcl_iolib.lsp ++@@ -69,7 +69,20 @@ ++ (progn ,@b) ++ (close ,var))))) ++ ++-(defmacro with-input-from-string ((var string &key index start end) . body) +++(defun make-string-input-stream (string &optional (start 0) end) +++ (declare (optimize (safety 1))) +++ (check-type string string) +++ (check-type start seqind) +++ (check-type end (or null seqind)) +++ (let ((l (- (or end (length string)) start))) +++ (make-string-input-stream-int +++ (make-array l :element-type (array-element-type string) :displaced-to string :displaced-index-offset start :fill-pointer 0) +++ 0 l))) +++ +++(defun get-string-input-stream-index (stream &aux (s (c-stream-object0 stream))) +++ (+ (fill-pointer s) (multiple-value-bind (a b) (array-displacement s) b))) +++ +++(defmacro with-input-from-string ((var string &key index (start 0) end) . body) ++ (declare (optimize (safety 1))) ++ (multiple-value-bind (ds b) (find-declarations body) ++ `(let ((,var (make-string-input-stream ,string ,start ,end))) ++@@ -77,7 +90,8 @@ ++ (unwind-protect ++ (multiple-value-prog1 ++ (progn ,@b) ++- ,@(when index `((setf ,index (get-string-input-stream-index ,var))))) +++ ,@(when index +++ `((setf ,index (get-string-input-stream-index ,var))))) ++ (close ,var))))) ++ ++ (defmacro with-output-to-string ((var &optional string &key element-type) . body) ++@@ -406,7 +420,7 @@ ++ ++ ++ (defun write-sequence (seq strm &rest r &key (start 0) end ++- &aux (l (listp seq))(cp (eq (stream-element-type strm) 'character))) +++ &aux (cp (eq (stream-element-type strm) 'character))) ++ (declare (optimize (safety 1))(dynamic-extent r)) ++ (check-type seq sequence) ++ (check-type strm stream) ++@@ -443,9 +457,15 @@ ++ if-exists iesp if-does-not-exist idnesp external-format))) ++ (when (typep s 'stream) (c-set-stream-object1 s pf) s))) ++ +++(defun load-pathname-exists (z) +++ (or (probe-file z) +++ (when *allow-gzipped-file* +++ (when (probe-file (string-concatenate (namestring z) ".gz")) +++ z)))) +++ ++ (defun load-pathname (p print if-does-not-exist external-format ++ &aux (pp (merge-pathnames p)) ++- (epp (reduce (lambda (y x) (or y (probe-file (translate-pathname x "" p)))) +++ (epp (reduce (lambda (y x) (or y (load-pathname-exists (translate-pathname x "" p)))) ++ '(#P".o" #P".lsp" #P".lisp" #P"") :initial-value nil)));FIXME newest? ++ (if epp ++ (let* ((*load-pathname* pp)(*load-truename* epp)) ++@@ -484,3 +504,36 @@ ++ (d pd (cdr pd))) ++ (values ps created))) ++ +++(defun file-length (x) +++ (declare (optimize (safety 1))) +++ (check-type x (or broadcast-stream file-stream)) +++ (if (typep x 'broadcast-stream) +++ (let ((s (broadcast-stream-streams x))) (if s (file-length (car (last s))) 0)) +++ (multiple-value-bind (tp sz) (stat x) +++ (declare (ignore tp)) +++ (/ sz (get-byte-stream-nchars x))))) +++ +++(defun file-position (x &optional (pos :start pos-p)) +++ (declare (optimize (safety 1))) +++ (check-type x (or broadcast-stream file-stream string-stream)) +++ (check-type pos (or (member :start :end) (integer 0))) +++ (typecase x +++ (broadcast-stream +++ (let ((s (car (last (broadcast-stream-streams x))))) +++ (if s (if pos-p (file-position s pos) (file-position s)) 0))) +++ (string-stream +++ (let* ((st (c-stream-object0 x))(l (length st))(d (array-dimension st 0)) +++ (p (case pos (:start 0) (:end l) (otherwise pos)))) +++ (if pos-p (when (<= p d) (setf (fill-pointer st) p)) l))) +++ (otherwise +++ (let ((n (get-byte-stream-nchars x)) +++ (p (case pos (:start 0) (:end (file-length x)) (otherwise pos)))) +++ (if pos-p (when (fseek x (* p n)) p) (/ (ftell x) n)))))) +++ +++(defun file-string-length (strm obj) +++ (let* ((pos (file-position strm)) +++ (w (write obj :stream strm :escape nil :readably nil)) +++ (pos1 (file-position strm)));(break) +++ (declare (ignore w)) +++ (file-position strm pos) +++ (- pos1 pos))) ++--- gcl-2.6.12.orig/lsp/gcl_namestring.lsp +++++ gcl-2.6.12/lsp/gcl_namestring.lsp ++@@ -27,7 +27,7 @@ ++ (declare (optimize (safety 1))) ++ (check-type x pathname-designator) ++ (check-type def pathname-designator) ++- ,(labels ((new? (k &aux (f (intern (concatenate 'string "PATHNAME-" (string k)) :si))) +++ ,(labels ((new? (k &aux (f (intern (string-concatenate "PATHNAME-" (string k)) :si))) ++ `(let ((k (,f px))) (unless (equal k (,f pdef)) k)))) ++ `(namestring (make-pathname ++ ,@(mapcan (lambda (x) (list x (new? x))) +pathname-keys+))))) ++--- gcl-2.6.12.orig/lsp/gcl_predlib.lsp +++++ gcl-2.6.12/lsp/gcl_predlib.lsp ++@@ -125,6 +125,8 @@ ++ (character . characterp) ++ (package . packagep) ++ (stream . streamp) +++ (string-input-stream . string-input-stream-p) +++ (string-output-stream . string-output-stream-p) ++ (file-stream . file-stream-p) ++ (synonym-stream . synonym-stream-p) ++ (broadcast-stream . broadcast-stream-p) ++--- gcl-2.6.12.orig/lsp/gcl_restart.lsp +++++ gcl-2.6.12/lsp/gcl_restart.lsp ++@@ -73,7 +73,7 @@ ++ &aux rr (report (if (stringp report) `(lambda (s) (write-string ,report s)) report))) ++ (macrolet ((do-setf (x) ++ `(when ,x ++- (setf (getf rr ,(intern (concatenate 'string (symbol-name x) "-FUNCTION") :keyword)) +++ (setf (getf rr ,(intern (string-concatenate (symbol-name x) "-FUNCTION") :keyword)) ++ (list 'function ,x))))) ++ (do-setf report) ++ (do-setf interactive) ++--- gcl-2.6.12.orig/lsp/gcl_serror.lsp +++++ gcl-2.6.12/lsp/gcl_serror.lsp ++@@ -2,11 +2,11 @@ ++ (in-package :si) ++ ++ (macrolet ++- ((make-conditionp (condition &aux (n (intern (concatenate 'string (string condition) "P")))) +++ ((make-conditionp (condition &aux (n (intern (string-concatenate (string condition) "P")))) ++ `(defun ,n (x &aux (z (si-find-class ',condition))) ++ (when z ++ (funcall (setf (symbol-function ',n) (lambda (x) (typep x z))) x)))) ++- (make-condition-classp (class &aux (n (intern (concatenate 'string (string class) "-CLASS-P")))) +++ (make-condition-classp (class &aux (n (intern (string-concatenate (string class) "-CLASS-P")))) ++ `(defun ,n (x &aux (s (si-find-class 'standard-class)) (z (si-find-class ',class))) ++ (when (and s z) ++ (funcall (setf (symbol-function ',n) ++@@ -124,9 +124,9 @@ ++ ++ (defun process-error (datum args &optional (default-type 'simple-error)) ++ (let ((internal (cond ((simple-condition-class-p datum) ++- (find-symbol (concatenate 'string "INTERNAL-" (string datum)) :conditions)) +++ (find-symbol (string-concatenate "INTERNAL-" (string datum)) :conditions)) ++ ((condition-class-p datum) ++- (find-symbol (concatenate 'string "INTERNAL-SIMPLE-" (string datum)) :conditions))))) +++ (find-symbol (string-concatenate "INTERNAL-SIMPLE-" (string datum)) :conditions))))) ++ (coerce-to-condition (or internal datum) (if internal (list* :function-name *sig-fn-name* args) args) default-type 'process-error))) ++ ++ (defun universal-error-handler (n cp fn cs es &rest args &aux (*sig-fn-name* fn)) ++--- gcl-2.6.12.orig/lsp/gcl_top.lsp +++++ gcl-2.6.12/lsp/gcl_top.lsp ++@@ -593,12 +593,11 @@ First directory is checked for first nam ++ (when (eq (stat x) :directory) ++ (return-from get-temp-dir x)))))) ++ ++-(defun get-path (s &aux (m (string-match "([^ ]*)( |$)" s))(b (match-beginning 1))(e (match-end 1))) ++- (string-concatenate (which (pathname-name (subseq s b e))) (subseq s e))) +++ ++ ++ (defvar *cc* "cc") ++ (defvar *ld* "ld") ++-(defvar *objdump* "objdump --source ") +++(defvar *objdump* nil) ++ ++ (defvar *current-directory* *system-directory*) ++ ++@@ -608,9 +607,9 @@ First directory is checked for first nam ++ (declare (fixnum i)) ++ (setq *current-directory* (current-directory-pathname)) ++ (setq *tmp-dir* (get-temp-dir) ++- *cc* (get-path *cc*) ++- *ld* (get-path *ld*) ++- *objdump* (get-path *objdump*)) +++ *cc* (or (get-path *cc*) *cc*) +++ *ld* (or (get-path *ld*) *ld*) +++ *objdump* (get-path "objdump --source ")) ++ (dotimes (j i) (push (argv j) tem)) ++ (setq *command-args* (nreverse tem)) ++ (setq tem *lib-directory*) ++--- gcl-2.6.12.orig/lsp/gcl_translate_pathname.lsp +++++ gcl-2.6.12/lsp/gcl_translate_pathname.lsp ++@@ -32,7 +32,7 @@ ++ (defun do-repl (x y) ++ (labels ((r (x l &optional (b 0) &aux (f (string-match #v"\\*" x b))) ++ (if (eql f -1) (if (eql b 0) x (subseq x b)) ++- (concatenate 'string (subseq x b f) (or (car l) "") (r x (cdr l) (1+ f)))))) +++ (string-concatenate (subseq x b f) (or (car l) "") (r x (cdr l) (1+ f)))))) ++ (r y x))) ++ ++ (defun dir-p (x) (when (consp x) (member (car x) '(:absolute :relative)))) ++--- gcl-2.6.12.orig/lsp/sys-proclaim.lisp +++++ gcl-2.6.12/lsp/sys-proclaim.lisp ++@@ -4,229 +4,269 @@ ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++- COMMON-LISP::*) ++- (COMMON-LISP::INTEGER -9223372036854775808 ++- 9223372036854775807)) ++- COMMON-LISP::FIXNUM) ++- SYSTEM::ATOI)) +++ COMMON-LISP::*)) +++ COMMON-LISP::T) +++ SYSTEM::RESET-SYS-PATHS)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++- (COMMON-LISP::OR COMMON-LISP::NULL ++- COMMON-LISP::HASH-TABLE)) ++- SYSTEM::CONTEXT-HASH)) +++ (COMMON-LISP::VECTOR COMMON-LISP::T)) +++ SYSTEM::CONTEXT-VEC)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::*) ++- SYSTEM::PARSE-DEFMACRO-LAMBDA-LIST SYSTEM::PARSE-DEFMACRO)) +++ ((COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807)) +++ COMMON-LISP::T) +++ SYSTEM::PUSH-CONTEXT SYSTEM::GET-CONTEXT)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::*) ++- COMMON-LISP::SUBTYPEP COMMON-LISP::REDUCE ++- SLOOP::FIND-IN-ORDERED-LIST SYSTEM::PARSE-BODY ++- COMMON-LISP::STABLE-SORT COMMON-LISP::SORT)) +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +++ SLOOP::PARSE-LOOP-DO ANSI-LOOP::LOOP-WHEN-IT-VARIABLE +++ SYSTEM::GET-INDEX-NODE SLOOP::LOOP-PEEK +++ ANSI-LOOP::LOOP-POP-SOURCE SYSTEM::STEP-READ-LINE +++ SYSTEM::SET-UP-TOP-LEVEL SLOOP::LOOP-POP SYSTEM::SET-ENV +++ SYSTEM::DBL COMMON-LISP::TYPE-ERROR SYSTEM::INSPECT-INDENT +++ SLOOP::PARSE-LOOP-COLLECT SYSTEM::CLEANUP +++ SYSTEM::DEFAULT-SYSTEM-BANNER +++ SYSTEM::CURRENT-DIRECTORY-PATHNAME ANSI-LOOP::LOOP-DO-WITH +++ SYSTEM::INIT-BREAK-POINTS SYSTEM::TEST-ERROR +++ SYSTEM::GET-SIG-FN-NAME SLOOP::PARSE-ONE-WHEN-CLAUSE +++ ANSI-LOOP::LOOP-DO-DO SYSTEM::READ-EVALUATED-FORM +++ SYSTEM::INSPECT-INDENT-1 ANSI-LOOP::LOOP-DO-NAMED +++ SLOOP::PARSE-LOOP-FOR SYSTEM::ALL-TRACE-DECLARATIONS +++ ANSI-LOOP::LOOP-GET-FORM ANSI-LOOP::LOOP-BIND-BLOCK +++ SLOOP::PARSE-LOOP-WHEN SYSTEM::TOP-LEVEL +++ SYSTEM::DM-TOO-FEW-ARGUMENTS SYSTEM::KCL-TOP-RESTARTS +++ SYSTEM::DEFAULT-INFO-HOTLIST SYSTEM::SHOW-RESTARTS +++ SYSTEM::DM-TOO-MANY-ARGUMENTS SYSTEM::SETUP-LINEINFO +++ SYSTEM::GET-TEMP-DIR ANSI-LOOP::LOOP-ITERATION-DRIVER +++ SLOOP::PARSE-LOOP1 SLOOP::LOOP-UN-POP +++ ANSI-LOOP::LOOP-DO-FINALLY SYSTEM::INSPECT-READ-LINE +++ ANSI-LOOP::LOOP-CONTEXT SYSTEM::SET-CURRENT +++ ANSI-LOOP::LOOP-DO-REPEAT SYSTEM::ILLEGAL-BOA +++ COMMON-LISP::LISP-IMPLEMENTATION-VERSION +++ ANSI-LOOP::LOOP-DO-RETURN ANSI-LOOP::LOOP-DO-INITIALLY +++ ANSI-LOOP::LOOP-GET-PROGN)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::*) ++- SYSTEM::SHARP-+-READER SYSTEM::SHARP---READER ++- SYSTEM::SHARP-S-READER ANSI-LOOP::LOOP-GET-COLLECTION-INFO ++- SYSTEM::VERIFY-KEYWORDS SYSTEM::LIST-MERGE-SORT ++- SYSTEM::RESTART-PRINT SYSTEM::READ-INSPECT-COMMAND)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ COMMON-LISP::HASH-TABLE) +++ SYSTEM::CONTEXT-SPICE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T) ++- COMMON-LISP::*) ++- SYSTEM::TRACE-CALL)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ (COMMON-LISP::OR COMMON-LISP::NULL +++ COMMON-LISP::HASH-TABLE)) +++ SYSTEM::CONTEXT-HASH)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::*) ++- COMMON-LISP::*) ++- SYSTEM::EXPAND-WILD-DIRECTORY SYSTEM::MASET)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::FIXNUM) +++ ANSI-LOOP::DUPLICATABLE-CODE-P SYSTEM::RELATIVE-LINE +++ SYSTEM::LENEL SYSTEM::GET-NODE-INDEX SYSTEM::FASLINK +++ SYSTEM::THE-END)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T) ++- COMMON-LISP::*) ++- SYSTEM::MME3)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ SLOOP::IN-PACKAGE-SLOOP-MAP SLOOP::DESETQ1 +++ COMMON-LISP::LOGANDC2 ANSI-LOOP::MAKE-LOOP-MINIMAX +++ COMMON-LISP::WRITE-BYTE SYSTEM::MATCH-DIMENSIONS +++ SLOOP::IN-CAREFULLY-SLOOP-FOR SLOOP::SUM-SLOOP-COLLECT +++ SYSTEM::DOT-DIR-P SLOOP::IN-FRINGE-SLOOP-MAP +++ SLOOP::COLLATE-SLOOP-COLLECT ANSI-LOOP::LOOP-TMEMBER +++ FPE::READ-OPERANDS SYSTEM::IN-INTERVAL-P SYSTEM::SUBSTRINGP +++ FPE::PAREN-READER ANSI-LOOP::HIDE-VARIABLE-REFERENCES +++ SYSTEM::QUOTATION-READER SYSTEM::ALL-MATCHES SYSTEM::GET-MATCH +++ SYSTEM::ADD-FILE ANSI-LOOP::LOOP-DO-ALWAYS SLOOP::THE-TYPE +++ SYSTEM::?PUSH SYSTEM::INCREMENT-CURSOR +++ SYSTEM::CHECK-SEQ-START-END SLOOP::MAKE-VALUE +++ SLOOP::THEREIS-SLOOP-COLLECT ANSI-LOOP::LOOP-DO-WHILE +++ COMMON-LISP::COERCE ANSI-LOOP::LOOP-TEQUAL +++ ANSI-LOOP::LOOP-DECLARE-VARIABLE COMMON-LISP::LOGNAND +++ COMMON-LISP::LOGORC1 SYSTEM::BREAK-STEP-NEXT +++ SLOOP::LOGXOR-SLOOP-COLLECT COMMON-LISP::LOGNOR +++ COMPILER::COMPILER-DEF-HOOK ANSI-LOOP::LOOP-TASSOC +++ SYSTEM::GET-LINE-OF-FORM SLOOP::MAXIMIZE-SLOOP-COLLECT +++ ANSI-LOOP::LOOP-DO-IF SYSTEM::SETF-EXPAND SYSTEM::DM-V +++ SYSTEM::ITERATE-OVER-BKPTS COMMON-LISP::NTHCDR +++ SYSTEM::CONDITION-PASS SYSTEM::DISPLAY-COMPILED-ENV +++ COMMON-LISP::LDB-TEST ANSI-LOOP::LOOP-MAYBE-BIND-FORM +++ SYSTEM::SUPER-GO SYSTEM::SETF-LOGICAL-PATHNAME-TRANSLATIONS +++ FPE::RF SYSTEM::SUB-INTERVAL-P SYSTEM::LEFT-PARENTHESIS-READER +++ COMMON-LISP::FILE-STRING-LENGTH SYSTEM::OBJLT SYSTEM::MSUB +++ SYSTEM::COERCE-TO-STRING SYSTEM::SAFE-EVAL +++ SYSTEM::SET-PATH-STREAM-NAME SYSTEM::SET-BACK +++ ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION COMMON-LISP::LOGTEST +++ SYSTEM::*BREAK-POINTS* SLOOP::=-SLOOP-FOR +++ SLOOP::MINIMIZE-SLOOP-COLLECT SYSTEM::KEYWORD-SUPPLIED-P +++ SLOOP::COUNT-SLOOP-COLLECT FPE::%-READER COMMON-LISP::LOGORC2 +++ SYSTEM::SEQUENCE-CURSOR SYSTEM::LOOKUP-KEYWORD +++ COMMON-LISP::BYTE SYSTEM::PARSE-SLOT-DESCRIPTION +++ COMMON-LISP::LOGANDC1 SYSTEM::DM-NTH-CDR FPE::0-READER +++ SLOOP::L-EQUAL SYSTEM::LIST-DELQ SYSTEM::DM-NTH +++ COMMON-LISP::LDB SYSTEM::SETF-HELPER +++ SLOOP::NEVER-SLOOP-COLLECT SLOOP::PARSE-LOOP-MAP +++ COMMON-LISP::NTH SYSTEM::BREAK-STEP-INTO +++ SYSTEM::GET-INFO-CHOICES SLOOP::IN-TABLE-SLOOP-MAP +++ SYSTEM::GET-NODES COMMON-LISP::VECTOR-PUSH +++ COMMON-LISP::PATHNAME-MATCH-P SYSTEM::DBL-UP +++ ANSI-LOOP::LOOP-LOOKUP-KEYWORD FPE::READ-INSTRUCTION +++ SLOOP::ALWAYS-SLOOP-COLLECT SYSTEM::SET-DIR SYSTEM::INFO-AUX +++ SYSTEM::DISPLAY-ENV COMMON-LISP::DOCUMENTATION +++ SYSTEM::OVERWRITE-SLOT-DESCRIPTIONS)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++- SYSTEM::PUSH-OPTIONAL-BINDING)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++- (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) ++- SYSTEM::MAKE-KEYWORD)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T ++- (COMMON-LISP::INTEGER -9223372036854775808 ++- 9223372036854775807) ++- (COMMON-LISP::INTEGER -9223372036854775808 ++- 9223372036854775807) ++- COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::T) ++- SYSTEM::QUICK-SORT)) +++ COMMON-LISP::APROPOS ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE +++ COMMON-LISP::FFLOOR SYSTEM::PRINT-DOC SYSTEM::INFO +++ SYSTEM::PARSE-BODY-HEADER COMMON-LISP::INVOKE-RESTART +++ SYSTEM::BREAK-FUNCTION SYSTEM::SHOW-INFO COMMON-LISP::FROUND +++ COMMON-LISP::GET-SETF-EXPANSION COMMON-LISP::PARSE-NAMESTRING +++ SYSTEM::APROPOS-DOC COMMON-LISP::ENSURE-DIRECTORIES-EXIST +++ COMMON-LISP::USE-VALUE COMMON-LISP::READ-FROM-STRING +++ COMMON-LISP::FTRUNCATE COMMON-LISP::STORE-VALUE +++ SYSTEM::STEPPER SYSTEM::GET-SETF-METHOD-MULTIPLE-VALUE +++ COMMON-LISP::APROPOS-LIST COMMON-LISP::FCEILING +++ COMMON-LISP::WRITE-TO-STRING +++ COMMON-LISP::DECODE-UNIVERSAL-TIME)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T ++- (COMMON-LISP::INTEGER -9223372036854775808 ++- 9223372036854775807) ++- COMMON-LISP::T COMMON-LISP::T) +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- SYSTEM::BIGNTHCDR)) +++ SYSTEM::SETF-EXPAND-1 SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS +++ SYSTEM::WARN-VERSION ANSI-LOOP::LOOP-TRANSLATE +++ ANSI-LOOP::LOOP-FOR-IN ANSI-LOOP::PRINT-LOOP-UNIVERSE +++ ANSI-LOOP::LOOP-STANDARD-EXPANSION +++ ANSI-LOOP::LOOP-ANSI-FOR-EQUALS SYSTEM::DM-VL +++ SYSTEM::SHARP-A-READER COMMON-LISP::DEPOSIT-FIELD +++ SYSTEM::RESTART-CASE-EXPRESSION-CONDITION +++ SYSTEM::APPLY-DISPLAY-FUN ANSI-LOOP::HIDE-VARIABLE-REFERENCE +++ SYSTEM::FLOATING-POINT-ERROR SYSTEM::GET-SLOT-POS +++ ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE +++ SYSTEM::MAKE-BREAK-POINT SYSTEM::SHARP-V-READER +++ SYSTEM::TO-REGEXP-OR-NAMESTRING ANSI-LOOP::LOOP-FOR-ON +++ SYSTEM::SHARP-U-READER ANSI-LOOP::LOOP-SUM-COLLECTION +++ SYSTEM::SHARP-P-READER SYSTEM::MAKE-T-TYPE +++ ANSI-LOOP::LOOP-FOR-ACROSS SYSTEM::MFR SYSTEM::RECURSE-DIR +++ SYSTEM::PATHNAME-PARSE ANSI-LOOP::LOOP-FOR-BEING +++ COMMON-LISP::DPB SYSTEM::SHARP-DQ-READER +++ SYSTEM::CHECK-TRACE-ARGS SYSTEM::DEFMACRO* +++ SYSTEM::CHECK-S-DATA FPE::REF)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++- COMMON-LISP::EVERY COMMON-LISP::SET-DIFFERENCE ++- SYSTEM::VECTOR-PUSH-STRING SYSTEM::PROCESS-ERROR ++- COMMON-LISP::POSITION-IF-NOT COMMON-LISP::FIND-IF ++- SLOOP::LOOP-ADD-BINDING COMMON-LISP::BIT-ORC1 ++- COMMON-LISP::READ-SEQUENCE SYSTEM::INTERNAL-COUNT-IF ++- COMMON-LISP::COUNT COMMON-LISP::MISMATCH ++- COMMON-LISP::ADJUST-ARRAY COMMON-LISP::INTERSECTION ++- COMMON-LISP::UNION COMMON-LISP::DELETE-IF-NOT ++- COMMON-LISP::NINTERSECTION COMMON-LISP::BIT-ANDC1 ++- COMMON-LISP::REMOVE-IF-NOT COMMON-LISP::TYPEP ++- COMMON-LISP::NUNION COMMON-LISP::WRITE-SEQUENCE ++- COMMON-LISP::VECTOR-PUSH-EXTEND COMMON-LISP::REMOVE ++- COMMON-LISP::BIT-IOR SLOOP::PARSE-LOOP-MACRO ++- COMMON-LISP::SEARCH COMMON-LISP::SUBSETP ++- COMMON-LISP::SET-EXCLUSIVE-OR SYSTEM::WREADDIR ++- COMMON-LISP::POSITION-IF COMMON-LISP::DELETE ++- COMMON-LISP::BIT-EQV COMMON-LISP::BIT-ANDC2 ++- COMMON-LISP::BIT-AND COMMON-LISP::NSET-EXCLUSIVE-OR ++- SLOOP::IN-ARRAY-SLOOP-FOR ANSI-LOOP::LOOP-CHECK-DATA-TYPE ++- COMMON-LISP::POSITION COMMON-LISP::MAKE-SEQUENCE ++- COMMON-LISP::NOTEVERY COMMON-LISP::MAP-INTO ++- COMMON-LISP::REPLACE COMMON-LISP::NSET-DIFFERENCE +++ SYSTEM::FIND-IHS COMMON-LISP::NSET-DIFFERENCE +++ COMMON-LISP::BIT-NAND SYSTEM::BREAK-CALL +++ COMMON-LISP::COUNT-IF-NOT COMMON-LISP::DELETE +++ SYSTEM::INTERNAL-COUNT COMMON-LISP::BIT-ORC1 +++ COMMON-LISP::DELETE-IF COMMON-LISP::BIT-ANDC1 +++ SYSTEM::VECTOR-PUSH-STRING COMMON-LISP::MISMATCH +++ COMMON-LISP::NOTEVERY SYSTEM::PROCESS-ERROR COMMON-LISP::TYPEP +++ COMMON-LISP::BIT-IOR COMMON-LISP::BIT-EQV +++ COMMON-LISP::COUNT-IF COMMON-LISP::REMOVE-IF +++ COMMON-LISP::EVERY COMMON-LISP::POSITION-IF-NOT +++ COMMON-LISP::ADJUST-ARRAY COMMON-LISP::VECTOR-PUSH-EXTEND +++ SYSTEM::INTERNAL-COUNT-IF-NOT COMMON-LISP::COUNT +++ COMMON-LISP::DELETE-IF-NOT COMMON-LISP::NINTERSECTION ++ COMMON-LISP::FIND-IF-NOT COMMON-LISP::BIT-ORC2 ++- COMMON-LISP::DELETE-IF COMMON-LISP::CERROR ++- COMMON-LISP::BIT-XOR COMMON-LISP::FIND COMMON-LISP::FILL ++- SYSTEM::INTERNAL-COUNT-IF-NOT COMMON-LISP::REMOVE-IF ++- COMMON-LISP::BIT-NAND COMMON-LISP::BIT-NOR COMMON-LISP::SOME ++- COMMON-LISP::COUNT-IF SYSTEM::BREAK-CALL ++- COMMON-LISP::COUNT-IF-NOT SYSTEM::FIND-IHS COMMON-LISP::NOTANY ++- SYSTEM::INTERNAL-COUNT)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::T) ++- SYSTEM::PATHNAME-PARSE ANSI-LOOP::LOOP-TRANSLATE ++- SYSTEM::CHECK-S-DATA SYSTEM::MFR FPE::REF ++- ANSI-LOOP::LOOP-STANDARD-EXPANSION ANSI-LOOP::LOOP-FOR-ON ++- ANSI-LOOP::LOOP-SUM-COLLECTION SYSTEM::SHARP-DQ-READER ++- COMMON-LISP::DPB SYSTEM::CHECK-TRACE-ARGS ++- SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS SYSTEM::RECURSE-DIR ++- SYSTEM::SHARP-U-READER SYSTEM::FLOATING-POINT-ERROR ++- ANSI-LOOP::LOOP-FOR-IN ANSI-LOOP::HIDE-VARIABLE-REFERENCE ++- SYSTEM::GET-SLOT-POS SYSTEM::APPLY-DISPLAY-FUN ++- SYSTEM::RESTART-CASE-EXPRESSION-CONDITION ++- SYSTEM::MAKE-BREAK-POINT SYSTEM::TO-REGEXP-OR-NAMESTRING ++- COMMON-LISP::DEPOSIT-FIELD SYSTEM::SHARP-V-READER ++- SYSTEM::MAKE-T-TYPE ANSI-LOOP::LOOP-FOR-ACROSS ++- ANSI-LOOP::LOOP-ANSI-FOR-EQUALS ANSI-LOOP::PRINT-LOOP-UNIVERSE ++- ANSI-LOOP::LOOP-FOR-BEING SYSTEM::SHARP-P-READER SYSTEM::DM-VL ++- SYSTEM::SHARP-A-READER ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE ++- SYSTEM::DEFMACRO* SYSTEM::SETF-EXPAND-1 SYSTEM::WARN-VERSION)) +++ COMMON-LISP::SUBSETP COMMON-LISP::SOME SYSTEM::WREADDIR +++ COMMON-LISP::SET-DIFFERENCE COMMON-LISP::UNION +++ COMMON-LISP::BIT-XOR SLOOP::PARSE-LOOP-MACRO +++ COMMON-LISP::REPLACE COMMON-LISP::REMOVE +++ SLOOP::LOOP-ADD-BINDING COMMON-LISP::BIT-ANDC2 +++ COMMON-LISP::READ-SEQUENCE COMMON-LISP::CERROR +++ COMMON-LISP::INTERSECTION COMMON-LISP::POSITION-IF +++ ANSI-LOOP::LOOP-CHECK-DATA-TYPE SYSTEM::INTERNAL-COUNT-IF +++ COMMON-LISP::NUNION COMMON-LISP::WRITE-SEQUENCE +++ COMMON-LISP::MAP-INTO COMMON-LISP::MAKE-SEQUENCE +++ COMMON-LISP::SET-EXCLUSIVE-OR SLOOP::IN-ARRAY-SLOOP-FOR +++ COMMON-LISP::FIND-IF COMMON-LISP::SEARCH COMMON-LISP::FILL +++ COMMON-LISP::FIND COMMON-LISP::NOTANY +++ COMMON-LISP::NSET-EXCLUSIVE-OR COMMON-LISP::BIT-NOR +++ COMMON-LISP::REMOVE-IF-NOT COMMON-LISP::POSITION +++ COMMON-LISP::BIT-AND)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::*) +++ COMMON-LISP::T) ++ COMMON-LISP::T) ++- SYSTEM::MME2 COMMON-LISP::NSUBSTITUTE SYSTEM::MATCH-COMPONENT ++- SYSTEM::COMPLETE-PROP SYSTEM::WALK-DIR ++- COMMON-LISP::TRANSLATE-PATHNAME ANSI-LOOP::ADD-LOOP-PATH ++- SYSTEM::DIR-PARSE ANSI-LOOP::LOOP-MAKE-VARIABLE ++- COMMON-LISP::SUBSTITUTE-IF COMMON-LISP::NSUBSTITUTE-IF ++- SYSTEM::PUSH-LET-BINDING COMMON-LISP::SUBSTITUTE ++- ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH COMMON-LISP::MAP ++- COMMON-LISP::SUBSTITUTE-IF-NOT COMMON-LISP::NSUBSTITUTE-IF-NOT ++- ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH ++- SLOOP::LOOP-DECLARE-BINDING ++- ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH ++- SYSTEM::CHECK-TYPE-SYMBOL)) +++ SYSTEM::FIND-LINE-IN-FUN ANSI-LOOP::LOOP-FOR-ARITHMETIC +++ SYSTEM::EXPAND-RANGE SYSTEM::MAYBE-BREAK SYSTEM::MINMAX +++ SLOOP::FIRST-USE-SLOOP-FOR SLOOP::FIRST-SLOOP-FOR +++ SYSTEM::SETF-STRUCTURE-ACCESS SYSTEM::DO-BREAK-LEVEL +++ SYSTEM::CALL-TEST SYSTEM::ELEMENT SYSTEM::LOAD-PATHNAME +++ SYSTEM::COERCE-TO-CONDITION SYSTEM::ELSUB)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T ++- (COMMON-LISP::INTEGER -9223372036854775808 ++- 9223372036854775807)) +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++- SYSTEM::SHARP-EQ-READER SYSTEM::SHARP-SHARP-READER)) +++ SLOOP::DEF-LOOP-INTERNAL COMMON-LISP::MERGE +++ SYSTEM::PRINT-STACK-FRAME)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T) +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) ++ COMMON-LISP::T) ++- SYSTEM::ELSUB SLOOP::FIRST-USE-SLOOP-FOR ++- SLOOP::FIRST-SLOOP-FOR SYSTEM::SETF-STRUCTURE-ACCESS ++- SYSTEM::FIND-LINE-IN-FUN SYSTEM::COERCE-TO-CONDITION ++- ANSI-LOOP::LOOP-FOR-ARITHMETIC SYSTEM::MAYBE-BREAK ++- SYSTEM::ELEMENT SYSTEM::DO-BREAK-LEVEL SYSTEM::CALL-TEST)) +++ COMMON-LISP::ENCODE-UNIVERSAL-TIME)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T) +++ COMMON-LISP::*) ++ COMMON-LISP::T) ++- ANSI-LOOP::LOOP-SEQUENCER)) +++ ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH +++ SYSTEM::COMPLETE-PROP SYSTEM::CHECK-TYPE-SYMBOL +++ COMMON-LISP::NSUBSTITUTE +++ ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH COMMON-LISP::SUBSTITUTE +++ COMMON-LISP::TRANSLATE-PATHNAME COMMON-LISP::NSUBSTITUTE-IF +++ COMMON-LISP::MAP SLOOP::LOOP-DECLARE-BINDING SYSTEM::WALK-DIR +++ SYSTEM::MATCH-COMPONENT ANSI-LOOP::LOOP-MAKE-VARIABLE +++ ANSI-LOOP::ADD-LOOP-PATH COMMON-LISP::SUBSTITUTE-IF +++ COMMON-LISP::NSUBSTITUTE-IF-NOT SYSTEM::MME2 +++ ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH +++ COMMON-LISP::SUBSTITUTE-IF-NOT SYSTEM::PUSH-LET-BINDING)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T) +++ (COMMON-LISP::T COMMON-LISP::T +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807)) ++ COMMON-LISP::T) ++- SYSTEM::MAKE-CONSTRUCTOR SYSTEM::MAKE-PREDICATE)) +++ SYSTEM::SHARP-SHARP-READER SYSTEM::SHARP-EQ-READER)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- SYSTEM::PUSH-SUB-LIST-BINDING SYSTEM::DO-ARG-COUNT-ERROR)) +++ SYSTEM::DO-ARG-COUNT-ERROR SYSTEM::PUSH-SUB-LIST-BINDING)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- SLOOP::DEF-LOOP-INTERNAL COMMON-LISP::MERGE ++- SYSTEM::PRINT-STACK-FRAME)) +++ SYSTEM::MAKE-CONSTRUCTOR SYSTEM::MAKE-PREDICATE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::*) +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) ++ COMMON-LISP::T) ++- COMMON-LISP::ENCODE-UNIVERSAL-TIME)) +++ ANSI-LOOP::LOOP-SEQUENCER)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++@@ -234,43 +274,50 @@ ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ SYSTEM::UNIVERSAL-ERROR-HANDLER)) +++(COMMON-LISP::MAPC +++ (COMMON-LISP::LAMBDA (COMPILER::X) +++ (COMMON-LISP::SETF +++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) +++ COMMON-LISP::T)) +++ '(SYSTEM::SI-FIND-CLASS SYSTEM::WARNINGP SYSTEM::SI-CLASS-OF +++ SYSTEM::CONDITION-CLASS-P SYSTEM::UNTRACE-ONE +++ SYSTEM::MAKE-ACCESS-FUNCTION SYSTEM::SIMPLE-CONDITION-CLASS-P +++ SYSTEM::CONDITIONP SYSTEM::AUTOLOAD +++ SYSTEM::SI-CLASS-PRECEDENCE-LIST SYSTEM::SI-CLASSP +++ FPE::BREAK-ON-FLOATING-POINT-EXCEPTIONS SYSTEM::TRACE-ONE +++ SYSTEM::AUTOLOAD-MACRO SYSTEM::DEFINE-STRUCTURE +++ SYSTEM::SI-CLASS-NAME)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::T) ++- COMMON-LISP::MERGE-PATHNAMES ++- COMMON-LISP::TRANSLATE-LOGICAL-PATHNAME ANSI-LOOP::LOOP-ERROR ++- COMMON-LISP::WILD-PATHNAME-P SLOOP::LOOP-ADD-TEMPS ++- SYSTEM::FILE-SEARCH SYSTEM::INFO-SEARCH ++- COMMON-LISP::PATHNAME-VERSION COMMON-LISP::WARN SYSTEM::MGSUB ++- COMMON-LISP::ARRAY-ROW-MAJOR-INDEX ++- COMMON-LISP::REMOVE-DUPLICATES COMMON-LISP::PATHNAME-NAME ++- COMMON-LISP::BIT COMMON-LISP::FIND-RESTART SYSTEM::TO-REGEXP ++- SYSTEM::PROCESS-SOME-ARGS COMMON-LISP::ERROR ++- COMMON-LISP::REQUIRE COMMON-LISP::OPEN ++- COMMON-LISP::UPGRADED-ARRAY-ELEMENT-TYPE SLOOP::ADD-FROM-DATA ++- SYSTEM::BREAK-LEVEL SYSTEM::LIST-MATCHES ++- COMMON-LISP::DELETE-DUPLICATES ANSI-LOOP::LOOP-WARN ++- COMMON-LISP::PATHNAME-DEVICE COMMON-LISP::LOAD ++- COMMON-LISP::PATHNAME-HOST COMMON-LISP::SBIT SYSTEM::NLOAD ++- COMMON-LISP::BIT-NOT COMMON-LISP::ENOUGH-NAMESTRING ++- COMMON-LISP::SIGNAL COMMON-LISP::ARRAY-IN-BOUNDS-P ++- COMMON-LISP::PATHNAME-TYPE SYSTEM::FILE-TO-STRING ++- SYSTEM::LOGICAL-PATHNAME-PARSE SYSTEM::NTH-STACK-FRAME ++- ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES SYSTEM::MGLIST ++- COMMON-LISP::DIRECTORY SYSTEM::BAD-SEQ-LIMIT ++- COMMON-LISP::PATHNAME-DIRECTORY COMMON-LISP::READ-BYTE ++- SYSTEM::LINK-EXPAND COMMON-LISP::CONCATENATE ++- COMMON-LISP::MAKE-ARRAY)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) +++ SYSTEM::INSTREAM-NAME ANSI-LOOP::LOOP-LIST-STEP +++ COMMON-LISP::PRIN1-TO-STRING ANSI-LOOP::NAMED-VARIABLE +++ SYSTEM::WAITING SYSTEM::FIND-DECLARATIONS COMMON-LISP::INSPECT +++ SYSTEM::END-WAITING SYSTEM::BREAK-GO SYSTEM::INFO-SUBFILE +++ COMMON-LISP::INVOKE-RESTART-INTERACTIVELY +++ ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES SYSTEM::INSPECT-OBJECT +++ SYSTEM::BREAK-LEVEL-INVOKE-RESTART SYSTEM::EXPAND-RANGES +++ SYSTEM::GET-&ENVIRONMENT COMMON-LISP::DESCRIBE +++ COMMON-LISP::PRINC-TO-STRING)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::*) ++- SYSTEM::NEWLINE SYSTEM::LIST-TOGGLE-CASE ++- COMMON-LISP::RENAME-FILE ANSI-LOOP::ESTIMATE-CODE-SIZE ++- SYSTEM::SOURCE-PORTION SYSTEM::RESTART-REPORT SYSTEM::DO-REPL ++- SYSTEM::FIND-DOC ANSI-LOOP::ESTIMATE-CODE-SIZE-1 ++- SYSTEM::NEW-SEMI-COLON-READER)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +++ COMMON-LISP::ABORT ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE +++ SYSTEM::MAKE-S-DATA ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL +++ ANSI-LOOP::MAKE-LOOP-PATH SYSTEM::CURRENT-STEP-FUN SYSTEM::LOC +++ SYSTEM::DBL-READ SYSTEM::MAKE-RESTART +++ SYSTEM::TRANSFORM-KEYWORDS COMMON-LISP::Y-OR-N-P +++ SYSTEM::NEXT-MATCH COMMON-LISP::COMPUTE-RESTARTS +++ SLOOP::PARSE-LOOP-WITH COMMON-LISP::VECTOR SYSTEM::STEP-NEXT +++ ANSI-LOOP::MAKE-LOOP-COLLECTOR +++ COMMON-LISP::USER-HOMEDIR-PATHNAME SLOOP::PARSE-LOOP-DECLARE +++ COMMON-LISP::YES-OR-NO-P SYSTEM::STEP-INTO +++ SYSTEM::MAKE-CONTEXT SYSTEM::BREAK-LOCALS +++ SYSTEM::DESCRIBE-ENVIRONMENT COMMON-LISP::DRIBBLE +++ ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL SYSTEM::MAYBE-CLEAR-INPUT +++ COMMON-LISP::BREAK ANSI-LOOP::LOOP-GENTEMP +++ ANSI-LOOP::MAKE-LOOP-UNIVERSE SYSTEM::MAKE-INSTREAM +++ COMMON-LISP::MAKE-PATHNAME)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++@@ -280,74 +327,6 @@ ++ FPE::FE-ENABLE SYSTEM::DBL-WHAT-FRAME)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::*) ++- SYSTEM::INFO SYSTEM::GET-SETF-METHOD-MULTIPLE-VALUE ++- COMMON-LISP::FTRUNCATE COMMON-LISP::USE-VALUE ++- COMMON-LISP::INVOKE-RESTART COMMON-LISP::WRITE-TO-STRING ++- COMMON-LISP::FCEILING COMMON-LISP::FROUND ++- COMMON-LISP::READ-FROM-STRING COMMON-LISP::FFLOOR ++- SYSTEM::PARSE-BODY-HEADER SYSTEM::BREAK-FUNCTION ++- SYSTEM::APROPOS-DOC COMMON-LISP::APROPOS ++- COMMON-LISP::APROPOS-LIST ++- ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE ++- COMMON-LISP::GET-SETF-EXPANSION SYSTEM::PRINT-DOC ++- COMMON-LISP::PARSE-NAMESTRING ++- COMMON-LISP::ENSURE-DIRECTORIES-EXIST ++- COMMON-LISP::DECODE-UNIVERSAL-TIME SYSTEM::SHOW-INFO ++- COMMON-LISP::STORE-VALUE SYSTEM::STEPPER)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::T) ++- COMMON-LISP::VECTOR-PUSH SYSTEM::DM-NTH COMMON-LISP::LOGORC1 ++- SLOOP::L-EQUAL SLOOP::NEVER-SLOOP-COLLECT ++- COMMON-LISP::LDB-TEST COMMON-LISP::LDB COMMON-LISP::LOGORC2 ++- SLOOP::COUNT-SLOOP-COLLECT SLOOP::MAXIMIZE-SLOOP-COLLECT ++- SYSTEM::ALL-MATCHES ANSI-LOOP::LOOP-TMEMBER SLOOP::THE-TYPE ++- SYSTEM::?PUSH SYSTEM::INCREMENT-CURSOR SYSTEM::SET-DIR ++- SYSTEM::DM-NTH-CDR SYSTEM::IN-INTERVAL-P SLOOP::MAKE-VALUE ++- SYSTEM::DBL-UP COMMON-LISP::COERCE SYSTEM::MATCH-DIMENSIONS ++- COMMON-LISP::LOGNAND SLOOP::=-SLOOP-FOR ++- SYSTEM::KEYWORD-SUPPLIED-P SYSTEM::OVERWRITE-SLOT-DESCRIPTIONS ++- SYSTEM::LEFT-PARENTHESIS-READER ++- ANSI-LOOP::LOOP-MAYBE-BIND-FORM SYSTEM::COERCE-TO-STRING ++- SYSTEM::ADD-FILE SLOOP::PARSE-LOOP-MAP COMMON-LISP::LOGNOR ++- SYSTEM::MSUB SYSTEM::SET-BACK SYSTEM::SUPER-GO ++- SYSTEM::SUBSTRINGP ANSI-LOOP::LOOP-TEQUAL ++- ANSI-LOOP::LOOP-DO-WHILE SYSTEM::GET-LINE-OF-FORM ++- FPE::READ-INSTRUCTION SYSTEM::SUB-INTERVAL-P ++- SYSTEM::CHECK-SEQ-START-END SYSTEM::*BREAK-POINTS* ++- ANSI-LOOP::MAKE-LOOP-MINIMAX SLOOP::IN-PACKAGE-SLOOP-MAP ++- SYSTEM::DM-V SYSTEM::INFO-AUX ++- ANSI-LOOP::HIDE-VARIABLE-REFERENCES ++- SLOOP::COLLATE-SLOOP-COLLECT COMMON-LISP::PATHNAME-MATCH-P ++- SYSTEM::SET-PATH-STREAM-NAME SLOOP::SUM-SLOOP-COLLECT ++- ANSI-LOOP::LOOP-LOOKUP-KEYWORD ++- ANSI-LOOP::LOOP-DECLARE-VARIABLE SYSTEM::BREAK-STEP-NEXT ++- FPE::RF SLOOP::IN-TABLE-SLOOP-MAP SYSTEM::OBJLT ++- FPE::READ-OPERANDS SYSTEM::BREAK-STEP-INTO COMMON-LISP::BYTE ++- SYSTEM::SEQUENCE-CURSOR SYSTEM::LIST-DELQ ++- SYSTEM::SETF-LOGICAL-PATHNAME-TRANSLATIONS ++- SYSTEM::CONDITION-PASS SYSTEM::SETF-HELPER FPE::0-READER ++- SYSTEM::DISPLAY-COMPILED-ENV COMMON-LISP::NTH ++- COMPILER::COMPILER-DEF-HOOK SYSTEM::DOT-DIR-P ++- COMMON-LISP::LOGTEST SYSTEM::QUOTATION-READER ++- SYSTEM::ITERATE-OVER-BKPTS COMMON-LISP::LOGANDC1 ++- SLOOP::ALWAYS-SLOOP-COLLECT SLOOP::DESETQ1 ++- SYSTEM::GET-INFO-CHOICES COMMON-LISP::WRITE-BYTE ++- ANSI-LOOP::LOOP-DO-IF ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION ++- ANSI-LOOP::LOOP-TASSOC SLOOP::IN-CAREFULLY-SLOOP-FOR ++- COMMON-LISP::DOCUMENTATION FPE::PAREN-READER SYSTEM::GET-NODES ++- SYSTEM::PARSE-SLOT-DESCRIPTION SLOOP::IN-FRINGE-SLOOP-MAP ++- SYSTEM::SAFE-EVAL SYSTEM::DISPLAY-ENV FPE::%-READER ++- SLOOP::THEREIS-SLOOP-COLLECT SYSTEM::LOOKUP-KEYWORD ++- COMMON-LISP::LOGANDC2 COMMON-LISP::NTHCDR ++- SLOOP::MINIMIZE-SLOOP-COLLECT SYSTEM::GET-MATCH ++- SYSTEM::SETF-EXPAND SLOOP::LOGXOR-SLOOP-COLLECT ++- ANSI-LOOP::LOOP-DO-ALWAYS)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++@@ -357,263 +336,300 @@ ++ SYSTEM::ROUND-UP)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++- COMMON-LISP::Y-OR-N-P COMMON-LISP::YES-OR-NO-P ++- COMMON-LISP::DRIBBLE COMMON-LISP::VECTOR SYSTEM::NEXT-MATCH ++- SYSTEM::MAKE-S-DATA SYSTEM::LOC SYSTEM::BREAK-LOCALS ++- SLOOP::PARSE-LOOP-WITH COMMON-LISP::USER-HOMEDIR-PATHNAME ++- SYSTEM::STEP-INTO SYSTEM::MAYBE-CLEAR-INPUT ++- ANSI-LOOP::MAKE-LOOP-PATH SYSTEM::STEP-NEXT ++- ANSI-LOOP::LOOP-GENTEMP COMMON-LISP::COMPUTE-RESTARTS ++- SYSTEM::CURRENT-STEP-FUN SYSTEM::MAKE-INSTREAM ++- ANSI-LOOP::MAKE-LOOP-COLLECTOR SYSTEM::MAKE-RESTART ++- SYSTEM::DESCRIBE-ENVIRONMENT SYSTEM::TRANSFORM-KEYWORDS ++- COMMON-LISP::ABORT ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE ++- ANSI-LOOP::MAKE-LOOP-UNIVERSE SLOOP::PARSE-LOOP-DECLARE ++- COMMON-LISP::BREAK ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL ++- SYSTEM::MAKE-CONTEXT SYSTEM::DBL-READ ++- COMMON-LISP::MAKE-PATHNAME ++- ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++- ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES SYSTEM::BREAK-GO ++- COMMON-LISP::FILE-AUTHOR SYSTEM::ENSURE-DIR-STRING ++- SYSTEM::INFO-SUBFILE COMMON-LISP::DESCRIBE SYSTEM::END-WAITING ++- COMMON-LISP::PRIN1-TO-STRING SYSTEM::FIND-DECLARATIONS ++- COMMON-LISP::INSPECT ANSI-LOOP::NAMED-VARIABLE ++- SYSTEM::GET-&ENVIRONMENT SYSTEM::INSPECT-OBJECT ++- COMMON-LISP::PRINC-TO-STRING ANSI-LOOP::LOOP-LIST-STEP ++- SYSTEM::INSTREAM-NAME SYSTEM::BREAK-LEVEL-INVOKE-RESTART ++- SYSTEM::WAITING COMMON-LISP::INVOKE-RESTART-INTERACTIVELY)) +++ (COMMON-LISP::FUNCTION +++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER +++ COMMON-LISP::*) +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807)) +++ COMMON-LISP::FIXNUM) +++ SYSTEM::ATOI)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++- SYSTEM::IHS-NOT-INTERPRETED-ENV COMMON-LISP::NINTH ++- SYSTEM::FIND-KCL-TOP-RESTART COMMON-LISP::TRUENAME ++- SYSTEM::DIRECTORY-LIST-CHECK SYSTEM::REAL-ASINH ++- SYSTEM::SHOW-ENVIRONMENT SYSTEM::PRINT-FRS ++- SYSTEM::REWRITE-RESTART-CASE-CLAUSE ++- COMMON-LISP::TWO-WAY-STREAM-OUTPUT-STREAM ++- ANSI-LOOP::LOOP-COLLECTOR-DATA SLOOP::POINTER-FOR-COLLECT ++- SYSTEM::MLP SYSTEM::WILD-PATH-ELEMENT-P SYSTEM::LNP ++- ANSI-LOOP::LOOP-MINIMAX-OPERATIONS SYSTEM::FRS-KIND ++- SYSTEM::BKPT-FILE COMMON-LISP::FIFTH ++- ANSI-LOOP::LOOP-COLLECTOR-P ANSI-LOOP::LOOP-UNIVERSE-ANSI ++- ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS SYSTEM::IDESCRIBE ++- ANSI-LOOP::LOOP-CONSTANTP ++- ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS COMMON-LISP::PROBE-FILE ++- ANSI-LOOP::LOOP-UNIVERSE-P COMMON-LISP::SINH SYSTEM::RESTART-P ++- SYSTEM::S-DATA-DOCUMENTATION +++ SYSTEM::REGEXP-CONV SYSTEM::DIR-CONJ SYSTEM::DIR-P +++ ANSI-LOOP::LOOP-LIST-COLLECTION COMMON-LISP::COSH +++ SYSTEM::GET-BYTE-STREAM-NCHARS SYSTEM::INSPECT-CONS +++ SYSTEM::KNOWN-TYPE-P SYSTEM::LNP COMMON-LISP::SEVENTH +++ SYSTEM::BKPT-FUNCTION SYSTEM::WILD-DIR-ELEMENT-P +++ COMMON-LISP::COMPILER-MACRO-FUNCTION +++ ANSI-LOOP::LOOP-HACK-ITERATION ++ COMMON-LISP::ECHO-STREAM-OUTPUT-STREAM ++- SYSTEM::FIND-DOCUMENTATION SYSTEM::INFO-GET-FILE ++- SLOOP::PARSE-NO-BODY COMMON-LISP::FILE-NAMESTRING ++- COMMON-LISP::COMPILER-MACRO-FUNCTION SYSTEM::PROCESS-ARGS ++- ANSI-LOOP::LOOP-COLLECTOR-DTYPE COMMON-LISP::PHASE ++- SYSTEM::MAKE-FRAME SYSTEM::INSTREAM-STREAM ++- ANSI-LOOP::LOOP-COLLECTOR-HISTORY SYSTEM::FIX-LOAD-PATH ++- SYSTEM::COMPUTING-ARGS-P ++- ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE COMMON-LISP::TENTH ++- ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE SYSTEM::WILD-NAMESTRING-P ++- SYSTEM::BEST-ARRAY-ELEMENT-TYPE SYSTEM::DM-BAD-KEY ++- SYSTEM::TERMINAL-INTERRUPT SYSTEM::REGEXP-CONV ++- COMMON-LISP::FILE-WRITE-DATE SLOOP::PARSE-LOOP ++- ANSI-LOOP::LOOP-CONSTRUCT-RETURN SYSTEM::DWIM +++ SYSTEM::DIRECTORY-LIST-CHECK COMMON-LISP::FILE-WRITE-DATE +++ SYSTEM::NORMALIZE-TYPE COMMON-LISP::EIGHTH SYSTEM::TOGGLE-CASE +++ SYSTEM::SHOW-ENVIRONMENT +++ COMMON-LISP::TWO-WAY-STREAM-INPUT-STREAM SYSTEM::GET-PATH +++ COMMON-LISP::ASINH SYSTEM::FIND-KCL-TOP-RESTART +++ SYSTEM::RESTART-P SYSTEM::EVAL-FEATURE SYSTEM::ALOAD +++ COMMON-LISP::PHASE SLOOP::SUBSTITUTE-SLOOP-BODY +++ COMMON-LISP::ASIN SYSTEM::NODES-FROM-INDEX +++ SYSTEM::MAKE-DEFPACKAGE-FORM ANSI-LOOP::LOOP-COLLECTOR-DTYPE +++ SYSTEM::LOGICAL-PATHNAMEP SYSTEM::INSPECT-VECTOR ++ ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS ++- SLOOP::RETURN-SLOOP-MACRO SLOOP::AVERAGING-SLOOP-MACRO ++- SYSTEM::S-DATA-NAME SYSTEM::CHECK-TRACE-SPEC ++- SYSTEM::RESTRICT-STREAM-ELEMENT-TYPE SLOOP::TRANSLATE-NAME ++- SYSTEM::ADD-TO-HOTLIST SYSTEM::S-DATA-CONC-NAME ++- ANSI-LOOP::LOOP-MINIMAX-TYPE SYSTEM::PRINT-IHS ++- SYSTEM::DBL-RPL-LOOP SYSTEM::CANONICALIZE-PATHNAME-DIRECTORY ++- SYSTEM::INSPECT-CONS SYSTEM::INSTREAM-STREAM-NAME ++- SYSTEM::S-DATA-P SYSTEM::EVAL-FEATURE ++- COMMON-LISP::ARRAY-DIMENSIONS SYSTEM::IHS-VISIBLE ++- ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE ++- SYSTEM::CHECK-DECLARATIONS COMMON-LISP::TANH ++- ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS ++- COMMON-LISP::COMPILE-FILE-PATHNAME SYSTEM::INSPECT-PACKAGE ++- SLOOP::LOOP-LET-BINDINGS COMMON-LISP::CIS SYSTEM::SETUP-INFO ++- SYSTEM::NORMALIZE-TYPE ANSI-LOOP::LOOP-PSEUDO-BODY ++- SYSTEM::PATH-STREAM-NAME SYSTEM::INFO-GET-TAGS FPE::ST-LOOKUP ++- SYSTEM::BREAK-BACKWARD-SEARCH-STACK ++- ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE SYSTEM::SIMPLE-ARRAY-P ++- SYSTEM::S-DATA-TYPE COMMON-LISP::CONCATENATED-STREAM-STREAMS ++- SYSTEM::INSPECT-CHARACTER ANSI-LOOP::DESTRUCTURING-SIZE ++- SYSTEM::GET-BYTE-STREAM-NCHARS ANSI-LOOP::LOOP-PATH-P ++- COMMON-LISP::FIRST COMMON-LISP::SECOND ++- COMMON-LISP::TWO-WAY-STREAM-INPUT-STREAM ++- SYSTEM::MAKE-DEFPACKAGE-FORM SYSTEM::INSPECT-SYMBOL ++- SYSTEM::INSPECT-VECTOR ++- COMMON-LISP::LOAD-LOGICAL-PATHNAME-TRANSLATIONS ++- SYSTEM::RESTART-INTERACTIVE-FUNCTION SYSTEM::INSPECT-STRING ++- SYSTEM::DIR-P ANSI-LOOP::LOOP-COLLECTOR-CLASS ++- SYSTEM::S-DATA-CONSTRUCTORS SYSTEM::NODES-FROM-INDEX ++- SYSTEM::VERSION-PARSE SYSTEM::BKPT-FILE-LINE COMMON-LISP::ABS ++- SYSTEM::IHS-FNAME ANSI-LOOP::LOOP-MAKE-PSETQ ++- SYSTEM::LEAP-YEAR-P ANSI-LOOP::LOOP-EMIT-FINAL-VALUE ++- SYSTEM::GET-PATH SYSTEM::ALOAD SYSTEM::DM-KEY-NOT-ALLOWED ++- SYSTEM::MAKE-KCL-TOP-RESTART SYSTEM::S-DATA-SLOT-DESCRIPTIONS ++- COMMON-LISP::VECTOR-POP ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS ++- ANSI-LOOP::LOOP-PATH-USER-DATA SYSTEM::S-DATA-SLOT-POSITION ++- COMMON-LISP::BROADCAST-STREAM-STREAMS ++- SYSTEM::LOGICAL-PATHNAMEP SYSTEM::BREAK-FORWARD-SEARCH-STACK ++- SLOOP::SLOOP-SLOOP-MACRO COMMON-LISP::SIGNUM ++- SYSTEM::RESET-TRACE-DECLARATIONS SYSTEM::CONTEXT-P ++- SYSTEM::S-DATA-FROZEN SYSTEM::NUMBER-OF-DAYS-FROM-1900 ++- SYSTEM::S-DATA-STATICP ANSI-LOOP::LOOP-PATH-FUNCTION ++- SYSTEM::KNOWN-TYPE-P COMMON-LISP::PROVIDE SYSTEM::PNL1 ++- ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD ++- SYSTEM::COERCE-SLASH-TERMINATED COMMON-LISP::LOGICAL-PATHNAME ++- SYSTEM::DIR-CONJ SYSTEM::BKPT-FORM ++- SYSTEM::LOGICAL-PATHNAME-HOST-P SYSTEM::INSPECT-STRUCTURE ++- ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED ++- COMMON-LISP::FIND-ALL-SYMBOLS +++ SYSTEM::RESTART-REPORT-FUNCTION SYSTEM::IHS-VISIBLE +++ SLOOP::LOOP-COLLECT-KEYWORD-P ANSI-LOOP::LOOP-TYPED-INIT +++ COMMON-LISP::VECTOR-POP SYSTEM::UNIQUE-ID ++ ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS ++- ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED +++ SYSTEM::SIMPLE-ARRAY-P COMMON-LISP::ACOS SYSTEM::DBL-EVAL +++ SYSTEM::INSPECT-STRING SYSTEM::MLP +++ SYSTEM::INSTREAM-STREAM-NAME SYSTEM::WILD-NAMESTRING-P +++ ANSI-LOOP::LOOP-PATH-FUNCTION +++ SYSTEM::GET-STRING-INPUT-STREAM-INDEX +++ ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE SYSTEM::SEQTYPE +++ ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS +++ SYSTEM::BEST-ARRAY-ELEMENT-TYPE +++ ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA SYSTEM::S-DATA-FROZEN +++ SYSTEM::S-DATA-DOCUMENTATION SYSTEM::DWIM COMMON-LISP::SIGNUM +++ SYSTEM::FIND-DOCUMENTATION ANSI-LOOP::LOOP-COLLECTOR-HISTORY +++ ANSI-LOOP::LOOP-MAKE-PSETQ FPE::GREF SYSTEM::S-DATA-OFFSET +++ SYSTEM::WILD-PATH-ELEMENT-P SYSTEM::INSTREAM-P +++ COMMON-LISP::DIRECTORY-NAMESTRING SYSTEM::INSPECT-ARRAY +++ COMMON-LISP::ARRAY-DIMENSIONS +++ ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS ANSI-LOOP::LOOP-MINIMAX-P +++ SLOOP::RETURN-SLOOP-MACRO SYSTEM::WALK-THROUGH +++ SYSTEM::NEXT-STACK-FRAME SYSTEM::S-DATA-NAME COMMON-LISP::TANH +++ SYSTEM::BREAK-BACKWARD-SEARCH-STACK COMMON-LISP::TENTH +++ SYSTEM::INFO-NODE-FROM-POSITION FPE::ST-LOOKUP +++ COMMON-LISP::RESTART-NAME SYSTEM::S-DATA-TYPE +++ SYSTEM::BKPT-FILE-LINE COMMON-LISP::FIND-ALL-SYMBOLS +++ COMMON-LISP::FIFTH SLOOP::LOOP-LET-BINDINGS +++ COMMON-LISP::ECHO-STREAM-INPUT-STREAM +++ ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED +++ COMMON-LISP::PROBE-FILE SYSTEM::MAKE-FRAME +++ SYSTEM::IHS-NOT-INTERPRETED-ENV SYSTEM::SEARCH-STACK +++ COMMON-LISP::COMPILE-FILE-PATHNAME +++ SYSTEM::PRINT-SYMBOL-APROPOS COMMON-LISP::LOGNOT +++ SYSTEM::INFO-GET-TAGS SYSTEM::SHORT-NAME +++ ANSI-LOOP::LOOP-MINIMAX-TYPE COMMON-LISP::SIXTH +++ COMMON-LISP::SECOND ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS +++ COMMON-LISP::TWO-WAY-STREAM-OUTPUT-STREAM +++ SYSTEM::S-DATA-INCLUDES SYSTEM::RESTART-INTERACTIVE-FUNCTION +++ SLOOP::TRANSLATE-NAME SYSTEM::PATCH-SHARP COMMON-LISP::ABS +++ ANSI-LOOP::LOOP-CONSTANTP SYSTEM::LEAP-YEAR-P +++ ANSI-LOOP::LOOP-UNIVERSE-ANSI ANSI-LOOP::LOOP-EMIT-BODY +++ COMMON-LISP::HOST-NAMESTRING COMMON-LISP::FIRST +++ SYSTEM::INSERT-BREAK-POINT +++ COMMON-LISP::LOAD-LOGICAL-PATHNAME-TRANSLATIONS +++ COMMON-LISP::DELETE-FILE ANSI-LOOP::LOOP-PSEUDO-BODY +++ SYSTEM::GET-NEXT-VISIBLE-FUN SYSTEM::S-DATA-HAS-HOLES +++ ANSI-LOOP::LOOP-COLLECTOR-NAME COMMON-LISP::FOURTH +++ SYSTEM::BKPT-FILE SYSTEM::CANONICALIZE-PATHNAME-DIRECTORY +++ SYSTEM::INSTREAM-STREAM SYSTEM::PNL1 SYSTEM::IHS-FNAME +++ SYSTEM::S-DATA-SLOT-POSITION SLOOP::PARSE-LOOP +++ SYSTEM::CHECK-TRACE-SPEC SYSTEM::S-DATA-CONSTRUCTORS +++ SYSTEM::S-DATA-STATICP SYSTEM::CONTEXT-P ++ COMMON-LISP::LOGICAL-PATHNAME-TRANSLATIONS ++- SYSTEM::TRACE-ONE-PREPROCESS COMMON-LISP::CONSTANTLY ++- COMMON-LISP::ACOS SYSTEM::S-DATA-OFFSET COMMON-LISP::ASINH ++- SYSTEM::SHORT-NAME SYSTEM::S-DATA-INCLUDED SYSTEM::DBL-EVAL ++- SYSTEM::BKPT-FUNCTION SYSTEM::INSPECT-NUMBER ++- SYSTEM::GET-INSTREAM SYSTEM::SHOW-BREAK-POINT FPE::LOOKUP ++- SYSTEM::NEXT-STACK-FRAME SYSTEM::INSPECT-ARRAY ++- SYSTEM::S-DATA-RAW ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA ++- SYSTEM::RESTART-REPORT-FUNCTION SYSTEM::TOGGLE-CASE ++- SYSTEM::NODE-OFFSET SYSTEM::INSTREAM-P ++- ANSI-LOOP::LOOP-PATH-NAMES SYSTEM::FREEZE-DEFSTRUCT ++- COMMON-LISP::SEVENTH SYSTEM::SEARCH-STACK COMMON-LISP::SIXTH ++- ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS FPE::GREF ++- FPE::XMM-LOOKUP COMMON-LISP::HOST-NAMESTRING ++- ANSI-LOOP::LOOP-TYPED-INIT +++ SYSTEM::INFO-GET-FILE COMMON-LISP::COMPLEMENT +++ SYSTEM::INSPECT-NUMBER SYSTEM::RESET-TRACE-DECLARATIONS +++ ANSI-LOOP::LOOP-PATH-P SLOOP::REPEAT-SLOOP-MACRO SYSTEM::DO-F +++ SYSTEM::INSPECT-PACKAGE SYSTEM::PATH-STREAM-NAME +++ SYSTEM::GET-INSTREAM COMMON-LISP::BYTE-SIZE +++ SYSTEM::RESTART-FUNCTION FPE::LOOKUP SYSTEM::S-DATA-CONC-NAME +++ COMMON-LISP::PROVIDE SYSTEM::S-DATA-NAMED SYSTEM::PRINT-FRS +++ ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE SYSTEM::NODE-OFFSET +++ ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE SYSTEM::PRINT-IHS +++ ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS COMMON-LISP::TRUENAME +++ SYSTEM::BREAK-FORWARD-SEARCH-STACK +++ COMMON-LISP::CONCATENATED-STREAM-STREAMS SYSTEM::VERSION-PARSE +++ SYSTEM::INSPECT-CHARACTER SYSTEM::LOGICAL-PATHNAME-HOST-P +++ SYSTEM::DM-BAD-KEY SYSTEM::EXPAND-HOME-DIR +++ ANSI-LOOP::LOOP-PATH-USER-DATA +++ ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS SYSTEM::INSPECT-SYMBOL +++ COMMON-LISP::INVOKE-DEBUGGER ++ SYSTEM::LOGICAL-PATHNAME-DESIGNATOR-P ++- ANSI-LOOP::LOOP-DO-THEREIS COMMON-LISP::EIGHTH ++- SYSTEM::UNIQUE-ID COMMON-LISP::THIRD ++- COMMON-LISP::BYTE-POSITION COMMON-LISP::SYNONYM-STREAM-SYMBOL ++- SYSTEM::PATCH-SHARP SYSTEM::PRINT-SYMBOL-APROPOS ++- COMMON-LISP::LOGNOT SLOOP::REPEAT-SLOOP-MACRO ++- COMMON-LISP::FOURTH SLOOP::SUBSTITUTE-SLOOP-BODY ++- COMMON-LISP::ATANH SLOOP::LOOP-COLLECT-KEYWORD-P ++- SYSTEM::SEQTYPE SYSTEM::RE-QUOTE-STRING COMMON-LISP::ISQRT ++- SYSTEM::DO-F SYSTEM::S-DATA-HAS-HOLES ++- ANSI-LOOP::LOOP-HACK-ITERATION ANSI-LOOP::LOOP-COLLECTOR-NAME ++- COMMON-LISP::RESTART-NAME COMMON-LISP::DIRECTORY-NAMESTRING ++- ANSI-LOOP::LOOP-EMIT-BODY COMMON-LISP::ACOSH ++- SYSTEM::RESTART-FUNCTION SYSTEM::INFO-NODE-FROM-POSITION ++- COMMON-LISP::ASIN ANSI-LOOP::LOOP-LIST-COLLECTION ++- SYSTEM::S-DATA-INCLUDES SYSTEM::GET-NEXT-VISIBLE-FUN ++- COMMON-LISP::BYTE-SIZE COMMON-LISP::PATHNAME ++- ANSI-LOOP::LOOP-MINIMAX-P SLOOP::PARSE-LOOP-INITIALLY ++- COMMON-LISP::COSH SYSTEM::EXPAND-HOME-DIR ++- COMMON-LISP::ECHO-STREAM-INPUT-STREAM ++- SYSTEM::INSERT-BREAK-POINT SYSTEM::RESTART-TEST-FUNCTION ++- SYSTEM::S-DATA-PRINT-FUNCTION SYSTEM::WILD-DIR-ELEMENT-P ++- SYSTEM::S-DATA-NAMED COMMON-LISP::INVOKE-DEBUGGER ++- COMMON-LISP::NAMESTRING ANSI-LOOP::LOOP-MAKE-DESETQ ++- COMMON-LISP::COMPLEMENT SYSTEM::WALK-THROUGH ++- COMMON-LISP::RATIONAL ANSI-LOOP::LOOP-MAXMIN-COLLECTION ++- COMMON-LISP::DELETE-FILE ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS)) +++ COMMON-LISP::BYTE-POSITION COMMON-LISP::ISQRT COMMON-LISP::CIS +++ ANSI-LOOP::LOOP-COLLECTOR-CLASS +++ COMMON-LISP::SYNONYM-STREAM-SYMBOL ANSI-LOOP::LOOP-PATH-NAMES +++ SYSTEM::RE-QUOTE-STRING SYSTEM::INSPECT-STRUCTURE +++ COMMON-LISP::RATIONAL FPE::XMM-LOOKUP +++ SYSTEM::REWRITE-RESTART-CASE-CLAUSE +++ SYSTEM::S-DATA-PRINT-FUNCTION +++ SYSTEM::RESTRICT-STREAM-ELEMENT-TYPE SLOOP::SLOOP-SLOOP-MACRO +++ COMMON-LISP::NAMESTRING SYSTEM::ENSURE-DIR-STRING +++ COMMON-LISP::CONSTANTLY SLOOP::PARSE-LOOP-INITIALLY +++ SYSTEM::S-DATA-RAW SYSTEM::ADD-TO-HOTLIST SYSTEM::FRS-KIND +++ ANSI-LOOP::LOOP-MAXMIN-COLLECTION +++ ANSI-LOOP::LOOP-COLLECTOR-DATA SYSTEM::PROCESS-ARGS +++ SYSTEM::COERCE-SLASH-TERMINATED SYSTEM::MAKE-KCL-TOP-RESTART +++ COMMON-LISP::ATANH ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD +++ COMMON-LISP::SINH ANSI-LOOP::LOOP-UNIVERSE-P +++ ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED +++ SYSTEM::S-DATA-INCLUDED COMMON-LISP::STREAM-EXTERNAL-FORMAT +++ SYSTEM::COMPUTING-ARGS-P SYSTEM::REAL-ASINH +++ ANSI-LOOP::LOOP-CONSTRUCT-RETURN +++ SYSTEM::S-DATA-SLOT-DESCRIPTIONS SYSTEM::FIX-LOAD-PATH +++ SYSTEM::CHECK-DECLARATIONS +++ ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS +++ SLOOP::POINTER-FOR-COLLECT COMMON-LISP::LOGICAL-PATHNAME +++ SYSTEM::CHDIR SYSTEM::IDESCRIBE +++ ANSI-LOOP::LOOP-MINIMAX-OPERATIONS COMMON-LISP::ACOSH +++ COMMON-LISP::NINTH ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE +++ ANSI-LOOP::LOOP-COLLECTOR-P SYSTEM::S-DATA-P SYSTEM::BKPT-FORM +++ COMMON-LISP::FILE-NAMESTRING SYSTEM::TERMINAL-INTERRUPT +++ SYSTEM::SETUP-INFO SLOOP::PARSE-NO-BODY +++ SYSTEM::DM-KEY-NOT-ALLOWED ANSI-LOOP::LOOP-EMIT-FINAL-VALUE +++ SYSTEM::FREEZE-DEFSTRUCT SYSTEM::DBL-RPL-LOOP +++ SYSTEM::TRACE-ONE-PREPROCESS +++ COMMON-LISP::BROADCAST-STREAM-STREAMS COMMON-LISP::THIRD +++ SLOOP::AVERAGING-SLOOP-MACRO SYSTEM::SHOW-BREAK-POINT +++ COMMON-LISP::PATHNAME ANSI-LOOP::LOOP-DO-THEREIS +++ COMMON-LISP::FILE-AUTHOR ANSI-LOOP::LOOP-MAKE-DESETQ +++ SYSTEM::NC SYSTEM::NUMBER-OF-DAYS-FROM-1900 +++ SYSTEM::RESTART-TEST-FUNCTION SYSTEM::WHICH +++ ANSI-LOOP::DESTRUCTURING-SIZE COMMON-LISP::FILE-LENGTH)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++- SYSTEM::BREAK-QUIT SYSTEM::BREAK-BDS SYSTEM::DBL-BACKTRACE ++- SYSTEM::BREAK-LOCAL SYSTEM::INFO-ERROR ++- SYSTEM::SHOW-BREAK-VARIABLES SYSTEM::BREAK-VS ++- COMMON-LISP::CONTINUE COMMON-LISP::MUFFLE-WARNING ++- SYSTEM::IHS-BACKTRACE ANSI-LOOP::LOOP-OPTIONAL-TYPE ++- SYSTEM::BREAK-PREVIOUS SYSTEM::BREAK-NEXT)) +++ SYSTEM::BREAK-VS ANSI-LOOP::LOOP-OPTIONAL-TYPE +++ SYSTEM::BREAK-BDS SYSTEM::IHS-BACKTRACE SYSTEM::INFO-ERROR +++ SYSTEM::BREAK-LOCAL SYSTEM::SHOW-BREAK-VARIABLES +++ COMMON-LISP::MUFFLE-WARNING SYSTEM::BREAK-PREVIOUS +++ SYSTEM::BREAK-QUIT SYSTEM::DBL-BACKTRACE COMMON-LISP::CONTINUE +++ SYSTEM::BREAK-NEXT)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) +++ SYSTEM::MAKE-KEYWORD)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- ((COMMON-LISP::INTEGER -9223372036854775808 ++- 9223372036854775807) ++- COMMON-LISP::T) +++ (COMMON-LISP::T +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807) +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807) +++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- SYSTEM::SMALLNTHCDR)) +++ SYSTEM::QUICK-SORT)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++- COMMON-LISP::HASH-TABLE) ++- SYSTEM::CONTEXT-SPICE)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807) +++ COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::T) +++ SYSTEM::BIGNTHCDR)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++- SYSTEM::S-DATA-SIZE FPE::REG-LOOKUP SYSTEM::INSTREAM-LINE ++- SYSTEM::S-DATA-LENGTH SYSTEM::THE-START)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ COMMON-LISP::FIND-RESTART COMMON-LISP::PATHNAME-HOST +++ SYSTEM::LINK-EXPAND COMMON-LISP::CONCATENATE COMMON-LISP::WARN +++ COMMON-LISP::FILE-POSITION ANSI-LOOP::LOOP-WARN +++ COMMON-LISP::PATHNAME-DIRECTORY COMMON-LISP::SBIT +++ COMMON-LISP::BIT ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES +++ COMMON-LISP::PATHNAME-TYPE COMMON-LISP::MAKE-ARRAY +++ ANSI-LOOP::LOOP-ERROR COMMON-LISP::DIRECTORY SYSTEM::DIR-PARSE +++ COMMON-LISP::TRANSLATE-LOGICAL-PATHNAME +++ SYSTEM::NTH-STACK-FRAME COMMON-LISP::REQUIRE COMMON-LISP::LOAD +++ SYSTEM::MGLIST COMMON-LISP::DELETE-DUPLICATES +++ COMMON-LISP::PATHNAME-VERSION COMMON-LISP::ENOUGH-NAMESTRING +++ SYSTEM::BAD-SEQ-LIMIT COMMON-LISP::REMOVE-DUPLICATES +++ COMMON-LISP::PATHNAME-NAME +++ COMMON-LISP::MAKE-STRING-INPUT-STREAM SLOOP::LOOP-ADD-TEMPS +++ SYSTEM::NLOAD SYSTEM::LIST-MATCHES +++ COMMON-LISP::ARRAY-ROW-MAJOR-INDEX +++ COMMON-LISP::ARRAY-IN-BOUNDS-P SYSTEM::BREAK-LEVEL +++ SYSTEM::PROCESS-SOME-ARGS SYSTEM::TO-REGEXP +++ COMMON-LISP::UPGRADED-ARRAY-ELEMENT-TYPE COMMON-LISP::OPEN +++ SYSTEM::FILE-SEARCH COMMON-LISP::READ-BYTE +++ SYSTEM::FILE-TO-STRING SLOOP::ADD-FROM-DATA COMMON-LISP::ERROR +++ COMMON-LISP::SIGNAL SYSTEM::MGSUB COMMON-LISP::WILD-PATHNAME-P +++ COMMON-LISP::PATHNAME-DEVICE SYSTEM::LOGICAL-PATHNAME-PARSE +++ COMMON-LISP::MERGE-PATHNAMES SYSTEM::INFO-SEARCH +++ COMMON-LISP::BIT-NOT)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) ++- SYSTEM::MATCH-BEGINNING SYSTEM::MATCH-END)) ++-(COMMON-LISP::MAPC ++- (COMMON-LISP::LAMBDA (COMPILER::X) ++- (COMMON-LISP::SETF ++- (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) ++- COMMON-LISP::T)) ++- '(SYSTEM::CONDITION-CLASS-P SYSTEM::WARNINGP SYSTEM::SI-CLASS-OF ++- SYSTEM::SI-FIND-CLASS SYSTEM::DEFINE-STRUCTURE ++- FPE::BREAK-ON-FLOATING-POINT-EXCEPTIONS ++- SYSTEM::SIMPLE-CONDITION-CLASS-P SYSTEM::AUTOLOAD ++- SYSTEM::SI-CLASS-PRECEDENCE-LIST SYSTEM::SI-CLASS-NAME ++- SYSTEM::TRACE-ONE SYSTEM::MAKE-ACCESS-FUNCTION ++- SYSTEM::UNTRACE-ONE SYSTEM::SI-CLASSP SYSTEM::CONDITIONP ++- SYSTEM::AUTOLOAD-MACRO)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ ANSI-LOOP::ESTIMATE-CODE-SIZE-1 SYSTEM::DO-REPL +++ SYSTEM::SOURCE-PORTION SYSTEM::RESTART-REPORT +++ SYSTEM::NEW-SEMI-COLON-READER SYSTEM::FIND-DOC +++ ANSI-LOOP::ESTIMATE-CODE-SIZE SYSTEM::NEWLINE +++ COMMON-LISP::RENAME-FILE SYSTEM::LIST-TOGGLE-CASE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- ((COMMON-LISP::INTEGER -9223372036854775808 ++- 9223372036854775807)) ++- COMMON-LISP::T) ++- SYSTEM::GET-CONTEXT SYSTEM::PUSH-CONTEXT)) +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ COMMON-LISP::REDUCE COMMON-LISP::STABLE-SORT +++ SYSTEM::PARSE-BODY SLOOP::FIND-IN-ORDERED-LIST +++ COMMON-LISP::SUBTYPEP COMMON-LISP::SORT)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::FIXNUM) ++- SYSTEM::RELATIVE-LINE SYSTEM::LENEL SYSTEM::THE-END ++- ANSI-LOOP::DUPLICATABLE-CODE-P SYSTEM::FASLINK ++- SYSTEM::GET-NODE-INDEX)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ SYSTEM::LIST-MERGE-SORT ANSI-LOOP::LOOP-GET-COLLECTION-INFO +++ SYSTEM::SHARP---READER SYSTEM::SHARP-S-READER +++ SYSTEM::VERIFY-KEYWORDS SYSTEM::RESTART-PRINT +++ SYSTEM::SHARP-+-READER SYSTEM::READ-INSPECT-COMMAND)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++- SLOOP::PARSE-ONE-WHEN-CLAUSE ANSI-LOOP::LOOP-DO-FINALLY ++- SLOOP::LOOP-PEEK ANSI-LOOP::LOOP-DO-INITIALLY SLOOP::LOOP-POP ++- ANSI-LOOP::LOOP-GET-PROGN SYSTEM::KCL-TOP-RESTARTS ++- SYSTEM::INSPECT-READ-LINE SLOOP::PARSE-LOOP-WHEN ++- ANSI-LOOP::LOOP-GET-FORM SYSTEM::DEFAULT-SYSTEM-BANNER ++- SYSTEM::SET-UP-TOP-LEVEL SYSTEM::GET-INDEX-NODE ++- ANSI-LOOP::LOOP-DO-DO ANSI-LOOP::LOOP-WHEN-IT-VARIABLE ++- SYSTEM::SETUP-LINEINFO COMMON-LISP::TYPE-ERROR ++- SYSTEM::READ-EVALUATED-FORM SYSTEM::INSPECT-INDENT-1 ++- SLOOP::LOOP-UN-POP SLOOP::PARSE-LOOP-DO ++- ANSI-LOOP::LOOP-DO-WITH SYSTEM::INSPECT-INDENT ++- SYSTEM::GET-TEMP-DIR ANSI-LOOP::LOOP-ITERATION-DRIVER ++- SYSTEM::WINE-TMP-REDIRECT SLOOP::PARSE-LOOP-COLLECT ++- SYSTEM::DEFAULT-INFO-HOTLIST SLOOP::PARSE-LOOP1 ++- SYSTEM::CLEANUP ANSI-LOOP::LOOP-DO-NAMED SYSTEM::DBL ++- SYSTEM::ALL-TRACE-DECLARATIONS SYSTEM::TEST-ERROR ++- ANSI-LOOP::LOOP-BIND-BLOCK ANSI-LOOP::LOOP-DO-REPEAT ++- SYSTEM::ILLEGAL-BOA SYSTEM::SET-ENV SYSTEM::SET-CURRENT ++- SYSTEM::INIT-BREAK-POINTS SYSTEM::GET-SIG-FN-NAME ++- ANSI-LOOP::LOOP-DO-RETURN ANSI-LOOP::LOOP-CONTEXT ++- SYSTEM::SHOW-RESTARTS SYSTEM::STEP-READ-LINE ++- SLOOP::PARSE-LOOP-FOR SYSTEM::DM-TOO-MANY-ARGUMENTS ++- COMMON-LISP::LISP-IMPLEMENTATION-VERSION SYSTEM::TOP-LEVEL ++- ANSI-LOOP::LOOP-POP-SOURCE SYSTEM::DM-TOO-FEW-ARGUMENTS)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ SYSTEM::PUSH-OPTIONAL-BINDING)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++- COMMON-LISP::*)) ++- COMMON-LISP::T) ++- SYSTEM::RESET-SYS-PATHS)) +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) +++ COMMON-LISP::*) +++ SYSTEM::TRACE-CALL)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++- (COMMON-LISP::VECTOR COMMON-LISP::T)) ++- SYSTEM::CONTEXT-VEC)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::*) +++ SYSTEM::MASET)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ SYSTEM::EXPAND-WILD-DIRECTORY)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ SYSTEM::PARSE-DEFMACRO SYSTEM::PARSE-DEFMACRO-LAMBDA-LIST)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) +++ COMMON-LISP::*) +++ SYSTEM::MME3)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ ((COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807) +++ COMMON-LISP::T) +++ COMMON-LISP::T) +++ SYSTEM::SMALLNTHCDR)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) ++- SYSTEM::BREAK-HELP SYSTEM::BREAK-MESSAGE ++- SYSTEM::SIMPLE-BACKTRACE ANSI-LOOP::LOOP-DO-FOR ++- SYSTEM::BREAK-CURRENT SYSTEM::GCL-TOP-LEVEL ++- SYSTEM::BREAK-RESUME)) ++\ No newline at end of file +++ SYSTEM::GCL-TOP-LEVEL SYSTEM::BREAK-MESSAGE +++ SYSTEM::BREAK-RESUME SYSTEM::SIMPLE-BACKTRACE +++ SYSTEM::BREAK-HELP ANSI-LOOP::LOOP-DO-FOR +++ SYSTEM::BREAK-CURRENT)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) +++ SYSTEM::S-DATA-LENGTH SYSTEM::THE-START SYSTEM::INSTREAM-LINE +++ SYSTEM::S-DATA-SIZE FPE::REG-LOOKUP)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) +++ SYSTEM::MATCH-BEGINNING SYSTEM::MATCH-END)) ++\ No newline at end of file ++--- gcl-2.6.12.orig/o/fasdump.c +++++ gcl-2.6.12/o/fasdump.c ++@@ -598,7 +598,7 @@ DEFUN_NEW("OPEN-FASD",object,fSopen_fasd ++ if(tabl==Cnil) tabl=funcall_cfun(Lmake_hash_table,2,sKtest,sLeq); ++ else ++ check_type(tabl,t_hashtable);} ++- check_type(str,t_stream); +++ massert(str==stream); ++ result=alloc_simple_vector(sizeof(struct fasd)/sizeof(int),aet_object); ++ array_allocself(result,1,Cnil); ++ {struct fasd *fd= (struct fasd *)result->v.v_self; ++@@ -608,7 +608,7 @@ DEFUN_NEW("OPEN-FASD",object,fSopen_fasd ++ fd->eof=eof; ++ fd->index=small_fixnum(0); ++ fd->package=symbol_value(sLApackageA); ++- fd->filepos = make_fixnum(file_position(stream)); +++ fd->filepos = make_fixnum(ftell(stream->sm.sm_fp)); ++ ++ SETUP_FASD_IN(fd); ++ if (direction==sKoutput){ ++@@ -649,13 +649,13 @@ DEFUN_NEW("CLOSE-FASD",object,fSclose_fa ++ {clrhash(fd->table); ++ SETUP_FASD_IN(fd); ++ PUT_OP(d_end_of_file); ++- {int i = file_position(fd->stream); +++ {int i = ftell(fd->stream->sm.sm_fp); ++ if(type_of(fd->filepos) == t_fixnum) ++- { file_position_set(fd->stream,fix(fd->filepos) +2); +++ { fseek(fd->stream->sm.sm_fp,fix(fd->filepos)+2,SEEK_SET); ++ /* record the length of array needed to read the indices */ ++ PUT4(fix(fd->index)); ++ /* move back to where we were */ ++- file_position_set(fd->stream,i); +++ fseek(fd->stream->sm.sm_fp,i,SEEK_SET); ++ }} ++ ++ } ++--- gcl-2.6.12.orig/o/file.d +++++ gcl-2.6.12/o/file.d ++@@ -167,7 +167,6 @@ BEGIN: ++ case smm_probe: ++ return(FALSE); ++ ++- case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -224,7 +223,6 @@ BEGIN: ++ case smm_probe: ++ return(FALSE); ++ ++- case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -272,7 +270,6 @@ BEGIN: ++ case smm_socket: ++ return (sLcharacter); ++ ++- case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -440,7 +437,7 @@ open_stream(object fn,enum smmode smm, o ++ x->sm.sm_buffer = 0; ++ x->sm.sm_object0 = sLcharacter; ++ x->sm.sm_object1 = vs_head; ++- x->sm.sm_int0 = x->sm.sm_int1 = 0; +++ x->sm.sm_int = 0; ++ x->sm.sm_flags=0; ++ vs_push(x); ++ ++@@ -522,8 +519,6 @@ DEFUN_NEW("OPEN-STREAM-P",object,fLopen_ ++ void ++ close_stream(object strm) { ++ ++- object x; ++- ++ if (FFN(fLopen_stream_p)(strm)==Cnil) ++ return; ++ ++@@ -569,24 +564,15 @@ close_stream(object strm) { ++ strm->sm.sm_fd = -1; ++ break; ++ ++- case smm_file_synonym: ++ case smm_synonym: ++- strm = symbol_value(strm->sm.sm_object0); ++- if (type_of(strm) != t_stream) ++- TYPE_ERROR(strm,sLstream); ++- close_stream(strm); ++ break; ++ ++ case smm_broadcast: ++ case smm_concatenated: ++- for (x = strm->sm.sm_object0; !endp(x); x = x->c.c_cdr) ++- close_stream(x->c.c_car); ++ break; ++ ++ case smm_two_way: ++ case smm_echo: ++- close_stream(STREAM_INPUT_STREAM(strm)); ++- close_stream(STREAM_OUTPUT_STREAM(strm)); ++ break; ++ ++ case smm_string_input: ++@@ -616,7 +602,6 @@ DEFUN_NEW("INTERACTIVE-STREAM-P",object, ++ return Ct; ++ return Cnil; ++ break; ++- case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -656,7 +641,7 @@ object istrm, ostrm; ++ strm->sm.sm_buffer = 0; ++ STREAM_INPUT_STREAM(strm) = istrm; ++ STREAM_OUTPUT_STREAM(strm) = ostrm; ++- strm->sm.sm_int0 = strm->sm.sm_int1 = 0; +++ strm->sm.sm_int = 0; ++ strm->sm.sm_flags=0; ++ return(strm); ++ } ++@@ -672,24 +657,30 @@ object istrm, ostrm; ++ return(strm); ++ } ++ ++-object ++-make_string_input_stream(strng, istart, iend) ++-object strng; ++-int istart, iend; ++-{ ++- object strm; +++DEFUN_NEW("MAKE-STRING-INPUT-STREAM-INT",object,fSmake_string_input_stream_int,SI,3,3,NONE,OO,II,OO,OO, +++ (object strng,fixnum istart,fixnum iend),"") { +++ +++ object strm; +++ +++ strm = alloc_object(t_stream); +++ strm->sm.sm_mode = (short)smm_string_input; +++ strm->sm.sm_fp = NULL; +++ strm->sm.sm_buffer = 0; +++ STRING_STREAM_STRING(strm) = strng; +++ strm->sm.sm_object1 = OBJNULL; +++ STRING_INPUT_STREAM_NEXT(strm)= istart; +++ STRING_INPUT_STREAM_END(strm)= iend; +++ strm->sm.sm_flags=0; +++ +++ RETURN1(strm); ++ ++- strm = alloc_object(t_stream); ++- strm->sm.sm_mode = (short)smm_string_input; ++- strm->sm.sm_fp = NULL; ++- strm->sm.sm_buffer = 0; ++- STRING_STREAM_STRING(strm) = strng; ++- strm->sm.sm_object1 = OBJNULL; ++- STRING_INPUT_STREAM_NEXT(strm)= istart; ++- STRING_INPUT_STREAM_END(strm)= iend; ++- strm->sm.sm_flags=0; ++- return(strm); ++ } +++#ifdef STATIC_FUNCTION_POINTERS +++object +++fSmake_string_input_stream_int(object x,fixnum y,fixnum z) { +++ return FFN(fSmake_string_input_stream_int)(x,y,z); +++} +++#endif ++ ++ DEFUN_NEW("STRING-INPUT-STREAM-P",object,fSstring_input_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ return type_of(x)==t_stream && x->sm.sm_mode == (short)smm_string_input ? Ct : Cnil; ++@@ -722,7 +713,7 @@ int line_length; ++ strm->sm.sm_buffer = 0; ++ STRING_STREAM_STRING(strm) = strng; ++ strm->sm.sm_object1 = OBJNULL; ++- strm->sm.sm_int0 = STREAM_FILE_COLUMN(strm) = 0; +++ strm->sm.sm_int = 0; ++ strm->sm.sm_flags=0; ++ vs_reset; ++ return(strm); ++@@ -777,7 +768,6 @@ BEGIN: ++ /* strm->sm.sm_int0++; */ ++ return(c==EOF ? c : (c&0377)); ++ ++- case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -880,7 +870,6 @@ BEGIN: ++ /* --strm->sm.sm_int0; */ /* use ftell now for position */ ++ break; ++ ++- case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -982,7 +971,6 @@ BEGIN: ++ ++ break; ++ ++- case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -1093,7 +1081,6 @@ BEGIN: ++ #endif ++ closed_stream(strm); ++ break; ++- case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -1182,7 +1169,6 @@ BEGIN: ++ case smm_probe: ++ return(FALSE); ++ ++- case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ check_stream(strm); ++@@ -1308,7 +1294,6 @@ BEGIN: ++ #endif ++ return TRUE; ++ ++- case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -1345,136 +1330,6 @@ BEGIN: ++ } ++ ++ int ++-file_position(strm) ++-object strm; ++-{ ++-BEGIN: ++- switch (strm->sm.sm_mode) { ++- case smm_input: ++- case smm_output: ++- case smm_io: ++- /* return(strm->sm.sm_int0); */ ++- if (strm->sm.sm_fp == NULL) ++- closed_stream(strm); ++- return(ftell(strm->sm.sm_fp)); ++- case smm_socket: ++- return -1; ++- ++- ++- case smm_string_output: ++- return(STRING_STREAM_STRING(strm)->st.st_fillp); ++- ++- case smm_file_synonym: ++- case smm_synonym: ++- strm = symbol_value(strm->sm.sm_object0); ++- if (type_of(strm) != t_stream) ++- FEwrong_type_argument(sLstream, strm); ++- goto BEGIN; ++- ++- case smm_probe: ++- case smm_broadcast: ++- case smm_concatenated: ++- case smm_two_way: ++- case smm_echo: ++- case smm_string_input: ++- return(-1); ++- ++- default: ++- error("illegal stream mode"); ++- return(-1); ++- } ++-} ++- ++-int ++-file_position_set(strm, disp) ++-object strm; ++-int disp; ++-{ ++-BEGIN: ++- switch (strm->sm.sm_mode) { ++- case smm_socket: ++- return -1; ++- case smm_input: ++- case smm_output: ++- case smm_io: ++- ++- if (fseek(strm->sm.sm_fp, disp, 0) < 0) ++- return(-1); ++- /* strm->sm.sm_int0 = disp; */ ++- return(0); ++- ++- case smm_string_output: ++- if (disp < STRING_STREAM_STRING(strm)->st.st_fillp) { ++- STRING_STREAM_STRING(strm)->st.st_fillp = disp; ++- /* strm->sm.sm_int0 = disp; */ ++- } else { ++- disp -= STRING_STREAM_STRING(strm)->st.st_fillp; ++- while (disp-- > 0) ++- writec_stream(' ', strm); ++- } ++- return(0); ++- ++- case smm_file_synonym: ++- case smm_synonym: ++- strm = symbol_value(strm->sm.sm_object0); ++- if (type_of(strm) != t_stream) ++- FEwrong_type_argument(sLstream, strm); ++- goto BEGIN; ++- ++- case smm_probe: ++- case smm_broadcast: ++- case smm_concatenated: ++- case smm_two_way: ++- case smm_echo: ++- case smm_string_input: ++- return(-1); ++- ++- default: ++- error("illegal stream mode"); ++- return(-1); ++- } ++-} ++- ++-static int ++-file_length(strm) ++-object strm; ++-{ ++-BEGIN: ++- switch (strm->sm.sm_mode) { ++- case smm_input: ++- case smm_output: ++- case smm_io: ++- ++- if (strm->sm.sm_fp == NULL) ++- closed_stream(strm); ++- return(file_len(strm->sm.sm_fp)); ++- ++- ++- ++- case smm_file_synonym: ++- case smm_synonym: ++- strm = symbol_value(strm->sm.sm_object0); ++- if (type_of(strm) != t_stream) ++- FEwrong_type_argument(sLstream, strm); ++- goto BEGIN; ++- ++- case smm_socket: ++- case smm_probe: ++- case smm_broadcast: ++- case smm_concatenated: ++- case smm_two_way: ++- case smm_echo: ++- case smm_string_input: ++- case smm_string_output: ++- return(-1); ++- ++- default: ++- error("illegal stream mode"); ++- return(-1); ++- } ++-} ++- ++-int ++ file_column(object strm) { ++ int i; ++ object x; ++@@ -1491,7 +1346,6 @@ BEGIN: ++ case smm_two_way: ++ strm=STREAM_OUTPUT_STREAM(strm); ++ goto BEGIN; ++- case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -1558,22 +1412,6 @@ load(const char *s) { ++ ++ ++ ++-static int ++-file_synonym_stream_p(object x) { ++- switch(x->sm.sm_mode) { ++- case smm_input: ++- case smm_output: ++- case smm_io: ++- case smm_probe: ++- case smm_file_synonym: ++- return 1; ++- case smm_synonym: ++- return file_synonym_stream_p(x->sm.sm_object0->s.s_dbind); ++- default: ++- return 0; ++- } ++-} ++- ++ LFD(Lmake_synonym_stream)() ++ { ++ object x; ++@@ -1581,12 +1419,12 @@ LFD(Lmake_synonym_stream)() ++ check_arg(1); ++ check_type_sym(&vs_base[0]); ++ x = alloc_object(t_stream); ++- x->sm.sm_mode = file_synonym_stream_p(vs_base[0]) ? (short)smm_file_synonym : (short)smm_synonym; +++ x->sm.sm_mode = (short)smm_synonym; ++ x->sm.sm_fp = NULL; ++ x->sm.sm_buffer = 0; ++ x->sm.sm_object0 = vs_base[0]; ++ x->sm.sm_object1 = OBJNULL; ++- x->sm.sm_int0 = x->sm.sm_int1 = 0; +++ x->sm.sm_int = 0; ++ x->sm.sm_flags=0; ++ vs_base[0] = x; ++ } ++@@ -1610,7 +1448,7 @@ LFD(Lmake_broadcast_stream)() ++ x->sm.sm_buffer = 0; ++ x->sm.sm_object0 = vs_base[0]; ++ x->sm.sm_object1 = OBJNULL; ++- x->sm.sm_int0 = x->sm.sm_int1 = 0; +++ x->sm.sm_int = 0; ++ x->sm.sm_flags=0; ++ vs_base[0] = x; ++ } ++@@ -1634,7 +1472,7 @@ LFD(Lmake_concatenated_stream)() ++ x->sm.sm_buffer = 0; ++ x->sm.sm_object0 = vs_base[0]; ++ x->sm.sm_object1 = OBJNULL; ++- x->sm.sm_int0 = x->sm.sm_int1 = 0; +++ x->sm.sm_int = 0; ++ x->sm.sm_flags=0; ++ vs_base[0] = x; ++ } ++@@ -1667,32 +1505,6 @@ LFD(Lmake_echo_stream)() ++ vs_popp; ++ } ++ ++-@(static defun make_string_input_stream (strng &o istart iend) ++- int s, e; ++-@ ++- check_type_string(&strng); ++- if (istart == Cnil) ++- s = 0; ++- else if (type_of(istart) != t_fixnum) ++- goto E; ++- else ++- s = fix(istart); ++- if (iend == Cnil) ++- e = strng->st.st_fillp; ++- else if (type_of(iend) != t_fixnum) ++- goto E; ++- else ++- e = fix(iend); ++- if (s < 0 || e > strng->st.st_fillp || s > e) ++- goto E; ++- @(return `make_string_input_stream(strng, s, e)`) ++- ++-E: ++- FEerror("~S and ~S are illegal as :START and :END~%\ ++-for the string ~S.", ++- 3, istart, iend, strng); ++-@) ++- ++ @(static defun make_string_output_stream (&k element_type) ++ @ ++ element_type=Cnil;/*FIXME*/ ++@@ -1724,12 +1536,29 @@ LFD(siLoutput_stream_string)() ++ vs_base[0] = vs_base[0]->sm.sm_object0; ++ } ++ +++object +++file_stream(object x) { +++ if (type_of(x)==t_stream) +++ switch(x->sm.sm_mode) { +++ case smm_input: +++ case smm_output: +++ case smm_io: +++ case smm_probe: +++ return x; +++ case smm_synonym: +++ return file_stream(x->sm.sm_object0->s.s_dbind); +++ default: +++ break; +++ } +++ return Cnil; +++} +++ ++ DEFUN_NEW("FILE-STREAM-P",object,fSfile_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++- RETURN1(type_of(x)==t_stream && file_synonym_stream_p(x) ? Ct : Cnil); +++ RETURN1(file_stream(x)!=Cnil ? Ct : Cnil); ++ } ++ ++ DEFUN_NEW("SYNONYM-STREAM-P",object,fSsynonym_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++- RETURN1(type_of(x)==t_stream && (x->sm.sm_mode==smm_file_synonym || x->sm.sm_mode==smm_synonym) ? Ct : Cnil); +++ RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_synonym ? Ct : Cnil); ++ } ++ ++ DEFUN_NEW("TERMINAL-INPUT-STREAM-P",object,fSterminal_input_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++@@ -1802,43 +1631,6 @@ LFD(Lstream_element_type)() ++ @) ++ ++ ++-@(defun file_position (file_stream &o position) ++- int i=0; ++-@ ++- check_type_stream(&file_stream); ++- if (position == Cnil) { ++- i = file_position(file_stream); ++- if (i < 0) ++- @(return Cnil) ++- @(return `make_fixnum(i)`) ++- } else { ++- if (position == sKstart) ++- i = 0; ++- else if (position == sKend) ++- i = file_length(file_stream); ++- else if (type_of(position) != t_fixnum || ++- (i = fix((position))) < 0) ++- FEerror("~S is an illegal file position~%\ ++-for the file-stream ~S.", ++- 2, position, file_stream); ++- if (file_position_set(file_stream, i) < 0) ++- @(return Cnil) ++- @(return Ct) ++- } ++-@) ++- ++-LFD(Lfile_length)() ++-{ ++- int i; ++- ++- check_arg(1); ++- check_type_stream(&vs_base[0]); ++- i = file_length(vs_base[0]); ++- if (i < 0) ++- vs_base[0] = Cnil; ++- else ++- vs_base[0] = make_fixnum(i); ++-} ++ ++ object sLAload_pathnameA; ++ DEFVAR("*COLLECT-BINARY-MODULES*",sSAcollect_binary_modulesA,SI,sLnil,""); ++@@ -1911,17 +1703,6 @@ DEFUN_NEW("LOAD-FASL",object,fSload_fasl ++ ++ } ++ ++-static void ++-FFN(siLget_string_input_stream_index)() ++-{ ++- check_arg(1); ++- check_type_stream(&vs_base[0]); ++- if ((enum smmode)vs_base[0]->sm.sm_mode != smm_string_input) ++- FEerror("~S is not a string-input stream.", 1, vs_base[0]); ++- vs_base[0] = make_fixnum(STRING_INPUT_STREAM_NEXT(vs_base[0])); ++-} ++- ++- ++ LFD(siLmake_string_output_stream_from_string)() ++ { ++ object strng, strm; ++@@ -2042,7 +1823,6 @@ int out; ++ if (type_of(strm) != t_stream) ++ FEwrong_type_argument(sLstream, strm); ++ switch (strm->sm.sm_mode){ ++- case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++@@ -2203,7 +1983,7 @@ object async; ++ x->sm.sm_buffer = 0; ++ x->sm.sm_object0 = list(3,server,host,port); ++ x->sm.sm_object1 = 0; ++- x->sm.sm_int0 = x->sm.sm_int1 = 0; +++ x->sm.sm_int = 0; ++ x->sm.sm_flags=0; ++ SOCKET_STREAM_FD(x)= fd; ++ SET_STREAM_FLAG(x,mode,1); ++@@ -2466,8 +2246,7 @@ gcl_init_file(void) ++ #ifdef UNIX ++ = make_simple_string("stdin"); ++ #endif ++- standard_input->sm.sm_int0 = 0; /* unused */ ++- standard_input->sm.sm_int1 = 0; /* unused */ +++ standard_input->sm.sm_int = 0; /* unused */ ++ standard_input->sm.sm_flags=0; ++ ++ standard_output = alloc_object(t_stream); ++@@ -2479,8 +2258,7 @@ gcl_init_file(void) ++ #ifdef UNIX ++ = make_simple_string("stdout"); ++ #endif ++- standard_output->sm.sm_int0 = 0; /* unused */ ++- STREAM_FILE_COLUMN(standard_output) = 0; +++ standard_output->sm.sm_int = 0; /* unused */ ++ standard_output->sm.sm_flags=0; ++ ++ terminal_io = standard ++@@ -2488,12 +2266,12 @@ gcl_init_file(void) ++ enter_mark_origin(&terminal_io); ++ ++ x = alloc_object(t_stream); ++- x->sm.sm_mode = (short)smm_file_synonym; +++ x->sm.sm_mode = (short)smm_synonym; ++ x->sm.sm_fp = NULL; ++ x->sm.sm_buffer = 0; ++ x->sm.sm_object0 = sLAterminal_ioA; ++ x->sm.sm_object1 = OBJNULL; ++- x->sm.sm_int0 = x->sm.sm_int1 = 0; /* unused */ +++ x->sm.sm_int = 0; /* unused */ ++ x->sm.sm_flags=0; ++ standard_io = x; ++ enter_mark_origin(&standard_io); ++@@ -2561,8 +2339,6 @@ gcl_init_file_function() ++ Lmake_concatenated_stream); ++ make_function("MAKE-TWO-WAY-STREAM", Lmake_two_way_stream); ++ make_function("MAKE-ECHO-STREAM", Lmake_echo_stream); ++- make_function("MAKE-STRING-INPUT-STREAM", ++- Lmake_string_input_stream); ++ make_function("MAKE-STRING-OUTPUT-STREAM", ++ Lmake_string_output_stream); ++ make_function("GET-OUTPUT-STREAM-STRING", ++@@ -2581,11 +2357,6 @@ gcl_init_file_function() ++ make_function("STREAM-ELEMENT-TYPE", Lstream_element_type); ++ make_function("CLOSE", Lclose); ++ ++- make_function("FILE-POSITION", Lfile_position); ++- make_function("FILE-LENGTH", Lfile_length); ++- ++- make_si_function("GET-STRING-INPUT-STREAM-INDEX", ++- siLget_string_input_stream_index); ++ make_si_function("MAKE-STRING-OUTPUT-STREAM-FROM-STRING", ++ siLmake_string_output_stream_from_string); ++ make_si_function("COPY-STREAM", siLcopy_stream); ++--- gcl-2.6.12.orig/o/gbc.c +++++ gcl-2.6.12/o/gbc.c ++@@ -627,7 +627,6 @@ mark_object1(object x) { ++ } ++ break; ++ ++- case smm_file_synonym: ++ case smm_synonym: ++ mark_object(x->sm.sm_object0); ++ break; ++--- gcl-2.6.12.orig/o/pathname.d +++++ gcl-2.6.12/o/pathname.d ++@@ -83,6 +83,11 @@ DEFUN_NEW("C-STREAM-OBJECT1",object,fSc_ ++ RETURN1(x->sm.sm_object1); ++ } ++ +++DEFUN_NEW("C-SET-STREAM-OBJECT0",object,fSc_set_stream_object0,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { +++ x->sm.sm_object0=y; +++ RETURN1(x); +++} +++ ++ DEFUN_NEW("C-SET-STREAM-OBJECT1",object,fSc_set_stream_object1,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { ++ x->sm.sm_object1=y; ++ RETURN1(x); ++--- gcl-2.6.12.orig/o/print.d +++++ gcl-2.6.12/o/print.d ++@@ -1260,7 +1260,6 @@ int level; ++ write_ch('>'); ++ break; ++ ++- case smm_file_synonym: ++ case smm_synonym: ++ write_str("#sm.sm_object0, level); ++--- gcl-2.6.12.orig/o/read.d +++++ gcl-2.6.12/o/read.d ++@@ -2204,7 +2204,7 @@ object x; ++ object in; ++ vs_mark; ++ ++- in = make_string_input_stream(x, 0, x->st.st_fillp); +++ in = fSmake_string_input_stream_int(x, 0, x->st.st_fillp); ++ vs_push(in); ++ preserving_whitespace_flag = FALSE; ++ detect_eos_flag = FALSE; ++--- gcl-2.6.12.orig/o/run_process.c +++++ gcl-2.6.12/o/run_process.c ++@@ -434,7 +434,7 @@ enum smmode smm; ++ ++ stream->sm.sm_object0 = sLcharacter; ++ stream->sm.sm_object1 = host_l; ++- stream->sm.sm_int0 = stream->sm.sm_int1 = 0; +++ stream->sm.sm_int = 0; ++ stream->sm.sm_flags=0; ++ vs_push(stream); ++ setup_stream_buffer(stream); ++@@ -503,8 +503,7 @@ make_socket_pair() ++ stream_in->sm.sm_mode = smm_input; ++ stream_in->sm.sm_fp = fp1; ++ stream_in->sm.sm_buffer = 0; ++- stream_in->sm.sm_int0 = sockets_in[1]; ++- stream_in->sm.sm_int1 = 0; +++ stream_in->sm.sm_int = sockets_in[1]; ++ stream_in->sm.sm_object0=stream_in->sm.sm_object1=OBJNULL; ++ stream_in->sm.sm_flags = 0; ++ stream_out = (object) alloc_object(t_stream); ++@@ -513,8 +512,7 @@ make_socket_pair() ++ stream_out->sm.sm_buffer = 0; ++ setup_stream_buffer(stream_in); ++ setup_stream_buffer(stream_out); ++- stream_out->sm.sm_int0 = sockets_out[1]; ++- stream_out->sm.sm_int1 = 0; +++ stream_out->sm.sm_int = sockets_out[1]; ++ stream_out->sm.sm_flags = 0; ++ stream_out->sm.sm_object0=stream_out->sm.sm_object1=OBJNULL; ++ stream = make_two_way_stream(stream_in, stream_out); ++@@ -538,8 +536,8 @@ char **argv; ++ int fdout; ++ if (istream->sm.sm_fp == NULL || ostream->sm.sm_fp == NULL) ++ FEerror("Cannot spawn process with given stream", 0); ++- fdin = istream->sm.sm_int0; ++- fdout = ostream->sm.sm_int0; +++ fdin = istream->sm.sm_int; +++ fdout = ostream->sm.sm_int; ++ if (pfork() == 0) ++ { /* the child --- replace standard in and out with descriptors given */ ++ close(0); ++--- gcl-2.6.12.orig/o/sockets.c +++++ gcl-2.6.12/o/sockets.c ++@@ -518,16 +518,6 @@ DEFUN_NEW("SET-SIGIO-FOR-FD",object,fSse ++ ++ } ++ ++-DEFUN_NEW("RESET-STRING-INPUT-STREAM",object,fSreset_string_input_stream,SI,4,4,NONE,OO,OI,IO,OO,(object strm,object string,fixnum start,fixnum end), ++- "Reuse a string output STREAM by setting its output to STRING \ ++-and positioning the ouput/input to start at START and end at END") ++- ++-{ strm->sm.sm_object0 = string; ++- strm->sm.sm_int0 = start; ++- strm->sm.sm_int1 = end; ++- return strm; ++-} ++- ++ DEFUN_NEW("CHECK-STATE-INPUT",object,fScheck_state_input,SI,2,2,NONE,OO,IO,OO,OO,(object osfd,fixnum timeout), ++ "") ++ { ++--- gcl-2.6.12.orig/o/string.d +++++ gcl-2.6.12/o/string.d ++@@ -564,28 +564,33 @@ LFD(Lnstring_capitalize)() { casefun = c ++ @(return `coerce_to_string(x)`) ++ @) ++ ++-static void ++-FFN(siLstring_concatenate)() ++-{ ++- int narg, i, l, m; ++- object *v; +++DEFUN_NEW("STRING-CONCATENATE",object,fLstring_concatenate,SI,0,63,NONE,OO,OO,OO,OO,(object first,...),"") { +++ +++ fixnum i,l,m,narg=VFUN_NARGS; +++ object x; +++ va_list ap; +++ +++ va_start(ap,first); +++ vs_base=vs_top; +++ for (l=i=0;ist.st_fillp; +++ } +++ va_end(ap); +++ +++ { +++ object *p; +++ BEGIN_NO_INTERRUPT; +++ x=alloc_simple_string(l); +++ (x)->st.st_self = alloc_relblock(l); +++ for (l=0,p=vs_base;pst.st_fillp)>=0;p++,l+=m) +++ memcpy(x->st.st_self+l,(*p)->st.st_self,m); +++ END_NO_INTERRUPT; +++ +++ } +++ +++ RETURN1(x); ++ ++- narg = vs_top - vs_base; ++- for (i = 0, l = 0; i < narg; i++) { ++- vs_base[i] = coerce_to_string(vs_base[i]); ++- l += vs_base[i]->st.st_fillp; ++- } ++- v = vs_top; ++- {BEGIN_NO_INTERRUPT; ++- vs_push(alloc_simple_string(l)); ++- (*v)->st.st_self = alloc_relblock(l); ++- for (i = 0, l = 0; i < narg; i++) ++- for (m = 0; m < vs_base[i]->st.st_fillp; m++) ++- (*v)->st.st_self[l++] ++- = vs_base[i]->st.st_self[m]; ++- vs_base[0] = *v; ++- vs_top = vs_base + 1; ++- END_NO_INTERRUPT;} ++ } ++ ++ void ++@@ -628,6 +633,4 @@ gcl_init_string_function() ++ make_function("NSTRING-CAPITALIZE", Lnstring_capitalize); ++ make_function("STRING", Lstring); ++ ++- make_si_function("STRING-CONCATENATE", ++- siLstring_concatenate); ++ } ++--- gcl-2.6.12.orig/o/unixfsys.c +++++ gcl-2.6.12/o/unixfsys.c ++@@ -55,7 +55,7 @@ get_string(object x) { ++ case smm_probe: ++ case smm_io: ++ return get_string(x->sm.sm_object1); ++- case smm_file_synonym: +++ case smm_synonym: ++ return get_string(x->sm.sm_object0->s.s_dbind); ++ } ++ } ++@@ -169,24 +169,6 @@ DEF_ORDINARY("DIRECTORY",sKdirectory,KEY ++ DEF_ORDINARY("LINK",sKlink,KEYWORD,""); ++ DEF_ORDINARY("FILE",sKfile,KEYWORD,""); ++ ++-object ++-file_stream(object x) { ++- if (type_of(x)==t_stream) ++- switch(x->sm.sm_mode) { ++- case smm_input: ++- case smm_output: ++- case smm_io: ++- case smm_probe: ++- return x; ++- case smm_synonym: ++- return file_stream(x->sm.sm_object0->s.s_dbind); ++- default: ++- break; ++- } ++- return Cnil; ++-} ++- ++- ++ DEFUNM_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ ++ struct stat ss; ++--- gcl-2.6.12.orig/pcl/sys-proclaim.lisp +++++ gcl-2.6.12/pcl/sys-proclaim.lisp ++@@ -2,29 +2,19 @@ ++ (COMMON-LISP::IN-PACKAGE "PCL") ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FUNCTION) ++- PCL::CACHE-LIMIT-FN PCL::FAST-METHOD-CALL-FUNCTION ++- PCL::METHOD-CALL-FUNCTION)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM COMMON-LISP::T) +++ COMMON-LISP::T) +++ PCL::%CCLOSURE-ENV-NTHCDR)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++- PCL::DISPATCH-DFUN-INFO PCL::DEFAULT-METHOD-ONLY-DFUN-INFO ++- PCL::MAKE-CACHE PCL::BOOTSTRAP-BUILT-IN-CLASSES ++- PCL::RENEW-SYS-FILES PCL::SHOW-EMF-CALL-TRACE PCL::MAKE-CPD ++- PCL::BOOTSTRAP-META-BRAID PCL::CACHES-TO-ALLOCATE ++- PCL::LIST-ALL-DFUNS PCL::INITIAL-DISPATCH-DFUN-INFO ++- PCL::INITIAL-DFUN-INFO PCL::%%ALLOCATE-INSTANCE--CLASS ++- PCL::MAKE-ARG-INFO PCL::ALLOCATE-FUNCALLABLE-INSTANCE-2 ++- PCL::SHOW-FREE-CACHE-VECTORS PCL::UPDATE-DISPATCH-DFUNS ++- PCL::GET-EFFECTIVE-METHOD-GENSYM PCL::IN-THE-COMPILER-P ++- PCL::SHOW-DFUN-CONSTRUCTORS PCL::NO-METHODS-DFUN-INFO ++- PCL::INITIALIZE-CHECKING-OR-CACHING-FUNCTION-LIST ++- PCL::ALLOCATE-FUNCALLABLE-INSTANCE-1 ++- PCL::STRUCTURE-FUNCTIONS-EXIST-P)) +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::FIXNUM) +++ PCL::GET-WRAPPER-CACHE-NUMBER)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) PCL::FIELD-TYPE) ++- PCL::CACHE-FIELD)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ PCL::NON-NEGATIVE-FIXNUM) +++ PCL::CACHE-NLINES PCL::CACHE-MASK PCL::CACHE-SIZE +++ PCL::CACHE-MAX-LOCATION)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++@@ -32,296 +22,344 @@ ++ PCL::CACHE-VECTOR)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++- (COMMON-LISP::INTEGER 1 256)) ++- PCL::CACHE-LINE-SIZE)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ PCL::ACCESSOR-VALUES-INTERNAL +++ PCL::MAKE-OPTIMIZED-STD-READER-METHOD-FUNCTION +++ PCL::|(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| +++ PCL::MAKE-FINAL-N-N-ACCESSOR-DFUN +++ PCL::|(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| +++ PCL::CHECK-METHOD-ARG-INFO +++ PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| +++ PCL::GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION +++ PCL::GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +++ PCL::|(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| +++ PCL::MAKE-OPTIMIZED-STD-BOUNDP-METHOD-FUNCTION +++ PCL::OPTIMIZE-SLOT-VALUE-BY-CLASS-P +++ ITERATE::WALK-GATHERING-BODY +++ PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER +++ PCL::|(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| +++ PCL::SLOT-BOUNDP-USING-CLASS-DFUN WALKER::WALK-FORM-INTERNAL +++ PCL::LOAD-LONG-DEFCOMBIN PCL::MAKE-FINAL-CACHING-DFUN +++ PCL::EMIT-READER/WRITER +++ PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION +++ PCL::SLOT-VALUE-USING-CLASS-DFUN PCL::CACHING-MISS +++ PCL::|(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| +++ PCL::EMIT-READER/WRITER-FUNCTION PCL::ACCESSOR-VALUES1 +++ PCL::GENERATING-LISP PCL::GET-CLASS-SLOT-VALUE-1 +++ PCL::MAKE-FINAL-CONSTANT-VALUE-DFUN PCL::CACHE-MISS-VALUES +++ WALKER::WALK-LET-IF +++ PCL::|(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| +++ PCL::|(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| +++ PCL::CHECKING-MISS ITERATE::EXPAND-INTO-LET +++ PCL::MAKE-OPTIMIZED-STD-WRITER-METHOD-FUNCTION +++ PCL::CONSTANT-VALUE-MISS ITERATE::RENAME-VARIABLES +++ PCL::|(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| +++ PCL::SET-SLOT-VALUE +++ PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| +++ PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| +++ PCL::|(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| +++ PCL::CONVERT-METHODS)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++- (COMMON-LISP::INTEGER 1 255)) ++- PCL::CACHE-NKEYS)) +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ PCL::|(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| +++ PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| +++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| +++ PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::|(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| +++ PCL::|(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| +++ PCL::MAKE-TWO-CLASS-ACCESSOR-DFUN +++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| +++ PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| +++ PCL::ADD-METHOD-DECLARATIONS +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| +++ PCL::|(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| +++ PCL::WALK-METHOD-LAMBDA +++ PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))|)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) +++ COMMON-LISP::*) +++ PCL::GET-ACCESSOR-METHOD-FUNCTION +++ PCL::|(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| +++ PCL::|(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| +++ PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| +++ PCL::MAKE-ONE-CLASS-ACCESSOR-DFUN +++ PCL::|(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| +++ PCL::GENERATE-DISCRIMINATION-NET +++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| +++ PCL::LOAD-SHORT-DEFCOMBIN +++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| +++ PCL::|(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| +++ PCL::REAL-MAKE-METHOD-LAMBDA PCL::SET-CLASS-SLOT-VALUE-1 +++ PCL::BOOTSTRAP-ACCESSOR-DEFINITION +++ PCL::MAKE-FINAL-ONE-INDEX-ACCESSOR-DFUN +++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| +++ PCL::ACCESSOR-MISS PCL::|(FAST-METHOD MAKE-INSTANCE (SYMBOL))| +++ PCL::ACCESSOR-VALUES +++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (T T))| +++ PCL::|(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| +++ PCL::EMIT-CHECKING-OR-CACHING-FUNCTION +++ PCL::INITIALIZE-INSTANCE-SIMPLE-FUNCTION +++ PCL::MAKE-FINAL-CHECKING-DFUN +++ PCL::MAKE-SHARED-INITIALIZE-FORM-LIST +++ PCL::|(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| +++ PCL::EMIT-CHECKING-OR-CACHING +++ PCL::|(FAST-METHOD CHANGE-CLASS (T SYMBOL))| +++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| +++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| +++ PCL::|(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| +++ PCL::SETF-SLOT-VALUE-USING-CLASS-DFUN +++ PCL::GET-ACCESSOR-FROM-SVUC-METHOD-FUNCTION +++ PCL::|(FAST-METHOD NO-APPLICABLE-METHOD (T))| +++ PCL::ORDER-SPECIALIZERS +++ PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| +++ PCL::|(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))|)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ PCL::MAKE-N-N-ACCESSOR-DFUN +++ PCL::GET-SIMPLE-INITIALIZATION-FUNCTION +++ PCL::MAKE-FINAL-ACCESSOR-DFUN +++ PCL::GET-EFFECTIVE-METHOD-FUNCTION PCL::MAKE-ACCESSOR-TABLE +++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION PCL::MAKE-CHECKING-DFUN +++ PCL::GET-COMPLEX-INITIALIZATION-FUNCTIONS +++ PCL::MAKE-DEFAULT-INITARGS-FORM-LIST PCL::REAL-ADD-METHOD +++ PCL::SLOT-VALUE-OR-DEFAULT PCL::LOAD-DEFGENERIC PCL::CPL-ERROR +++ WALKER::NESTED-WALK-FORM PCL::TYPES-FROM-ARGUMENTS +++ PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ PCL::MAKE-LONG-METHOD-COMBINATION-FUNCTION +++ PCL::GENERATE-DISCRIMINATION-NET-INTERNAL +++ PCL::CACHE-MISS-VALUES-INTERNAL +++ PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::DO-SHORT-METHOD-COMBINATION PCL::MEMF-CODE-CONVERTER)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::*) +++ PCL::MAKE-ONE-INDEX-ACCESSOR-DFUN WALKER::WALK-DECLARATIONS +++ PCL::GET-SECONDARY-DISPATCH-FUNCTION)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T) +++ COMMON-LISP::*) +++ PCL::|(FAST-METHOD SLOT-MISSING (T T T T))| +++ PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| +++ ITERATE::ITERATE-TRANSFORM-BODY)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ ITERATE::RENAME-LET-BINDINGS +++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::*) +++ PCL::REAL-MAKE-A-METHOD)) ++ (COMMON-LISP::MAPC ++ (COMMON-LISP::LAMBDA (COMPILER::X) ++ (COMMON-LISP::SETF ++- (COMMON-LISP::GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE) +++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) ++ COMMON-LISP::T)) ++ '(PCL::REDEFINE-FUNCTION PCL::DO-STANDARD-DEFSETF-1 ++- PCL::FDEFINE-CAREFULLY PCL::TRACE-METHOD-INTERNAL)) +++ PCL::TRACE-METHOD-INTERNAL PCL::FDEFINE-CAREFULLY)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++- (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) ++- PCL::SYMBOL-APPEND)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) +++ PCL::ANALYZE-LAMBDA-LIST PCL::GET-DISPATCH-FUNCTION +++ PCL::PARSE-DEFMETHOD PCL::MAKE-DISPATCH-DFUN +++ PCL::EMIT-IN-CHECKING-CACHE-P PCL::EMIT-ONE-INDEX-READERS +++ PCL::METHOD-PROTOTYPE-FOR-GF PCL::EMIT-ONE-CLASS-READER +++ PCL::GENERIC-FUNCTION-NAME-P PCL::DEFAULT-CODE-CONVERTER +++ PCL::CLASS-EQ-TYPE PCL::CONVERT-TO-SYSTEM-TYPE +++ PCL::COMPILE-IIS-FUNCTIONS PCL::EMIT-CONSTANT-VALUE +++ PCL::GET-GENERIC-FUNCTION-INFO PCL::EARLY-METHOD-FUNCTION +++ PCL::FIND-STRUCTURE-CLASS PCL::PCL-DESCRIBE +++ PCL::NET-CODE-CONVERTER PCL::PARSE-METHOD-GROUP-SPECIFIER +++ PCL::TYPE-FROM-SPECIALIZER PCL::EMIT-TWO-CLASS-WRITER +++ PCL::COMPUTE-APPLICABLE-METHODS-EMF PCL::EMIT-ONE-CLASS-WRITER +++ PCL::PROTOTYPES-FOR-MAKE-METHOD-LAMBDA +++ PCL::SPECIALIZER-FROM-TYPE PCL::EARLY-COLLECT-INHERITANCE +++ PCL::EMIT-TWO-CLASS-READER PCL::FIND-WRAPPER +++ PCL::*NORMALIZE-TYPE PCL::EMIT-ONE-INDEX-WRITERS +++ PCL::STRUCTURE-WRAPPER PCL::MAKE-FINAL-DISPATCH-DFUN)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++- PCL::FAST-METHOD-CALL-NEXT-METHOD-CALL ++- PCL::GENERIC-CLOBBERS-FUNCTION PCL::STRUCTURE-SLOTD-TYPE ++- WALKER::GET-WALKER-TEMPLATE PCL::COMPILE-LAMBDA-UNCOMPILED ++- PCL::EXTRACT-LAMBDA-LIST PCL::DEFAULT-METHOD-ONLY-P ++- PCL::DISPATCH-CACHE PCL::STRUCTURE-SLOTD-NAME ++- PCL::FAST-METHOD-CALL-P PCL::SFUN-P ++- PCL::FTYPE-DECLARATION-FROM-LAMBDA-LIST ++- PCL::EARLY-CLASS-DEFINITION PCL::CONSTANT-SYMBOL-P ++- PCL::ARG-INFO-LAMBDA-LIST WALKER::ENV-LEXICAL-VARIABLES ++- PCL::INTERN-EQL-SPECIALIZER PCL::PARSE-SPECIALIZERS ++- PCL::%STD-INSTANCE-WRAPPER PCL::UPDATE-ALL-C-A-M-GF-INFO ++- PCL::INITIALIZE-INFO-CACHED-COMBINED-INITIALIZE-FUNCTION ++- PCL::STORE-FGEN PCL::COMPUTE-MCASE-PARAMETERS ++- PCL::INTERNED-SYMBOL-P PCL::MAKE-CALL-METHODS ++- PCL::USE-CACHING-DFUN-P PCL::LEGAL-CLASS-NAME-P ++- WALKER::VARIABLE-GLOBALLY-SPECIAL-P PCL::FUNCTION-RETURNING-T ++- PCL::METHOD-FUNCTION-METHOD PCL::GET-BUILT-IN-CLASS-SYMBOL ++- PCL::DEFAULT-STRUCTURE-TYPE PCL::GF-DFUN-INFO PCL::CACHING-P ++- PCL::FREE-CACHE-VECTOR PCL::ONE-CLASS-CACHE ++- PCL::DEFAULT-TEST-CONVERTER PCL::UNDEFMETHOD-1 ++- PCL::MAKE-INITFUNCTION PCL::GET-CACHE-VECTOR ++- PCL::CLASS-PRECEDENCE-DESCRIPTION-P PCL::GF-INFO-FAST-MF-P ++- PCL::ECD-SOURCE PCL::INITIAL-P PCL::ARG-INFO-APPLYP ++- PCL::ARG-INFO-KEYWORDS ++- PCL::MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION ++- PCL::CACHING-DFUN-COST PCL::INITIAL-DISPATCH-P PCL::EVAL-FORM ++- PCL::MAKE-CONSTANT-FUNCTION PCL::FUNCTION-RETURNING-NIL ++- PCL::INITIALIZE-INFO-BOUND-SLOTS PCL::FGEN-GENSYMS ++- PCL::EXPAND-SHORT-DEFCOMBIN WALKER::ENV-LOCK ++- PCL::INITIALIZE-INFO-CACHED-CONSTANTS ++- PCL::INITIALIZE-INFO-WRAPPER ++- PCL::STRUCTURE-TYPE-INCLUDED-TYPE-NAME PCL::TWO-CLASS-INDEX ++- PCL::ONE-INDEX-ACCESSOR-TYPE ++- PCL::EARLY-COLLECT-DEFAULT-INITARGS WALKER::ENV-WALK-FORM ++- PCL::STRUCTURE-TYPE-INTERNAL-SLOTDS PCL::MAKE-FUNCTION-INLINE ++- PCL::FLUSH-CACHE-VECTOR-INTERNAL ++- PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-T-FUNCTION ++- PCL::FGEN-GENERATOR PCL::CONSTANT-VALUE-P ++- PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION ++- PCL::EARLY-CLASS-PRECEDENCE-LIST PCL::SLOT-BOUNDP-SYMBOL ++- PCL::ARG-INFO-NUMBER-OPTIONAL ++- PCL::GF-PRECOMPUTE-DFUN-AND-EMF-P PCL::GET-PV-CELL-FOR-CLASS ++- PCL::CHECKING-FUNCTION PCL::USE-DEFAULT-METHOD-ONLY-DFUN-P ++- PCL::INITIAL-DISPATCH-CACHE PCL::STRUCTURE-SVUC-METHOD ++- PCL::NO-METHODS-CACHE PCL::GF-DFUN-CACHE PCL::%CCLOSURE-ENV ++- PCL::CONSTANT-VALUE-CACHE PCL::BUILT-IN-WRAPPER-OF ++- PCL::CLASS-HAS-A-FORWARD-REFERENCED-SUPERCLASS-P ++- PCL::EARLY-COLLECT-CPL COMMON-LISP::CLASS-OF ++- PCL::STRUCTURE-SLOTD-ACCESSOR-SYMBOL PCL::SYMBOL-PKG-NAME ++- PCL::GDEFINITION ++- PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-NIL-FUNCTION ++- PCL::ACCESSOR-DFUN-INFO-CACHE PCL::EXTRACT-SPECIALIZER-NAMES ++- PCL::CHECK-WRAPPER-VALIDITY PCL::MAKE-INITIAL-DFUN ++- PCL::WRAPPER-FIELD PCL::EARLY-SLOT-DEFINITION-LOCATION ++- PCL::EARLY-GF-P PCL::GF-INFO-STATIC-C-A-M-EMF PCL::LOOKUP-FGEN ++- PCL::MAKE-PV-TYPE-DECLARATION ++- PCL::INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS ++- PCL::EARLY-METHOD-CLASS ++- PCL::DEFAULT-SECONDARY-DISPATCH-FUNCTION ++- WALKER::ENV-DECLARATIONS PCL::ALLOCATE-CACHE-VECTOR ++- PCL::FUNCTION-PRETTY-ARGLIST ++- PCL::EARLY-CLASS-DIRECT-SUBCLASSES ++- PCL::COMPUTE-APPLICABLE-METHODS-EMF-STD-P ++- PCL::MAKE-CLASS-EQ-PREDICATE PCL::ECD-OTHER-INITARGS ++- PCL::GBOUNDP PCL::METHOD-FUNCTION-PV-TABLE ++- WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE ++- PCL::MAKE-INSTANCE-FUNCTION-SYMBOL ++- PCL::MAKE-OPTIMIZED-STRUCTURE-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++- PCL::FIND-CYCLE-REASONS PCL::FGEN-TEST ++- PCL::SLOT-INITARGS-FROM-STRUCTURE-SLOTD PCL::FREE-CACHE ++- PCL::TYPE-CLASS PCL::INITIAL-CACHE ++- PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS ++- PCL::STRUCTURE-SLOTD-WRITER-FUNCTION ++- PCL::INITIALIZE-INFO-CACHED-DEFAULT-INITARGS-FUNCTION ++- PCL::EARLY-COLLECT-SLOTS PCL::LIST-DFUN ++- PCL::EXPAND-MAKE-INSTANCE-FORM PCL::N-N-CACHE ++- PCL::MAKE-TYPE-PREDICATE PCL::INTERN-FUNCTION-NAME ++- PCL::GET-MAKE-INSTANCE-FUNCTIONS WALKER::ENV-WALK-FUNCTION ++- PCL::TWO-CLASS-CACHE PCL::MAKE-CALLS-TYPE-DECLARATION ++- PCL::MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION ++- PCL::INITIALIZE-INFO-KEY PCL::GF-LAMBDA-LIST ++- ITERATE::VARIABLES-FROM-LET PCL::COMPUTE-CLASS-SLOTS ++- PCL::DFUN-ARG-SYMBOL PCL::CHECKING-P PCL::ARG-INFO-P ++- PCL::INITIALIZE-INFO-CACHED-RI-VALID-P PCL::CHECKING-CACHE ++- PCL::METHOD-FUNCTION-PLIST PCL::STRUCTURE-OBJECT-P ++- PCL::ARG-INFO-PRECEDENCE PCL::ONE-CLASS-INDEX ++- PCL::STD-INSTANCE-P PCL::STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST ++- PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++- PCL::EARLY-SLOT-DEFINITION-NAME PCL::UNPARSE-SPECIALIZERS ++- PCL::STRUCTURE-TYPE-P PCL::ACCESSOR-DFUN-INFO-ACCESSOR-TYPE ++- PCL::PV-TABLEP PCL::CLASS-FROM-TYPE ++- PCL::GF-INFO-SIMPLE-ACCESSOR-TYPE PCL::STRUCTURE-TYPE ++- PCL::MAKE-EQL-PREDICATE PCL::TWO-CLASS-ACCESSOR-TYPE ++- PCL::DEFAULT-STRUCTURE-INSTANCE-P ++- PCL::EARLY-METHOD-STANDARD-ACCESSOR-SLOT-NAME ++- PCL::ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE PCL::GFS-OF-TYPE ++- PCL::DEFAULT-STRUCTUREP PCL::EARLY-CLASS-NAME-OF ++- PCL::%STD-INSTANCE-SLOTS PCL::ONE-INDEX-INDEX PCL::WRAPPER-OF ++- PCL::ARG-INFO-VALID-P PCL::KEYWORD-SPEC-NAME ++- PCL::METHOD-CALL-P PCL::SHOW-DFUN-COSTS PCL::DFUN-INFO-CACHE ++- PCL::DEFAULT-CONSTANT-CONVERTER ITERATE::SEQUENCE-ACCESSOR ++- PCL::COUNT-DFUN PCL::EXPAND-LONG-DEFCOMBIN ++- PCL::CACHING-DFUN-INFO PCL::INITIALIZE-INFO-CACHED-VALID-P ++- PCL::FAST-INSTANCE-BOUNDP-P PCL::ARG-INFO-METATYPES ++- PCL::EXTRACT-PARAMETERS PCL::GF-INFO-C-A-M-EMF-STD-P ++- PCL::FINAL-ACCESSOR-DFUN-TYPE PCL::GMAKUNBOUND ++- PCL::FAST-METHOD-CALL-ARG-INFO PCL::COMPUTE-LINE-SIZE ++- PCL::ONE-INDEX-CACHE PCL::NO-METHODS-P ++- PCL::COMPUTE-STD-CPL-PHASE-2 ++- PCL::COMPLICATED-INSTANCE-CREATION-METHOD ++- PCL::MAKE-PERMUTATION-VECTOR PCL::CONSTANT-VALUE-DFUN-INFO ++- PCL::TWO-CLASS-WRAPPER1 PCL::MAP-ALL-GENERIC-FUNCTIONS ++- PCL::CLASS-PREDICATE SYSTEM::%STRUCTURE-NAME ++- PCL::RESET-CLASS-INITIALIZE-INFO ++- PCL::BUILT-IN-OR-STRUCTURE-WRAPPER1 PCL::EARLY-CLASS-NAME ++- PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION-SYMBOL ++- PCL::UPDATE-PV-TABLE-CACHE-INFO PCL::SLOT-READER-SYMBOL ++- PCL::ARG-INFO-NKEYS PCL::METHOD-CALL-CALL-METHOD-ARGS ++- PCL::CCLOSUREP PCL::DEFAULT-METHOD-ONLY-CACHE ++- PCL::NEXT-WRAPPER-FIELD PCL::SLOT-WRITER-SYMBOL ++- PCL::ACCESSOR-DFUN-INFO-P ++- PCL::GET-MAKE-INSTANCE-FUNCTION-SYMBOL ++- PCL::EXTRACT-REQUIRED-PARAMETERS PCL::FORMAT-CYCLE-REASONS ++- PCL::UNENCAPSULATED-FDEFINITION ++- PCL::GET-BUILT-IN-WRAPPER-SYMBOL PCL::ONE-CLASS-P ++- PCL::ECD-METACLASS PCL::METHOD-LL->GENERIC-FUNCTION-LL ++- PCL::PROCLAIM-INCOMPATIBLE-SUPERCLASSES PCL::ONE-INDEX-P ++- PCL::INITIALIZE-INFO-CACHED-INITARGS-FORM-LIST ++- PCL::ECD-CANONICAL-SLOTS ++- PCL::METHOD-FUNCTION-NEEDS-NEXT-METHODS-P ++- PCL::INITIALIZE-INFO-CACHED-NEW-KEYS ++- PCL::STRUCTURE-SLOTD-READER-FUNCTION ++- PCL::INITIALIZE-INFO-CACHED-COMBINED-INITARGS-FORM-LIST ++- PCL::DISPATCH-P PCL::LIST-LARGE-CACHE ++- PCL::FAST-METHOD-CALL-PV-CELL PCL::GET-MAKE-INSTANCE-FUNCTION ++- PCL::DNET-METHODS-P PCL::STRUCTURE-SLOTD-INIT-FORM ++- PCL::UPDATE-CLASS-CAN-PRECEDE-P PCL::ONE-CLASS-ACCESSOR-TYPE ++- PCL::RESET-INITIALIZE-INFO PCL::STANDARD-SVUC-METHOD ++- PCL::DEFAULT-CONSTANTP PCL::UPDATE-C-A-M-GF-INFO ++- PCL::ONE-INDEX-DFUN-INFO-CACHE PCL::EARLY-CLASS-SLOTS ++- PCL::CPD-SUPERS PCL::FGEN-GENERATOR-LAMBDA ++- PCL::ECD-SUPERCLASS-NAMES PCL::ECD-CLASS-NAME PCL::SETFBOUNDP ++- PCL::GET-SETF-FUNCTION-NAME PCL::DFUN-INFO-P ++- PCL::SLOT-VECTOR-SYMBOL PCL::INITIALIZE-INFO-P ++- PCL::TWO-CLASS-P PCL::UPDATE-GF-SIMPLE-ACCESSOR-TYPE ++- PCL::COPY-CACHE PCL::MAKE-PV-TABLE-TYPE-DECLARATION ++- PCL::SORT-CALLS PCL::STRUCTURE-SLOT-BOUNDP PCL::%FBOUNDP ++- PCL::RESET-CLASS-INITIALIZE-INFO-1 PCL::UPDATE-GF-INFO ++- PCL::WRAPPER-FOR-STRUCTURE PCL::FUNCALLABLE-INSTANCE-P ++- PCL::CPD-CLASS PCL::EARLY-METHOD-STANDARD-ACCESSOR-P ++- PCL::SORT-SLOTS PCL::CANONICAL-SLOT-NAME ++- PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION ++- PCL::EARLY-ACCESSOR-METHOD-SLOT-NAME PCL::%SYMBOL-FUNCTION ++- PCL::EARLY-METHOD-LAMBDA-LIST PCL::ONE-INDEX-DFUN-INFO-INDEX ++- PCL::N-N-ACCESSOR-TYPE PCL::CACHING-CACHE ++- PCL::EARLY-CLASS-SLOTDS PCL::ONE-INDEX-DFUN-INFO-P ++- SYSTEM::%COMPILED-FUNCTION-NAME ++- PCL::BOOTSTRAP-CLASS-PREDICATES PCL::NET-TEST-CONVERTER ++- PCL::DO-STANDARD-DEFSETFS-FOR-DEFCLASS PCL::TWO-CLASS-WRAPPER0 ++- PCL::MAP-SPECIALIZERS PCL::EARLY-GF-NAME PCL::N-N-P ++- PCL::FGEN-SYSTEM PCL::METHODS-CONTAIN-EQL-SPECIALIZER-P ++- PCL::UPDATE-GFS-OF-CLASS PCL::ONE-CLASS-WRAPPER0 ++- PCL::CPD-AFTER ++- PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION ++- PCL::CACHE-P PCL::EARLY-METHOD-QUALIFIERS PCL::CHECK-CACHE ++- PCL::FORCE-CACHE-FLUSHES PCL::CACHE-OWNER ++- PCL::COMPILE-LAMBDA-DEFERRED PCL::ARG-INFO-KEY/REST-P)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +++ PCL::|__si::MAKE-INITIAL| PCL::|__si::MAKE-ARG-INFO| +++ PCL::STRING-APPEND PCL::|__si::MAKE-ONE-INDEX| +++ PCL::MAKE-INITIALIZE-INFO PCL::MAKE-FAST-METHOD-CALL +++ PCL::|__si::MAKE-STD-INSTANCE| +++ PCL::|__si::MAKE-ONE-INDEX-DFUN-INFO| +++ PCL::|__si::MAKE-CONSTANT-VALUE| PCL::|__si::MAKE-N-N| +++ PCL::FIX-EARLY-GENERIC-FUNCTIONS PCL::INTERN-PV-TABLE +++ PCL::FALSE PCL::|__si::MAKE-DFUN-INFO| +++ PCL::|__si::MAKE-CACHING| PCL::MAKE-PV-TABLE +++ PCL::MAKE-METHOD-CALL PCL::TRUE PCL::MAKE-PROGN +++ PCL::|__si::MAKE-CACHE| +++ PCL::|STRUCTURE-OBJECT class constructor| +++ PCL::|__si::MAKE-CLASS-PRECEDENCE-DESCRIPTION| +++ PCL::|__si::MAKE-NO-METHODS| PCL::|__si::MAKE-ONE-CLASS| +++ PCL::|__si::MAKE-PV-TABLE| PCL::PV-WRAPPERS-FROM-PV-ARGS +++ WALKER::UNBOUND-LEXICAL-FUNCTION PCL::|__si::MAKE-TWO-CLASS| +++ PCL::|__si::MAKE-ACCESSOR-DFUN-INFO| +++ PCL::|__si::MAKE-DEFAULT-METHOD-ONLY| +++ PCL::MAKE-FAST-INSTANCE-BOUNDP +++ PCL::CALLED-FIN-WITHOUT-FUNCTION PCL::USE-PACKAGE-PCL +++ PCL::|__si::MAKE-CHECKING| PCL::|__si::MAKE-INITIAL-DISPATCH| +++ PCL::|__si::MAKE-DISPATCH|)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++- COMMON-LISP::INVALID-METHOD-ERROR PCL::LIST-LARGE-CACHES ++- PCL::UPDATE-MAKE-INSTANCE-FUNCTION-TABLE PCL::UNTRACE-METHOD ++- COMMON-LISP::METHOD-COMBINATION-ERROR)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FUNCTION) +++ PCL::METHOD-CALL-FUNCTION PCL::FAST-METHOD-CALL-FUNCTION +++ PCL::CACHE-LIMIT-FN)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::BOOLEAN) +++ PCL::CACHE-VALUEP)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++- PCL::NON-NEGATIVE-FIXNUM) ++- PCL::CACHE-MAX-LOCATION PCL::CACHE-NLINES PCL::CACHE-SIZE ++- PCL::CACHE-MASK)) +++ (COMMON-LISP::INTEGER 1 255)) +++ PCL::CACHE-NKEYS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ (COMMON-LISP::INTEGER 1 256)) +++ PCL::CACHE-LINE-SIZE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) +++ PCL::SYMBOL-APPEND)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +++ (COMMON-LISP::*)) +++ PCL::SORT-APPLICABLE-METHODS PCL::SORT-METHODS)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- PCL::MAKE-INTERNAL-READER-METHOD-FUNCTION ++- ITERATE::SIMPLE-EXPAND-ITERATE-FORM PCL::ADD-DIRECT-SUBCLASSES ++- PCL::PROCLAIM-DEFMETHOD PCL::UPDATE-INITIALIZE-INFO-INTERNAL ++- PCL::RAISE-METATYPE PCL::CLASS-CAN-PRECEDE-P ++- WALKER::VARIABLE-SPECIAL-P PCL::GF-MAKE-FUNCTION-FROM-EMF ++- PCL::|SETF PCL METHOD-FUNCTION-PLIST| +++ PCL::COMPUTE-CALLS PCL::SET-STRUCTURE-SVUC-METHOD +++ PCL::UPDATE-STD-OR-STR-METHODS PCL::SET-METHODS +++ WALKER::NOTE-LEXICAL-BINDING +++ ITERATE::SIMPLE-EXPAND-ITERATE-FORM +++ PCL::|SETF PCL METHOD-FUNCTION-PLIST| PCL::SAUT-NOT-PROTOTYPE +++ PCL::VALUE-FOR-CACHING PCL::PROCLAIM-DEFMETHOD +++ PCL::MAKE-FAST-METHOD-CALL-LAMBDA-LIST +++ PCL::MAKE-STD-BOUNDP-METHOD-FUNCTION PCL::METHODS-CONVERTER +++ PCL::DEAL-WITH-ARGUMENTS-OPTION +++ PCL::UPDATE-ALL-PV-TABLE-CACHES +++ PCL::MAP-PV-TABLE-REFERENCES-OF PCL::UPDATE-CLASS +++ PCL::FIND-STANDARD-II-METHOD +++ PCL::METHOD-FUNCTION-RETURNING-NIL +++ PCL::REDIRECT-EARLY-FUNCTION-INTERNAL PCL::UPDATE-CPL +++ PCL::QUALIFIER-CHECK-RUNTIME PCL::COMPUTE-STD-CPL +++ PCL::COMPUTE-CONSTANTS PCL::ADD-FORMS PCL::AUGMENT-TYPE +++ PCL::MEMF-CONSTANT-CONVERTER PCL::SWAP-WRAPPERS-AND-SLOTS +++ PCL::SET-WRAPPER PCL::GET-KEY-ARG PCL::MAKE-PLIST +++ PCL::MAKE-PV-TABLE-INTERNAL ITERATE::EXTRACT-SPECIAL-BINDINGS +++ PCL::SAUT-NOT-EQL WALKER::VARIABLE-SYMBOL-MACRO-P +++ PCL::EMIT-1-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION ++ PCL::SET-FUNCTION-PRETTY-ARGLIST +++ PCL::GF-MAKE-FUNCTION-FROM-EMF PCL::FIND-SLOT-DEFINITION +++ PCL::SET-STANDARD-SVUC-METHOD PCL::ADD-TO-CVECTOR +++ PCL::PV-WRAPPERS-FROM-ALL-WRAPPERS COMMON-LISP::REMOVE-METHOD +++ PCL::CHECKING-DFUN-INFO PCL::PARSE-QUALIFIER-PATTERN +++ PCL::%SET-CCLOSURE-ENV PCL::MAKE-CDXR ++ PCL::FUNCALLABLE-STANDARD-INSTANCE-ACCESS +++ PCL::NET-CONSTANT-CONVERTER PCL::|SETF PCL FIND-CLASS| +++ PCL::METHOD-FUNCTION-RETURNING-T PCL::CHANGE-CLASS-INTERNAL +++ PCL::MAKE-DFUN-ARG-LIST PCL::DOCTOR-DFUN-FOR-THE-DEBUGGER +++ PCL::MAKE-STD-WRITER-METHOD-FUNCTION ITERATE::MV-SETQ +++ PCL::MAKE-EARLY-ACCESSOR PCL::GET-KEY-ARG1 +++ PCL::ADD-DIRECT-SUBCLASSES PCL::DO-SATISFIES-DEFTYPE +++ PCL::N-N-DFUN-INFO PCL::CLASSES-HAVE-COMMON-SUBCLASS-P +++ PCL::SAUT-NOT-CLASS PCL::CANONICALIZE-DEFCLASS-OPTION ++ PCL::MAKE-DISCRIMINATING-FUNCTION-ARGLIST ++- PCL::DEAL-WITH-ARGUMENTS-OPTION WALKER::NOTE-DECLARATION ++- PCL::MAKE-CLASS-PREDICATE PCL::VALUE-FOR-CACHING ++- PCL::EMIT-1-NIL-DLAP PCL::MAKE-CAXR PCL::SYMBOL-LESSP ++- PCL::GET-KEY-ARG1 PCL::ADD-FORMS ++- PCL::EMIT-N-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION ++- PCL::DOCTOR-DFUN-FOR-THE-DEBUGGER ++- PCL::CLASSES-HAVE-COMMON-SUBCLASS-P PCL::N-N-DFUN-INFO ++- PCL::CANONICALIZE-SLOT-SPECIFICATION ++- PCL::REDIRECT-EARLY-FUNCTION-INTERNAL ++- PCL::UPDATE-STD-OR-STR-METHODS PCL::%SET-CCLOSURE-ENV ++- PCL::QUALIFIER-CHECK-RUNTIME ++- PCL::MAKE-STD-READER-METHOD-FUNCTION ++- PCL::ADD-SLOT-ACCESSORS PCL::ADD-TO-CVECTOR ++- PCL::COMPUTE-LAYOUT PCL::DESTRUCTURE-INTERNAL ++- PCL::SUPERCLASSES-COMPATIBLE-P ++- PCL::COMPUTE-APPLICABLE-METHODS-FUNCTION ITERATE::MV-SETQ ++- PCL::COMPUTE-STD-CPL PCL::SET-METHODS PCL::CHECKING-DFUN-INFO ++- ITERATE::EXTRACT-SPECIAL-BINDINGS PCL::SWAP-WRAPPERS-AND-SLOTS ++- PCL::CANONICALIZE-DEFCLASS-OPTION PCL::MAKE-CDXR ++- PCL::PRINTING-RANDOM-THING-INTERNAL COMMON-LISP::ADD-METHOD +++ WALKER::VARIABLE-LEXICAL-P WALKER::ENVIRONMENT-FUNCTION +++ PCL::PV-TABLE-LOOKUP PCL::DESTRUCTURE-INTERNAL +++ PCL::MAKE-INTERNAL-READER-METHOD-FUNCTION +++ PCL::REMOVE-SLOT-ACCESSORS +++ PCL::|SETF PCL FIND-CLASS-PREDICATE| +++ PCL::|SETF PCL GDEFINITION| PCL::MAKE-DFUN-LAMBDA-LIST +++ PCL::CANONICALIZE-SLOT-SPECIFICATION WALKER::WALK-REPEAT-EVAL ++ PCL::STANDARD-INSTANCE-ACCESS ++- SYSTEM::%SET-COMPILED-FUNCTION-NAME PCL::FIND-SLOT-DEFINITION +++ PCL::PRINTING-RANDOM-THING-INTERNAL PCL::REMTAIL +++ PCL::ACCESSOR-MISS-FUNCTION PCL::COMPUTE-LAYOUT ++ PCL::CLASS-MIGHT-PRECEDE-P ++- PCL::MAKE-STD-BOUNDP-METHOD-FUNCTION PCL::SAUT-NOT-EQL ++- PCL::SET-WRAPPER PCL::SET-STANDARD-SVUC-METHOD ++- PCL::SAUT-NOT-PROTOTYPE PCL::ACCESSOR-MISS-FUNCTION ++- PCL::NO-SLOT PCL::REMTAIL PCL::PV-WRAPPERS-FROM-ALL-ARGS ++- PCL::UPDATE-CLASS PCL::AUGMENT-TYPE PCL::MAKE-EARLY-ACCESSOR ++- PCL::MAKE-PLIST PCL::MEC-ALL-CLASSES-INTERNAL ++- PCL::MAKE-STD-WRITER-METHOD-FUNCTION ++- PCL::PARSE-QUALIFIER-PATTERN PCL::MEMF-CONSTANT-CONVERTER ++- PCL::|SETF PCL FIND-CLASS-PREDICATE| ++- PCL::MAKE-UNORDERED-METHODS-EMF WALKER::ENVIRONMENT-FUNCTION ++- PCL::MEC-ALL-CLASS-LISTS PCL::SAUT-NOT-CLASS-EQ ++- PCL::DO-SATISFIES-DEFTYPE PCL::SET-STRUCTURE-SVUC-METHOD ++- PCL::MAKE-DLAP-LAMBDA-LIST PCL::METHOD-FUNCTION-RETURNING-T ++- PCL::COMPUTE-CALLS PCL::REMOVE-SLOT-ACCESSORS ++- PCL::UPDATE-ALL-PV-TABLE-CACHES PCL::MAKE-DFUN-LAMBDA-LIST ++- WALKER::NOTE-LEXICAL-BINDING PCL::REMOVE-DIRECT-SUBCLASSES ++- PCL::MAP-PV-TABLE-REFERENCES-OF PCL::COMPUTE-CONSTANTS ++- PCL::METHOD-FUNCTION-RETURNING-NIL PCL::METHODS-CONVERTER ++- PCL::PV-TABLE-LOOKUP PCL::DESCRIBE-PACKAGE ++- COMMON-LISP::SLOT-EXISTS-P PCL::MAKE-PV-TABLE-INTERNAL ++- PCL::SAUT-NOT-CLASS PCL::|SETF PCL FIND-CLASS| ++- PCL::UPDATE-INITS PCL::UPDATE-CPL ++- PCL::EMIT-1-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION ++- PCL::COMPUTE-PV WALKER::VARIABLE-LEXICAL-P ++- PCL::PROCLAIM-DEFGENERIC PCL::MAKE-DFUN-ARG-LIST ++- PCL::GET-KEY-ARG COMMON-LISP::REMOVE-METHOD ++- PCL::PV-WRAPPERS-FROM-ALL-WRAPPERS PCL::VARIABLE-CLASS ++- PCL::UPDATE-SLOTS PCL::SYMBOL-OR-CONS-LESSP ++- PCL::MEC-ALL-CLASSES PCL::LIST-EQ ++- PCL::SET-FUNCALLABLE-INSTANCE-FUNCTION ++- WALKER::WALK-REPEAT-EVAL WALKER::ENVIRONMENT-MACRO ++- WALKER::VARIABLE-SYMBOL-MACRO-P ++- PCL::MAKE-FAST-METHOD-CALL-LAMBDA-LIST ++- PCL::BOOTSTRAP-SLOT-INDEX PCL::PLIST-VALUE ++- PCL::CHANGE-CLASS-INTERNAL PCL::NET-CONSTANT-CONVERTER ++- PCL::|SETF PCL GDEFINITION| PCL::FIND-STANDARD-II-METHOD)) +++ PCL::EMIT-N-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION +++ SYSTEM::%SET-COMPILED-FUNCTION-NAME PCL::PLIST-VALUE +++ PCL::MAKE-CAXR PCL::MAKE-DLAP-LAMBDA-LIST +++ PCL::MAKE-STD-READER-METHOD-FUNCTION WALKER::ENVIRONMENT-MACRO +++ PCL::UPDATE-SLOTS PCL::VARIABLE-CLASS +++ PCL::SET-FUNCALLABLE-INSTANCE-FUNCTION PCL::LIST-EQ +++ PCL::ADD-SLOT-ACCESSORS PCL::SAUT-NOT-CLASS-EQ PCL::COMPUTE-PV +++ PCL::PV-WRAPPERS-FROM-ALL-ARGS PCL::UPDATE-INITS +++ PCL::MEC-ALL-CLASS-LISTS PCL::RAISE-METATYPE +++ WALKER::NOTE-DECLARATION PCL::EMIT-1-NIL-DLAP +++ PCL::BOOTSTRAP-SLOT-INDEX PCL::SUPERCLASSES-COMPATIBLE-P +++ PCL::MEC-ALL-CLASSES-INTERNAL COMMON-LISP::SLOT-EXISTS-P +++ PCL::DESCRIBE-PACKAGE PCL::NO-SLOT PCL::PROCLAIM-DEFGENERIC +++ COMMON-LISP::ADD-METHOD PCL::MAKE-UNORDERED-METHODS-EMF +++ PCL::MEC-ALL-CLASSES PCL::SYMBOL-OR-CONS-LESSP +++ PCL::UPDATE-INITIALIZE-INFO-INTERNAL PCL::CLASS-CAN-PRECEDE-P +++ PCL::SYMBOL-LESSP PCL::COMPUTE-APPLICABLE-METHODS-FUNCTION +++ PCL::MAKE-CLASS-PREDICATE WALKER::VARIABLE-SPECIAL-P +++ PCL::REMOVE-DIRECT-SUBCLASSES)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++- WALKER::WALK-FORM PCL::MAKE-INSTANCE-1 ++- PCL::EXTRACT-DECLARATIONS PCL::GET-FUNCTION ++- WALKER::MACROEXPAND-ALL PCL::ALLOCATE-STRUCTURE-INSTANCE ++- PCL::MAKE-FINAL-DFUN-INTERNAL PCL::GET-METHOD-FUNCTION ++- PCL::COERCE-TO-CLASS PCL::MAP-ALL-CLASSES PCL::ENSURE-CLASS ++- PCL::PARSE-METHOD-OR-SPEC COMMON-LISP::ENSURE-GENERIC-FUNCTION ++- PCL::MAKE-CACHING-DFUN PCL::GET-FUNCTION1 ++- PCL::GET-DFUN-CONSTRUCTOR PCL::MAKE-CONSTANT-VALUE-DFUN ++- PCL::MAKE-METHOD-FUNCTION-INTERNAL PCL::COMPILE-LAMBDA ++- PCL::PARSE-SPECIALIZED-LAMBDA-LIST PCL::DISPATCH-DFUN-COST ++- PCL::MAKE-METHOD-LAMBDA-INTERNAL)) +++ PCL::MAKE-METHOD-FUNCTION-INTERNAL +++ PCL::MAKE-FINAL-DFUN-INTERNAL WALKER::MACROEXPAND-ALL +++ COMMON-LISP::ENSURE-GENERIC-FUNCTION +++ PCL::MAKE-METHOD-LAMBDA-INTERNAL PCL::MAKE-CONSTANT-VALUE-DFUN +++ PCL::GET-FUNCTION PCL::EXTRACT-DECLARATIONS +++ PCL::COERCE-TO-CLASS PCL::PARSE-METHOD-OR-SPEC +++ PCL::DISPATCH-DFUN-COST PCL::PARSE-SPECIALIZED-LAMBDA-LIST +++ PCL::MAP-ALL-CLASSES PCL::COMPILE-LAMBDA PCL::ENSURE-CLASS +++ PCL::GET-METHOD-FUNCTION WALKER::WALK-FORM +++ PCL::ALLOCATE-STRUCTURE-INSTANCE PCL::GET-FUNCTION1 +++ PCL::MAKE-CACHING-DFUN PCL::MAKE-INSTANCE-1 +++ PCL::GET-DFUN-CONSTRUCTOR)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++@@ -329,270 +367,405 @@ ++ PCL::MAKE-CLASS-PREDICATE-NAME PCL::MAKE-KEYWORD)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ (COMMON-LISP::VECTOR COMMON-LISP::CHARACTER +++ COMMON-LISP::*)) +++ PCL::CAPITALIZE-WORDS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE-1 PCL::SHOW-EMF-CALL-TRACE +++ PCL::CACHES-TO-ALLOCATE PCL::MAKE-CACHE +++ PCL::SHOW-FREE-CACHE-VECTORS PCL::MAKE-ARG-INFO +++ PCL::NO-METHODS-DFUN-INFO PCL::STRUCTURE-FUNCTIONS-EXIST-P +++ PCL::INITIALIZE-CHECKING-OR-CACHING-FUNCTION-LIST +++ PCL::BOOTSTRAP-BUILT-IN-CLASSES +++ PCL::%%ALLOCATE-INSTANCE--CLASS PCL::DISPATCH-DFUN-INFO +++ PCL::INITIAL-DISPATCH-DFUN-INFO PCL::BOOTSTRAP-META-BRAID +++ PCL::UPDATE-DISPATCH-DFUNS PCL::LIST-ALL-DFUNS +++ PCL::DEFAULT-METHOD-ONLY-DFUN-INFO PCL::RENEW-SYS-FILES +++ PCL::IN-THE-COMPILER-P PCL::GET-EFFECTIVE-METHOD-GENSYM +++ PCL::MAKE-CPD PCL::INITIAL-DFUN-INFO +++ PCL::SHOW-DFUN-CONSTRUCTORS +++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE-2)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::FIXNUM) +++ PCL::ZERO)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ (COMMON-LISP::T COMMON-LISP::STREAM COMMON-LISP::T) ++ COMMON-LISP::T) ++- PCL::FIND-CLASS-FROM-CELL PCL::GET-METHOD-FUNCTION-PV-CELL ++- PCL::PROBE-CACHE PCL::NAMED-OBJECT-PRINT-FUNCTION ++- PCL::PRECOMPUTE-EFFECTIVE-METHODS ++- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE ++- PCL::GET-EFFECTIVE-METHOD-FUNCTION1 PCL::MAKE-EMF-FROM-METHOD ++- PCL::EMIT-MISS PCL::REAL-ENSURE-GF-USING-CLASS--NULL ++- PCL::RECORD-DEFINITION WALKER::CONVERT-MACRO-TO-LAMBDA ++- PCL::INITIALIZE-INFO PCL::EXPAND-EFFECTIVE-METHOD-FUNCTION ++- PCL::METHOD-FUNCTION-GET PCL::FIND-CLASS-PREDICATE-FROM-CELL ++- PCL::ENSURE-GENERIC-FUNCTION-USING-CLASS ++- PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION1 PCL::GET-DECLARATION ++- PCL::REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION ++- PCL::MAP-CACHE)) +++ PCL::PRINT-DFUN-INFO)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::FIXNUM COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::*) +++ PCL::FIND-FREE-CACHE-LINE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::FIXNUM COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ PCL::COMPUTE-CACHE-PARAMETERS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) +++ PCL::COUNT-ALL-DFUNS PCL::EMIT-N-N-WRITERS +++ PCL::EMIT-N-N-READERS)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ PCL::MAKE-FINAL-DFUN PCL::SET-ARG-INFO PCL::TRACE-METHOD +++ PCL::MAKE-SPECIALIZABLE WALKER::WALKER-ENVIRONMENT-BIND-1 +++ ITERATE::FUNCTION-LAMBDA-P COMMON-LISP::FIND-CLASS +++ PCL::MAKE-WRAPPER PCL::UPDATE-DFUN +++ PCL::MAKE-TYPE-PREDICATE-NAME PCL::PV-TABLE-LOOKUP-PV-ARGS +++ PCL::USE-CONSTANT-VALUE-DFUN-P WALKER::RELIST +++ PCL::MAKE-EARLY-GF PCL::INITIALIZE-METHOD-FUNCTION +++ PCL::FIND-CLASS-CELL PCL::USE-DISPATCH-DFUN-P +++ PCL::FIND-CLASS-PREDICATE PCL::ALLOCATE-STANDARD-INSTANCE +++ PCL::INITIALIZE-INTERNAL-SLOT-GFS ITERATE::MAYBE-WARN +++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE +++ PCL::EARLY-METHOD-SPECIALIZERS WALKER::RELIST* PCL::SET-DFUN)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +++ COMMON-LISP::*) +++ PCL::SLOT-UNBOUND-INTERNAL ITERATE::PARSE-DECLARATIONS +++ PCL::EMIT-CACHING PCL::COMPUTE-STD-CPL-PHASE-1 +++ PCL::INITIAL-DFUN PCL::INSURE-DFUN PCL::EMIT-CHECKING +++ PCL::COMPUTE-TEST PCL::COMPUTE-CODE PCL::MAKE-DIRECT-SLOTD +++ PCL::SAUT-CLASS COMMON-LISP::SLOT-MAKUNBOUND +++ PCL::CPL-FORWARD-REFERENCED-CLASS-ERROR PCL::INVOKE-EMF +++ PCL::*SUBTYPEP PCL::SPECIALIZER-APPLICABLE-USING-TYPE-P +++ PCL::COMPUTE-APPLICABLE-METHODS-USING-TYPES +++ PCL::REAL-REMOVE-METHOD PCL::SAUT-PROTOTYPE +++ PCL::MUTATE-SLOTS-AND-CALLS PCL::FIND-SUPERCLASS-CHAIN +++ COMMON-LISP::SLOT-BOUNDP PCL::FORM-LIST-TO-LISP +++ PCL::CPL-INCONSISTENT-ERROR PCL::EMIT-DEFAULT-ONLY-FUNCTION +++ PCL::ENSURE-CLASS-VALUES PCL::CHECK-INITARGS-VALUES +++ PCL::SAUT-EQL PCL::SPLIT-DECLARATIONS +++ PCL::UPDATE-SLOT-VALUE-GF-INFO PCL::SAUT-AND +++ PCL::SLOT-NAME-LISTS-FROM-SLOTS +++ PCL::MAKE-INSTANCE-FUNCTION-TRAP PCL::EMIT-DEFAULT-ONLY +++ PCL::SAUT-NOT PCL::SAUT-CLASS-EQ COMMON-LISP::SLOT-VALUE +++ PCL::DESTRUCTURE PCL::GENERATE-FAST-CLASS-SLOT-ACCESS-P +++ PCL::GET-NEW-FUNCTION-GENERATOR-INTERNAL +++ PCL::CLASS-APPLICABLE-USING-CLASS-P PCL::SDFUN-FOR-CACHING +++ PCL::SET-FUNCTION-NAME)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) +++ PCL::ARG-INFO-NUMBER-REQUIRED PCL::CACHING-LIMIT-FN +++ PCL::PV-CACHE-LIMIT-FN PCL::ONE-INDEX-LIMIT-FN +++ PCL::PV-TABLE-PV-SIZE PCL::CACHE-COUNT PCL::DEFAULT-LIMIT-FN +++ PCL::CPD-COUNT PCL::CHECKING-LIMIT-FN +++ PCL::N-N-ACCESSORS-LIMIT-FN PCL::EARLY-CLASS-SIZE +++ PCL::FAST-INSTANCE-BOUNDP-INDEX)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) +++ PCL::POWER-OF-TWO-CEILING)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::*) +++ COMMON-LISP::T) +++ PCL::GET-CACHE-FROM-CACHE)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM COMMON-LISP::T) +++ COMMON-LISP::FIXNUM) +++ PCL::COMPUTE-PRIMARY-CACHE-LOCATION)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) PCL::FIELD-TYPE) +++ PCL::CACHE-FIELD)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) +++ (COMMON-LISP::OR PCL::CACHE COMMON-LISP::NULL)) +++ PCL::PV-TABLE-CACHE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::T) ++- PCL::|(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| ++- PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| ++- WALKER::WALK-PROG/PROG* ++- PCL::|(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| ++- WALKER::WALK-BINDINGS-2 ++- PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| ++- WALKER::WALK-DO/DO* ++- PCL::|(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++- PCL::|(FAST-METHOD DOCUMENTATION (T))| +++ WALKER::WALK-TEMPLATE PCL::|(FAST-METHOD PRINT-OBJECT (T T))| +++ WALKER::WALK-DO/DO* PCL::LOAD-PRECOMPILED-DFUN-CONSTRUCTOR ++ PCL::|(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| ++- PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++- PCL::|(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| ++- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| +++ WALKER::WALK-LET/LET* +++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| +++ PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| +++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-TYPE +++ PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| ++- PCL::INITIALIZE-INSTANCE-SIMPLE PCL::BOOTSTRAP-SET-SLOT ++- PCL::|(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| ++- PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| ++- PCL::|(FAST-METHOD PRINT-OBJECT (CLASS T))| ++- PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++- PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| ++- PCL::|(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| ++- PCL::FILL-CACHE-P ++- PCL::|(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| ++- PCL::|(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| ++- PCL::|(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| +++ PCL::|(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| +++ PCL::INITIALIZE-INSTANCE-SIMPLE +++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| +++ PCL::EXPAND-SYMBOL-MACROLET-INTERNAL ++ PCL::|(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| ++- PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| ++- PCL::OPTIMIZE-WRITER PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-TYPE ++- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-INTERNAL ++- PCL::|(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION1 ++- PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| ++- PCL::|(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| +++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| ++ PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| ++- PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| ++- PCL::|(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| ++- PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| ++- PCL::|(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| ++- PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| ++- PCL::ADJUST-CACHE ++- PCL::|(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++- PCL::LOAD-PRECOMPILED-DFUN-CONSTRUCTOR ++- PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| +++ PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++- PCL::|(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| ++- PCL::|(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| ++- PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| ++- PCL::MEMF-TEST-CONVERTER ++ PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++- PCL::|(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| ++- PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| ++- WALKER::WALK-TEMPLATE PCL::TWO-CLASS-DFUN-INFO ++- PCL::EXPAND-CACHE +++ PCL::|(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| +++ PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +++ PCL::|(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +++ PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| +++ PCL::|(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| +++ PCL::|(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| +++ PCL::|(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| +++ PCL::|(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| +++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| +++ PCL::|(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| +++ PCL::|(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| +++ PCL::MAKE-DISPATCH-LAMBDA +++ PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| +++ PCL::EXPAND-DEFCLASS +++ PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| +++ PCL::|(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| +++ PCL::OPTIMIZE-WRITER +++ PCL::|(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| +++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| +++ PCL::|(FAST-METHOD DOCUMENTATION (T))| +++ PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| ++- PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++- PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| ++- PCL::GET-WRAPPERS-FROM-CLASSES ++- PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| ++- PCL::|(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++- PCL::LOAD-PRECOMPILED-IIS-ENTRY ++- PCL::|(FAST-METHOD PRINT-OBJECT (T T))| ++- PCL::EXPAND-SYMBOL-MACROLET-INTERNAL ++- PCL::MAYBE-EXPAND-ACCESSOR-FORM +++ PCL::OPTIMIZE-READER WALKER::WALK-PROG/PROG* +++ PCL::BOOTSTRAP-SET-SLOT ++ PCL::EMIT-CHECKING-OR-CACHING-FUNCTION-PRELIMINARY ++- PCL::|(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| ++- PCL::|(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| +++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| +++ PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +++ PCL::TWO-CLASS-DFUN-INFO +++ PCL::|(FAST-METHOD MAKE-INSTANCE (CLASS))| +++ PCL::|(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +++ PCL::ADJUST-CACHE +++ PCL::|(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| +++ PCL::|(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| +++ PCL::EXPAND-CACHE +++ PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| +++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| +++ PCL::|(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| +++ PCL::|(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| +++ PCL::|(FAST-METHOD PRINT-OBJECT (CLASS T))| +++ PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| +++ PCL::|(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +++ PCL::|(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| +++ PCL::|(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| +++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| +++ PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| ++- PCL::|(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| ++- PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++- PCL::EXPAND-DEFCLASS ++- PCL::|(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| ++- WALKER::WALK-LET/LET* PCL::MAKE-DISPATCH-LAMBDA +++ PCL::GET-WRAPPERS-FROM-CLASSES +++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| +++ PCL::MAYBE-EXPAND-ACCESSOR-FORM WALKER::WALK-BINDINGS-2 +++ PCL::FILL-CACHE-P PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-INTERNAL ++ PCL::|(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| ++- PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| ++- PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| ++- PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))| ++- PCL::OPTIMIZE-READER ++- PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| ++- PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++- PCL::|(FAST-METHOD MAKE-INSTANCE (CLASS))|)) +++ PCL::|(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| +++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| +++ PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| +++ PCL::LOAD-PRECOMPILED-IIS-ENTRY PCL::MEMF-TEST-CONVERTER +++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))|)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ PCL::REAL-ADD-NAMED-METHOD PCL::EARLY-ADD-NAMED-METHOD +++ PCL::FILL-DFUN-CACHE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- PCL::OPTIMIZE-SET-SLOT-VALUE ++- PCL::|(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| ++- PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| ++- PCL::MAKE-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++- PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| ++- PCL::|(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| ++- PCL::PRINT-CACHE WALKER::WALK-UNEXPECTED-DECLARE ++- ITERATE::OPTIMIZE-ITERATE-FORM ++- PCL::|(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| ++- WALKER::WALK-MULTIPLE-VALUE-SETQ PCL::FIRST-FORM-TO-LISP ++- PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| ++- WALKER::WALK-LABELS ++- PCL::|(FAST-METHOD SPECIALIZER-CLASS (CLASS))| ++- PCL::ONE-CLASS-DFUN-INFO PCL::GET-FUNCTION-GENERATOR ++- WALKER::RELIST-INTERNAL PCL::NOTE-PV-TABLE-REFERENCE ++- WALKER::WALK-LAMBDA PCL::WRAP-METHOD-GROUP-SPECIFIER-BINDINGS ++- PCL::ONE-INDEX-DFUN-INFO PCL::MAP-ALL-ORDERS ++- PCL::OPTIMIZE-GF-CALL-INTERNAL PCL::COMPUTE-PRECEDENCE ++- WALKER::WALK-DO PCL::PRINT-STD-INSTANCE ++- PCL::OBSOLETE-INSTANCE-TRAP PCL::SORT-APPLICABLE-METHODS ++- PCL::|(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++- PCL::EMIT-GREATER-THAN-1-DLAP ++- PCL::|(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++- WALKER::WALK-FLET ++- PCL::|(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| ++- PCL::|SETF PCL PLIST-VALUE| WALKER::WALK-PROG* ++- WALKER::VARIABLE-DECLARATION ++- PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| ++- PCL::SKIP-FAST-SLOT-ACCESS-P PCL::SET-FUNCTION-NAME-1 ++- WALKER::WALK-MACROLET PCL::CAN-OPTIMIZE-ACCESS ++- WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL ++- PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| ++- PCL::|(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| ++- PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| ++- PCL::SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P ++- PCL::|(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| ++- PCL::|(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| ++- PCL::EMIT-BOUNDP-CHECK PCL::|SETF PCL METHOD-FUNCTION-GET| +++ PCL::OBSOLETE-INSTANCE-TRAP ++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| ++- PCL::MAKE-METHOD-SPEC PCL::FLUSH-CACHE-TRAP WALKER::WALK-IF ++- PCL::OPTIMIZE-SLOT-BOUNDP ++- PCL::STANDARD-COMPUTE-EFFECTIVE-METHOD ++- WALKER::WALK-MULTIPLE-VALUE-BIND ++- ITERATE::RENAME-AND-CAPTURE-VARIABLES WALKER::WALK-LET* ++- WALKER::WALK-DO* ++- PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| ++- PCL::INVALIDATE-WRAPPER ++- PCL::|(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| +++ WALKER::WALK-TAGBODY +++ PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| +++ PCL::ENTRY-IN-CACHE-P WALKER::WALK-COMPILER-LET ++ PCL::|(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| ++- PCL::MAKE-OPTIMIZED-STD-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION ++- ITERATE::SIMPLE-EXPAND-GATHERING-FORM PCL::ENTRY-IN-CACHE-P ++- WALKER::WALK-LOCALLY PCL::OPTIMIZE-SLOT-VALUE +++ PCL::NOTE-PV-TABLE-REFERENCE PCL::COMPUTE-EFFECTIVE-METHOD +++ PCL::MAKE-DFUN-CALL PCL::|SETF PCL PLIST-VALUE| +++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| +++ PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| +++ PCL::|(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| +++ PCL::|(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +++ WALKER::WALK-UNEXPECTED-DECLARE ++ PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL +++ PCL::SKIP-FAST-SLOT-ACCESS-P PCL::SET-FUNCTION-NAME-1 +++ WALKER::WALK-DO PCL::EMIT-1-T-DLAP PCL::PRINT-STD-INSTANCE +++ PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| +++ WALKER::WALK-LAMBDA PCL::MAKE-METHOD-SPEC +++ PCL::|(FAST-METHOD CLASS-PREDICATE-NAME (T))| +++ PCL::|(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| +++ PCL::OPTIMIZE-SET-SLOT-VALUE +++ PCL::MAKE-OPTIMIZED-STD-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +++ PCL::EXPAND-DEFGENERIC WALKER::VARIABLE-DECLARATION +++ ITERATE::RENAME-AND-CAPTURE-VARIABLES +++ PCL::|(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| +++ PCL::MAP-ALL-ORDERS +++ PCL::|(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| +++ PCL::DECLARE-STRUCTURE WALKER::WALK-PROG +++ PCL::|(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| +++ PCL::OPTIMIZE-SLOT-VALUE WALKER::WALK-MULTIPLE-VALUE-BIND ++ PCL::|(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| +++ PCL::STANDARD-COMPUTE-EFFECTIVE-METHOD WALKER::WALK-LOCALLY +++ PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| +++ WALKER::WALK-DO* ++ PCL::|(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| +++ PCL::MAKE-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +++ PCL::EMIT-BOUNDP-CHECK WALKER::RECONS +++ PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| +++ PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| +++ WALKER::WALK-LET* WALKER::WALK-TAGBODY-1 PCL::FLUSH-CACHE-TRAP +++ WALKER::WALK-FLET +++ PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| +++ PCL::|(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| +++ PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| +++ PCL::PRINT-CACHE ++ PCL::|(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| ++- PCL::|(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| ++- PCL::TRACE-EMF-CALL-INTERNAL WALKER::WALK-SYMBOL-MACROLET ++- PCL::|(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| ++- PCL::CONVERT-TABLE +++ PCL::INVALIDATE-WRAPPER PCL::GET-NEW-FUNCTION-GENERATOR +++ ITERATE::OPTIMIZE-ITERATE-FORM WALKER::RELIST-INTERNAL +++ PCL::CAN-OPTIMIZE-ACCESS PCL::MAKE-TOP-LEVEL-FORM ++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| +++ WALKER::WALK-MULTIPLE-VALUE-SETQ WALKER::WALK-LABELS +++ PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| +++ PCL::|(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| +++ PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| +++ WALKER::WALK-SETQ WALKER::WALK-LET +++ PCL::|SETF PCL METHOD-FUNCTION-GET| WALKER::WALK-IF +++ PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| +++ ITERATE::SIMPLE-EXPAND-GATHERING-FORM +++ PCL::|(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| +++ WALKER::WALK-NAMED-LAMBDA PCL::FIRST-FORM-TO-LISP +++ PCL::ONE-CLASS-DFUN-INFO +++ WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL +++ PCL::EMIT-GREATER-THAN-1-DLAP PCL::CONVERT-TABLE +++ PCL::|(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| ++ PCL::INITIALIZE-INTERNAL-SLOT-GFS* +++ ITERATE::OPTIMIZE-GATHERING-FORM +++ PCL::|(FAST-METHOD SPECIALIZER-CLASS (CLASS))| +++ PCL::OPTIMIZE-SLOT-BOUNDP +++ PCL::|(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| +++ PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| +++ PCL::WRAP-METHOD-GROUP-SPECIFIER-BINDINGS +++ WALKER::WALK-SYMBOL-MACROLET ITERATE::VARIABLE-SAME-P +++ PCL::EMIT-SLOT-READ-FORM +++ PCL::SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P +++ PCL::|(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| +++ PCL::GET-FUNCTION-GENERATOR +++ PCL::MAKE-OPTIMIZED-STD-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION +++ PCL::FIX-SLOT-ACCESSORS ++ PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| ++- PCL::|(FAST-METHOD CLASS-PREDICATE-NAME (T))| ++- PCL::|(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| ++- PCL::MAKE-OPTIMIZED-STD-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| ++- PCL::|(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| ++- PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| ++- WALKER::WALK-SETQ PCL::EXPAND-DEFGENERIC ++- PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| ++- ITERATE::OPTIMIZE-GATHERING-FORM PCL::FIX-SLOT-ACCESSORS ++- PCL::EMIT-SLOT-READ-FORM WALKER::WALK-PROG ++- PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| ++- WALKER::WALK-NAMED-LAMBDA PCL::GET-NEW-FUNCTION-GENERATOR ++- PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++- WALKER::WALK-TAGBODY ++- PCL::|(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| ++- WALKER::WALK-COMPILER-LET PCL::DECLARE-STRUCTURE ++- WALKER::WALK-LET ITERATE::VARIABLE-SAME-P ++- PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| ++- PCL::EMIT-1-T-DLAP PCL::MAKE-DFUN-CALL ++- PCL::COMPUTE-EFFECTIVE-METHOD PCL::SORT-METHODS ++- WALKER::WALK-TAGBODY-1 +++ PCL::OPTIMIZE-GF-CALL-INTERNAL +++ PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| ++ PCL::|(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| +++ PCL::|(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| +++ PCL::|(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| ++ PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++- PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| ++- PCL::MAKE-TOP-LEVEL-FORM ++- PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| ++- WALKER::RECONS)) +++ PCL::|(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +++ WALKER::WALK-PROG* PCL::ONE-INDEX-DFUN-INFO +++ PCL::COMPUTE-PRECEDENCE PCL::TRACE-EMF-CALL-INTERNAL +++ WALKER::WALK-MACROLET)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::*) +++ COMMON-LISP::T) +++ PCL::MAKE-DEFMETHOD-FORM-INTERNAL PCL::LOAD-DEFMETHOD +++ PCL::EARLY-MAKE-A-METHOD PCL::MAKE-DEFMETHOD-FORM)) +++(COMMON-LISP::PROCLAIM +++ '(COMMON-LISP::FTYPE +++ (COMMON-LISP::FUNCTION +++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::T) +++ PCL::GET-EFFECTIVE-METHOD-FUNCTION1 +++ PCL::ENSURE-GENERIC-FUNCTION-USING-CLASS +++ PCL::MAKE-EMF-FROM-METHOD +++ PCL::REAL-ENSURE-GF-USING-CLASS--NULL PCL::PROBE-CACHE +++ PCL::MAP-CACHE PCL::GET-DECLARATION +++ PCL::REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION +++ WALKER::CONVERT-MACRO-TO-LAMBDA +++ PCL::EXPAND-EFFECTIVE-METHOD-FUNCTION PCL::EMIT-MISS +++ PCL::GET-METHOD-FUNCTION-PV-CELL PCL::METHOD-FUNCTION-GET +++ PCL::FIND-CLASS-FROM-CELL PCL::RECORD-DEFINITION +++ PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION1 +++ PCL::FIND-CLASS-PREDICATE-FROM-CELL +++ PCL::NAMED-OBJECT-PRINT-FUNCTION +++ PCL::PRECOMPUTE-EFFECTIVE-METHODS PCL::INITIALIZE-INFO +++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++- PCL::UPDATE-SLOTS-IN-PV PCL::MAKE-INSTANCE-FUNCTION-COMPLEX ++- PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| +++ PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL1 ++ PCL::GET-MAKE-INSTANCE-FUNCTION-INTERNAL ++- PCL::|(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| ++- PCL::MAKE-INSTANCE-FUNCTION-SIMPLE ++- PCL::|(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| ++- PCL::COMPUTE-PV-SLOT PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL1 ++- PCL::|(FAST-METHOD SLOT-UNBOUND (T T T))| ++- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| ++- PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| ++- PCL::OPTIMIZE-INSTANCE-ACCESS ++- PCL::|(FAST-METHOD REMOVE-NAMED-METHOD (T T))| +++ PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS1 PCL::MAKE-EMF-CACHE +++ PCL::|(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| +++ PCL::MAKE-FGEN ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| ++- PCL::REAL-MAKE-METHOD-INITARGS-FORM +++ PCL::BOOTSTRAP-MAKE-SLOT-DEFINITIONS +++ PCL::|(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| +++ PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::OPTIMIZE-ACCESSOR-CALL +++ PCL::MAKE-INSTANCE-FUNCTION-COMPLEX PCL::UPDATE-SLOTS-IN-PV +++ PCL::COMPUTE-PV-SLOT ++ PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| +++ PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| +++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| ++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T T))| +++ PCL::OPTIMIZE-INSTANCE-ACCESS +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| +++ PCL::MAKE-INSTANCE-FUNCTION-SIMPLE +++ PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +++ PCL::OPTIMIZE-GENERIC-FUNCTION-CALL +++ PCL::LOAD-FUNCTION-GENERATOR WALKER::WALK-BINDINGS-1 ++ PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| ++- PCL::MAKE-FINAL-ORDINARY-DFUN-INTERNAL ++- PCL::BOOTSTRAP-MAKE-SLOT-DEFINITIONS ++- PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| +++ PCL::REAL-MAKE-METHOD-INITARGS-FORM +++ PCL::|(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| +++ PCL::|(FAST-METHOD REMOVE-NAMED-METHOD (T T))| +++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| +++ WALKER::WALK-TEMPLATE-HANDLE-REPEAT ++ PCL::MAKE-PARAMETER-REFERENCES ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| +++ PCL::|(FAST-METHOD SLOT-UNBOUND (T T T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| +++ PCL::EXPAND-EMF-CALL-METHOD +++ PCL::|(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| +++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| ++ PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++- PCL::OPTIMIZE-ACCESSOR-CALL ++- WALKER::WALK-TEMPLATE-HANDLE-REPEAT WALKER::WALK-BINDINGS-1 ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| ++- PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS1 ++- PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++- PCL::MAKE-FGEN ++- PCL::|(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| ++- PCL::|(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| ++- PCL::OPTIMIZE-GENERIC-FUNCTION-CALL ++- PCL::LOAD-FUNCTION-GENERATOR PCL::MAKE-EMF-CACHE ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| ++- PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++- PCL::EXPAND-EMF-CALL-METHOD)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T) ++- COMMON-LISP::T) ++- PCL::EXPAND-DEFMETHOD PCL::LOAD-DEFMETHOD-INTERNAL)) +++ PCL::MAKE-FINAL-ORDINARY-DFUN-INTERNAL)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::T) ++- PCL::FILL-CACHE PCL::CAN-OPTIMIZE-ACCESS1 PCL::MAKE-EMF-CALL +++ PCL::GET-METHOD WALKER::WALK-ARGLIST PCL::REAL-GET-METHOD ++ PCL::EMIT-FETCH-WRAPPER PCL::CHECK-INITARGS-2-LIST ++- PCL::GET-METHOD PCL::CHECK-INITARGS-2-PLIST ++- PCL::CHECK-INITARGS-1 PCL::REAL-GET-METHOD ++- WALKER::WALK-ARGLIST)) +++ PCL::FILL-CACHE PCL::CHECK-INITARGS-2-PLIST PCL::MAKE-EMF-CALL +++ PCL::CHECK-INITARGS-1 PCL::CAN-OPTIMIZE-ACCESS1)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++@@ -605,394 +778,250 @@ ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::*) ++- COMMON-LISP::T) ++- PCL::LOAD-DEFMETHOD PCL::MAKE-DEFMETHOD-FORM ++- PCL::EARLY-MAKE-A-METHOD PCL::MAKE-DEFMETHOD-FORM-INTERNAL)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) +++ PCL::REAL-LOAD-DEFCLASS PCL::LOAD-DEFCLASS PCL::SET-ARG-INFO1 +++ PCL::BOOTSTRAP-MAKE-SLOT-DEFINITION PCL::EMIT-SLOT-ACCESS +++ WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1 PCL::OPTIMIZE-GF-CALL ++ PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++- PCL::SET-ARG-INFO1 PCL::BOOTSTRAP-MAKE-SLOT-DEFINITION ++- PCL::LOAD-DEFCLASS PCL::REAL-LOAD-DEFCLASS ++- PCL::OPTIMIZE-GF-CALL WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1 ++- PCL::EMIT-SLOT-ACCESS PCL::MAKE-EARLY-CLASS-DEFINITION)) +++ PCL::MAKE-EARLY-CLASS-DEFINITION)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +++ COMMON-LISP::FIXNUM) ++ COMMON-LISP::T) ++- PCL::EMIT-DLAP PCL::GET-SECONDARY-DISPATCH-FUNCTION1)) +++ PCL::GET-CACHE PCL::FILL-CACHE-FROM-CACHE-P)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::T) ++- PCL::EARLY-ADD-NAMED-METHOD PCL::FILL-DFUN-CACHE ++- PCL::REAL-ADD-NAMED-METHOD)) +++ (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::*) +++ COMMON-LISP::FIXNUM) +++ PCL::COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::*) ++- COMMON-LISP::T) ++- PCL::BOOTSTRAP-INITIALIZE-CLASS)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +++ PCL::EVAL-FORM PCL::EARLY-CLASS-NAME-OF PCL::DFUN-INFO-CACHE +++ PCL::MAKE-CONSTANT-FUNCTION PCL::EXPAND-SHORT-DEFCOMBIN +++ PCL::COPY-CACHE PCL::PROCLAIM-INCOMPATIBLE-SUPERCLASSES +++ PCL::MAKE-INITIAL-DFUN PCL::ECD-METACLASS +++ PCL::EXTRACT-SPECIALIZER-NAMES PCL::GBOUNDP +++ PCL::GET-SETF-FUNCTION-NAME PCL::USE-CACHING-DFUN-P +++ PCL::INITIALIZE-INFO-CACHED-CONSTANTS +++ PCL::STRUCTURE-TYPE-INTERNAL-SLOTDS COMMON-LISP::CLASS-OF +++ PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-NIL-FUNCTION +++ PCL::ARG-INFO-KEY/REST-P PCL::METHOD-CALL-CALL-METHOD-ARGS +++ PCL::FGEN-GENSYMS PCL::EARLY-CLASS-PRECEDENCE-LIST +++ PCL::EARLY-SLOT-DEFINITION-LOCATION +++ PCL::EXPAND-MAKE-INSTANCE-FORM PCL::INTERN-EQL-SPECIALIZER +++ PCL::METHOD-FUNCTION-METHOD PCL::FGEN-GENERATOR-LAMBDA +++ PCL::SLOT-READER-SYMBOL PCL::CACHING-P +++ PCL::EARLY-METHOD-QUALIFIERS +++ PCL::EARLY-COLLECT-DEFAULT-INITARGS PCL::KEYWORD-SPEC-NAME +++ PCL::ONE-INDEX-P PCL::COMPLICATED-INSTANCE-CREATION-METHOD +++ PCL::DFUN-ARG-SYMBOL PCL::N-N-CACHE +++ PCL::ONE-INDEX-DFUN-INFO-INDEX PCL::INITIAL-DISPATCH-CACHE +++ PCL::CPD-CLASS PCL::FAST-METHOD-CALL-ARG-INFO +++ PCL::MAKE-PV-TYPE-DECLARATION PCL::COMPUTE-STD-CPL-PHASE-2 +++ PCL::GET-BUILT-IN-CLASS-SYMBOL +++ PCL::INITIALIZE-INFO-CACHED-RI-VALID-P +++ PCL::UPDATE-GFS-OF-CLASS PCL::STRUCTURE-SVUC-METHOD +++ PCL::SLOT-BOUNDP-SYMBOL PCL::FGEN-SYSTEM +++ PCL::FIND-CYCLE-REASONS ITERATE::SEQUENCE-ACCESSOR +++ PCL::GF-INFO-C-A-M-EMF-STD-P PCL::STRUCTURE-TYPE-P +++ PCL::TWO-CLASS-CACHE PCL::METHOD-LL->GENERIC-FUNCTION-LL +++ PCL::ONE-CLASS-ACCESSOR-TYPE PCL::WRAPPER-FOR-STRUCTURE +++ PCL::ACCESSOR-DFUN-INFO-CACHE PCL::%SYMBOL-FUNCTION +++ PCL::STRUCTURE-TYPE PCL::NET-TEST-CONVERTER +++ PCL::CONSTANT-SYMBOL-P PCL::GMAKUNBOUND PCL::INITIAL-P +++ PCL::GF-DFUN-CACHE PCL::STRUCTURE-SLOTD-TYPE +++ PCL::%STD-INSTANCE-WRAPPER PCL::INITIALIZE-INFO-P +++ PCL::CACHING-DFUN-INFO +++ PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +++ PCL::FAST-METHOD-CALL-P PCL::GF-DFUN-INFO +++ PCL::INITIALIZE-INFO-BOUND-SLOTS PCL::ECD-CLASS-NAME +++ PCL::MAKE-INSTANCE-FUNCTION-SYMBOL +++ PCL::INITIALIZE-INFO-CACHED-DEFAULT-INITARGS-FUNCTION +++ PCL::STD-INSTANCE-P PCL::EXTRACT-PARAMETERS +++ WALKER::GET-WALKER-TEMPLATE PCL::SYMBOL-PKG-NAME +++ PCL::CCLOSUREP PCL::LOOKUP-FGEN PCL::CPD-SUPERS +++ PCL::ARG-INFO-KEYWORDS PCL::DISPATCH-P +++ PCL::INITIALIZE-INFO-CACHED-NEW-KEYS +++ PCL::MAKE-CALLS-TYPE-DECLARATION PCL::INITIALIZE-INFO-WRAPPER +++ PCL::%FBOUNDP PCL::DEFAULT-STRUCTURE-INSTANCE-P +++ WALKER::ENV-WALK-FORM PCL::EARLY-CLASS-DEFINITION +++ PCL::SORT-CALLS PCL::EARLY-METHOD-STANDARD-ACCESSOR-SLOT-NAME +++ PCL::DISPATCH-CACHE PCL::INITIALIZE-INFO-KEY +++ PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION +++ PCL::ARG-INFO-METATYPES PCL::GF-LAMBDA-LIST +++ WALKER::ENV-LEXICAL-VARIABLES PCL::ACCESSOR-DFUN-INFO-P +++ PCL::GF-PRECOMPUTE-DFUN-AND-EMF-P PCL::COMPUTE-LINE-SIZE +++ PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-T-FUNCTION +++ PCL::FORCE-CACHE-FLUSHES PCL::TWO-CLASS-P PCL::DFUN-INFO-P +++ PCL::MAP-SPECIALIZERS PCL::MAKE-PERMUTATION-VECTOR +++ WALKER::ENV-LOCK PCL::CPD-AFTER PCL::EARLY-CLASS-SLOTS +++ PCL::GET-PV-CELL-FOR-CLASS PCL::ARG-INFO-P +++ PCL::EXTRACT-REQUIRED-PARAMETERS +++ PCL::STRUCTURE-SLOTD-READER-FUNCTION PCL::COMPUTE-CLASS-SLOTS +++ PCL::INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS +++ PCL::TWO-CLASS-WRAPPER0 +++ PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION-SYMBOL +++ PCL::COMPILE-LAMBDA-UNCOMPILED PCL::EARLY-CLASS-NAME +++ PCL::SFUN-P PCL::EXTRACT-LAMBDA-LIST PCL::UNDEFMETHOD-1 +++ PCL::ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE PCL::WRAPPER-OF +++ PCL::ARG-INFO-LAMBDA-LIST PCL::LIST-DFUN +++ PCL::NEXT-WRAPPER-FIELD PCL::CHECK-WRAPPER-VALIDITY +++ PCL::STRUCTURE-SLOTD-NAME PCL::BUILT-IN-WRAPPER-OF +++ PCL::GET-MAKE-INSTANCE-FUNCTIONS +++ PCL::GENERIC-CLOBBERS-FUNCTION PCL::NO-METHODS-P +++ PCL::CONSTANT-VALUE-P WALKER::ENV-WALK-FUNCTION +++ PCL::INITIAL-CACHE PCL::SLOT-INITARGS-FROM-STRUCTURE-SLOTD +++ PCL::MAKE-CLASS-EQ-PREDICATE +++ PCL::GET-MAKE-INSTANCE-FUNCTION-SYMBOL +++ PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS +++ PCL::FUNCTION-PRETTY-ARGLIST +++ PCL::MAKE-OPTIMIZED-STRUCTURE-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +++ PCL::FTYPE-DECLARATION-FROM-LAMBDA-LIST PCL::TYPE-CLASS +++ PCL::CHECK-CACHE PCL::STANDARD-SVUC-METHOD +++ PCL::STRUCTURE-SLOTD-ACCESSOR-SYMBOL PCL::GF-INFO-FAST-MF-P +++ PCL::STRUCTURE-SLOTD-WRITER-FUNCTION +++ PCL::BOOTSTRAP-CLASS-PREDICATES PCL::DEFAULT-METHOD-ONLY-CACHE +++ PCL::GET-CACHE-VECTOR PCL::SLOT-WRITER-SYMBOL +++ PCL::FGEN-GENERATOR PCL::DNET-METHODS-P +++ PCL::DEFAULT-STRUCTURE-TYPE +++ PCL::INITIALIZE-INFO-CACHED-COMBINED-INITARGS-FORM-LIST +++ PCL::N-N-ACCESSOR-TYPE +++ PCL::STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST +++ WALKER::ENV-DECLARATIONS WALKER::VARIABLE-GLOBALLY-SPECIAL-P +++ PCL::ONE-INDEX-INDEX PCL::ONE-INDEX-DFUN-INFO-CACHE +++ PCL::EARLY-ACCESSOR-METHOD-SLOT-NAME PCL::EARLY-CLASS-SLOTDS +++ PCL::CANONICAL-SLOT-NAME PCL::EARLY-COLLECT-CPL +++ PCL::RESET-CLASS-INITIALIZE-INFO-1 +++ PCL::BUILT-IN-OR-STRUCTURE-WRAPPER1 PCL::ONE-INDEX-CACHE +++ PCL::MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION +++ PCL::MAKE-TYPE-PREDICATE PCL::FREE-CACHE +++ ITERATE::VARIABLES-FROM-LET +++ PCL::EARLY-METHOD-STANDARD-ACCESSOR-P +++ PCL::DEFAULT-CONSTANT-CONVERTER PCL::CLASS-PREDICATE +++ PCL::CHECKING-CACHE PCL::ARG-INFO-PRECEDENCE +++ PCL::METHOD-FUNCTION-NEEDS-NEXT-METHODS-P +++ PCL::DEFAULT-METHOD-ONLY-P +++ PCL::COMPUTE-APPLICABLE-METHODS-EMF-STD-P +++ PCL::STRUCTURE-SLOT-BOUNDP PCL::ONE-INDEX-ACCESSOR-TYPE +++ PCL::TWO-CLASS-ACCESSOR-TYPE +++ PCL::USE-DEFAULT-METHOD-ONLY-DFUN-P PCL::METHOD-CALL-P +++ PCL::UPDATE-CLASS-CAN-PRECEDE-P PCL::CONSTANT-VALUE-DFUN-INFO +++ PCL::COMPILE-LAMBDA-DEFERRED PCL::SETFBOUNDP +++ PCL::CLASS-HAS-A-FORWARD-REFERENCED-SUPERCLASS-P +++ PCL::PV-TABLEP PCL::STRUCTURE-OBJECT-P PCL::TWO-CLASS-INDEX +++ PCL::METHOD-FUNCTION-PV-TABLE PCL::ECD-OTHER-INITARGS +++ WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE +++ PCL::EARLY-GF-P PCL::STRUCTURE-SLOTD-INIT-FORM +++ PCL::FUNCALLABLE-INSTANCE-P PCL::CHECKING-FUNCTION +++ PCL::FUNCTION-RETURNING-NIL PCL::FUNCTION-RETURNING-T +++ PCL::UPDATE-C-A-M-GF-INFO PCL::COUNT-DFUN +++ PCL::UNPARSE-SPECIALIZERS PCL::CACHE-OWNER +++ PCL::EARLY-METHOD-CLASS +++ PCL::INITIALIZE-INFO-CACHED-COMBINED-INITIALIZE-FUNCTION +++ PCL::EARLY-SLOT-DEFINITION-NAME +++ PCL::GET-MAKE-INSTANCE-FUNCTION +++ PCL::STRUCTURE-TYPE-INCLUDED-TYPE-NAME +++ PCL::ECD-SUPERCLASS-NAMES PCL::GFS-OF-TYPE PCL::SORT-SLOTS +++ PCL::DO-STANDARD-DEFSETFS-FOR-DEFCLASS +++ PCL::COMPUTE-MCASE-PARAMETERS PCL::METHOD-FUNCTION-PLIST +++ PCL::ARG-INFO-NKEYS PCL::FINAL-ACCESSOR-DFUN-TYPE +++ PCL::EARLY-COLLECT-SLOTS PCL::EARLY-METHOD-LAMBDA-LIST +++ PCL::FAST-INSTANCE-BOUNDP-P PCL::GDEFINITION +++ PCL::%CCLOSURE-ENV SYSTEM::%COMPILED-FUNCTION-NAME +++ PCL::RESET-INITIALIZE-INFO PCL::ARG-INFO-NUMBER-OPTIONAL +++ PCL::RESET-CLASS-INITIALIZE-INFO +++ PCL::INITIALIZE-INFO-CACHED-VALID-P PCL::INTERNED-SYMBOL-P +++ PCL::EARLY-GF-NAME PCL::FGEN-TEST PCL::MAKE-INITFUNCTION +++ PCL::MAP-ALL-GENERIC-FUNCTIONS PCL::SHOW-DFUN-COSTS +++ PCL::CLASS-FROM-TYPE PCL::EXPAND-LONG-DEFCOMBIN +++ PCL::MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION +++ PCL::FREE-CACHE-VECTOR PCL::%STD-INSTANCE-SLOTS +++ PCL::ALLOCATE-CACHE-VECTOR PCL::ONE-CLASS-P +++ PCL::CLASS-PRECEDENCE-DESCRIPTION-P PCL::SLOT-VECTOR-SYMBOL +++ PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION +++ PCL::ONE-CLASS-WRAPPER0 PCL::N-N-P +++ PCL::UPDATE-ALL-C-A-M-GF-INFO PCL::CHECKING-P +++ PCL::TWO-CLASS-WRAPPER1 PCL::PARSE-SPECIALIZERS +++ PCL::FORMAT-CYCLE-REASONS PCL::FLUSH-CACHE-VECTOR-INTERNAL +++ PCL::UNENCAPSULATED-FDEFINITION PCL::ONE-CLASS-INDEX +++ PCL::DEFAULT-CONSTANTP PCL::UPDATE-GF-INFO +++ PCL::ACCESSOR-DFUN-INFO-ACCESSOR-TYPE +++ PCL::INITIALIZE-INFO-CACHED-INITARGS-FORM-LIST +++ PCL::MAKE-EQL-PREDICATE PCL::ARG-INFO-VALID-P +++ PCL::CACHING-CACHE PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION +++ PCL::FAST-METHOD-CALL-NEXT-METHOD-CALL +++ PCL::DEFAULT-SECONDARY-DISPATCH-FUNCTION +++ PCL::MAKE-FUNCTION-INLINE PCL::STORE-FGEN +++ PCL::LIST-LARGE-CACHE PCL::METHODS-CONTAIN-EQL-SPECIALIZER-P +++ PCL::ARG-INFO-APPLYP SYSTEM::%STRUCTURE-NAME +++ PCL::GF-INFO-SIMPLE-ACCESSOR-TYPE PCL::ECD-SOURCE +++ PCL::EARLY-CLASS-DIRECT-SUBCLASSES +++ PCL::UPDATE-PV-TABLE-CACHE-INFO PCL::DEFAULT-TEST-CONVERTER +++ PCL::MAKE-CALL-METHODS PCL::GET-BUILT-IN-WRAPPER-SYMBOL +++ PCL::GF-INFO-STATIC-C-A-M-EMF PCL::DEFAULT-STRUCTUREP +++ PCL::CONSTANT-VALUE-CACHE PCL::INITIAL-DISPATCH-P +++ PCL::ECD-CANONICAL-SLOTS PCL::WRAPPER-FIELD +++ PCL::UPDATE-GF-SIMPLE-ACCESSOR-TYPE PCL::ONE-CLASS-CACHE +++ PCL::CACHING-DFUN-COST PCL::LEGAL-CLASS-NAME-P +++ PCL::INTERN-FUNCTION-NAME PCL::FAST-METHOD-CALL-PV-CELL +++ PCL::CACHE-P PCL::ONE-INDEX-DFUN-INFO-P +++ PCL::MAKE-PV-TABLE-TYPE-DECLARATION PCL::NO-METHODS-CACHE)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::FIXNUM) ++- COMMON-LISP::T) ++- PCL::COMPUTE-STD-CPL-PHASE-3)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) +++ PCL::UPDATE-MAKE-INSTANCE-FUNCTION-TABLE PCL::UNTRACE-METHOD +++ COMMON-LISP::METHOD-COMBINATION-ERROR +++ COMMON-LISP::INVALID-METHOD-ERROR PCL::LIST-LARGE-CACHES)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::FIXNUM) +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++- PCL::FILL-CACHE-FROM-CACHE-P PCL::GET-CACHE)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::LIST) ++- PCL::PV-TABLE-CALL-LIST PCL::CACHE-OVERFLOW ++- PCL::PV-TABLE-SLOT-NAME-LISTS)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::FIXNUM COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::*) ++- PCL::COMPUTE-CACHE-PARAMETERS)) +++ PCL::EMIT-DLAP PCL::GET-SECONDARY-DISPATCH-FUNCTION1)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++- (COMMON-LISP::FIXNUM COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::*) ++- PCL::FIND-FREE-CACHE-LINE)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::BOOLEAN) ++- PCL::CACHE-VALUEP)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++- PCL::DEFAULT-CODE-CONVERTER PCL::EMIT-IN-CHECKING-CACHE-P ++- PCL::METHOD-PROTOTYPE-FOR-GF PCL::EMIT-TWO-CLASS-WRITER ++- PCL::PARSE-METHOD-GROUP-SPECIFIER PCL::EMIT-ONE-CLASS-WRITER ++- PCL::EMIT-ONE-INDEX-WRITERS PCL::FIND-STRUCTURE-CLASS ++- PCL::PROTOTYPES-FOR-MAKE-METHOD-LAMBDA PCL::MAKE-DISPATCH-DFUN ++- PCL::COMPUTE-APPLICABLE-METHODS-EMF PCL::EARLY-METHOD-FUNCTION ++- PCL::NET-CODE-CONVERTER PCL::GET-DISPATCH-FUNCTION ++- PCL::STRUCTURE-WRAPPER PCL::FIND-WRAPPER PCL::CLASS-EQ-TYPE ++- PCL::TYPE-FROM-SPECIALIZER PCL::SPECIALIZER-FROM-TYPE ++- PCL::PCL-DESCRIBE PCL::PARSE-DEFMETHOD ++- PCL::ANALYZE-LAMBDA-LIST PCL::EMIT-ONE-CLASS-READER ++- PCL::EARLY-COLLECT-INHERITANCE PCL::GET-GENERIC-FUNCTION-INFO ++- PCL::COMPILE-IIS-FUNCTIONS PCL::EMIT-CONSTANT-VALUE ++- PCL::EMIT-ONE-INDEX-READERS PCL::GENERIC-FUNCTION-NAME-P ++- PCL::CONVERT-TO-SYSTEM-TYPE PCL::MAKE-FINAL-DISPATCH-DFUN ++- PCL::EMIT-TWO-CLASS-READER PCL::*NORMALIZE-TYPE)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++- PCL::|__si::MAKE-CLASS-PRECEDENCE-DESCRIPTION| ++- PCL::MAKE-FAST-INSTANCE-BOUNDP PCL::MAKE-INITIALIZE-INFO ++- PCL::|STRUCTURE-OBJECT class constructor| ++- PCL::|__si::MAKE-CACHE| PCL::|__si::MAKE-DEFAULT-METHOD-ONLY| ++- PCL::TRUE PCL::|__si::MAKE-PV-TABLE| ++- PCL::|__si::MAKE-ONE-INDEX| WALKER::UNBOUND-LEXICAL-FUNCTION ++- PCL::|__si::MAKE-CHECKING| PCL::MAKE-PV-TABLE ++- PCL::|__si::MAKE-NO-METHODS| PCL::MAKE-METHOD-CALL ++- PCL::CALLED-FIN-WITHOUT-FUNCTION PCL::USE-PACKAGE-PCL ++- PCL::INTERN-PV-TABLE PCL::|__si::MAKE-ACCESSOR-DFUN-INFO| ++- PCL::|__si::MAKE-DISPATCH| ++- PCL::|__si::MAKE-ONE-INDEX-DFUN-INFO| ++- PCL::|__si::MAKE-ARG-INFO| PCL::FIX-EARLY-GENERIC-FUNCTIONS ++- PCL::ZERO PCL::MAKE-PROGN PCL::|__si::MAKE-INITIAL| ++- PCL::|__si::MAKE-ONE-CLASS| PCL::|__si::MAKE-DFUN-INFO| ++- PCL::|__si::MAKE-CONSTANT-VALUE| ++- PCL::|__si::MAKE-STD-INSTANCE| PCL::PV-WRAPPERS-FROM-PV-ARGS ++- PCL::|__si::MAKE-TWO-CLASS| PCL::|__si::MAKE-N-N| ++- PCL::|__si::MAKE-CACHING| PCL::FALSE PCL::STRING-APPEND ++- PCL::|__si::MAKE-INITIAL-DISPATCH| PCL::MAKE-FAST-METHOD-CALL)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++- PCL::ARG-INFO-NUMBER-REQUIRED PCL::PV-TABLE-PV-SIZE ++- PCL::CACHE-COUNT PCL::PV-CACHE-LIMIT-FN PCL::CHECKING-LIMIT-FN ++- PCL::CACHING-LIMIT-FN PCL::N-N-ACCESSORS-LIMIT-FN ++- PCL::DEFAULT-LIMIT-FN PCL::EARLY-CLASS-SIZE PCL::CPD-COUNT ++- PCL::ONE-INDEX-LIMIT-FN PCL::FAST-INSTANCE-BOUNDP-INDEX)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) ++- PCL::POWER-OF-TWO-CEILING)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +++ (COMMON-LISP::T COMMON-LISP::T +++ (COMMON-LISP::INTEGER -9223372036854775808 +++ 9223372036854775807)) ++ COMMON-LISP::T) ++- PCL::MAKE-TYPE-PREDICATE-NAME PCL::MAKE-FINAL-DFUN ++- PCL::CAPITALIZE-WORDS PCL::SET-DFUN ITERATE::MAYBE-WARN ++- PCL::MAKE-EARLY-GF PCL::USE-DISPATCH-DFUN-P WALKER::RELIST ++- PCL::MAKE-SPECIALIZABLE PCL::PV-TABLE-LOOKUP-PV-ARGS ++- PCL::ALLOCATE-STANDARD-INSTANCE ++- PCL::ALLOCATE-FUNCALLABLE-INSTANCE ++- PCL::USE-CONSTANT-VALUE-DFUN-P ITERATE::FUNCTION-LAMBDA-P ++- PCL::UPDATE-DFUN PCL::SET-ARG-INFO ++- PCL::EARLY-METHOD-SPECIALIZERS PCL::MAKE-WRAPPER ++- PCL::FIND-CLASS-CELL WALKER::WALKER-ENVIRONMENT-BIND-1 ++- PCL::TRACE-METHOD WALKER::RELIST* COMMON-LISP::FIND-CLASS ++- PCL::INITIALIZE-INTERNAL-SLOT-GFS PCL::FIND-CLASS-PREDICATE ++- PCL::INITIALIZE-METHOD-FUNCTION)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::*) ++- PCL::SAUT-NOT PCL::INVOKE-EMF PCL::SAUT-PROTOTYPE ++- PCL::COMPUTE-CODE ITERATE::PARSE-DECLARATIONS ++- PCL::SDFUN-FOR-CACHING ++- PCL::COMPUTE-APPLICABLE-METHODS-USING-TYPES ++- PCL::GET-NEW-FUNCTION-GENERATOR-INTERNAL ++- PCL::SLOT-NAME-LISTS-FROM-SLOTS PCL::DESTRUCTURE ++- PCL::SPLIT-DECLARATIONS PCL::MAKE-DIRECT-SLOTD ++- PCL::FORM-LIST-TO-LISP PCL::EMIT-CHECKING ++- PCL::CPL-FORWARD-REFERENCED-CLASS-ERROR PCL::COMPUTE-TEST ++- PCL::SET-FUNCTION-NAME COMMON-LISP::SLOT-BOUNDP PCL::SAUT-AND ++- PCL::EMIT-CACHING PCL::INITIAL-DFUN ++- COMMON-LISP::SLOT-MAKUNBOUND COMMON-LISP::SLOT-VALUE ++- PCL::UPDATE-SLOT-VALUE-GF-INFO ++- PCL::CLASS-APPLICABLE-USING-CLASS-P ++- PCL::CPL-INCONSISTENT-ERROR PCL::*SUBTYPEP ++- PCL::SLOT-UNBOUND-INTERNAL ++- PCL::GENERATE-FAST-CLASS-SLOT-ACCESS-P ++- PCL::CHECK-INITARGS-VALUES PCL::ENSURE-CLASS-VALUES ++- PCL::SAUT-EQL PCL::REAL-REMOVE-METHOD PCL::EMIT-DEFAULT-ONLY ++- PCL::INSURE-DFUN PCL::EMIT-DEFAULT-ONLY-FUNCTION ++- PCL::MUTATE-SLOTS-AND-CALLS PCL::FIND-SUPERCLASS-CHAIN ++- PCL::SAUT-CLASS PCL::MAKE-INSTANCE-FUNCTION-TRAP ++- PCL::SAUT-CLASS-EQ PCL::COMPUTE-STD-CPL-PHASE-1 ++- PCL::SPECIALIZER-APPLICABLE-USING-TYPE-P)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++- (COMMON-LISP::OR PCL::CACHE COMMON-LISP::NULL)) ++- PCL::PV-TABLE-CACHE)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::*) ++- COMMON-LISP::*) ++- WALKER::WALK-DECLARATIONS PCL::GET-SECONDARY-DISPATCH-FUNCTION ++- PCL::MAKE-ONE-INDEX-ACCESSOR-DFUN)) +++ PCL::COMPUTE-STD-CPL-PHASE-3)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++- COMMON-LISP::*) ++- PCL::MAKE-SHARED-INITIALIZE-FORM-LIST PCL::ACCESSOR-MISS ++- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| ++- PCL::|(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| ++- PCL::|(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| ++- PCL::|(FAST-METHOD NO-APPLICABLE-METHOD (T))| ++- PCL::SET-CLASS-SLOT-VALUE-1 ++- PCL::|(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| ++- PCL::|(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))| ++- PCL::GET-ACCESSOR-FROM-SVUC-METHOD-FUNCTION ++- PCL::SETF-SLOT-VALUE-USING-CLASS-DFUN ++- PCL::|(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| ++- PCL::EMIT-CHECKING-OR-CACHING-FUNCTION ++- PCL::MAKE-FINAL-ONE-INDEX-ACCESSOR-DFUN ++- PCL::LOAD-SHORT-DEFCOMBIN PCL::EMIT-CHECKING-OR-CACHING ++- PCL::|(FAST-METHOD MAKE-INSTANCE (SYMBOL))| ++- PCL::MAKE-FINAL-CHECKING-DFUN ++- PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| ++- PCL::|(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| ++- PCL::ACCESSOR-VALUES ++- PCL::|(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| ++- PCL::|(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| ++- PCL::REAL-MAKE-METHOD-LAMBDA ++- PCL::|(FAST-METHOD CHANGE-CLASS (T SYMBOL))| ++- PCL::GET-ACCESSOR-METHOD-FUNCTION ++- PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| ++- PCL::|(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| ++- PCL::ORDER-SPECIALIZERS ++- PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| ++- PCL::GENERATE-DISCRIMINATION-NET ++- PCL::|(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| ++- PCL::|(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| ++- PCL::MAKE-ONE-CLASS-ACCESSOR-DFUN ++- PCL::|(FAST-METHOD DESCRIBE-OBJECT (T T))| ++- PCL::BOOTSTRAP-ACCESSOR-DEFINITION ++- PCL::INITIALIZE-INSTANCE-SIMPLE-FUNCTION)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::*) ++- PCL::GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION ++- PCL::MAKE-OPTIMIZED-STD-WRITER-METHOD-FUNCTION ++- PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| ++- PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| ++- PCL::|(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| ++- PCL::MAKE-OPTIMIZED-STD-BOUNDP-METHOD-FUNCTION ++- PCL::CONVERT-METHODS WALKER::WALK-LET-IF ++- PCL::EMIT-READER/WRITER-FUNCTION PCL::ACCESSOR-VALUES-INTERNAL ++- PCL::|(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| ++- PCL::LOAD-LONG-DEFCOMBIN PCL::CHECK-METHOD-ARG-INFO ++- PCL::ACCESSOR-VALUES1 ++- PCL::|(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| ++- PCL::GENERATING-LISP PCL::MAKE-FINAL-N-N-ACCESSOR-DFUN ++- WALKER::WALK-FORM-INTERNAL PCL::CONSTANT-VALUE-MISS ++- PCL::SLOT-VALUE-USING-CLASS-DFUN PCL::CACHING-MISS ++- PCL::|(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| ++- PCL::SLOT-BOUNDP-USING-CLASS-DFUN PCL::CHECKING-MISS ++- PCL::|(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| ++- PCL::EMIT-READER/WRITER ITERATE::EXPAND-INTO-LET ++- PCL::GET-CLASS-SLOT-VALUE-1 ++- PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION ++- PCL::MAKE-FINAL-CACHING-DFUN ++- PCL::|(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| ++- PCL::|(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| ++- PCL::GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++- PCL::|(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| ++- PCL::OPTIMIZE-SLOT-VALUE-BY-CLASS-P PCL::SET-SLOT-VALUE ++- PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER ++- ITERATE::RENAME-VARIABLES ++- PCL::|(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| ++- PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| ++- ITERATE::WALK-GATHERING-BODY PCL::CACHE-MISS-VALUES ++- PCL::MAKE-OPTIMIZED-STD-READER-METHOD-FUNCTION ++- PCL::MAKE-FINAL-CONSTANT-VALUE-DFUN)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::*) ++- PCL::DO-SHORT-METHOD-COMBINATION PCL::MEMF-CODE-CONVERTER ++- PCL::GENERATE-DISCRIMINATION-NET-INTERNAL ++- PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++- PCL::MAKE-LONG-METHOD-COMBINATION-FUNCTION ++- PCL::CACHE-MISS-VALUES-INTERNAL)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::T) ++- COMMON-LISP::*) ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| ++- PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| ++- PCL::ADD-METHOD-DECLARATIONS ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| ++- PCL::|(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| ++- PCL::COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL ++- PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| ++- PCL::|(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| ++- PCL::MAKE-TWO-CLASS-ACCESSOR-DFUN ++- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| ++- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| ++- PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++- PCL::|(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| ++- PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| ++- PCL::|(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| ++- PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++- PCL::WALK-METHOD-LAMBDA ++- PCL::|(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))|)) +++ COMMON-LISP::T) +++ PCL::EXPAND-DEFMETHOD PCL::LOAD-DEFMETHOD-INTERNAL)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::*) ++- COMMON-LISP::*) ++- PCL::REAL-MAKE-A-METHOD)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::*) ++- PCL::MAKE-DEFAULT-INITARGS-FORM-LIST ++- PCL::GET-COMPLEX-INITIALIZATION-FUNCTIONS ++- PCL::SLOT-VALUE-OR-DEFAULT ++- PCL::GET-SIMPLE-INITIALIZATION-FUNCTION PCL::REAL-ADD-METHOD ++- PCL::LOAD-DEFGENERIC PCL::CPL-ERROR ++- PCL::MAKE-FINAL-ACCESSOR-DFUN PCL::MAKE-N-N-ACCESSOR-DFUN ++- PCL::TYPES-FROM-ARGUMENTS PCL::MAKE-ACCESSOR-TABLE ++- PCL::MAKE-CHECKING-DFUN WALKER::NESTED-WALK-FORM ++- PCL::GET-EFFECTIVE-METHOD-FUNCTION ++- PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION ++- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T) ++- COMMON-LISP::*) ++- ITERATE::ITERATE-TRANSFORM-BODY ++- PCL::|(FAST-METHOD SLOT-MISSING (T T T T))| ++- PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))|)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++- COMMON-LISP::T COMMON-LISP::*) ++- COMMON-LISP::*) ++- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1 ++- ITERATE::RENAME-LET-BINDINGS)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM COMMON-LISP::T) ++- COMMON-LISP::FIXNUM) ++- PCL::COMPUTE-PRIMARY-CACHE-LOCATION)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::*) ++- COMMON-LISP::T) ++- PCL::COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION ++- PCL::GET-CACHE-FROM-CACHE)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM COMMON-LISP::T) ++- COMMON-LISP::T) ++- PCL::%CCLOSURE-ENV-NTHCDR)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION ++- (COMMON-LISP::T COMMON-LISP::STREAM COMMON-LISP::T) +++ COMMON-LISP::*) ++ COMMON-LISP::T) ++- PCL::PRINT-DFUN-INFO)) ++-(COMMON-LISP::PROCLAIM ++- '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) ++- PCL::COUNT-ALL-DFUNS PCL::EMIT-N-N-WRITERS ++- PCL::EMIT-N-N-READERS)) +++ PCL::BOOTSTRAP-INITIALIZE-CLASS)) ++ (COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::FIXNUM) ++- PCL::GET-WRAPPER-CACHE-NUMBER)) +++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::LIST) +++ PCL::PV-TABLE-CALL-LIST PCL::CACHE-OVERFLOW +++ PCL::PV-TABLE-SLOT-NAME-LISTS)) ++ (IN-PACKAGE "PCL") ++ ++-(DOLIST (V '(|(FAST-WRITER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-METHODS)| +++(DOLIST (V '(|(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-METHODS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT SLOTS)| ++ |(FAST-WRITER-METHOD SLOT-CLASS SLOTS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SLOTS)| ++ |(FAST-WRITER-METHOD SLOT-CLASS DIRECT-SLOTS)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT METHODS)| ++ |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHODS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT OPTIONS)| ++@@ -1034,17 +1063,16 @@ ++ COMPATIBLE-META-CLASS-CHANGE-P ++ |(FAST-READER-METHOD SLOT-OBJECT CLASS-EQ-SPECIALIZER)| ++ |(FAST-READER-METHOD CLASS CLASS-EQ-SPECIALIZER)| ++- |(BOUNDP READER-FUNCTION)| TRACE-METHOD-INTERNAL ++- |(BOUNDP PREDICATE-NAME)| |(BOUNDP READERS)| ++- UPDATE-GF-DFUN |(BOUNDP CLASS-PRECEDENCE-LIST)| +++ |(BOUNDP READER-FUNCTION)| |(BOUNDP PREDICATE-NAME)| +++ |(BOUNDP READERS)| UPDATE-GF-DFUN +++ |(BOUNDP CLASS-PRECEDENCE-LIST)| ++ |(BOUNDP ACCESSOR-FLAGS)| |(BOUNDP LOCATION)| ++ |(BOUNDP DOCUMENTATION)| SPECIALIZER-OBJECT ++ |(BOUNDP INCOMPATIBLE-SUPERCLASS-LIST)| ++ ACCESSOR-METHOD-SLOT-NAME |(BOUNDP SPECIALIZERS)| ++ |(BOUNDP IDENTITY-WITH-ONE-ARGUMENT)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)| ++- REDEFINE-FUNCTION SPECIALIZER-CLASS ++- |(BOUNDP PRETTY-ARGLIST)| +++ SPECIALIZER-CLASS |(BOUNDP PRETTY-ARGLIST)| ++ |PCL::PCL-CLASS class predicate| ++ |PCL::STD-CLASS class predicate| ++ |(BOUNDP DEFSTRUCT-FORM)| ++@@ -1082,104 +1110,104 @@ ++ |(BOUNDP OPTIONS)| |(WRITER METHOD)| ++ |PCL::DEPENDENT-UPDATE-MIXIN class predicate| ++ GENERIC-FUNCTION-PRETTY-ARGLIST |(WRITER SOURCE)| +++ |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| ++ |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| ++ |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| ++- |(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))| ++ |(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| +++ |(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))| ++ |(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))| ++- |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| ++- |(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| ++- |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| ++ |(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| ++- |(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| ++ |(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| +++ |(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| ++ |(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| +++ |(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| +++ |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| ++ MAKE-BOUNDP-METHOD-FUNCTION ++ |(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| ++ |(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| ++ |PCL::METAOBJECT class predicate| ++- |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +++ |(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| +++ |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| +++ |(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| +++ |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| +++ |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| ++ |(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| +++ |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| +++ |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| +++ |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +++ |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +++ |(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| +++ |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| +++ |(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| +++ |(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| ++ |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| ++- |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| ++- |(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| ++- |(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| ++- |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| +++ |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| +++ |(FAST-METHOD CHANGE-CLASS (T SYMBOL))| +++ |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| ++ |(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++- |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| ++ |(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++- |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +++ |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| ++ |(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| ++- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++- |(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| ++- |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| ++- |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| ++- |(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| ++- |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| ++- |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| ++- |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| ++- |(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| ++- |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| ++- |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| ++- |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| ++- |(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| ++- |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD CHANGE-CLASS (T SYMBOL))| ++ |(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| +++ |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| +++ |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD MAKE-INSTANCE (SYMBOL))| +++ |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +++ |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++- |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| ++- |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| ++- |(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| ++- |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| ++- |(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++- |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| ++- |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| ++- |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| +++ |(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +++ |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +++ |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +++ |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +++ |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +++ |(FAST-METHOD SPECIALIZER-CLASS (CLASS))| +++ |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| +++ |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| +++ |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| +++ |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| +++ |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +++ |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| +++ |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| +++ |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| +++ |(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++ |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| +++ |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| ++ |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| ++- |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| +++ |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| +++ |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| ++ |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| ++- |(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| +++ |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| ++ |(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| ++- |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| ++- |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| ++- |(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| ++- |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| +++ |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| ++ |(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| ++- |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| ++- |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| ++- |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++- |(FAST-METHOD SPECIALIZER-CLASS (CLASS))| ++- |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| ++- |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| ++- |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| +++ |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| +++ |(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| ++ |(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| ++- |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| ++- |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| ++- |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| ++- |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| ++- |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| ++- |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| ++- |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| ++- |(FAST-METHOD MAKE-INSTANCE (CLASS))| ++- |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| ++- |(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| ++- |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| ++- |(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| +++ |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| +++ |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| ++ |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| +++ |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| +++ |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| +++ |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| +++ |(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| +++ |(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| +++ |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| +++ |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| +++ |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| +++ |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| ++ |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| ++ |(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| +++ |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| +++ |(FAST-METHOD MAKE-INSTANCE (CLASS))| ++ |(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| ++- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| +++ |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| +++ |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| +++ |(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| +++ |(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| ++ CLASS-PREDICATE-NAME ++ |PCL::STRUCTURE-SLOT-DEFINITION class predicate| ++ |PCL::STRUCTURE-DIRECT-SLOT-DEFINITION class predicate| ++@@ -1205,8 +1233,8 @@ ++ |(WRITER PREDICATE-NAME)| |(WRITER READERS)| ++ |(READER WRITER-FUNCTION)| |(READER INITFUNCTION)| ++ INITIALIZE-INTERNAL-SLOT-FUNCTIONS ++- |SETF PCL SLOT-DEFINITION-TYPE| |(READER WRITERS)| ++- |(WRITER CLASS-PRECEDENCE-LIST)| +++ |SETF PCL SLOT-DEFINITION-TYPE| +++ |(WRITER CLASS-PRECEDENCE-LIST)| |(READER WRITERS)| ++ |(WRITER ACCESSOR-FLAGS)| |(READER INITFORM)| ++ METHOD-COMBINATION-P |(WRITER LOCATION)| ++ |(WRITER DOCUMENTATION)| ++@@ -1220,11 +1248,11 @@ ++ |(READER ALLOCATION)| |(WRITER SPECIALIZERS)| ++ |(CALL REAL-ENSURE-GF-USING-CLASS--NULL)| ++ |(WRITER IDENTITY-WITH-ONE-ARGUMENT)| ++- |(SETF METHOD-GENERIC-FUNCTION)| ++- |(WRITER PRETTY-ARGLIST)| LEGAL-SPECIALIZERS-P ++- |SETF PCL OBJECT-PLIST| |(WRITER DEFSTRUCT-FORM)| ++- |(READER FUNCTION)| |(READER GENERIC-FUNCTION)| ++- |(READER LAMBDA-LIST)| |(READER SLOT-DEFINITION)| +++ |(SETF METHOD-GENERIC-FUNCTION)| LEGAL-SPECIALIZERS-P +++ |(WRITER PRETTY-ARGLIST)| |SETF PCL OBJECT-PLIST| +++ |(WRITER DEFSTRUCT-FORM)| |(READER FUNCTION)| +++ |(READER GENERIC-FUNCTION)| |(READER LAMBDA-LIST)| +++ |(READER SLOT-DEFINITION)| ++ |PCL::CLASS-PROTOTYPE-SPECIALIZER class predicate| ++ |SETF PCL SLOT-DEFINITION-INITFORM| ++ |SETF PCL CLASS-DEFSTRUCT-FORM| ++@@ -1245,16 +1273,17 @@ ++ |SETF PCL SLOT-DEFINITION-ALLOCATION| ++ |SETF PCL SLOT-DEFINITION-INITFUNCTION| ++ |(WRITER SLOT-NAME)| |(BOUNDP NAME)| ++- |(READER FAST-FUNCTION)| |(WRITER ALLOCATION)| +++ |(WRITER ALLOCATION)| |(READER FAST-FUNCTION)| ++ |(READER METHOD-CLASS)| |(SETF OBJECT-PLIST)| ++ |(READER INTERNAL-WRITER-FUNCTION)| ++ |(READER INTERNAL-READER-FUNCTION)| ++ |(READER METHOD-COMBINATION)| ++ METHOD-COMBINATION-OPTIONS |(READER DIRECT-SLOTS)| ++ |(READER DIRECT-METHODS)| ++- |SETF PCL SLOT-DEFINITION-READERS| |(WRITER FUNCTION)| ++- |(WRITER GENERIC-FUNCTION)| |(READER BOUNDP-FUNCTION)| ++- |SETF PCL DOCUMENTATION| |(READER DIRECT-SUBCLASSES)| +++ |SETF PCL SLOT-DEFINITION-READERS| +++ |(READER BOUNDP-FUNCTION)| |(WRITER FUNCTION)| +++ |(WRITER GENERIC-FUNCTION)| |SETF PCL DOCUMENTATION| +++ |(READER DIRECT-SUBCLASSES)| ++ |(READER DIRECT-SUPERCLASSES)| |(WRITER LAMBDA-LIST)| ++ FUNCALLABLE-STANDARD-CLASS-P ++ |(FAST-WRITER-METHOD SLOT-OBJECT METHOD)| ++@@ -1265,7 +1294,7 @@ ++ |SETF PCL SLOT-VALUE-USING-CLASS| ++ |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)| ++ |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)| ++- |(WRITER PROTOTYPE)| |(BOUNDP TYPE)| |(BOUNDP OBJECT)| +++ |(WRITER PROTOTYPE)| |(BOUNDP OBJECT)| |(BOUNDP TYPE)| ++ CLASS-CAN-PRECEDE-LIST |SETF PCL CLASS-DIRECT-SLOTS| ++ |SETF PCL CLASS-SLOTS| SLOT-ACCESSOR-FUNCTION ++ |(BOUNDP PLIST)| ++@@ -1280,11 +1309,11 @@ ++ |(FAST-WRITER-METHOD SLOT-OBJECT ARG-INFO)| ++ |PCL::PLIST-MIXIN class predicate| ++ |(WRITER FAST-FUNCTION)| |(WRITER METHOD-CLASS)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT WRAPPER)| GET-METHOD +++ |(FAST-WRITER-METHOD SLOT-OBJECT WRAPPER)| ++ |(WRITER INTERNAL-WRITER-FUNCTION)| ++ |(WRITER INTERNAL-READER-FUNCTION)| ++- |(WRITER METHOD-COMBINATION)| |(WRITER DIRECT-SLOTS)| ++- |(WRITER DIRECT-METHODS)| +++ |(WRITER METHOD-COMBINATION)| GET-METHOD +++ |(WRITER DIRECT-SLOTS)| |(WRITER DIRECT-METHODS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT INITARGS)| ++ |(FAST-WRITER-METHOD SLOT-DEFINITION INITARGS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT OPERATOR)| ++@@ -1354,18 +1383,18 @@ ++ |(FAST-READER-METHOD SLOT-DEFINITION READERS)| ++ |(FAST-READER-METHOD SLOT-OBJECT SPECIALIZERS)| ++ |(FAST-READER-METHOD STANDARD-METHOD SPECIALIZERS)| +++ |(FAST-READER-METHOD SHORT-METHOD-COMBINATION IDENTITY-WITH-ONE-ARGUMENT)| +++ |(FAST-READER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| ++ |(FAST-READER-METHOD SPECIALIZER TYPE)| ++ |(FAST-READER-METHOD SLOT-OBJECT PROTOTYPE)| ++ |(FAST-READER-METHOD PCL-CLASS PROTOTYPE)| ++- |(FAST-READER-METHOD SLOT-DEFINITION TYPE)| ++- |(FAST-READER-METHOD SLOT-OBJECT TYPE)| ++- |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION TYPE)| ++- |(FAST-READER-METHOD SHORT-METHOD-COMBINATION IDENTITY-WITH-ONE-ARGUMENT)| ++- |(FAST-READER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| ++ |(FAST-READER-METHOD CLASS-EQ-SPECIALIZER OBJECT)| ++ |(FAST-READER-METHOD CLASS-PROTOTYPE-SPECIALIZER OBJECT)| ++ |(FAST-READER-METHOD SLOT-OBJECT OBJECT)| ++ |(FAST-READER-METHOD EQL-SPECIALIZER OBJECT)| +++ |(FAST-READER-METHOD SLOT-DEFINITION TYPE)| +++ |(FAST-READER-METHOD SLOT-OBJECT TYPE)| +++ |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION TYPE)| ++ |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| ++ |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)| ++ |(FAST-READER-METHOD SLOT-OBJECT INITFORM)| ++@@ -1387,11 +1416,11 @@ ++ |(FAST-READER-METHOD SLOT-CLASS SLOTS)| ++ |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SLOTS)| ++ |(FAST-READER-METHOD SLOT-CLASS DIRECT-SLOTS)| +++ |(FAST-READER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| ++ |(FAST-READER-METHOD SLOT-OBJECT METHODS)| ++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHODS)| ++ |(FAST-READER-METHOD SLOT-OBJECT OPTIONS)| ++ |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION OPTIONS)| ++- |(FAST-READER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| ++ |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)| ++ |(FAST-READER-METHOD CLASS DIRECT-SUBCLASSES)| ++ |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)| ++@@ -1429,8 +1458,8 @@ ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT READERS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT SPECIALIZERS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT PROTOTYPE)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT TYPE)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT OBJECT)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT TYPE)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT INITFORM)| ++ |(SETF SLOT-VALUE-USING-CLASS)| ++@@ -1456,10 +1485,10 @@ ++ |(SETF SLOT-DEFINITION-TYPE)| ++ |(SETF SLOT-DEFINITION-INITFORM)| ++ |(BOUNDP INITIALIZE-INFO)| ++- |(FAST-BOUNDP-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-METHODS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOTS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SLOTS)| +++ |(FAST-BOUNDP-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT METHODS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT OPTIONS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)| ++@@ -1468,94 +1497,95 @@ ++ |(BOUNDP INITARGS)| LONG-METHOD-COMBINATION-FUNCTION ++ GENERIC-FUNCTION-P ++ |PCL::SLOT-DEFINITION class predicate| |(READER NAME)| ++- |(READER CLASS)| |(FAST-METHOD SLOT-UNBOUND (T T T))| ++- |(FAST-METHOD (SETF DOCUMENTATION) (T T))| ++- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| ++- |(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| ++- |(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| ++- |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| +++ |(READER CLASS)| +++ |(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| +++ |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| +++ |(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| +++ |(FAST-METHOD DESCRIBE-OBJECT (T T))| +++ |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| +++ |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| +++ |(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| +++ |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| +++ |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| +++ |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| ++ |(FAST-METHOD REMOVE-NAMED-METHOD (T T))| +++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| +++ |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| +++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| ++- |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| ++- |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| ++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| ++- |(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| ++- |(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| ++- |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| ++- |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| +++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| +++ |(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| +++ |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| ++ |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| ++- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +++ |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| +++ |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| +++ |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| +++ |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| +++ |(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| +++ |(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| +++ |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| +++ |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| +++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| +++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| +++ |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| +++ |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| ++ |(FAST-METHOD PRINT-OBJECT (CLASS T))| ++- |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| ++ |(FAST-METHOD PRINT-OBJECT (T T))| ++- |(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++- |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| ++- |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| +++ |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +++ |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++ |(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| ++ |(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++- |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++- |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| ++- |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++- |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| ++- |(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| ++- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| ++- |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| ++- |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| ++- |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| ++- |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| ++- |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| +++ |(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| +++ |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| ++ |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| ++- |(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| ++- |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| ++- |(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| ++- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| +++ |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| ++ |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| ++- |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| ++- |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| ++- |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| ++ |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| ++- |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +++ |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| +++ |(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| +++ |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| +++ |(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| ++ |(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| ++- |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| ++- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| ++- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| ++- |(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| +++ |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| ++ |(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| ++- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| ++- |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| +++ |(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| +++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| +++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| +++ |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +++ |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| +++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| +++ |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| +++ |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| +++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| +++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| +++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| +++ |(FAST-METHOD (SETF DOCUMENTATION) (T T))| +++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| +++ |(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| +++ |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| +++ |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| +++ |(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| +++ |(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| ++ |(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| ++- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| ++- |(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| ++- |(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| ++- |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| ++- |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| +++ |(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| ++ |(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| ++- |(FAST-METHOD DESCRIBE-OBJECT (T T))| ++- |(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| ++- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| ++- |(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| ++- |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| ++- |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| ++- |(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| +++ |(FAST-METHOD SLOT-UNBOUND (T T T))| ++ |(FAST-METHOD SLOT-MISSING (T T T T))| ++- |(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| ++- LEGAL-SLOT-NAME-P |(READER TYPE)| |(READER OBJECT)| +++ |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| +++ |(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| +++ LEGAL-SLOT-NAME-P |(READER OBJECT)| |(READER TYPE)| ++ CLASS-WRAPPER |(READER PLIST)| ++ |(FAST-METHOD CLASS-PREDICATE-NAME (T))| ++ |(FAST-METHOD DOCUMENTATION (T))| ++ |(FAST-METHOD NO-APPLICABLE-METHOD (T))| ++ |(READER SLOTS)| |(WRITER NAME)| DEFINITION-SOURCE ++ |PCL::SLOT-OBJECT class predicate| DEFAULT-INITARGS ++- |(WRITER CLASS)| CLASS-SLOT-VALUE |(WRITER TYPE)| ++- |(WRITER OBJECT)| +++ |(WRITER CLASS)| CLASS-SLOT-VALUE |(WRITER OBJECT)| +++ |(WRITER TYPE)| ++ |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| ++ |(WRITER PLIST)| |(WRITER SLOTS)| ++ |PCL::DOCUMENTATION-MIXIN class predicate| ++@@ -1595,10 +1625,10 @@ ++ |COMMON-LISP::STANDARD-OBJECT class predicate| ++ |COMMON-LISP::BUILT-IN-CLASS class predicate| ++ |SETF PCL CLASS-SLOT-VALUE| |(SETF CLASS-SLOTS)| ++- |(SETF CLASS-DIRECT-SLOTS)| DO-STANDARD-DEFSETF-1 ++- |(READER OPERATOR)| |(CALL REAL-GET-METHOD)| ++- |(CALL REAL-REMOVE-METHOD)| |(CALL REAL-ADD-METHOD)| ++- |(READER ARG-INFO)| METHOD-COMBINATION-TYPE +++ |(SETF CLASS-DIRECT-SLOTS)| |(READER OPERATOR)| +++ |(CALL REAL-GET-METHOD)| |(CALL REAL-REMOVE-METHOD)| +++ |(CALL REAL-ADD-METHOD)| |(READER ARG-INFO)| +++ METHOD-COMBINATION-TYPE ++ |(READER DEFSTRUCT-CONSTRUCTOR)| ++ |(INTERNAL-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)| ++ |(READER INITIALIZE-INFO)| |(WRITER WRAPPER)| ++@@ -1607,8 +1637,8 @@ ++ |(WRITER DEFSTRUCT-ACCESSOR-SYMBOL)| ++ COMPUTE-SLOT-ACCESSOR-INFO |(READER INITARGS)| ++ |(WRITER CLASS-EQ-SPECIALIZER)| ++- STANDARD-BOUNDP-METHOD-P FDEFINE-CAREFULLY ++- |(SETF DOCUMENTATION)| RAW-INSTANCE-ALLOCATOR +++ STANDARD-BOUNDP-METHOD-P |(SETF DOCUMENTATION)| +++ RAW-INSTANCE-ALLOCATOR ++ |SETF PCL SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL| ++ |SETF PCL CLASS-INITIALIZE-INFO| |(WRITER OPERATOR)| ++ |(WRITER ARG-INFO)| ++@@ -1621,8 +1651,9 @@ ++ METHOD-COMBINATION-DOCUMENTATION ++ |SETF PCL SLOT-DEFINITION-INITARGS| ++ REMOVE-BOUNDP-METHOD ADD-NAMED-METHOD +++ |(WRITER INITARGS)| ++ |SETF PCL CLASS-DEFSTRUCT-CONSTRUCTOR| ++- |(WRITER INITARGS)| |(BOUNDP METHOD)| +++ |(BOUNDP METHOD)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT PREDICATE-NAME)| ++ |(FAST-WRITER-METHOD CLASS NAME)| ++ |(FAST-WRITER-METHOD SLOT-DEFINITION NAME)| ++@@ -1668,11 +1699,11 @@ ++ |(FAST-WRITER-METHOD SLOT-OBJECT READERS)| ++ |(FAST-WRITER-METHOD SLOT-DEFINITION READERS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT SPECIALIZERS)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT PROTOTYPE)| +++ |(FAST-WRITER-METHOD SLOT-OBJECT OBJECT)| ++ |(FAST-WRITER-METHOD SLOT-DEFINITION TYPE)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT TYPE)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| ++- |(FAST-WRITER-METHOD SLOT-OBJECT OBJECT)| ++ REMOVE-NAMED-METHOD ++ |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| ++ |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)| ++@@ -1725,6 +1756,5 @@ ++ ENSURE-CLASS-USING-CLASS NO-APPLICABLE-METHOD ++ SLOT-DEFINITION-WRITERS ++ COMPUTE-APPLICABLE-METHODS-USING-CLASSES ++- CLASS-PRECEDENCE-LIST DISASSEMBLE DESCRIBE-OBJECT ++- COMPILE)) ++- (SETF (GET V 'SYSTEM::PROCLAIMED-CLOSURE) T)) +++ CLASS-PRECEDENCE-LIST DESCRIBE-OBJECT)) +++ (SETF (GET V 'COMPILER::PROCLAIMED-CLOSURE) T)) diff --cc debian/patches/real_list_order.12 index 00000000,00000000..9da00c36 new file mode 100644 --- /dev/null +++ b/debian/patches/real_list_order.12 @@@ -1,0 -1,0 +1,159 @@@ ++Description: ++ TODO: Put a short summary on the line above and replace this paragraph ++ with a longer explanation of this change. Complete the meta-information ++ with other relevant fields (see below for details). To make it easier, the ++ information below has been extracted from the changelog. Adjust it or drop ++ it. ++ . ++ gcl (2.6.12-56) unstable; urgency=medium ++ . ++ * list_order.12 ++Author: Camm Maguire ++ ++--- ++The information above should follow the Patch Tagging Guidelines, please ++checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here ++are templates for supplementary fields that you might want to add: ++ ++Origin: , ++Bug: ++Bug-Debian: https://bugs.debian.org/ ++Bug-Ubuntu: https://launchpad.net/bugs/ ++Forwarded: ++Reviewed-By: ++Last-Update: 2017-08-25 ++ ++--- gcl-2.6.12.orig/o/print.d +++++ gcl-2.6.12/o/print.d ++@@ -702,18 +702,18 @@ print_symbol_name_body(object x) { ++ #define FOUND -1 ++ ++ static int ++-write_sharp_eq(object *vp,bool dot) { +++do_write_sharp_eq(object x,bool dot) { ++ ++- bool defined=vp[1]!=Cnil; +++ bool defined=x->c.c_cdr!=Cnil; ++ ++ if (dot) { ++ write_str(" . "); ++ if (!defined) return FOUND; ++ } ++ ++- vp[1]=Ct; +++ x->c.c_cdr=Ct; ++ write_ch('#'); ++- write_decimal((vp-PRINTvs_top)/2); +++ write_decimal(fix(x->c.c_car)); ++ write_ch(defined ? '#' : '='); ++ ++ return defined ? DONE : FOUND; ++@@ -721,15 +721,12 @@ write_sharp_eq(object *vp,bool dot) { ++ } ++ ++ static int ++-write_sharp_eqs(object x,bool dot) { +++write_sharp_eq(object x,bool dot) { ++ ++- object *vp; +++ struct htent *e; ++ ++- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) ++- if (x == *vp) ++- return write_sharp_eq(vp,dot); ++- ++- return 0; +++ return PRINTvs_top[0]!=Cnil && (e=gethash(x,PRINTvs_top[0]))->hte_key!=OBJNULL ? +++ do_write_sharp_eq(e->hte_value,dot) : 0; ++ ++ } ++ ++@@ -916,7 +913,7 @@ int level; ++ if (PRINTescape) { ++ if (x->s.s_hpack == Cnil) { ++ if (PRINTcircle) ++- if (write_sharp_eqs(x,FALSE)==DONE) return; +++ if (write_sharp_eq(x,FALSE)==DONE) return; ++ if (PRINTgensym) ++ write_str("#:"); ++ } else if (x->s.s_hpack == keyword_package) { ++@@ -952,7 +949,7 @@ int level; ++ break; ++ } ++ if (PRINTcircle) ++- if (write_sharp_eqs(x,FALSE)==DONE) return; +++ if (write_sharp_eq(x,FALSE)==DONE) return; ++ if (PRINTlevel >= 0 && level >= PRINTlevel) { ++ write_ch('#'); ++ break; ++@@ -1028,7 +1025,7 @@ int level; ++ break; ++ } ++ if (PRINTcircle) ++- if (write_sharp_eqs(x,FALSE)==DONE) return; +++ if (write_sharp_eq(x,FALSE)==DONE) return; ++ if (PRINTlevel >= 0 && level >= PRINTlevel) { ++ write_ch('#'); ++ break; ++@@ -1099,7 +1096,7 @@ int level; ++ break; ++ } ++ if (PRINTcircle) ++- if (write_sharp_eqs(x,FALSE)==DONE) return; +++ if (write_sharp_eq(x,FALSE)==DONE) return; ++ if (PRINTpretty) { ++ if (x->c.c_car == sLquote && ++ type_of(x->c.c_cdr) == t_cons && ++@@ -1146,7 +1143,7 @@ int level; ++ break; ++ } ++ if (PRINTcircle) ++- switch (write_sharp_eqs(x,TRUE)) { +++ switch (write_sharp_eq(x,TRUE)) { ++ case FOUND: ++ write_object(x, level); ++ case DONE: ++@@ -1316,7 +1313,7 @@ int level; ++ ++ case t_structure: ++ if (PRINTcircle) ++- if (write_sharp_eqs(x,FALSE)==DONE) return; +++ if (write_sharp_eq(x,FALSE)==DONE) return; ++ if (PRINTlevel >= 0 && level >= PRINTlevel) { ++ write_ch('#'); ++ break; ++@@ -1415,7 +1412,6 @@ travel_push(object x) { ++ ++ if (!travel_pushed(x)) { ++ vs_check_push(x); ++- vs_check_push(Cnil); ++ travel_pushed(x)=1; ++ } ++ ++@@ -1519,10 +1515,13 @@ travel_clear(object x) { ++ ++ } ++ +++object sLeq; ++ ++ static void ++ setupPRINTcircle(object x,int dogensyms) { ++ +++ object *xp; +++ ++ BEGIN_NO_INTERRUPT; ++ dgs=dogensyms; ++ travel_push(x); ++@@ -1531,6 +1530,12 @@ setupPRINTcircle(object x,int dogensyms) ++ travel_clear(x); ++ END_NO_INTERRUPT; ++ +++ vs_check_push(PRINTvs_limit>PRINTvs_top ? funcall_cfun(Lmake_hash_table,2,sKtest,sLeq) : Cnil); +++ for (xp=PRINTvs_top;xp, 2007. +# Copyright (C) Helge Kreutzmann , 2007, 2008. +# This file is distributed under the same license as the gcl package. +# +msgid "" +msgstr "" +"Project-Id-Version: gcl 2.6.7-36\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-01-09 11:49+0100\n" +"Last-Translator: Stefan Bauer \n" +"Language-Team: de \n" +"Language: \n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=ISO-8859-15\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" - msgstr "Verwende standardmäßig den sich in Arbeit befindlichen ANSI-Build?" ++msgstr "Verwende standardmig den sich in Arbeit befindlichen ANSI-Build?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" - "GCL ist derzeit dabei, zusätzlich zu dem noch im Einsatz befindlichen " ++"GCL ist derzeit dabei, zustzlich zu dem noch im Einsatz befindlichen " +"traditionellen CLtL1-Image ein ANSI-konformes Image bereitzustellen." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" - "Bitte lesen Sie die Datei README.Debian für eine kurze Beschreibung dieser " - "Begriffe. Die Wahl dieser Option bestimmen, welches Image standardmäßig " - "verwendet wird, wenn »gcl@EXT@« ausgeführt wird." ++"Bitte lesen Sie die Datei README.Debian fr eine kurze Beschreibung dieser " ++"Begriffe. Die Wahl dieser Option bestimmen, welches Image standardmig " ++"verwendet wird, wenn gcl@EXT@ ausgefhrt wird." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" - "Diese Einstellung kann mit der Umgebungsvariablen GCL_ANSI überschrieben " - "werden. Jede nicht-leere Zeichenkette führt zur ANSI-Erstellung, und die " - "leere Zeichenkette führt zum CLtL1-Bau, z.B. GCL_ANSI=t gcl@EXT@. In der " ++"Diese Einstellung kann mit der Umgebungsvariablen GCL_ANSI berschrieben " ++"werden. Jede nicht-leere Zeichenkette fhrt zur ANSI-Erstellung, und die " ++"leere Zeichenkette fhrt zum CLtL1-Bau, z.B. GCL_ANSI=t gcl@EXT@. In der " +"Startmeldung wird die derzeit erzwungene Bauart berichtet." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" - msgstr "Verwende standardmäßig den Profiling-Build?" ++msgstr "Verwende standardmig den Profiling-Build?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." - msgstr "GCL besitzt optionale Unterstützung für Profiling mittels Gprof." ++msgstr "GCL besitzt optionale Untersttzung fr Profiling mittels Gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" - "Bitte lesen Sie die Dokumentation für si::gprof-start und si::gprof-quit für " ++"Bitte lesen Sie die Dokumentation fr si::gprof-start und si::gprof-quit fr " +"Details. Da ein solches Programm langsamer ist als ein Programm ohne Gprof-" - "Unterstützung, wird dies für den Produktiveinsatz nicht empfohlen." ++"Untersttzung, wird dies fr den Produktiveinsatz nicht empfohlen." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Setzen Sie die Umgebungsvariable GCL_PROF auf die leere Zeichenkette, um ein " +"optimiertes Programm zu erhalten oder auf irgendeine nicht-leere " - "Zeichenkette, für Profiling-Unterstützung; z.B. GCL_PROF=t gcl@EXT@. Falls " ++"Zeichenkette, fr Profiling-Untersttzung; z.B. GCL_PROF=t gcl@EXT@. Falls " +"Profiling aktiviert ist, wird dies in der Startmeldung angezeigt." + +#~ msgid "" +#~ "GCL is in the process of providing an ANSI compliant image in addition to " +#~ "its traditional CLtL1 image still in production use. Please see the " +#~ "README.Debian file for a brief description of these terms. Setting this " +#~ "variable will determine which image you will use by default on executing " +#~ "'gcl@EXT@'. You can locally override this choice by setting the GCL_ANSI " +#~ "environment variable to any non-empty string for the ANSI build, and to " +#~ "the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The " +#~ "flavor of the build in force will be reported in the initial startup " +#~ "banner." +#~ msgstr "" - #~ "GCL arbeitet neben dem traditionellen CLtL1-Image für den " - #~ "Produktiveinsatz zusätzlich an der Bereitstellung eines kompatiblen ANSI-" - #~ "Images. Bitte beachten Sie die README.Debian-Datei für eine kurze " ++#~ "GCL arbeitet neben dem traditionellen CLtL1-Image fr den " ++#~ "Produktiveinsatz zustzlich an der Bereitstellung eines kompatiblen ANSI-" ++#~ "Images. Bitte beachten Sie die README.Debian-Datei fr eine kurze " +#~ "Beschreibung dieses Themas. Durch diese Variable definieren Sie, welches " - #~ "Image voreingestellt bei der Ausführung von »gcl@EXT@« verwendet wird. " ++#~ "Image voreingestellt bei der Ausfhrung von gcl@EXT@ verwendet wird. " +#~ "Diese Auswahl kann lokal, durch einen nicht leeren Wert in der " - #~ "Umgebungsvariable »GCL_ANSI« für den ANSI-Build, bzw. einen leeren Wert " - #~ "für den CLtL1-Build, z.B. GCL_ANSI=t gcl@EXT@ definiert werden. Es " - #~ "erfolgt eine Meldung über die aktive Erstellung im einführenden Start-" ++#~ "Umgebungsvariable GCL_ANSI fr den ANSI-Build, bzw. einen leeren Wert " ++#~ "fr den CLtL1-Build, z.B. GCL_ANSI=t gcl@EXT@ definiert werden. Es " ++#~ "erfolgt eine Meldung ber die aktive Erstellung im einfhrenden Start-" +#~ "Banner." + +#~ msgid "" +#~ "GCL now has optional support for profiling via gprof. Please see the " +#~ "documentation for si::gprof-start and si::gprof-quit for details. As this " +#~ "build is slower than builds without gprof support, it is not recommended " +#~ "for final production use. You can locally override the default choice " +#~ "made here by setting the GCL_PROF environment variable to any non-empty " +#~ "string for profiling support, and to the empty string for the more " +#~ "optimized builds, e.g. GCL_PROF=t gcl@EXT@. If profiling is enabled, " +#~ "this will be reported in the initial startup banner." +#~ msgstr "" - #~ "GCL besitzt optionale Unterstützung für Profiling mit gprof. Bitte lesen " - #~ "Sie hierzu die Dokumentation von si::gprof-start und si::gprof-quit für " - #~ "weiterführende Informationen. Da dieser Build langsamer ist als ohne " - #~ "gprof-Unterstützung, wird dieser Weg nicht für den endgültig produktiven " - #~ "Einsatz empfohlen. Sie können die hier gemachten Angaben lokal über die " - #~ "GCL_PROF-Umgebungsvariable durch einen beliebigen Wert ändern, bzw. durch " - #~ "einen leeren Wert für das weitaus anpassungsfähigere Build, z.B. " ++#~ "GCL besitzt optionale Untersttzung fr Profiling mit gprof. Bitte lesen " ++#~ "Sie hierzu die Dokumentation von si::gprof-start und si::gprof-quit fr " ++#~ "weiterfhrende Informationen. Da dieser Build langsamer ist als ohne " ++#~ "gprof-Untersttzung, wird dieser Weg nicht fr den endgltig produktiven " ++#~ "Einsatz empfohlen. Sie knnen die hier gemachten Angaben lokal ber die " ++#~ "GCL_PROF-Umgebungsvariable durch einen beliebigen Wert ndern, bzw. durch " ++#~ "einen leeren Wert fr das weitaus anpassungsfhigere Build, z.B. " +#~ "GCL_PROF=t gcl@EXT@. Falls Profiling aktiviert ist, erfolgt eine Meldung " - #~ "im einführenden Start-Banner." ++#~ "im einfhrenden Start-Banner." diff --cc debian/po/fr.po index b21eac88,00000000..0a513f44 mode 100644,000000..100644 --- a/debian/po/fr.po +++ b/debian/po/fr.po @@@ -1,141 -1,0 +1,141 @@@ +# Translation of gcl debconf templates to French +# Copyright (C) 2007 Sylvain Archenault +# This file is distributed under the same license as the iodine package. +# +# Sylvain Archenault , 2007. +msgid "" +msgstr "" +"Project-Id-Version: gcl 2.6.7-1\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2007-12-23 13:03+0100\n" +"Last-Translator: Sylvain Archenault \n" +"Language-Team: French \n" +"Language: fr\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=ISO-8859-15\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" - msgstr "Faut-il utiliser la compilation ANSI par défaut ?" ++msgstr "Faut-il utiliser la compilation ANSI par dfaut?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL est en passe de fournir une image respectant la norme ANSI en plus de " - "l'image traditionnelle CLtL1, toujours utilisée en production." ++"l'image traditionnelle CLtL1, toujours utilise en production." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" - "Veuillez lire le fichier README.Debian pour une brève description de ces " - "termes. Le choix de cette option déterminera quelle image sera utilisée par " - "défaut en exécutant « gcl@EXT@ »." ++"Veuillez lire le fichier README.Debian pour une brve description de ces " ++"termes. Le choix de cette option dterminera quelle image sera utilise par " ++"dfaut en excutant gcl@EXT@." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" - "Ce réglage peut être changé en affectant à la variable d'environnement " - "GCL_ANSI une chaîne non vide pour la compilation ANSI, et une chaîne vide " ++"Ce rglage peut tre chang en affectant la variable d'environnement " ++"GCL_ANSI une chane non vide pour la compilation ANSI, et une chane vide " +"pour la compilation CLtL1, par exemple GCL_ANSI=t gcl@EXT@. Le type de " - "compilation sera affiché dans le bandeau de démarrage." ++"compilation sera affich dans le bandeau de dmarrage." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" - msgstr "Faut-il utiliser le profilage par défaut ?" ++msgstr "Faut-il utiliser le profilage par dfaut?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL permet optionnellement la gestion du profilage via gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" - "Veuillez vous reporter à la documentation de « si::gprof-start » et « si::" - "gprof-quit » pour plus de détails. Comme cet exécutable est plus lent que " - "les exécutables sans la gestion de gprof, il n'est pas recommandé de " ++"Veuillez vous reporter la documentation de si::gprof-start et si::" ++"gprof-quit pour plus de dtails. Comme cet excutable est plus lent que " ++"les excutables sans la gestion de gprof, il n'est pas recommand de " +"l'utiliser en production." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" - "Veuillez affecter une chaîne vide à la variable d'environnement GCL_PROF " - "pour des compilations optimisées, ou une chaîne non vide pour avoir la " ++"Veuillez affecter une chane vide la variable d'environnement GCL_PROF " ++"pour des compilations optimises, ou une chane non vide pour avoir la " +"gestion du profilage; par exemple GCL_PROF=t gcl@EXT@. Si le profilage est " - "activé, cela sera affiché dans le bandeau de démarrage." ++"activ, cela sera affich dans le bandeau de dmarrage." + +#~ msgid "" +#~ "GCL is in the process of providing an ANSI compliant image in addition to " +#~ "its traditional CLtL1 image still in production use. Please see the " +#~ "README.Debian file for a brief description of these terms. Setting this " +#~ "variable will determine which image you will use by default on executing " +#~ "'gcl@EXT@'. You can locally override this choice by setting the GCL_ANSI " +#~ "environment variable to any non-empty string for the ANSI build, and to " +#~ "the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The " +#~ "flavor of the build in force will be reported in the initial startup " +#~ "banner." +#~ msgstr "" - #~ "GCL a pour but de fournir une image conforme à la définition de " ++#~ "GCL a pour but de fournir une image conforme la dfinition de " +#~ "l'ANSI en plus de son image traditionnelle CLtL1 qui est toujours " - #~ "utilisée en production. Veuillez consulter le fichier README.Debian " - #~ "pour plus d'informations sur ces normes. Ce choix déterminera quelle " - #~ "norme vous allez utiliser par défaut lors de l'exécution de " - #~ "« gcl@EXT@ ». Vous pouvez localement modifier ce choix en " - #~ "affectant une chaîne non vide à la variable d'environnement GCL_ANSI " - #~ "pour une compilation respectant la norme définie par l'ANSI, et une " - #~ "chaîne vide pour une compilation en accord avec la norme CLtL1, par " - #~ "exemple GCL_ANSI=t gcl@EXT@. Le type de compilation sera affiché dans " - #~ "le bandeau de démarrage." ++#~ "utilise en production. Veuillez consulter le fichier README.Debian " ++#~ "pour plus d'informations sur ces normes. Ce choix dterminera quelle " ++#~ "norme vous allez utiliser par dfaut lors de l'excution de " ++#~ "gcl@EXT@. Vous pouvez localement modifier ce choix en " ++#~ "affectant une chane non vide la variable d'environnement GCL_ANSI " ++#~ "pour une compilation respectant la norme dfinie par l'ANSI, et une " ++#~ "chane vide pour une compilation en accord avec la norme CLtL1, par " ++#~ "exemple GCL_ANSI=t gcl@EXT@. Le type de compilation sera affich dans " ++#~ "le bandeau de dmarrage." + +#~ msgid "" +#~ "GCL now has optional support for profiling via gprof. Please see the " +#~ "documentation for si::gprof-start and si::gprof-quit for details. As this " +#~ "build is slower than builds without gprof support, it is not recommended " +#~ "for final production use. You can locally override the default choice " +#~ "made here by setting the GCL_PROF environment variable to any non-empty " +#~ "string for profiling support, and to the empty string for the more " +#~ "optimized builds, e.g. GCL_PROF=t gcl@EXT@. If profiling is enabled, " +#~ "this will be reported in the initial startup banner." +#~ msgstr "" - #~ "GCL gÚre désormais le profilage via gprof. Veuillez consulter la " ++#~ "GCL gre dsormais le profilage via gprof. Veuillez consulter la " +#~ "documentation de si::gprof-start et de si::gprof-quit pour plus " +#~ "d'informations. La construction produite avec cette option est plus lente " - #~ "que la construction classique. Par conséquent il n'est pas recommandé " ++#~ "que la construction classique. Par consquent il n'est pas recommand " +#~ "de l'utiliser en production. Vous pouvez localement modifier ce choix en " - #~ "affectant à la variable d'environnement GCL_PROF, une chaîne non vide " - #~ "pour activer le profilage, ou une chaîne vide pour une compilation " - #~ "optimisée, par exemple GCL_PROF=t gcl@EXT@. Si le profilage est " - #~ "activé, cela sera affiché dans le bandeau de démarrage." ++#~ "affectant la variable d'environnement GCL_PROF, une chane non vide " ++#~ "pour activer le profilage, ou une chane vide pour une compilation " ++#~ "optimise, par exemple GCL_PROF=t gcl@EXT@. Si le profilage est " ++#~ "activ, cela sera affich dans le bandeau de dmarrage." diff --cc debian/po/pt_BR.po index 00000000,00000000..74f2f037 new file mode 100644 --- /dev/null +++ b/debian/po/pt_BR.po @@@ -1,0 -1,0 +1,98 @@@ ++# Debconf translations for gcl. ++# Copyright (C) 2016 THE gcl'S COPYRIGHT HOLDER ++# This file is distributed under the same license as the gcl package. ++# Adriano Rafael Gomes , 2016. ++# ++msgid "" ++msgstr "" ++"Project-Id-Version: gcl\n" ++"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" ++"POT-Creation-Date: 2012-12-30 11:53-0400\n" ++"PO-Revision-Date: 2016-01-05 11:09-0200\n" ++"Last-Translator: Adriano Rafael Gomes \n" ++"Language-Team: Brazilian Portuguese \n" ++"Language: pt_BR\n" ++"MIME-Version: 1.0\n" ++"Content-Type: text/plain; charset=UTF-8\n" ++"Content-Transfer-Encoding: 8bit\n" ++ ++#. Type: boolean ++#. Description ++#: ../gcl.templates:2001 ++msgid "Use the work-in-progress ANSI build by default?" ++msgstr "Usar a versão ANSI em desenvolvimento por padrão?" ++ ++#. Type: boolean ++#. Description ++#: ../gcl.templates:2001 ++msgid "" ++"GCL is in the process of providing an ANSI compliant image in addition to " ++"its traditional CLtL1 image still in production use." ++msgstr "" ++"O GCL está em processo de fornecer uma imagem de acordo com o padrão ANSI em " ++"adição à sua imagem CLtL1 tradicional, ainda em uso em produção." ++ ++#. Type: boolean ++#. Description ++#: ../gcl.templates:2001 ++msgid "" ++"Please see the README.Debian file for a brief description of these terms. " ++"Choosing this option will determine which image will be used by default when " ++"executing 'gcl@EXT@'." ++msgstr "" ++"Por favor, veja o arquivo README.Debian para uma breve descrição desses " ++"termos. Escolher essa opção determinará qual imagem será usada por padrão ao " ++"executar \"gcl@EXT@\"." ++ ++#. Type: boolean ++#. Description ++#: ../gcl.templates:2001 ++msgid "" ++"This setting may be overridden by setting the GCL_ANSI environment variable " ++"to any non-empty string for the ANSI build, and to the empty string for the " ++"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " ++"will be reported in the initial startup banner." ++msgstr "" ++"Essa configuração pode ser sobreposta definindo a variável de ambiente " ++"GCL_ANSI para qualquer texto não vazio para a versão ANSI, e para um texto " ++"vazio para a versão CLtL1, por exemplo, GCL_ANSI=t gcl@EXT@. O sabor da " ++"versão atualmente definida será exibida na mensagem de inicialização." ++ ++#. Type: boolean ++#. Description ++#: ../gcl.templates:3001 ++msgid "Use the profiling build by default?" ++msgstr "Usar a versão de \"profiling\" por padrão?" ++ ++#. Type: boolean ++#. Description ++#: ../gcl.templates:3001 ++msgid "GCL has optional support for profiling via gprof." ++msgstr "O GCL tem suporte opcional a \"profiling\" via gprof." ++ ++#. Type: boolean ++#. Description ++#: ../gcl.templates:3001 ++msgid "" ++"Please see the documentation for si::gprof-start and si::gprof-quit for " ++"details. As this build is slower than builds without gprof support, it is " ++"not recommended for final production use." ++msgstr "" ++"Por favor, veja a documentação para si::gprof-start e si::gprof-quit para " ++"detalhes. Como essa versão é mais lenta que versões sem suporte a gprof, ela " ++"não é recomendada para uso final em produção." ++ ++#. Type: boolean ++#. Description ++#: ../gcl.templates:3001 ++msgid "" ++"Set the GCL_PROF environment variable to the empty string for more optimized " ++"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " ++"gcl@EXT@. If profiling is enabled, this will be reported in the initial " ++"startup banner." ++msgstr "" ++"Defina a variável de ambiente GCL_PROF para um texto vazio para versões mais " ++"otimizadas, ou para qualquer texto não vazio para ter suporte a \"profiling" ++"\"; por exemplo, GCL_PROF=t gcl@EXT@. Se o \"profiling\" estiver habilitado, " ++"isso será exibido na mensagem de inicialização." diff --cc debian/po/sv.po index 6a3a93f3,00000000..9545624a mode 100644,000000..100644 --- a/debian/po/sv.po +++ b/debian/po/sv.po @@@ -1,106 -1,0 +1,106 @@@ +# translation of gcl_2.6.7-36.1_sv.po to Swedish +# Translators, if you are not familiar with the PO format, gettext +# documentation is worth reading, especially sections dedicated to +# this format, e.g. by running: +# info -n '(gettext)PO Files' +# info -n '(gettext)Header Entry' +# Some information specific to po-debconf are available at +# /usr/share/doc/po-debconf/README-trans +# or http://www.debian.org/intl/l10n/po-debconf/README-trans +# Developers do not need to manually edit POT or PO files. +# - # Martin Ågren , 2008. ++# Martin gren , 2008. +msgid "" +msgstr "" +"Project-Id-Version: gcl_2.6.7-36.1_sv\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-07-24 18:21+0200\n" - "Last-Translator: Martin Ågren \n" ++"Last-Translator: Martin gren \n" +"Language-Team: Swedish \n" +"Language: sv\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=ISO-8859-1\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Generator: KBabel 1.11.4\n" +"Plural-Forms: nplurals=2; plural=(n != 1);\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" - msgstr "Använd det ännu inte färdiga ANSI-bygget som standard?" ++msgstr "Anvnd det nnu inte frdiga ANSI-bygget som standard?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" - "GCL arbetar på att tillhandahålla en ANSI-godkänd bild förutom dess " - "traditionella CLtL1-bild som fortfarande används i produktionsmiljön." ++"GCL arbetar p att tillhandahlla en ANSI-godknd bild frutom dess " ++"traditionella CLtL1-bild som fortfarande anvnds i produktionsmiljn." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" - "Se README.Debian-filen för en översiktlig beskrivning av dessa termer. När " - "du väljer det här alternativet avgörs vilken bild som kommer användas som " - "standard när 'gcl@EXT@' körs." ++"Se README.Debian-filen fr en versiktlig beskrivning av dessa termer. Nr " ++"du vljer det hr alternativet avgrs vilken bild som kommer anvndas som " ++"standard nr 'gcl@EXT@' krs." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" - "Denna inställning kan överskridas genom att sätta miljövariabeln GCL_ANSI " - "till en icke-tom sträng för ANSI-bygget, och till den tomma strängen för " - "CLtL1-bygget, t. ex. GCL_ANSI=t gcl@EXT@. Det bygge som för tillfället " - "används kommer anges i uppstartsutskriften." ++"Denna instllning kan verskridas genom att stta miljvariabeln GCL_ANSI " ++"till en icke-tom strng fr ANSI-bygget, och till den tomma strngen fr " ++"CLtL1-bygget, t. ex. GCL_ANSI=t gcl@EXT@. Det bygge som fr tillfllet " ++"anvnds kommer anges i uppstartsutskriften." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" - msgstr "Använd profileringsbygget som standard?" ++msgstr "Anvnd profileringsbygget som standard?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." - msgstr "GCL har valfritt stöd för profilering via gprof." ++msgstr "GCL har valfritt std fr profilering via gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" - "Se dokumentationen för si::gprof-start och si::gprof-quit för detaljer. " - "Eftersom detta bygge är långsammare än byggen utan stöd för gprof, " - "rekommenderas det inte för slutlig användning i produktionsmiljö." ++"Se dokumentationen fr si::gprof-start och si::gprof-quit fr detaljer. " ++"Eftersom detta bygge r lngsammare n byggen utan std fr gprof, " ++"rekommenderas det inte fr slutlig anvndning i produktionsmilj." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" - "Sätt miljövariabeln GCL_PROF till den tomma strängen för mer optimiserade " - "byggen, eller en icke-tom sträng för profileringsstöd; t. ex. GCL_PROF=t " - "gcl@EXT@. Om profilering är aktiverad, kommer denna rapporteras i den " ++"Stt miljvariabeln GCL_PROF till den tomma strngen fr mer optimiserade " ++"byggen, eller en icke-tom strng fr profileringsstd; t. ex. GCL_PROF=t " ++"gcl@EXT@. Om profilering r aktiverad, kommer denna rapporteras i den " +"ursprungliga uppstartsutskriften." diff --cc debian/rules index 0697af40,00000000..2de2887e mode 100755,000000..100755 --- a/debian/rules +++ b/debian/rules @@@ -1,268 -1,0 +1,271 @@@ +#!/usr/bin/make -f +# Sample debian/rules that uses debhelper. +# GNU copyright 1997 by Joey Hess. +# +# This version is for a hypothetical package that builds an +# architecture-dependant package, as well as an architecture-independent +# package. + +# Uncomment this to turn on verbose mode. +#export DH_VERBOSE=1 + ++export GCL_MEM_MULTIPLE=0.1 ++ +# This is the debhelper compatability version to use. +ARCHT:=$(shell dpkg-architecture -qDEB_HOST_ARCH) + - MCC:=gcc ++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/* + - [ "$*" != "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 \ ++ [ "$*" != "trad" ] || FLAGS="--disable-ansi" ; \ ++ [ "$*" != "gprof" ] || FLAGS="--disable-ansi --enable-gprof" ; \ ++ [ "$*" != "ansi-gprof" ] || FLAGS="--enable-gprof" ; \ ++ eval `dpkg-buildflags --export=sh` && CC=$(MCC) ./configure \ + --host=$$(dpkg-architecture -qDEB_HOST_GNU_TYPE) \ + --disable-statsysbfd \ + --disable-custreloc \ + --disable-dlopen \ + --enable-prelink \ + --enable-$(RELOC) \ + $(GMP) \ + $(DEBUG) \ + $$FLAGS \ + --prefix=/usr \ + --mandir=\$${prefix}/share/man \ + --enable-infodir=\$${prefix}/share/info \ + --enable-emacsdir=\$${prefix}/share/emacs/site-lisp + + touch $@ + + +build-%-stamp: configure-%-stamp + dh_testdir + + $(MAKE) + + rm -rf debian/$* + mkdir -p debian/$* + $(MAKE) install DESTDIR=$$(pwd)/debian/$* + [ "$(findstring gprof,$*)" = "" ] || (\ + tmp=debian/$*; old=/usr/lib/gcl-$(VERS); new=$$old-prof;\ + if [ "$(findstring ansi,$*)" = "" ] ; then i=saved_gcl ; else i=saved_ansi_gcl ; fi;\ + mv $$tmp/$$old $$tmp/$$new ;\ - echo "(reset-sys-paths \"$$new/\")(si::save-system \"debian/tmp-image\")" | $$tmp/$$new/unixport/$$i &&\ ++ echo "(si::reset-sys-paths \"$$new/\")(si::save-system \"debian/tmp-image\")" | $$tmp/$$new/unixport/$$i &&\ + mv debian/tmp-image $$tmp/$$new/unixport/$$i;) + + touch $@ + +bclean-stamp: + $(MAKE) clean + touch $@ + +ansi-tests/test_results: build-ansi-stamp + $(MAKE) $@ + +build: build-arch build-indep +build-arch: build-stamp +build-indep: build-stamp +build-stamp: build-gprof-stamp build-ansi-gprof-stamp build-trad-stamp build-ansi-stamp ansi-tests/test_results + touch $@ + +debian/control.rm: + rm -f `echo $@ | sed 's,\.rm$$,,1'` + +debian/control: debian/control.rm + cp debian/control.$(EXT) debian/control + +clean: debian/control debian/gcl.templates + dh_testdir + dh_testroot + rm -f *stamp + debconf-updatepo + + $(MAKE) clean + + dh_clean + rm -rf debian/gprof debian/ansi-gprof debian/trad debian/ansi $(INS) debian/substvars debian.upstream + rm -rf *stamp + for i in $(CFGS) ; do ! [ -e $$i ] || mv $$i $${i%.ori} ; done + +INS:=$(shell for i in debian/in.* ; do echo $$i | sed 's,in.,,1' ; done |sed "s,gcl,gcl$(EXT),g") + +$(INS): debian/gcl$(EXT)% : debian/in.gcl% + cat $< | sed 's,@EXT@,$(EXT),g' >$@ + +install: install-stamp +install-stamp: build-stamp debian/control $(INS) + dh_testdir + dh_testroot - dh_clean -k ++# dh_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_strip -a -Xlibgcl -Xlibansi_gcl ++# -Xgcl-$(VERS)-prof/unixport/saved_gcl -Xgcl-$(VERS)-prof/unixport/saved_ansi_gcl + dh_lintian -a + dh_link -a + dh_compress -a + dh_fixperms -a + dh_installdeb -a + dh_shlibdeps -a + dh_gencontrol -a -u"-Vgcc=$(MCC)" + dh_md5sums -a + dh_builddeb -a + +binary: binary-indep binary-arch +.PHONY: build clean binary-indep binary-arch binary install configure +.PRECIOUS: configure-trad-stamp configure-ansi-stamp configure-gprof-stamp configure-ansi-gprof-stamp diff --cc debian/source/include-binaries index 0fe30092,00000000..f95b9a3e mode 100644,000000..100644 --- a/debian/source/include-binaries +++ b/debian/source/include-binaries @@@ -1,3 -1,0 +1,4 @@@ +info/gcl-si.pdf +info/gcl-tk.pdf +xgcl-2/dwdoc.pdf ++unixport/ff